I am trying to input a list into the function and it send me a list with the first half of the elements taken away using f# with the below recursion but I keep running into a base case problem that I just cant figure out. any thoughts? I am using the second shadow list to count how far I need to go until I am half way into the list (by removing two elements at a time)
let rec dropHalf listToDrop shadowList =
match shadowList with
| [] -> listToDrop
| shadowHead2::shadowHead1::shadowTail -> if shadowTail.Length<=1 then listToDrop else
match listToDrop with
|[] -> listToDrop
|listToDropHead::listToDropTail -> dropHalf listToDropTail shadowTail
let rec dropHalf listToDrop shadowList =
match shadowList with
| [] -> listToDrop
| shadowHead2::[] -> listToDrop (* odd number! *)
| shadowHead1::shadowHead2::shadowTail ->
match listToDrop with
| [] -> listToDrop (* should never happen? *)
| listToDropHead::listToDropTail -> dropHalf listToDropTail shadowTail
i'm afraid i don't use F#, but it's similar to ocaml, so hopefully the following is close to what you're looking for (maybe the comment format has changed?!). the idea is that when you exhaust the shadow you're done. your code was almost there, but the test for length on the shadow tail made no sense.
i want to emphasize that this isn't anything like anyone would write "in real life", but it sounds like you're battling with some weird requirements.
Because you use the shadow list with the same length as the original list and remove elements from these lists with different rates, it's better to create an auxiliary function:
let dropHalf xs =
let rec dropHalf' ys zs =
match ys, zs with
| _::_::ys', _::zs' -> dropHalf' ys' zs'
| _, zs' -> zs' (* One half of the shadow list ys *)
dropHalf' xs xs
If you don't care to traverse the list twice, the following solution is simpler:
let rec drop n xs =
match xs, n with
| _ when n < 0 -> failwith "n should be greater or equals to 0"
| [], _ -> []
| _, 0 -> xs
| _::xs', _ -> drop (n-1) xs'
let dropHalf xs =
xs |> drop (List.length xs/2)
and another simple solution needs some extra space but doesn't have to use recursion:
let dropHalf xs =
let xa = Array.ofList xs
xa.[xa.Length/2..] |> List.ofArray
As a general rule of thumb, if you're calling Length on a list, then there is most likely a better way to do what you're doing. Length has to iterate the entire list and is therefore O(n).
let secondHalf list =
let rec half (result : 'a list) = function
| a::b::sx -> half result.Tail sx
// uncomment to remove odd value from second half
// | (a::sx) -> result.Tail
| _ -> result
half list list
Here is a sample does what you described.
open System
open System.Collections.Generic
let items = seq { 1 .. 100 } |> Seq.toList
let getBackOfList ( targetList : int list) =
if (targetList.Length = 0) then
targetList
else
let len = targetList.Length
let halfLen = len / 2
targetList |> Seq.skip halfLen |> Seq.toList
let shortList = items |> getBackOfList
("Len: {0}", shortList.Length) |> Console.WriteLine
let result = Console.ReadLine()
Hope this helps
Related
tldr; go to My Question
I believe that the problem presented here must not be at all new, but I have failed to find any directly corresponding discussion.
Let's say that I have the following function (in order to provide a deterministic substitute for a real-world function having the same structural properties, of type 'a -> 'a seq):
// I'm a function that looks suspiciously like a tree
let lsExample x =
match x with
| 0 -> seq { 1; 6; 7 }
| 1 -> seq { 2; 3 }
| 3 -> seq { 4; 5 }
| 7 -> seq { 8; 9 }
| _ -> Seq.empty
Now, I wish to have the following:
let lsAll: ('a -> 'a seq) -> 'a -> 'a seq
such that
lsAll lsExample 0
evaluates to
seq { 0 .. 9 }
I have found one long-winded solution to this, and one simple, but still not ideal, solution to a similar problem.
Solution 1
Convert the ls function to a Rose Tree, then do a pre-order dfs on the tree, as follows:
open FSharpx.Collections
module L = LazyList
module R = Experimental.RoseTree
let rec asRoseTree (ls: 'a -> seq<'a>) (item: 'a) =
let children = ls item
if (Seq.isEmpty children) then
R.singleton item
else
children
|> Seq.map (asRoseTree ls)
|> L.ofSeq
|> R.create item
let lsAll ls =
asRoseTree ls >> R.dfsPre
Solution 2
Having got the job done, I wanted a more elegant solution, so started with this approximation using 'a -> 'a list (lists offer structural pattern matching, whereas seqs don't... I hope no one ever uses this implementation):
let rec lsAll' (ls: 'a -> 'a list) (xs: 'a list) =
match xs with
| [] -> []
| [x] -> lsAll' ls (ls x) |> List.append [x]
| x :: tail -> lsAll' ls tail |> List.append (lsAll' ls [x])
let lsAll ls x = lsAll' ls [x]
I then got stumped trying to make this tail-recursive, even without the extra inconvenience of switching back to seq.
My question
How can we implement lsAll:
without resorting to constructing an intermediate, explicit tree structure;
with the desired types (seq, not list);
using tail recursion (a case for CPS?); and
without explicit self recursion (e.g. use a fold with accumulator/cps)?
Aside: Having got the job done and written this question up, I'm now thinking that getting the input function into a tree structure might not be a waste at all, and I should have made better use of it. That said, I'm still too curious to give up on this quest!
You can do this very nicely using F# sequence expressions and the yield and yield! constructs:
let rec lsAll ls x = seq {
yield x
for c in ls x do
yield! lsAll ls c }
lsAll lsExample 0
A sequence expression seq { .. } is a code block that generates a sequence. Inside this, you can use yield to add a single element to the sequence but also yield! to add all elements of some other sequence. Here, you can do this to include all values produced by a recursive call.
You could combine this with the approach in your solution 2 too:
let rec lsAll ls xs = seq {
match xs with
| [] -> ()
| x::xs ->
yield x
yield! lsAll ls (ls x)
yield! lsAll ls xs }
This requires lsAll to return a list - you could insert List.ofSeq on the line before the last, but I think it's probably best to leave this to the user. However, you can now turn this into tail-recursive version by using CPS where the continuation is "sequence of values to be produced after the current one is done":
let rec lsAll ls xs cont = seq {
match xs with
| [] -> yield! cont
| x::xs ->
yield x
yield! lsAll ls (ls x) (lsAll ls xs cont) }
lsAll (lsExample >> List.ofSeq) [0] Seq.empty
If I give this an infinite tree, it does not actually StackOverflow, but keeps allocating more and more memory, so I guess it works!
I want to learn some functional style programming, so I want to write a littel Connect 4 engine.
Given a board I want to determine if a player has won in that board state, so I need a function
let winner (board : Board) : Player option = ???
'Usually' one could simply loop through the rows, the columns, and the diagonals, and as soon as we find a winner we return whoever we found and 'break out'. I'm not sure if something like that is even possible in F#.
In my current implementation I am using a helper function which takes a list of board cells and checks if there are four consecutive cells belonging to PlayerA or PlayerB. It returns a Player option type.
Then in my main 'winner' function I check if there is a winner in the rows, if yes, return that Player, if None, check the columns, etc.
So basically I am doing a lot of matching and stuff, and it seems to me like this should be easier to do with some kind of bind, but I wouldn't know how.
So how would one approach this problem in functional style?
EDIT: Some Code Snippets
These are my basic types
type Player =
| PlayerA
| PlayerB
type Cell =
| Empty
| Occupied of Player
type Board = Cell [] list
// Cell [] [] would probably be better, but some things were easier when I could use pattern matching x :: xs for lists
Here are some helper functions. This already seems like too much.
let rec getFours (l: 'a list):'a list list =
if List.length l < 4 then
[[]]
elif List.length l = 4 then
[l]
else
match l with
| [] -> [[]]
| x::xs -> [[x;l.[1];l.[2];l.[3]]] # getFours xs
let quadToPlayer quad=
if List.forall (fun x -> x = Occupied PlayerA) quad then
Some PlayerA
elif List.forall (fun x -> x = Occupied PlayerB) quad then
Some PlayerB
else
None
let rowWinnerHelper (row : Cell []) : Player option=
if Array.length row <4 then
None
else
let possibleWinners = getFours (List.ofArray row) |> List.map quadToPlayer
if List.exists (fun x -> x = Some PlayerA) possibleWinners then
Some PlayerA
elif List.exists (fun x -> x = Some PlayerB) possibleWinners then
Some PlayerB
else
None
let rowWinner (board:Board) : Player option =
let rowWinners = List.map rowWinnerHelper board
if List.exists (fun x -> x = Some PlayerA) rowWinners then
Some PlayerA
elif List.exists (fun x -> x = Some PlayerB) rowWinners then
Some PlayerB
else
None
What I don't like for example is that I am computing possible winners for all rows and all quadruples in each row etc. Instead of just stopping once I found the first winning Player.
Your could improve your getFours by computing if it's a win immediately rather than building lists.
let rec getFours player (l: 'a list): bool =
if List.length l < 4 then
false
elif List.length l = 4 then
quadToPlayer player l
else
match l with
| [] -> false
| x::xs -> (quadToPlayer player [x; l.[1];l.[2];l.[3]]) || (getFours xs)
let quadToPlayer player quad =
List.forall (fun x -> x = Occupied player) quad
Alternatively, if you have a fixed board size you can then precompute winning patterns and you can bitmask against them. This will increase significantly the performance.
Encode each players moves into a bit array (each) maybe using long type depending on the size of your board. The example below is for tic-tac-toe.
let white,black = board
let winningPatterns =
[
0b111000000; // horizontal
0b000111000;
0b000000111;
0b100100100; // vertical
0b010010010;
0b001001001;
0b100010001; // diagonal
0b001010100 ]
let whiteWin = winningPatterns
|> Seq.map( fun p -> white &&& p = p )
|> Seq.reduce (||)
let blackWin = winningPatterns
|> Seq.map( fun p -> black &&& p = p )
|> Seq.reduce (||)
There is an Elm implementation of Connect 4 here.
Following ideas from there, I learned that fold does the trick, as it can just keep track how many consecutive pieces by one player we have seen.
let arrayWinner (row:Cell []) (player:Player) =
Array.fold (fun count p->
if count = 4 then
4
elif p = Occupied player then
count + 1
else
0
) 0 row
|> (=) 4
This can then be used in an 'exists'-check
let arrayOfArrayWinner (board:Cell [] []) (player:Player) =
Array.exists (fun arr -> arrayWinner arr player) board
This bit of code accomplishes basically the same as the code snippet in the question.
How would I go about adding sub-lists.
For example, [ [10;2;10]; [10;50;10]] ----> [20;52;20] that is 10+10, 2+50 and 10+10. Not sure how to start this.
Fold is a higher order function:
let input = [[10;2;10]; [10;50;10]]
input |> Seq.fold (fun acc elem -> acc + (List.nth elem 1)) 0
val it : int = 52
Solution 1: Recursive version
We need a helper function to add two lists by summing elements one-to-one. It is recursive and assumes that both lists are of the same length:
let rec sum2Lists (l1:List<int>) (l2:List<int>) =
match (l1,l2) with
| ([],[]) -> []
| (x1::t1, x2::t2) -> (x1+x2)::sum2Lists t1 t2
Then the following recursive function can process a list of lists, using our helper function :
let rec sumLists xs =
match xs with
| [] -> [] // empty list
| x1::[] -> x1 // a single sublist
| xh::xt -> sum2Lists xh (sumLists xt) // add the head to recursion on tail
let myres = sumLists mylist
Solution 2: higher order function
Our helper function can be simplified, using List.map2:
let sum2hfLists (l1:List<int>) (l2:List<int>) = List.map2 (+) l1 l2
We can then use List.fold to create an on the flow accumulator using our helper function:
let sumhfList (l:List<List<int>>) =
match l with
| [] -> [] // empty list of sublist
| h::[] -> h // list with a single sublist
| h::t -> List.fold (fun a x -> sum2hfLists a x) h t
The last match case is applied only for lists of at least two sublists. The trick is to take the first sublist as starting point of the accumulator, and let fold execute on the rest of the list.
I am trying to implement a tail-recursive MergeSort in OCaml.
Since Mergesort naturally is not tail-recursive, so I am using CPS to implement it.
Also my implementation is inspired by Tail-recursive merge sort in OCaml
Below is my code
let merge compare_fun l1 l2 =
let rec mg l1 l2 acc =
match l1, l2 with
| ([], []) -> List.rev acc
| ([], hd2::tl2) -> mg [] tl2 (hd2::acc)
| (hd1::tl1, []) -> mg tl1 [] (hd1::acc)
| (hd1::tl1, hd2::tl2) ->
let c = compare_fun hd1 hd2
in
if c = 1 then mg l1 tl2 (hd2::acc)
else if c = 0 then mg tl1 tl2 (hd2::hd1::acc)
else mg tl1 l2 (hd1::acc)
in
mg l1 l2 [];;
let split_list p l =
let rec split_list p (acc1, acc2) = function
| [] -> (List.rev acc1, List.rev acc2)
| hd::tl ->
if p > 0 then split_list (p-1) (hd::acc1, acc2) tl
else split_list (p-2) (acc1, hd::acc2) tl
in
split_list p ([], []) l;;
let mergeSort_cps compare_fun l =
let rec sort_cps l cf = (*cf = continuation func*)
match l with
| [] -> cf []
| hd::[] -> cf [hd]
| _ ->
let (left, right) = split_list ((List.length l)/2) l
in
sort_cps left (fun leftR -> sort_cps right (fun rightR -> cf (merge compare_fun leftR rightR)))
in
sort_cps l (fun x -> x);;
When I compile it, and run it with a 1,000,000 integers, it gives the error of stackoverflow. Why?
Edit
Here is the code I used for testing:
let compare_int x y =
if x > y then 1
else if x = y then 0
else -1;;
let create_list n =
Random.self_init ();
let rec create n' acc =
if n' = 0 then acc
else
create (n'-1) ((Random.int (n/2))::acc)
in
create n [];;
let l = create_list 1000000;;
let sl = mergeSort_cps compare_int l;;
in http://try.ocamlpro.com/, it gave this error: Exception: RangeError: Maximum call stack size exceeded.
in local ocaml top level, it didn't have any problem
Adding another answer to make a separate point: it seems that much of the confusion among answerers is caused by the fact that you don't use the standard OCaml compiler, but the TryOCaml website which runs a distinct OCaml backend, on top of javascript, and has therefore slightly different optimization and runtime characteristics.
I can reliably reproduce the fact that, on the TryOCaml website, the CPS-style function mergeSort_cps you show fails on lists of length 1_000_000 with the following error:
Exception: InternalError: too much recursion.
My analysis is that this is not due to a lack of tail-rec-ness, but by a lack of support, on the Javascript backend, of the non-obvious way in which the CPS-translated call is tailrec: recursion goes through a lambda-abstraction boundary (but still in tail position).
Turning the code in the direct, non-tail-rec version makes the problem go away:
let rec merge_sort compare = function
| [] -> []
| [hd] -> [hd]
| l ->
let (left, right) = split_list (List.length l / 2) l in
merge compare (merge_sort compare left) (merge_sort compare right);;
As I said in my other answer, this code has a logarithmic stack depth, so no StackOverflow will arise from its use (tail-rec is not everything). It is simpler code that the Javascript backend handles better.
Note that you can make it noticeably faster by using a better implementation split (still with your definition of merge) that avoids the double traversal of List.length then splitting:
let split li =
let rec split ls rs = function
| [] -> (ls, rs)
| x::xs -> split rs (x::ls) xs in
split [] [] li;;
let rec merge_sort compare = function
| [] -> []
| [hd] -> [hd]
| l ->
let (left, right) = split l in
merge compare (merge_sort compare left) (merge_sort compare right);;
Reading the comments, it seems that your Stack_overflow error is hard to reproduce.
Nevertheless, your code is not entirely in CPS or tail-recursive: in merge_sort, the calls to split_list and merge are made in a non-tail-call position.
The question is: by making your CPS transform and generous use of accumulators, what will be the worst stack depth related to recursion? Saving stack depth on the sort calls is in fact not very interesting: as each split the list in two, the worst stack depth would be O(log n) for n the size the input list.
On the contrary, split and merge would have made a linear O(n) usage of the stack if they weren't written in accumulator-passing style, so they are important to make tail-rec. As your implementation of those routines is tail-rec, there should be no need to worry about stack usage, and neither to convert the sort routine itself in CPS form that makes the code harder to read.
(Note that this logarithmic-decrease argument is specific to mergesort. A quicksort can have linear stack usage in worst case, so it could be important to make it tail-rec.)
Take this example code (ignore it being horribly inefficient for the moment)
let listToString (lst:list<'a>) = ;;' prettify fix
let rec inner (lst:list<'a>) buffer = ;;' prettify fix
match List.length lst with
| 0 -> buffer
| _ -> inner (List.tl lst) (buffer + ((List.hd lst).ToString()))
inner lst ""
This is a common pattern I keep coming across in F#, I need to have an inner function who recurses itself over some value - and I only need this function once, is there in any way possible to call a lambda from within it self (some magic keyword or something) ? I would like the code to look something like this:
let listToString2 (lst:list<'a>) = ;;' prettify fix
( fun
(lst:list<'a>) buffer -> match List.length lst with ;;' prettify fix
| 0 -> buffer
| _ -> ##RECURSE## (List.tl lst) (buffer + ((List.hd lst).ToString()))
) lst ""
But as you might expect there is no way to refer to the anonymous function within itself, which is needed where I put ##RECURSE##
Yes, it's possible using so called y-combinators (or fixed-point combinators). Ex:
let rec fix f x = f (fix f) x
let fact f = function
| 0 -> 1
| x -> x * f (x-1)
let _ = (fix fact) 5 (* evaluates to "120" *)
I don't know articles for F# but this haskell entry might also be helpful.
But: I wouldn't use them if there is any alternative - They're quite hard to understand.
Your code (omit the type annotations here) is a standard construct and much more expressive.
let listToString lst =
let rec loop acc = function
| [] -> acc
| x::xs -> loop (acc ^ (string x)) xs
loop "" lst
Note that although you say you use the function only once, technically you refer to it by name twice, which is why it makes sense to give it a name.