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.
Related
I'm currently generating a sequence in a similar way to:
migrators
|> Seq.map (fun m -> m())
The migrator function is ultimately returning a discriminated union like:
type MigratorResult =
| Success of string * TimeSpan
| Error of string * Exception
I want to stop the map once I encounter my first Error but I need to include the Error in the final sequence.
I have something like the following to display a final message to the user
match results |> List.rev with
| [] -> "No results equals no migrators"
| head :: _ ->
match head with
| Success (dt, t) -> "All migrators succeeded"
| Error (dt, ex) -> "Migration halted owing to error"
So I need:
A way to stop the mapping when one of the map steps produces an Error
A way to have that error be the final element added to the sequence
I appreciate there may be a different sequence method other than map that will do this, I'm new to F# and searching online hasn't yielded anything as yet!
I guess there are multiple approaches here, but one way would be to use unfold:
migrators
|> Seq.unfold (fun ms ->
match ms with
| m :: tl ->
match m () with
| Success res -> Some (Success res, tl)
| Error res -> Some (Error res, [])
| [] -> None)
|> List.ofSeq
Note the List.ofSeq at the end, that's just there for realizing the sequence. A different way to go would be to use sequence comprehensions, some might say it results in a clearer code.
The ugly things Tomaš alludes to are 1) mutable state, and 2) manipulation of the underlying enumerator. A higher-order function which returns up to and including when the predicate holds would then look like this:
module Seq =
let takeUntil pred (xs : _ seq) = seq{
use en = xs.GetEnumerator()
let flag = ref true
while !flag && en.MoveNext() do
flag := not <| pred en.Current
yield en.Current }
seq{1..10} |> Seq.takeUntil (fun x -> x % 5 = 0)
|> Seq.toList
// val it : int list = [1; 2; 3; 4; 5]
For your specific application, you'd map the cases of the DU to a boolean.
(migrators : seq<MigratorResult>)
|> Seq.takeUntil (function Success _ -> false | Error _ -> true)
I think the answer from #scrwtp is probably the nicest way to do this if your input is reasonably small (and you can turn it into an F# list to use pattern matching). I'll add one more version, which works when your input is just a sequence and you do not want to turn it into a list.
Essentially, you want to do something that's almost like Seq.takeWhile, but it gives you one additional item at the end (the one, for which the predicate fails).
To use a simpler example, the following returns all numbers from a sequence until one that is divisible by 5:
let nums = [ 2 .. 10 ]
nums
|> Seq.map (fun m -> m % 5)
|> Seq.takeWhile (fun n -> n <> 0)
So, you basically just need to look one element ahead - to do this, you could use Seq.pairwise which gives you the current and the next element in the sequence"
nums
|> Seq.map (fun m -> m % 5)
|> Seq.pairwise // Get sequence of pairs with the next value
|> Seq.takeWhile (fun (p, n) -> p <> 0) // Look at the next value for test
|> Seq.mapi (fun i (p, n) -> // For the first item, we return both
if i = 0 then [p;n] else [n]) // for all other, we return the second
|> Seq.concat
The only ugly thing here is that you then need to flatten the sequence again using mapi and concat.
This is not very nice, so a good thing to do would be to define your own higher-order function like Seq.takeUntilAfter that encapsulates the behavior you need (and hides all the ugly things). Then your code could just use the function and look nice & readable (and you can experiment with other ways of implementing this).
I implemented quicksort in OCaml. Here is the code:
let shuffle d =
let nd = List.map (fun c -> (Random.bits (), c)) d in
let sond = List.sort compare nd in
List.map snd sond;;
let partition = function
| [] -> ([], [], [])
| pivot::tl ->
let rec p (left, right) = function
| [] -> (left, right, [pivot])
| first::rest ->
let c = compare pivot first
in
if c > 0 then
p (first::left, right) rest
else
p (left, first::right) rest
in
p ([], []) tl;;
let quicksort l =
let sl = shuffle l
in
let rec qs = function
| [] -> []
| l ->
let (left, right, pivot) = partition l
in
(qs left) # pivot # (qs right)
in
qs sl;;
First, I think maybe there is a better way to implement partition. List.partition came to my mind, but I just wanted to implement the key part by myself
Second, I use # a lot in the sorting which is inefficient, right?
any suggestions?
Edit
One more question to think about is whether 3-way quicksort affects the implementation in OCaml?
The p function is badly indented; speaking of indentation, I tend to think the style of having a in on the next line is overkill for single-line declarations, so I'd rather put them at the end of the one-liner declaration.
More importantly, there is no need for it to take a tuple of lists as arguments, you'll have something syntactically lighter using two separate (curried) arguments. You could also use the List.partition function of the standard library.
A micro optimization that you can try is to do List.concat[[qs left]; [pivot]; [qs right]] to append the lists at once buth you will need to run some benchmarks to verify this even helps.
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.)
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
For an assignment, i have written the following code in recursion. It takes a list of a vector data type, and a vector and calculates to closeness of the two vectors. This method works fine, but i don't know how to do the recursive version.
let romulus_iter (x:vector list) (vec:vector) =
let vector_close_hash = Hashtbl.create 10 in
let prevkey = ref 10000.0 in (* Define previous key to be a large value since we intially want to set closefactor to prev key*)
if List.length x = 0 then
{a=0.;b=0.}
else
begin
Hashtbl.clear vector_close_hash;
for i = 0 to (List.length x)-1 do
let vecinquestion = {a=(List.nth x i).a;b=(List.nth x i).b} in
let closefactor = vec_close vecinquestion vec in
if (closefactor < !prevkey) then
begin
prevkey := closefactor;
Hashtbl.add vector_close_hash closefactor vecinquestion
end
done;
Hashtbl.find vector_close_hash !prevkey
end;;
The general recursive equivalent of
for i = 0 to (List.length x)-1 do
f (List.nth x i)
done
is this:
let rec loop = function
| x::xs -> f x; loop xs
| [] -> ()
Note that just like a for-loop, this function only returns unit, though you can define a similar recursive function that returns a meaningful value (and in fact that's what most do). You can also use List.iter, which is meant just for this situation where you're applying an impure function that doesn't return anything meaningful to each item in the list:
List.iter f x