Related
I would like to implement a sort function in Haskell with these two functions:
smallest :: (Ord a) => [a] -> a
smallest [] = error "empty list"
smallest [x] = x
smallest (x:xs)
| x < smallest xs = x
| otherwise = smallest xs
insert :: Int -> [Int] -> [Int]
insert x [] = [x]
insert x (y:ys)
| x <= y = x:y:ys
| otherwise = y:insert x ys
My idea is to insert the smallest value at the right position with a recursion but as I am new to Haskell I got some problems on how to implement that.
smallest (x:xs)
| x < smallest xs = x
| otherwise = smallest xs
duplicates the number of smallest queries at each point in the list, blowing up exponentially. Instead:
smallest (x:xs) = min x (smallest xs)
, or even just smallest = minimum. Here are a few sorts I can see with your functions or similar ones:
insertionSort [] = []
insertionSort (x:xs) = insert x (insertionSort xs)
This one will need smallest to give back the remaining list as well:
selectSmallest :: [Int] -> (Int, [Int])
selectSmallest (x:xs) = let (y, ys) = smallest xs in if x < y
then (x, xs)
else (y, x:ys)
selectionSorta [] = []
selectionSorta xs = let (y, ys) = smallest xs in
y : selectionSorta ys
I am writing a code for the permutation with repetition for n elements drawn from choice of k values. So the cardinality of my resulting set should have k^n elements. In Haskell, it is fairly easy. For example, one can just write:
import Control.Monad (replicateM)
main = mapM_ print (replicateM 2 [1,2,3])
then you will get a list as:
[1,1] [1,2] [1,3] [2,1] [2,2] [2,3] [3,1] [3,2] [3,3]
But on Standard ML, I don't know how to do.
I tried this:
fun combs_with_rep (k,xxs) =
case (k, xxs) of (0,_) => [[]]
|(_, []) => []
|(k, x::xs) =>List.map (fn ys => x::ys) (combs_with_rep((k-1),xxs))# combs_with_rep(k,xs)
But the list is not complete and I don't know why....
Is there an analog coding as the one in Haskell that does the same thing? Or how should I fix my sml code?
Any help is appreciated!
Just transform the monadic code:
rep_comb n xs -- n times choose 1 elem from xs, repetition allowed
= replicateM n xs
= sequence $ replicate n xs
= foldr k (return []) $ replicate n xs
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
= case n of 0 -> [[]] ;
_ -> k xs (rep_comb (n-1) xs)
where
k m m' = m >>= (\x->
m' >>= (\xs -> return (x:xs) ))
= case n of 0 -> [[]] ;
_ -> xs >>= (\y->
rep_comb (n-1) xs >>= (\ys -> [y:ys]))
-- i.e.
= case n of 0 -> [[]] ;
_ -> [y:ys | y<- xs, ys<- rep_comb (n-1) xs]
= case n of 0 -> [[]] ;
_ -> concatMap (\y-> map (y:) (rep_comb (n-1) xs)) xs
-- or, in a different order
= case n of 0 -> [[]] ;
_ -> [y:ys | ys<- rep_comb (n-1) xs, y<- xs]
= case n of 0 -> [[]] ;
_ -> concatMap (\ys-> map (:ys) xs) (rep_comb (n-1) xs)
Now you can translate this to ML.
In haskell, how can I generate a balanced partition of a set?
Assuming I have a set {1,3,4,6,9}, a balanced partition of that set would be s1{9,3} and s2{6,4,1}, seeing as s1-s2 is 1.
Well, for brute force, we can generate all partitions recursively by generating partitions for the tail and then putting the head on the left list or the right:
partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
[(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]
have a way to compute the unbalance:
unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)
and then put it all together:
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions
Here's the complete module:
module Balance where
import Data.List(minimumBy)
import Data.Ord(comparing)
partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
[(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]
unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions
Here's a solution that does a little better:
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = snd . head . partitionsByBadness . sort
where
-- recursively builds a list of possible partitionings and their badness
-- sorted by their (increasing) badness
partitionsByBadness [] = [(0, ([], []))]
partitionsByBadness (x:xs) = let res = partitionsByBadness xs
withX = map ( (+x) *** first (x:)) res
sansX = map (subtract x *** second (x:)) res
in merge withX $ normalize sansX
-- When items are added to the second list, the difference between the sums
-- decreases - and might become negative
-- We take those cases and swap the lists, so that the first list has always
-- a greater sum and the difference is always positive
-- So that we can sort the list again (with linear complexity)
normalize xs = let (neg, pos) = span ((<0) . fst) xs
in merge pos $ reverse $ map (negate *** swap) neg
-- merge two sorted lists (as known from mergesort, but
-- omits "duplicates" with same badness)
merge :: Ord k => [(k, v)] -> [(k, v)] -> [(k, v)]
merge [] zss = zss
merge yss [] = yss
merge yss#(y:ys) zss#(z:zs) = case comparing fst y z of
LT -> y : merge ys zss
EQ -> merge ys zss
GT -> z : merge yss zs
Bin packing works pretty well:
% stack ghci --package Binpack
λ: import Data.BinPack
λ: let bins numberOfBins items = let totalSize = sum items; binSize = succ (totalSize `div` (max 1 numberOfBins)) in binpack WorstFit Decreasing id (replicate numberOfBins (emptyBin binSize)) items
λ: bins 2 [1,3,4,6,9]
([(0,[3,9]),(1,[1,4,6])],[])
If you know your input will fit into the bins you can extract out the partitions:
λ: map snd . fst . bins 2 $ [1,3,4,6,9]
[[3,9],[1,4,6]]
I have two lists of unequal length. When I add both of them I want the final list to have the length of the longest list.
addtwolists [0,0,221,2121] [0,0,0,99,323,99,32,2332,23,23]
>[0,0,221,2220,323,99,32,2332,23,23]
addtwolists [945,45,4,45,22,34,2] [0,34,2,34,2]
>[945,79,6,79,24,34,2]
zerolist :: Int -> [Integer]
zerolist x = take x (repeat 0)
addtwolists :: [Integer] -> [Integer] -> [Integer]
addtwolists x y = zipWith (+) (x ++ (zerolist ((length y)-(length x)))) (y ++ (zerolist ((length x)-(length y))))
This code is inefficient. So I tried:
addtwolist :: [Integer] -> [Integer] -> [Integer]
addtwolist x y = zipWith (+) (x ++ [head (zerolist ((length y)-(length x))) | (length y) > (length x)]) (y ++ [head (zerolist ((length x)-(length y))) | (length x) > (length y)])
Any other way to increase the efficiency?Could you only check once to see which list is bigger?
Your implementation is slow because it looks like you call the length function on each list multiple times on each step of zipWith. Haskell computes list length by walking the entire list and counting the number of elements it traverses.
The first speedy method that came to my mind was explicit recursion.
addLists :: [Integer] -> [Integer] -> [Integer]
addLists xs [] = xs
addLists [] ys = ys
addLists (x:xs) (y:ys) = x + y : addLists xs ys
I'm not aware of any standard Prelude functions that would fill your exact need, but if you wanted to generalize this to a higher order function, you could do worse than this. The two new values passed to the zip function are filler used in computing the remaining portion of the long list after the short list has been exhausted.
zipWithExtend :: (a -> b -> c) -> [a] -> [b] -> a -> b -> [c]
zipWithExtend f [] [] a' b' = []
zipWithExtend f (a:as) [] a' b' = f a b' : zipWithExtend f as [] a' b'
zipWithExtend f [] (b:bs) a' b' = f a' b : zipWithExtend f [] bs a' b'
zipWithExtend f (a:as) (b:bs) a' b' = f a b : zipWithExtend f as bs a' b'
Usage:
> let as = [0,0,221,2121]
> let bs = [0,0,0,99,323,99,32,2332,23,23]
> zipWithExtend (+) as bs 0 0
[0,0,221,2220,323,99,32,2332,23,23]
This can be done in a single iteration, which should be a significant improvement for long lists. It's probably simplest with explicit recursion:
addTwoLists xs [] = xs
addTwoLists [] ys = ys
addTwoLists (x:xs) (y:ys) = x+y:addTwoLists xs ys
Just because I can't help bikeshedding, you might enjoy this function:
Prelude Data.Monoid Data.List> :t map mconcat . transpose
map mconcat . transpose :: Monoid b => [[b]] -> [b]
For example:
> map (getSum . mconcat) . transpose $ [map Sum [0..5], map Sum [10,20..100]]
[10,21,32,43,54,65,70,80,90,100]
Two suggestions:
addtwolists xs ys =
let common = zipWith (+) xs ys
len = length common
in common ++ drop len xs ++ drop len ys
addtwolists xs ys | length xs < length ys = zipWith (+) (xs ++ repeat 0) ys
| otherwise = zipWith (+) xs (ys ++ repeat 0)
I have a sorted list of inputs:
let x = [2; 4; 6; 8; 8; 10; 12]
let y = [-8; -7; 2; 2; 3; 4; 4; 8; 8; 8;]
I want to write a function which behaves similar to an SQL INNER JOIN. In other words, I want to return the cartesian product of x and y which contains only items shared in both lists:
join(x, y) = [2; 2; 4; 4; 8; 8; 8; 8; 8; 8]
I've written a naive version as follows:
let join x y =
[for x' in x do
for y' in y do
yield (x', y')]
|> List.choose (fun (x, y) -> if x = y then Some x else None)
It works, but this runs in O(x.length * y.length). Since both my lists are sorted, I think its possible to get the results I want in O(min(x.length, y.length)).
How can I find common elements in two sorted lists in linear time?
I can't help you with the F#, but the basic idea is to use two indices, one for each list. Choose the item in each list at the current index for that list. If the two items are the same value, then add that value to your result set and increment both indices. If the items have different values, increment just the index for the list containing the lesser of the two values. Repeat the comparison until one of your lists is empty and then return the result set.
O(min(n,m)) time is impossible: Take two lists [x;x;...;x;y] and [x;x;...;x;z]. You have to browse both lists till the end to compare y and z.
Even O(n+m) is impossible. Take
[1,1,...,1] - n times
and
[1,1,...,1] - m times
Then the resulting list should have n*m elements. You need at least O(n m) (correctly Omega(n m)) time do create such list.
Without cartesian product (simple merge), this is quite easy. Ocaml code (I don't know F#, should be reasonably close; compiled but not tested):
let rec merge a b = match (a,b) with
([], xs) -> xs
| (xs, []) -> xs
| (x::xs, y::ys) -> if x <= y then x::(merge xs (y::ys))
else y::(merge (x::xs) (y::ys));;
(Edit: I was too late)
So your code in O(n m) is the best possible in worst case. However, IIUIC it performs always n*m operations, which is not optimal.
My approach would be
1) write a function
group : 'a list -> ('a * int) list
that counts the number of same elements:
group [1,1,1,1,1,2,2,3] == [(1,5);(2,2);(3,1)]
2) use it to merge both lists using similar code as before (there you can multiply those coefficients)
3) write a function
ungroup : ('a * int) list -> 'a list
and compose those three.
This has complexity O(n+m+x) where x is the length of resulting list. This is the best possible up to constant.
Edit: Here you go:
let group x =
let rec group2 l m =
match l with
| [] -> []
| a1::a2::r when a1 == a2 -> group2 (a2::r) (m+1)
| x::r -> (x, m+1)::(group2 r 0)
in group2 x 0;;
let rec merge a b = match (a,b) with
([], xs) -> []
| (xs, []) -> []
| ((x, xm)::xs, (y, ym)::ys) -> if x == y then (x, xm*ym)::(merge xs ys)
else if x < y then merge xs ((y, ym)::ys)
else merge ((x, xm)::xs) ys;;
let rec ungroup a =
match a with
[] -> []
| (x, 0)::l -> ungroup l
| (x, m)::l -> x::(ungroup ((x,m-1)::l));;
let crossjoin x y = ungroup (merge (group x) (group y));;
# crossjoin [2; 4; 6; 8; 8; 10; 12] [-7; -8; 2; 2; 3; 4; 4; 8; 8; 8;];;
- : int list = [2; 2; 4; 4; 8; 8; 8; 8; 8; 8]
The following is also tail-recursive (so far as I can tell), but the output list is consequently reversed:
let rec merge xs ys acc =
match (xs, ys) with
| ((x :: xt), (y :: yt)) ->
if x = y then
let rec count_and_remove_leading zs acc =
match zs with
| z :: zt when z = x -> count_and_remove_leading zt (acc + 1)
| _ -> (acc, zs)
let rec replicate_and_prepend zs n =
if n = 0 then
zs
else
replicate_and_prepend (x :: zs) (n - 1)
let xn, xt = count_and_remove_leading xs 0
let yn, yt = count_and_remove_leading ys 0
merge xt yt (replicate_and_prepend acc (xn * yn))
else if x < y then
merge xt ys acc
else
merge xs yt acc
| _ -> acc
let xs = [2; 4; 6; 8; 8; 10; 12]
let ys = [-7; -8; 2; 2; 3; 4; 4; 8; 8; 8;]
printf "%A" (merge xs ys [])
Output:
[8; 8; 8; 8; 8; 8; 4; 4; 2; 2]
Note that, as sdcvvc says in his answer, this is still O(x.length * y.length) in worst case, simply because the edge case of two lists of repeating identical elements would require the creation of x.length * y.length values in the output list, which is by itself inherently an O(m*n) operation.
I don't know F#, however I suppose it has arrays and binary-search implementation over arrays(can be implemented also)
choose smallest list
copy it to array (for O(1) random access, if F# already gives you that, you can skip this step)
go over big list and using binary search find in small array elements from big list,
if found add it to result list
Complexity O(min + max*log min), where min = sizeof small list and max - sizeof(big list)
I don't know F#, but I can provide a functional Haskell implementation, based on the algorithm outlined by tvanfosson (further specified by Lasse V. Karlsen).
import Data.List
join :: (Ord a) => [a] -> [a] -> [a]
join l r = gjoin (group l) (group r)
where
gjoin [] _ = []
gjoin _ [] = []
gjoin l#(lh#(x:_):xs) r#(rh#(y:_):ys)
| x == y = replicate (length lh * length rh) x ++ gjoin xs ys
| x < y = gjoin xs r
| otherwise = gjoin l ys
main :: IO ()
main = print $ join [2, 4, 6, 8, 8, 10, 12] [-7, -8, 2, 2, 3, 4, 4, 8, 8, 8]
This prints [2,2,4,4,8,8,8,8,8,8]. I case you're not familiar with Haskell, some references to the documentation:
group
length
replicate
I think it can be done simply by using hash tables. The hash tables store the frequencies of the elements in each list. These are then used to create a list where the frequency of each element e is frequency of e in X multiplied by the frequency of e in Y. This has a complexity of O(n+m).
(EDIT: Just noticed that this can be worst case O(n^2), after reading comments on other posts. Something very much like this has already been posted. Sorry for the duplicate. I'm keeping the post in case the code helps.)
I don't know F#, so I'm attaching Python code. I'm hoping the code is readable enough to be converted to F# easily.
def join(x,y):
x_count=dict()
y_count=dict()
for elem in x:
x_count[elem]=x_count.get(elem,0)+1
for elem in y:
y_count[elem]=y_count.get(elem,0)+1
answer=[]
for elem in x_count:
if elem in y_count:
answer.extend( [elem]*(x_count[elem]*y_count[elem] ) )
return answer
A=[2, 4, 6, 8, 8, 10, 12]
B=[-8, -7, 2, 2, 3, 4, 4, 8, 8, 8]
print join(A,B)
The problem with what he wants is that it obviously has to re-traverse the list.
In order to get 8,8,8 to show up twice, the function has to loop thru the second list a bit. Worst case scenario (two identical lists) will still yield O(x * y)
As a note, this is not utilizing external functions that loop on their own.
for (int i = 0; i < shorterList.Length; i++)
{
if (shorterList[i] > longerList[longerList.Length - 1])
break;
for (int j = i; j < longerList.Length && longerList[j] <= shorterList[i]; j++)
{
if (shorterList[i] == longerList[j])
retList.Add(shorterList[i]);
}
}
I think this is O(n) on the intersect/join code, though the full thing traverses each list twice:
// list unique elements and their multiplicity (also reverses sorting)
// e.g. pack y = [(8, 3); (4, 2); (3, 1); (2, 2); (-8, 1); (-7, 1)]
// we assume xs is ordered
let pack xs = Seq.fold (fun acc x ->
match acc with
| (y,ny) :: tl -> if y=x then (x,ny+1) :: tl else (x,1) :: acc
| [] -> [(x,1)]) [] xs
let unpack px = [ for (x,nx) in px do for i in 1 .. nx do yield x ]
// for lists of (x,nx) and (y,ny), returns list of (x,nx*ny) when x=y
// assumes inputs are sorted descending (from pack function)
// and returns results sorted ascending
let intersect_mult xs ys =
let rec aux rx ry acc =
match (rx,ry) with
| (x,nx)::xtl, (y,ny)::ytl ->
if x = y then aux xtl ytl ((x,nx*ny) :: acc)
elif x < y then aux rx ytl acc
else aux xtl ry acc
| _,_ -> acc
aux xs ys []
let inner_join x y = intersect_mult (pack x) (pack y) |> unpack
Now we test it on your sample data
let x = [2; 4; 6; 8; 8; 10; 12]
let y = [-7; -8; 2; 2; 3; 4; 4; 8; 8; 8;]
> inner_join x y;;
val it : int list = [2; 2; 4; 4; 8; 8; 8; 8; 8; 8]
EDIT: I just realized this is the same idea as the earlier answer by sdcvvc (after the edit).
You can't get O(min(x.length, y.length)), because the output may be greater than that. Supppose all elements of x and y are equal, for instance. Then the output size is the product of the size of x and y, which gives a lower bound to the efficiency of the algorithm.
Here's the algorithm in F#. It is not tail-recursive, which can be easily fixed. The trick is doing mutual recursion. Also note that I may invert the order of the list given to prod to avoid unnecessary work.
let rec prod xs ys =
match xs with
| [] -> []
| z :: zs -> reps xs ys ys
and reps xs ys zs =
match zs with
| [] -> []
| w :: ws -> if xs.Head = w then w :: reps xs ys ws
else if xs.Head > w then reps xs ys ws
else match ys with
| [] -> []
| y :: yss -> if y < xs.Head then prod ys xs.Tail else prod xs.Tail ys
The original algorithm in Scala:
def prod(x: List[Int], y: List[Int]): List[Int] = x match {
case Nil => Nil
case z :: zs => reps(x, y, y)
}
def reps(x: List[Int], y: List[Int], z: List[Int]): List[Int] = z match {
case w :: ws if x.head == w => w :: reps(x, y, ws)
case w :: ws if x.head > w => reps(x, y, ws)
case _ => y match {
case Nil => Nil
case y1 :: ys if y1 < x.head => prod(y, x.tail)
case _ => prod(x.tail, y)
}
}