I have this series of functions, isMember, addElem and countries:
let rec isMember x = function
| y::ys -> y=x || (isMember x ys)
| [] -> false
let addElem x ys = if isMember x ys then ys else x::ys
let rec countries = function
| [] -> []
| (c1,c2)::m -> addElem c1 (addElem c2 (countries m))
I want to rewrite countries using higher-order functions, but I'm not entirely sure how to:
My guess would be it having something to do with List.map, as I'm applying a function to each element of the list.
let countriesHigherOrder m =
List.map (fun x -> addElem x m)
Instead of using List.map, you can use List.fold with an accu that you initialize to [] and add elements to accu.
let countriesHigherOrder m =
List.fold (fun acc (c1,c2) -> addElem c1 (addElem c2 acc)) [] m
or by defining addPair:
let addPair (x, y) ys =
addElem x (addElem y ys)
let countriesHigherOrder m =
List.fold (fun acc (c1,c2) -> addPair (c1, c2) acc) [] m
If you want to flatten a list of pairs into a simple list and at the same time, preserve only one occurence of identical elements, the shortest code will involve the append operator.
let countries' m =
List.unzip m ||> (#)
|> Seq.distinct
|> Seq.toList
If, on the other hand, you need the peculiar order of your doubly recursive approach, you can convert the list of tuples into two-element lists and concatenate those.
let countries'' m =
List.rev m
|> List.collect(fun (x,y) -> [y;x])
|> Seq.distinct
|> Seq.toList
|> List.rev
Related
My goal here was to convert a (int * int) list to an int list. This is what I did:
let tuples_list_to_list l =
let rec aux_tuples_to_list acc l =
match l with
| [] -> acc
| x :: tl -> aux_tuples_to_list (fst x :: snd x :: acc) tl in
aux_tuples_to_list [] l
I was wondering if there was a more "elegant" even though this is subjective or at least better, way to write my function. I was thinking about using List.map or List.fold_left but I was having issues figuring out I could use those two functions to do the same thing I did. Basically, I think it would be possible to have a one-liner instead of the whole function I wrote.
What do you think? Thanks
This task is suited for List.concat_map (also known as "flat map" in some other languages):
(* List.concat_map : ('a -> 'b list) -> 'a list -> 'b list *)
let tuples_list_to_list l =
List.concat_map (fun (x, y) -> [x; y]) l
You can use List.fold_left, but you'll have to reverse the result at the end as the list is constructed in reverse order:
let tuples_list_to_list l =
List.rev (List.fold_left (fun acc (x, y) -> y :: x :: acc) [] l)
You can also deconstruct the tuple values in the pattern matching instead of using fst and snd (This version, unlike yours, gives a result list with the numbers in the same order as the orignal):
let tuples_list_to_list l =
let rec aux_tuples_to_list acc l =
match l with
| [] -> List.rev acc
| (x, y) :: tl -> aux_tuples_to_list (y :: x :: acc) tl in
aux_tuples_to_list [] l
Yet Another Option is using List.fold_right, which avoids the need to reverse the accumulator list at the end at the cost of not being tail recursive:
let tuples_list_to_list l =
List.fold_right (fun (x, y) acc -> x :: y :: acc) l [];;
I wrote this little function, I'll repeat it here for ease-of-reference:
/// Take a list of lists, go left-first, and return each combination,
/// then apply a function to the resulting sublists, each length of main list
let rec nestedApply f acc inp =
match inp with
| [] -> f acc
| head::tail ->
[
for x in head do
yield! nestedApply f (x::acc) tail
]
It made me wonder whether using yield! in this context, or in general with list comprehensions, is tail-recursive. I actually think it isn't, which makes that the above function would create a stack-depth equal to the size of the main list.
If it isn't, how can I write this same code in a tail-recursive way? I've tried with List.collect (a rolled out idea is in the referred-to question), but I didn't quite get there.
No, it's not tail-recursive, and will in fact blow up the stack:
let lists =
[1 .. 10000]
|> List.map (fun i -> List.replicate 100 i)
nestedApply id [] lists
You could make nestedApply tail-recursive by rewriting it in continuation-passing style, but isn't it just an n-ary cartesian product followed by a map?
To simplify things I am going to separate the multiplication of lists from the mapping of the function. So nestedApply will look like this:
let nestedApply f lsts = mult lsts |> List.collect f
Where mult does the multiplication of the lists and returns all the combinations.
I usually find that to do tail recursion is better to start with the simple recursion first:
let rec mult lsts =
match lsts with
| [ ] -> [[]]
| h :: rest -> let acc = mult rest
h |> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
So this version of mult does the job but it does not use tail recursion.
It does serves as a template to create the tail recursion version and I can check that both return the same value:
let mult lsts =
let rec multT lsts acc =
match lsts with
| h :: rest -> h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
|> multT rest
| [ ] -> acc
multT (List.rev lsts) [[]]
The tail recursion version multT uses an internal accumulator parameter. To hide it, I nest the recursive part inside the function mult. I also reverse the list because this version works backwards.
Many times when you have a tail recursive function you can eliminate the recursion by using the fold function:
let mult lsts =
List.rev lsts
|> List.fold (fun acc h ->
h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
) [[]]
or foldBack:
let mult lsts =
List.foldBack (fun h acc ->
h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
) lsts [[]]
Notice the similarities.
Here is the solution in fiddle:
https://dotnetfiddle.net/sQOI7q
I am learning Haskell at the moment and have come to a bit of a standstill. I'm trying to write a function that takes a predicate p and a list xs and returns the list of those elements of xs which immediately follow an element which passes the predicate p. Here is what I have :
afterFilter :: (a -> Bool) -> [a] -> [a]
afterFilter x (y:ys) =
if x y
then (map head [ys])
else
afterFilter x (tail ys)
test input : afterFilter (<0) [-4,7,-4,-8,3,-3,-6,0,-9,-1]
output : [7]
The trick is to pull two elements out of the input list by pattern-matching two cons cells. If the first element passes the predicate, we stick the second on the output. But don't forget to stick the second element back on the input list when you make the recursive call.
afterFilter :: (a -> Bool) -> [a] -> [a]
afterFilter f [] = [] -- input list is empty
afterFilter f [x] = [] -- input list has only one element - no "next element" to return
afterFilter f (x:y:xs) =
let ys = afterFilter f (y:xs)
in (if f x then y:ys else rest)
However, a higher-level - and much more Haskellish - way to approach the problem would be to break it down into a pipeline of operations.
Pair up each item in the list with the element that follows it using zip, so we have a list of (element, next) pairs.
Use filter to drop the pairs for which element does not pass the predicate.
Use map to extract the next part of each surviving pair.
So the code looks like this:
pairWithSuccessors :: [a] -> [(a, a)]
pairWithSuccessors xs = zip xs (tail xs)
afterFilter :: (a -> Bool) -> [a] -> [a]
afterFilter p xs =
let withSuccessors = pairWithSuccessors xs (tail xs)
filtered = filter (\(element, next) -> p element) withSuccessors
filteredSuccessors = map (\(element, next) -> next) filtered
in filteredSuccessors
Or, written in point-free style:
afterFilter p = map snd . filter (p . fst) . pairWithSuccessors
Functions built with the composition operator . are read right-to-left: first pairWithSuccessors, then filter (p . fst), then map snd over the result.
GHC is good at working with lists: when compiled with optimisations, both approaches should produce roughly the same machine code - that is, there's no performance cost to the high-level solution
Following what you did, there are some strange things with your code :
The map head [ys] is very odd, and causes your function to stop : At the first element matching the predicate, your function returns a list containing its immediate successor and stops there. You still need to process the rest of the list.
Also, following your definition of the problem, each item which is a successor of an item passing the predicate should be on the resulting array. I may be wrong, but what I understood is that afterFilter (<0) [-1, -1, 1] should return [-1, 1].
However, you're discarding one element you didn't check for by calling tail ys : You checked for y, but not for head ys.
Finally, by adding the edge cases, here is what you get :
afterFilter :: (a -> Bool) -> [a] -> [a]
afterFilter _ [] = []
afterFilter _ [_] = []
afterFilter x (y:ys#(z:zs)) =
if x y
then z : afterFilter x ys
else
afterFilter x ys
Try:
afterFilter :: (a -> Bool) -> [a] -> [a]
afterFilter p [] = []
afterFilter p [_] = []
afterFilter p (x1:x2:xs)
| p x1 = x2:rest
| otherwise = rest
where rest = afterFilter p (x2:xs)
Or
afterFilter' :: (a -> Bool) -> [a] -> [a]
afterFilter' p xs = map snd $ filter (\(x, _) -> p x) $ zip xs (tail xs)
Or
afterFilter'' :: (a -> Bool) -> [a] -> [a]
afterFilter'' p xs = [y | (x, y) <- zip xs (tail xs), p x]
I am trying to enumerate all the possible merges of two lists.
In example inserting "bb" into "aaa" would look like
["bbaaa", "babaa", "baaba", "baaab", "abbaa", "ababa", "abaab", "aabba", "aabab", "aaabb"]
What I currently did is this
import Data.List
insert'' :: Char -> String -> [(String, String)] -> String
insert'' _ _ ([]) = []
insert'' h b ((x, y):xs) =
(x ++ [h] ++ (insert' (b, y))) ++ (insert'' h b xs)
insert' :: (String, String) -> String
insert' ([], ys) = ys
insert' (xs, ys) =
insert'' h b lists
where
h = head xs
b = tail xs
lists = zip (tails ys) (inits ys)
This returns for ("aaa", "bb")
"bbaaababaaabaababbaababaababbabababb"
a concatenated string, I tried making it a list of strings, but I just cannot wrap my head around this function. I always seems to get infinite type construction.
How could I rewrite the function, so it would return a list of strings?
An other implementation idea as in Daniel Wagners first post is to choose in each step a element from one of the lists and prepending it to the results generated by the function called with only the remaining parts of the list:
interleave :: [a] -> [a] -> [[a]]
interleave xs [] = [xs]
interleave [] ys = [ys]
interleave xs#(x : xs') ys#(y : ys') =
map (x :) (interleave xs' ys) ++ map (y :) (interleave xs ys')
For your intial example this produces:
ghci> interleave "bb" "aaa"
["bbaaa","babaa","baaba","baaab","abbaa","ababa","abaab","aabba","aabab","aaabb"]
Here is one implementation idea: for each element in the first list, we will choose (nondeterministically) a position in the second list to insert it, then recurse. For this to work, we first need a way to nondeterministically choose a position; thus:
choose :: [a] -> [([a], [a])]
choose = go [] where
go before xs = (before, xs) : case xs of
[] -> []
x:xs -> go (x:before) xs
For example:
> choose "abcd"
[("","abcd"),("a","bcd"),("ba","cd"),("cba","d"),("dcba","")]
Now we can use this tool to do the insertion:
insert :: [a] -> [a] -> [[a]]
insert [] ys = [ys]
insert (x:xs) ys = do
(before, after) <- choose ys
rest <- insert xs (reverse after)
return (before ++ [x] ++ rest)
In ghci:
> insert "ab" "cde"
["abcde","aebcd","adebc","acdeb","cabde","caebd","cadeb","dcabe","dcaeb","edcab"]
In this answer, I will give the minimal change needed to fix the code you already have (without completely rewriting your code). The first change needed is to update your type signatures to return lists of strings:
insert'' :: Char -> String -> [(String, String)] -> [String]
insert' :: (String, String) -> [String]
Now your compiler will complain that the first clause of insert' is returning a String instead of a [String], which is easily fixed:
insert' ([], ys) = [ys]
...and that the second clause of insert'' is trying to append a String to a [String] when running [h] ++ insert' (b, y). This one takes some thinking to figure out what you really meant; but my conclusion is that instead of x ++ [h] ++ insert' (b, y), you really want to run \t -> x ++ [h] ++ t for each element in insert' (b, y). Thus:
insert'' h b ((x, y):xs) =
(map (\t -> x ++ [h] ++ t) (insert' (b, y))) ++ (insert'' h b xs)
The complete final code is:
import Data.List
insert'' :: Char -> String -> [(String, String)] -> [String]
insert'' _ _ ([]) = []
insert'' h b ((x, y):xs) =
(map (\t -> x ++ [h] ++ t) (insert' (b, y))) ++ (insert'' h b xs)
insert' :: (String, String) -> [String]
insert' ([], ys) = [ys]
insert' (xs, ys) =
insert'' h b lists
where
h = head xs
b = tail xs
lists = zip (tails ys) (inits ys)
Now ghci will happily produce good answers:
> insert' ("aaa", "bb")
["bbaaa","babaa","baaba","baaab","abbaa","ababa","abaab","aabba","aabab","aaabb"]
I'm trying to make a recursive function to get the transpose of a list of lists, n x p to p x n. But i'm unable to do so. I've been able to make a function to transpose a 3 x n list of lists to an n x 3 one:
let rec drop1 list=
[(match (List.nth list 0) with [] -> [] | a::b -> b);
(match (List.nth list 1) with [] -> [] | a::b -> b);
(match (List.nth list 2) with [] -> [] | a::b -> b);]
let rec transpose list=
if List.length (List.nth list 0) == 0 then []
else [(match (List.nth list 0) with [] -> 0 | a::b -> a);
(match (List.nth list 1) with [] -> 0 | a::b -> a);
(match (List.nth list 2) with [] -> 0 | a::b -> a)]
:: transpose (drop1 list)
But I'm not able to generalize it. I'm surely thinking in the wrong direction. Is this generalizable? Is there a better solution? Please help.
let rec transpose list = match list with
| [] -> []
| [] :: xss -> transpose xss
| (x::xs) :: xss ->
(x :: List.map List.hd xss) :: transpose (xs :: List.map List.tl xss)
Taking advantage of syntax changes since answer first posted:
let rec transpose list = match list with
| [] -> []
| [] :: xss -> transpose xss
| (x::xs) :: xss ->
List.(
(x :: map hd xss) :: transpose (xs :: map tl xss)
)
I know this is an old question, but I recently had to solve this as part of an exercise I was doing, and I came across #sepp2k's solution, but I couldn't understand how it worked, so I tried to arrive at it by myself.
This is essentially the same algorithm, but a little bit more terse, as it does not destructure the list of lists. I thought I would post it here in case anyone else is searching, and might find this way of expressing it useful:
let rec transpose = function
| []
| [] :: _ -> []
| rows ->
List.map List.hd rows :: transpose (List.map List.tl rows)
Assuming the matrix is rectangular (otherwise Invalid_argument "map2" will be raised):
let transpose m =
if m = [] then [] else
List.(fold_right (map2 cons) m ## map (fun _ -> []) (hd m))
Note that map (fun _ -> []) (hd m) just creates a list of empty lists, of length equal to the number of columns in m.
So a clearer representation of this code would be:
let transpose m =
if m = [] then [] else
let open List in
let empty_rows = map (fun _ -> []) (hd m) in
fold_right (map2 cons) m empty_rows