I'm trying to solve tasks from 99 Haskell problems in F#.
The task #7 looks pretty simple, and the solution can be found in lots of places. Except the fact that the first several solutions that I've tried and found by googling (e.g. https://github.com/paks/99-FSharp-Problems/blob/master/P01to10/Solutions.fs) are wrong.
My example is pretty simple.
I'm trying to build extremely deep nested structure and fold it
type NestedList<'a> =
| Elem of 'a
| NestedList of NestedList<'a> list
let flatten list =
//
(* StackOverflowException
| Elem(a) as i -> [a]
| NestedList(nest) -> nest |> Seq.map myFlatten |> List.concat
*)
// Both are failed with stackoverflowexception too https://github.com/paks/99-FSharp-Problems/blob/master/P01to10/Solutions.fs
let insideGen count =
let rec insideGen' count agg =
match count with
| 0 -> agg
| _ ->
insideGen' (count-1) (NestedList([Elem(count); agg]))
insideGen' count (Elem(-1))
let z = insideGen 50000
let res = flatten z
I've tried to rewrite solution in CPS style, but eiter I'm doing something wrong or look into incorrect direction - everything that I've tried isn't working.
Any advices?
p.s. Haskell solution, at least on nested structure with 50000 nested levels is working slowly, but without stack overflow.
Here's a CPS version that doesn't overflow using your test.
let flatten lst =
let rec loop k = function
| [] -> k []
| (Elem x)::tl -> loop (fun ys -> k (x::ys)) tl
| (NestedList xs)::tl -> loop (fun ys -> loop (fun zs -> k (zs # ys)) xs) tl
loop id [lst]
EDIT
A much more readable way to write this would be:
let flatten lst =
let results = ResizeArray()
let rec loop = function
| [] -> ()
| h::tl ->
match h with
| Elem x -> results.Add(x)
| NestedList xs -> loop xs
loop tl
loop [lst]
List.ofSeq results
Disclaimer - I'm not a deep F# programmer and this will not be idiomatic.
If your stack is overflowing, it means that you don't have a tail recursive solution. It also means that you are choosing to use stack memory for state. Traditionally, you want to exchange heap memory for stack memory since heap memory is in comparatively large supply. So the trick is to model a stack.
I'm going to define a virtual machine that is a stack. Each stack element will be a state nugget for traversing a list which will include the list and a program counter, which is the current element to examine and will be a tuple of a NestedList<'a> list * int. The list is the current list being traversed. The int is the current position in the list.
type NestedList<'a> =
| Elem of 'a
| Nested of NestedList<'a> list
let flatten l =
let rec listMachine instructions result =
match instructions with
| [] -> result
| (currList, currPC) :: tail ->
if currPC >= List.length currList then listMachine tail result
else
match List.nth currList currPC with
| Elem(a) -> listMachine ((currList, currPC + 1 ) :: tail) (result # [ a ])
| Nested(l) -> listMachine ((l, 0) :: (currList, currPC + 1) :: instructions.Tail) result
match l with
| Elem(a) -> [ a ]
| Nested(ll) -> listMachine [ (ll, 0) ] []
What have I done? I've written a tail-recursive function that operates of "Little Lisper" style code - if my instruction list is empty, return my accumulated result. If not, operate on the top of the stack. I bind a convenience variable to the top and if the PC is at the end, I recurse on the tail of the stack (pop) with the current result. Otherwise, I look at the current element in the list. If it's an Elem, I recurse, advancing the PC and appending the Elem onto the list. If it's not an elem, I recurse, by pushing a new stack with the NestedList followed by the current stack elem with the PC advanced by 1 and everything else.
Related
I'm trying to write a tail-recursion function that will look at a list of distinct words, a list of all words, and return a list with the count of occurrences of each word. I'm actually reading the words out of files in a directory, but I can't seem to get the tail-recursion to compile. This is what I have so far:
let countOccurence (word:string) list =
List.filter (fun x -> x.Equals(word)) list
//(all words being a list of all words across several files)
let distinctWords = allWords |> Seq.distinct
let rec wordCloud distinct (all:string list) acc =
match distinct with
| head :: tail -> wordCloud distinct tail Array.append(acc, (countOccurence head all)) //<- What am I doing with my life?
| [] -> 0
I realize this is probably a fairly straightforward question, but I've been banging my head for an hour on this final piece of the puzzle. Any thoughts?
There are several issues with the statement as given:
Use of Array.append to manipulate lists
Typos
Incorrect use of whitespace to group things together
Try expressing the logic as a series of steps instead of putting everything into a single, unreadable line of code. Here's what I did to understand the problems with the above expression:
let rec wordCloud distinct (all:string list) acc =
match distinct with
| head :: tail ->
let count = countOccurence head all
let acc' = acc |> List.append count
wordCloud distinct tail acc'
| [] -> 0
This compiles, but I don't know if it does what you want it to do...
Notice the replacement of Array.append with List.append.
This is still tail recursive, since the call to wordCloud sits in the tail position.
After several hours more work, I came up with this:
let countOccurance (word:string) list =
let count = List.filter (fun x -> word.Equals(x)) list
(word, count.Length)
let distinctWords = allWords |> Seq.distinct |> Seq.toList
let print (tup:string*int) =
match tup with
| (a,b) -> printfn "%A: %A" a b
let rec wordCloud distinct (all:string list) (acc:(string*int) list) =
match distinct with
| [] -> acc
| head :: tail ->
let accumSoFar = acc # [(countOccurance head all)]
wordCloud tail all accumSoFar
let acc = []
let cloud = (wordCloud distinctWords allWords acc)
let rec printTup (tupList:(string*int) list) =
match tupList with
| [] -> 0
| head :: tail ->
printfn "%A" head
printTup tail
printTup cloud
This problem actually has a pretty straightforward solution, if you take a step back and simply type in what you want to do.
/// When you want to make a tag cloud...
let makeTagCloud (words: string list) =
// ...take a list of all words...
words
// ...then walk along the list...
|> List.fold (fun cloud word ->
// ...and check if you've seen that word...
match cloud |> Map.tryFind word with
// ...if you have, bump the count...
| Some count -> cloud |> Map.add word (count+1)
// ...if not, add it to the map...
| None -> cloud |> Map.add word 1) Map.empty
// ...and change the map back into a list when you are done.
|> Map.toList
Reads like poetry ;)
All of the continuation tutorials I can find are on fixed length continuations(i.e. the datastructure has a known number of items as it is being traversed
I am implementing DepthFirstSearch Negamax(http://en.wikipedia.org/wiki/Negamax) and while the code works, I would like to rewrite the code using continuations
the code I have is as follows
let naiveDFS driver depth game side =
List.map (fun x ->
//- negamax depth-1 childnode opposite side
(x, -(snd (driver (depth-1) (update game x) -side))))
(game.AvailableMoves.Force())
|> List.maxBy snd
let onPlay game = match game.Turn with
| Black -> -1
| White -> 1
///naive depth first search using depth limiter
let DepthFirstSearch (depth:int) (eval:Evaluator<_>) (game:GameState) : (Move * Score) =
let myTurn = onPlay game
let rec searcher depth game side =
match depth with
//terminal Node
| x when x = 0 || (isTerminal game) -> let movescore = (eval ((),game)) |> fst
(((-1,-1),(-1,-1)),(movescore * side))
//the max of the child moves, each child move gets mapped to
//it's associated score
| _ -> naiveDFS searcher depth game side
where update updates a gamestate with a with a given move, eval evaluates the game state and returns an incrementer(currently unused) for incremental evaluation and isTerminal evaluates whether or not the position is an end position or not.
The Problem is that I have to sign up an unknown number of actions(every remaining list.map iteration) to the continuation, and I actually can't conceive of an efficient way of doing this.
Since this is an exponential algorithm, I am obviously looking to keep this as efficient as possible(although my brain hurts trying to figure this our, so I do want the answer more than an efficient one)
Thanks
I think you'll need to implement a continuation-based version of List.map to do this.
A standard implementation of map (using the accumulator argument) looks like this:
let map' f l =
let rec loop acc l =
match l with
| [] -> acc |> List.rev
| x::xs -> loop ((f x)::acc) xs
loop [] l
If you add a continuation as an argument and transform the code to return via a continuation, you'll get (the interesting case is the x::xs branch in the loop function, where we first call f using tail-call with some continuation as an argument):
let contMap f l cont =
let rec loop acc l cont =
match l with
| [] -> cont acc |> List.rev
| x::xs -> f x (fun x' -> loop (x'::acc) xs cont)
loop [] l cont
Then you can turn normal List.map into a continuation based version like this:
// Original version
let r = List.map (fun x -> x*2) [ 1 .. 3 ]
// Continuation-based version
contMap (fun x c -> c(x*2)) [ 1 .. 3 ] (fun r -> ... )
I'm not sure if this will give you any notable performance improvement. I think continuations are mainly needed if you have a very deep recursion (that doesn't fit on the stack). If it fits on the stack, then it will probably run fast using stack.
Also, the rewriting to explicit continuation style makes the program a bit ugly. You can improve that by using a computation expression for working with continuations. Brian has a blog post on this very topic.
I am new to F# and was reading about tail recursive functions and was hoping someone could give me two different implementations of a function foo - one that is tail recursive and one that isn't so that I can better understand the principle.
Start with a simple task, like mapping items from 'a to 'b in a list. We want to write a function which has the signature
val map: ('a -> 'b) -> 'a list -> 'b list
Where
map (fun x -> x * 2) [1;2;3;4;5] == [2;4;6;8;10]
Start with non-tail recursive version:
let rec map f = function
| [] -> []
| x::xs -> f x::map f xs
This isn't tail recursive because function still has work to do after making the recursive call. :: is syntactic sugar for List.Cons(f x, map f xs).
The function's non-recursive nature might be a little more obvious if I re-wrote the last line as | x::xs -> let temp = map f xs; f x::temp -- obviously its doing work after the recursive call.
Use an accumulator variable to make it tail recursive:
let map f l =
let rec loop acc = function
| [] -> List.rev acc
| x::xs -> loop (f x::acc) xs
loop [] l
Here's we're building up a new list in a variable acc. Since the list gets built up in reverse, we need to reverse the output list before giving it back to the user.
If you're in for a little mind warp, you can use continuation passing to write the code more succinctly:
let map f l =
let rec loop cont = function
| [] -> cont []
| x::xs -> loop ( fun acc -> cont (f x::acc) ) xs
loop id l
Since the call to loop and cont are the last functions called with no additional work, they're tail-recursive.
This works because the continuation cont is captured by a new continuation, which in turn is captured by another, resulting in a sort of tree-like data structure as follows:
(fun acc -> (f 1)::acc)
((fun acc -> (f 2)::acc)
((fun acc -> (f 3)::acc)
((fun acc -> (f 4)::acc)
((fun acc -> (f 5)::acc)
(id [])))))
which builds up a list in-order without requiring you to reverse it.
For what its worth, start writing functions in non-tail recursive way, they're easier to read and work with.
If you have a big list to go through, use an accumulator variable.
If you can't find a way to use an accumulator in a convenient way and you don't have any other options at your disposal, use continuations. I personally consider non-trivial, heavy use of continuations hard to read.
An attempt at a shorter explanation than in the other examples:
let rec foo n =
match n with
| 0 -> 0
| _ -> 2 + foo (n-1)
let rec bar acc n =
match n with
| 0 -> acc
| _ -> bar (acc+2) (n-1)
Here, foo is not tail-recursive, because foo has to call foo recursively in order to evaluate 2+foo(n-1) and return it.
However, bar ís tail-recursive, because bar doesn't have to use the return value of the recursive call in order to return a value. It can just let the recursively called bar return its value immediately (without returning all the way up though the calling stack). The compiler sees this and optimized this by rewriting the recursion into a loop.
Changing the last line in bar into something like | _ -> 2 + (bar (acc+2) (n-1)) would again destroy the function being tail-recursive, since 2 + leads to an action that needs to be done after the recursive call is finished.
Here is a more obvious example, compare it to what you would normally do for a factorial.
let factorial n =
let rec fact n acc =
match n with
| 0 -> acc
| _ -> fact (n-1) (acc*n)
fact n 1
This one is a bit complex, but the idea is that you have an accumulator that keeps a running tally, rather than modifying the return value.
Additionally, this style of wrapping is usually a good idea, that way your caller doesn't need to worry about seeding the accumulator (note that fact is local to the function)
I'm learning F# too.
The following are non-tail recursive and tail recursive function to calculate the fibonacci numbers.
Non-tail recursive version
let rec fib = function
| n when n < 2 -> 1
| n -> fib(n-1) + fib(n-2);;
Tail recursive version
let fib n =
let rec tfib n1 n2 = function
| 0 -> n1
| n -> tfib n2 (n2 + n1) (n - 1)
tfib 0 1 n;;
Note: since the fibanacci number could grow really fast you could replace last line tfib 0 1 n to
tfib 0I 1I n to take advantage of Numerics.BigInteger Structure in F#
Also, when testing, don't forget that indirect tail recursion (tailcall) is turned off by default when compiling in Debug mode. This can cause tailcall recursion to overflow the stack in Debug mode but not in Release mode.
I have two snippets of code that tries to convert a float list to a Vector3 or Vector2 list. The idea is to take 2/3 elements at a time from the list and combine them as a vector. The end result is a sequence of vectors.
let rec vec3Seq floatList =
seq {
match floatList with
| x::y::z::tail -> yield Vector3(x,y,z)
yield! vec3Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 3?"
}
let rec vec2Seq floatList =
seq {
match floatList with
| x::y::tail -> yield Vector2(x,y)
yield! vec2Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 2?"
}
The code looks very similiar and yet there seems to be no way to extract a common portion. Any ideas?
Here's one approach. I'm not sure how much simpler this really is, but it does abstract some of the repeated logic out.
let rec mkSeq (|P|_|) x =
seq {
match x with
| P(p,tail) ->
yield p
yield! mkSeq (|P|_|) tail
| [] -> ()
| _ -> failwith "List length mismatch" }
let vec3Seq =
mkSeq (function
| x::y::z::tail -> Some(Vector3(x,y,z), tail)
| _ -> None)
As Rex commented, if you want this only for two cases, then you probably won't have any problem if you leave the code as it is. However, if you want to extract a common pattern, then you can write a function that splits a list into sub-list of a specified length (2 or 3 or any other number). Once you do that, you'll only use map to turn each list of the specified length into Vector.
The function for splitting list isn't available in the F# library (as far as I can tell), so you'll have to implement it yourself. It can be done roughly like this:
let divideList n list =
// 'acc' - accumulates the resulting sub-lists (reversed order)
// 'tmp' - stores values of the current sub-list (reversed order)
// 'c' - the length of 'tmp' so far
// 'list' - the remaining elements to process
let rec divideListAux acc tmp c list =
match list with
| x::xs when c = n - 1 ->
// we're adding last element to 'tmp',
// so we reverse it and add it to accumulator
divideListAux ((List.rev (x::tmp))::acc) [] 0 xs
| x::xs ->
// add one more value to 'tmp'
divideListAux acc (x::tmp) (c+1) xs
| [] when c = 0 -> List.rev acc // no more elements and empty 'tmp'
| _ -> failwithf "not multiple of %d" n // non-empty 'tmp'
divideListAux [] [] 0 list
Now, you can use this function to implement your two conversions like this:
seq { for [x; y] in floatList |> divideList 2 -> Vector2(x,y) }
seq { for [x; y; z] in floatList |> divideList 3 -> Vector3(x,y,z) }
This will give a warning, because we're using an incomplete pattern that expects that the returned lists will be of length 2 or 3 respectively, but that's correct expectation, so the code will work fine. I'm also using a brief version of sequence expression the -> does the same thing as do yield, but it can be used only in simple cases like this one.
This is simular to kvb's solution but doesn't use a partial active pattern.
let rec listToSeq convert (list:list<_>) =
seq {
if not(List.isEmpty list) then
let list, vec = convert list
yield vec
yield! listToSeq convert list
}
let vec2Seq = listToSeq (function
| x::y::tail -> tail, Vector2(x,y)
| _ -> failwith "float array not multiple of 2?")
let vec3Seq = listToSeq (function
| x::y::z::tail -> tail, Vector3(x,y,z)
| _ -> failwith "float array not multiple of 3?")
Honestly, what you have is pretty much as good as it can get, although you might be able to make a little more compact using this:
// take 3 [1 .. 5] returns ([1; 2; 3], [4; 5])
let rec take count l =
match count, l with
| 0, xs -> [], xs
| n, x::xs -> let res, xs' = take (count - 1) xs in x::res, xs'
| n, [] -> failwith "Index out of range"
// split 3 [1 .. 6] returns [[1;2;3]; [4;5;6]]
let rec split count l =
seq { match take count l with
| xs, ys -> yield xs; if ys <> [] then yield! split count ys }
let vec3Seq l = split 3 l |> Seq.map (fun [x;y;z] -> Vector3(x, y, z))
let vec2Seq l = split 2 l |> Seq.map (fun [x;y] -> Vector2(x, y))
Now the process of breaking up your lists is moved into its own generic "take" and "split" functions, its much easier to map it to your desired type.
I need to generate permutations on a given list. I managed to do it like this
let rec Permute (final, arr) =
if List.length arr > 0 then
for x in arr do
let n_final = final # [x]
let rest = arr |> List.filter (fun a -> not (x = a))
Permute (n_final, rest)
else
printfn "%A" final
let DoPermute lst =
Permute ([], lst)
DoPermute lst
There are obvious issues with this code. For example, list elements must be unique. Also, this is more-less a same approach that I would use when generating straight forward implementation in any other language. Is there any better way to implement this in F#.
Thanks!
Here's the solution I gave in my book F# for Scientists (page 166-167):
let rec distribute e = function
| [] -> [[e]]
| x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs]
let rec permute = function
| [] -> [[]]
| e::xs -> List.collect (distribute e) (permute xs)
For permutations of small lists, I use the following code:
let distrib e L =
let rec aux pre post =
seq {
match post with
| [] -> yield (L # [e])
| h::t -> yield (List.rev pre # [e] # post)
yield! aux (h::pre) t
}
aux [] L
let rec perms = function
| [] -> Seq.singleton []
| h::t -> Seq.collect (distrib h) (perms t)
It works as follows: the function "distrib" distributes a given element over all positions in a list, example:
distrib 10 [1;2;3] --> [[10;1;2;3];[1;10;2;3];[1;2;10;3];[1;2;3;10]]
The function perms works (recursively) as follows: distribute the head of the list over all permutations of its tail.
The distrib function will get slow for large lists, because it uses the # operator a lot, but for lists of reasonable length (<=10), the code above works fine.
One warning: if your list contains duplicates, the result will contain identical permutations. For example:
perms [1;1;3] = [[1;1;3]; [1;1;3]; [1;3;1]; [1;3;1]; [3;1;1]; [3;1;1]]
The nice thing about this code is that it returns a sequence of permutations, instead of generating them all at once.
Of course, generating permutations with an imperative array-based algorithm will be (much) faster, but this algorithm has served me well in most cases.
Here's another sequence-based version, hopefully more readable than the voted answer.
This version is similar to Jon's version in terms of logic, but uses computation expressions instead of lists. The first function computes all ways to insert an element x in a list l. The second function computes permutations.
You should be able to use this on larger lists (e.g. for brute force searches on all permutations of a set of inputs).
let rec inserts x l =
seq { match l with
| [] -> yield [x]
| y::rest ->
yield x::l
for i in inserts x rest do
yield y::i
}
let rec permutations l =
seq { match l with
| [] -> yield []
| x::rest ->
for p in permutations rest do
yield! inserts x p
}
It depends on what you mean by "better". I'd consider this to be slightly more elegant, but that may be a matter of taste:
(* get the list of possible heads + remaining elements *)
let rec splitList = function
| [x] -> [x,[]]
| x::xs -> (x, xs) :: List.map (fun (y,l) -> y,x::l) (splitList xs)
let rec permutations = function
| [] -> [[]]
| l ->
splitList l
|> List.collect (fun (x,rest) ->
(* permute remaining elements, then prepend head *)
permutations rest |> List.map (fun l -> x::l))
This can handle lists with duplicate elements, though it will result in duplicated permutations.
In the spirit of Cyrl's suggestion, here's a sequence comprehension version
let rec permsOf xs =
match xs with
| [] -> List.toSeq([[]])
| _ -> seq{ for x in xs do
for xs' in permsOf (remove x xs) do
yield (x::xs')}
where remove is a simple function that removes a given element from a list
let rec remove x xs =
match xs with [] -> [] | (x'::xs')-> if x=x' then xs' else x'::(remove x xs')
IMHO the best solution should alleviate the fact that F# is a functional language so imho the solution should be as close to the definition of what we mean as permutation there as possible.
So the permutation is such an instance of list of things where the head of the list is somehow added to the permutation of the rest of the input list.
The erlang solution shows that in a pretty way:
permutations([]) -> [[]];
permutations(L) -> [[H|T] H<- L, T <- permutations( L--[H] ) ].
taken fron the "programming erlang" book
There is a list comprehension operator used, in solution mentioned here by the fellow stackoverflowers there is a helper function which does the similar job
basically I'd vote for the solution without any visible loops etc, just pure function definition
I'm like 11 years late, but still in case anyone needs permutations like I did recently. Here's Array version of permutation func, I believe it's more performant:
[<RequireQualifiedAccess>]
module Array =
let private swap (arr: _[]) i j =
let buf = arr.[i]
arr.[i] <- arr.[j]
arr.[j] <- buf
let permutations arr =
match arr with
| null | [||] -> [||]
| arr ->
let last = arr.Length - 1
let arr = Array.copy arr
let rec perm arr k =
let arr = Array.copy arr
[|
if k = last then
yield arr
else
for i in k .. last do
swap arr k i
yield! perm arr (k + 1)
|]
perm arr 0