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.
Related
I tried to write a tail recursive code for mergesort. The code does compile and run. However, the output is wrong. It only outputs one integer. I was wondering how I would fix this code so that the list of integers are sorted and outputted.
let rec merge L L2 P =
match L, L2 with
| [], [] -> P
| [], _ -> L2
| _, [] -> L
| hd::t1, hd2::t2 ->
if hd <= hd2 then
merge t1 L2 (P # [hd])
else
merge L t2 (P # [hd2])
//
// mergesort:
//
let rec ms L =
match L with
| [] -> []
| e::[] -> L
| _ ->
let mid = List.length L / 2
let (L, L2) = List.splitAt mid L
merge (ms L) (ms L2) []
Your problem is in function merge: imagine you sort the list [2;1]. It turns to merge [2] [1] [], then to merge [] [2] [1], and finally second case of match yields [2]. Second and third cases of match must account for P somehow.
In fact, you absolutely do not need to manipulate 3 lists in your merge, two is quite enough if we refactor it to:
let rec merge l1 l2 =
match (l1,l2) with
| (x,[]) -> x
| ([],y) -> y
| (x::tx,y::ty) ->
if x <= y then x::merge tx l2
else y::merge l1 ty
and change the last line of ms to merge (ms L) (ms L2) - and this variant does work as expected:
ms List<int>.Empty returns []
ms [2;1] returns [1;2]
e.t.c
Update: As #kvb pointed out the merge function above is not tail recursive. This is correct and refactoring it to tail-recursive version requires more involvement by introducing an accumulator acc being filled via continuation function:
let merge l1 l2 =
let rec mergeAux continuation l1 l2 =
match l1, l2 with
| l1, [] -> continuation l1
| [], l2 -> continuation l2
| x::tx, y::ty ->
if x <= y then mergeAux (fun acc -> continuation(x::acc)) tx l2
else mergeAux (fun acc -> continuation(y::acc)) l1 ty
mergeAux id l1 l2
Now the implementation is tail-recursive that is easy to check with:
let rand = System.Random() in
List.init 1000000 (fun _ -> rand.Next(-10000,10000)) |> ms
>
val it : int list =
[-10000; -10000; -10000; -10000; -10000; -10000; -10000; ...
Even after the changes made for the accepted answer you still do not have a tail recursive merge sort. The last line of the merge sort merge (ms L) (ms L2) calls ms twice then calls merge. In order for a function to be tail recursive your function must end with at most one recursive call to itself. This scenario is where continuations are needed. By passing a continuation you can make one call to ms and pass it a continuation that makes the second call to ms and pass that second call another continuation that makes the call to merge. I would actually remove the continuation from the merge function as it is not needed and it makes the merge function more difficult to read than implementing it with an accumulator parameter. Lastly, for easy callability from the outside, I would nest the merge function as well as the ms function inside of a mergeSort function that only takes one list parameter, There's no need to expose the rest of the details to callers. My implementation of a fully tail recursive merge sort in F# would be as follows:
let mergeSort ls =
let rec merge l1 l2 res =
match l1, l2 with
| [], [] -> res |> List.rev
| x::xs, [] -> merge xs [] (x::res)
| [], y::ys -> merge [] ys (y::res)
| x::xs, y::ys when x < y -> merge xs (y::ys) (x::res)
| xs, y::ys -> merge xs ys (y::res)
let rec ms ls cont =
match ls with
| [] -> cont []
| [x] -> cont [x]
| xs ->
let ys, zs = List.splitAt ((List.length xs) / 2) xs
ms ys (fun ys' -> ms zs (fun zs' -> cont (merge ys' zs' [])))
ms ls id
Note that there are ways to do this more efficiently in terms of memory usage, which would likely also help the speed due to less memory allocations, but since that is beyond the scope of this question I'm not going to get into that in the answer.
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.
This question already has answers here:
Merge two lists
(6 answers)
Closed 6 years ago.
I am looking to write a recursive function to merge to integer lists in F#
I started with this, but not sure what to do next.
let rec merge xs ys =
match xs with
| [] -> ys
|
let li = [1;3;5;7;]
let ll = [2;4;5;8;]
As I said in my comment, it's probably easiest if you pattern match on xs and ys simultaneously:
let rec merge xs ys =
match xs,ys with
| [],l | l,[] -> l
| x::xs', y::ys' ->
if x < y then x :: (merge xs' ys) //'
else y :: (merge xs ys') //'
I found a way that might suit what the asker wanted. I for one had to solve this very same problem and was barely given a week's worth of lessons on F# so the whole syntax wasn't discussed in class and when I saw the answer above the use of multiple matching ( match lst1, list2 with ... ) I recognized it's use instantly but the professor wouldn't allow it's use, therefor I had to come up with this other alternative. Even thought it's basically the same algorithm it uses more basic code. Just thought I should post it =)
let rec merge2 list1 list2 =
let head list = match list with | [] -> 0 | h::t -> h
let tail list = match list with | [] -> [] | h::t -> t
match list1 with
| [] -> []
| h::t ->
//list2's head is 0 then list is empty then return whats in the first list
//(i.e no more values of second list to compare)
if head list2 = 0 then list1
elif h < head list2 then h :: merge2 t list2
else head list2 :: merge2 list1 (tail list2)
You already have one of the base cases right: If xs is empty, just return ys.
Likewise, if ys empty, return xs.
For the case where both xs and ys are not empty, you need to look at xs's and ys's first elements (let's call them x and y):
If x is less than y, than it needs to be inserted before y in the final list. So you take y and prepend to the result of merging the tail of xs with ys (including y).
Otherwise y needs to come first. So prepend y to the result of merging xs (including x) with the tail of ys.
It's not recursive, but if the inputs aren't sorted:
let merge xs ys = (Seq.append xs ys) |> Seq.sort |> Seq.toList
I would use List.fold to do this:
let merge a b =
List.fold (fun acc x ->
if List.exists ((=)x) acc = false then
elem :: acc
else
acc
) (List.sort a) b
This may not be the fastest way to do it, though.
I don't think this is a recursion problem
let a = [1;3;5]
let b = [2;4;6]
let c = Seq.append a b |> Seq.sort
output from fsi session:
c:
val it : seq<int> = seq [1; 2; 3; 4; ...]
A simple append function like this (in F#):
let rec app s t =
match s with
| [] -> t
| (x::ss) -> x :: (app ss t)
will crash when s becomes big, since the function is not tail recursive. I noticed that F#'s standard append function does not crash with big lists, so it must be implemented differently. So I wondered: How does a tail recursive definition of append look like? I came up with something like this:
let rec comb s t =
match s with
| [] -> t
| (x::ss) -> comb ss (x::t)
let app2 s t = comb (List.rev s) t
which works, but looks rather odd. Is there a more elegant definition?
Traditional (not tail-recursive)
let rec append a b =
match a, b with
| [], ys -> ys
| x::xs, ys -> x::append xs ys
With an accumulator (tail-recursive)
let append2 a b =
let rec loop acc = function
| [] -> acc
| x::xs -> loop (x::acc) xs
loop b (List.rev a)
With continuations (tail-recursive)
let append3 a b =
let rec append = function
| cont, [], ys -> cont ys
| cont, x::xs, ys -> append ((fun acc -> cont (x::acc)), xs, ys)
append(id, a, b)
Its pretty straight-forward to convert any non-tail recursive function to recursive with continuations, but I personally prefer accumulators for straight-forward readability.
In addition to what Juliet posted:
Using sequence expressions
Internally, sequence expressions generate tail-recursive code, so this works just fine.
let append xs ys =
[ yield! xs
yield! ys ]
Using mutable .NET types
David mentioned that F# lists can be mutated - that's however limited only to F# core libraries (and the feature cannot be used by users, because it breaks the functional concepts). You can use mutable .NET data types to implement a mutation-based version:
let append (xs:'a[]) (ys:'a[]) =
let ra = new ResizeArray<_>(xs)
for y in ys do ra.Add(y)
ra |> List.ofSeq
This may be useful in some scenarios, but I'd generally avoid mutation in F# code.
From a quick glance at the F# sources, it seems the tail is internally mutable. A simple solution would be to reverse the first list before consing its elements to the second list. That, along with reversing the list, are trivial to implement tail recursively.
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