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.
Related
This is my code, when I enter a very large number I get stack overflow error does anyone know why? When i enter a very large number i get that error and im not really sure what is causing it, it is only with large numbers small ones work fine.....
//
// merge two sorted lists into one:
//
let rec merge L1 L2 =
if L1 = [] && L2 = [] then
[]
else if L1 = [] then
L2
else if L2 = [] then
L1
else if L1.Head <= L2.Head then
L1.Head :: merge L1.Tail L2
else
L2.Head :: merge L1 L2.Tail
//
// mergesort:
//
let rec mergesort L =
match L with
| [] -> []
| E::[] -> L
| _ ->
let mid = List.length L / 2
let (L1, L2) = List.splitAt mid L
merge (mergesort L1) (mergesort L2)
In both your functions you had the problem, that the last step you take is not the recursive call but some other thing:
in merge it is the :: operation
in mergesort it is the merge
So you have to get to a point where the very last thing is the recursive call!
One possibility in situations where you have more than one recursive call to make is to use continuations - the idea is to pass a function around that should be called with the result of the current step and then continue the computation from there.
this is a tail-recursive version of mergesort using this technique:
let mergesort xs =
let rec msort xs cont =
match xs with
| [] -> cont []
| [x] -> cont xs
| _ ->
let mid = List.length xs / 2
let (xs', xs'') = List.splitAt mid xs
msort xs' (fun ys' -> msort xs'' (fun ys'' -> cont (merge ys' ys'')))
msort xs id
as you can see the idea is not to hard - instead of first calling both recursive paths it starts with just one half but adds a continuation that basically says:
once I have the result of mergesort xs' I take the result ys' and continue by mergesorting xs'' and then merge those
of course the second step is done in just the same way (push the merge into the continuation)
the very first continuation is usually the identity as you can see in the very last line ;)
and here is something similar for your merge:
let merge xs ys =
let rec mrg xs ys cont =
match (xs, ys) with
| ([], ys) -> cont ys
| (xs, []) -> cont xs
| (x::xs', y::ys') ->
if x < y
then mrg xs' ys (fun rs -> cont (x::rs))
else mrg xs ys' (fun rs -> cont (y::rs))
mrg xs ys id
those will of course take as much space on the heap (probably more) - but that is usually no problem - your stack should be fine ;)
Each recursive call requires stack space. The more times mergesort calls itself, the more stack is used.
You avoid the stack overflow with recursive function by taking advantage of tail recursion. It simply means the last thing a function does is call itself, the call is removed and turns into a jump instead, saving stack space.
This is tricky to do in your case because you have to call mergesort twice. Only one of them can be last. The solution is to use a continuation. You only call mergesort once, but pass it a function to call, which will call mergesort the second time.
Search the internet for F# examples of a merge sort that uses continuations.
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.
Is there already a way to do something like a chooseTill or a foldTill, where it will process until a None option is received? Really, any of the higher order functions with a "till" option. Granted, it makes no sense for stuff like map, but I find I need this kind of thing pretty often and I wanted to make sure I wasn't reinventing the wheel.
In general, it'd be pretty easy to write something like this, but I'm curious if there is already a way to do this, or if this exists in some known library?
let chooseTill predicate (sequence:seq<'a>) =
seq {
let finished = ref false
for elem in sequence do
if not !finished then
match predicate elem with
| Some(x) -> yield x
| None -> finished := true
}
let foldTill predicate seed list =
let rec foldTill' acc = function
| [] -> acc
| (h::t) -> match predicate acc h with
| Some(x) -> foldTill' x t
| None -> acc
foldTill' seed list
let (++) a b = a.ToString() + b.ToString()
let abcdef = foldTill (fun acc v ->
if Char.IsWhiteSpace v then None
else Some(acc ++ v)) "" ("abcdef ghi" |> Seq.toList)
// result is "abcdef"
I think you can get that easily by combining Seq.scan and Seq.takeWhile:
open System
"abcdef ghi"
|> Seq.scan (fun (_, state) c -> c, (string c) + state) ('x', "")
|> Seq.takeWhile (fst >> Char.IsWhiteSpace >> not)
|> Seq.last |> snd
The idea is that Seq.scan is doing something like Seq.fold, but instead of waiting for the final result, it yields the intermediate states as it goes. You can then keep taking the intermediate states until you reach the end. In the above example, the state is the current character and the concatenated string (so that we can check if the character was whitespace).
A more general version based on a function that returns option could look like this:
let foldWhile f initial input =
// Generate sequence of all intermediate states
input |> Seq.scan (fun stateOpt inp ->
// If the current state is not 'None', then calculate a new one
// if 'f' returns 'None' then the overall result will be 'None'
stateOpt |> Option.bind (fun state -> f state inp)) (Some initial)
// Take only 'Some' states and get the last one
|> Seq.takeWhile Option.isSome
|> Seq.last |> Option.get
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 write some code to learning F#.
Here is a example:
let nextPrime list=
let rec loop n=
match n with
| _ when (list |> List.filter (fun x -> x <= ( n |> double |> sqrt |> int)) |> List.forall (fun x -> n % x <> 0)) -> n
| _ -> loop (n+1)
loop (List.max list + 1)
let rec findPrimes num=
match num with
| 1 -> [2]
| n ->
let temp = findPrimes <| n-1
(nextPrime temp ) :: temp
//find 10 primes
findPrimes 10 |> printfn "%A"
I'm very happy that it just works!
I'm totally beginner to recursion
Recursion is a wonderful thing.
I think findPrimes is not efficient.
Someone help me to refactor findPrimes to tail recursion if possible?
BTW, is there some more efficient way to find first n primes?
Regarding the first part of your question, if you want to write a recursive list building function tail-recursively you should pass the list of intermediate results as an extra parameter to the function. In your case this would be something like
let findPrimesTailRecursive num =
let rec aux acc num =
match num with
| 1 -> acc
| n -> aux ((nextPrime acc)::acc) (n-1)
aux [2] num
The recursive function aux gathers its results in an extra parameter conveniently called acc (as in acc-umulator). When you reach your ending condition, just spit out the accumulated result. I've wrapped the tail-recursive helper function in another function, so the function signature remains the same.
As you can see, the call to aux is the only, and therefore last, call to happen in the n <> 1 case. It's now tail-recursive and will compile into a while loop.
I've timed your version and mine, generating 2000 primes. My version is 16% faster, but still rather slow. For generating primes, I like to use an imperative array sieve. Not very functional, but very (very) fast.
An alternative is to use an extra continuation argument to make findPrimes tail recursive. This technique always works. It will avoid stack overflows, but probably won't make your code faster.
Also, I put your nextPrime function a little closer to the style I'd use.
let nextPrime list=
let rec loop n = if list |> List.filter (fun x -> x*x <= n)
|> List.forall (fun x -> n % x <> 0)
then n
else loop (n+1)
loop (1 + List.head list)
let rec findPrimesC num cont =
match num with
| 1 -> cont [2]
| n -> findPrimesC (n-1) (fun temp -> nextPrime temp :: temp |> cont)
let findPrimes num = findPrimesC num (fun res -> res)
findPrimes 10
As others have said, there's faster ways to generate primes.
Why not simply write:
let isPrime n =
if n<=1 then false
else
let m = int(sqrt (float(n)))
{2..m} |> Seq.forall (fun i->n%i<>0)
let findPrimes n =
{2..n} |> Seq.filter isPrime |> Seq.toList
or sieve (very fast):
let generatePrimes max=
let p = Array.create (max+1) true
let rec filter i step =
if i <= max then
p.[i] <- false
filter (i+step) step
{2..int (sqrt (float max))} |> Seq.iter (fun i->filter (i+i) i)
{2..max} |> Seq.filter (fun i->p.[i]) |> Seq.toArray
BTW, is there some more efficient way to find first n primes?
I described a fast arbitrary-size Sieve of Eratosthenes in F# here that accumulated its results into an ever-growing ResizeArray:
> let primes =
let a = ResizeArray[2]
let grow() =
let p0 = a.[a.Count-1]+1
let b = Array.create p0 true
for di in a do
let rec loop i =
if i<b.Length then
b.[i] <- false
loop(i+di)
let i0 = p0/di*di
loop(if i0<p0 then i0+di-p0 else i0-p0)
for i=0 to b.Length-1 do
if b.[i] then a.Add(p0+i)
fun n ->
while n >= a.Count do
grow()
a.[n];;
val primes : (int -> int)
I know that this is a bit late, and an answer was already accepted. However, I believe that a good step by step guide to making something tail recursive may be of interest to the OP or anyone else for that matter. Here are some tips that have certainly helped me out. I'm going to use a strait-forward example other than prime generation because, as others have stated, there are better ways to generate primes.
Consider a naive implementation of a count function that will create a list of integers counting down from some n. This version is not tail recursive so for long lists you will encounter a stack overflow exception:
let rec countDown = function
| 0 -> []
| n -> n :: countDown (n - 1)
(* ^
|... the cons operator is in the tail position
as such it is evaluated last. this drags
stack frames through subsequent recursive
calls *)
One way to fix this is to apply continuation passing style with a parameterized function:
let countDown' n =
let rec countDown n k =
match n with
| 0 -> k [] (* v--- this is continuation passing style *)
| n -> countDown (n - 1) (fun ns -> n :: k ns)
(* ^
|... the recursive call is now in tail position *)
countDown n (fun ns -> ns)
(* ^
|... and we initialize k with the identity function *)
Then, refactor this parameterized function into a specialized representation. Notice that the function countDown' is not actually counting down. This is an artifact of the way the continuation is built up when n > 0 and then evaluated when n = 0. If you have something like the first example and you can't figure out how to make it tail recursive, what I'm suggesting is that you write the second one and then try to optimize it to eliminate the function parameter k. That will certainly improve the readability. This is an optimization of the second example:
let countDown'' n =
let rec countDown n ns =
match n with
| 0 -> List.rev ns (* reverse so we are actually counting down again *)
| n -> countDown (n - 1) (n :: ns)
countDown n []