I know recursive function is a powerful technique in F#. My question is: Is there an exit statement, which can jump out recursive functions, just like imperative languages. For example, Insert a node to a binary tree.
type Tree<'a> when 'a :> IComparable<'a> =
| Nil
| Leaf of 'a
| Node of Tree<'a> * 'a * Tree<'a>
let tt2 = Node(
Node(Leaf "D", "B",Node(Leaf "G", "E", Leaf "H" )),
"A",
Node(Nil, "C", Node(Nil, "F", Leaf "I")))
let rec contains (x : #IComparable<'a>) = function
| Nil -> false
| Leaf y -> if x.CompareTo(y) = 0 then true else false
| Node(l, y, r) ->
match l, y, r with
| l, y, Nil -> if x.CompareTo(y) = 0 then true else contains x l
| Nil,y, r -> if x.CompareTo(y) = 0 then true else contains x r
| _ -> if x.CompareTo(y) = 0 then true
else contains x r |>ignore
contains x l
let xx = contains "C" tt2 //It is wrong answer.
Is there an exit statement, which can jump out recursive functions, just like imperative languages.
No. The very reason is that you can encode imperative break/return by recursive functions and pattern matching. If you would like to break, just return a value, otherwise invoke another recursive call.
This question is more appropriate to ask for high-order functions. When you need early exit on high-order functions, writing custom recursive function is the way to go. If you are interested in imperative constructs in F#, take a look at the excellent series by #Tomas.
Your function will exit at some branch when the condition is determined. The only problem is that you should not discard contain x r in the second to last line.
You can remove superfluous if/else for clarity
let rec contains (x : #IComparable<'a>) = function
| Nil -> false
| Leaf y -> x.CompareTo(y) = 0
| Node(l, y, r) ->
match l, y, r with
| l, y, Nil -> x.CompareTo(y) = 0 || contains x l
| Nil,y, r -> x.CompareTo(y) = 0 || contains x r
| _ -> x.CompareTo(y) = 0 || contains x l || contains x r
Related
This weekends programming fun of mine was to write a 300 lines reversi program in F#. It will probably take a few more weekends to find out how to get alphabeta search parallelized and this is actually out of scope for this question.
What I found, though was that I could not come up with some "pure functional" way to implement alphabeta function. I.e. without any mutable state.
Any good ideas for that?
The only idea which came to my mind would be to write something like Seq.foldUntil() function, where the accumulator state is used to store the changes in state. And which can be canceled by the lambda function passed in.
Maybe looking like this:
let transformWhile<'t,'s,'r> (transformer : 's -> 't -> 's * 'r * bool ) (state : 's) (sequence : 't seq) : 'r seq
Here the impure alphabeta function...
let rec alphabeta depth alpha beta fork (position : ReversiPosition) (maximize : bool) : (SquareName option * int) =
match depth with
| 0 -> (None, snd (eval position))
| _ ->
let allMoves =
allSquares
|> Seq.map (fun sq -> (sq,tryMove (position.ToMove) sq position))
|> Seq.filter (fun pos -> match snd pos with | Some(_) -> true | None -> false )
|> Seq.map (fun opos -> match opos with | (sq,Some(p)) -> (sq,p) | _ -> failwith("only Some(position) expected here."))
|> Array.ofSeq
let len = allMoves.Length
match len with
| 0 -> (None, snd (eval position))
| _ ->
if maximize then
let mutable v = System.Int32.MinValue
let mutable v1 = 0
let mutable a = alpha
let b = beta
let mutable i = 0
let mutable bm : SquareName option = None
let mutable bm1 : SquareName option = None
while (i<len) && (b > a) do
let x,y = alphabeta (depth-1) a b false (snd allMoves.[i]) false
bm1 <- Some(fst allMoves.[i])
v1 <- y
if v1 > v then
bm <- bm1
v <- v1
a <- max a v
if b > a then
i <- (i + 1)
(bm,v)
else
let mutable v = System.Int32.MaxValue
let mutable v1 = 0
let a = alpha
let mutable b = beta
let mutable i = 0
let mutable bm : SquareName option = None
let mutable bm1 : SquareName option = None
while (i<len) && (b > a) do
let x,y = alphabeta (depth-1) a b false (snd allMoves.[i]) true
bm1 <- Some(fst allMoves.[i])
v1 <- y
if v1 < v then
bm <- bm1
v <- v1
b <- min b v
if b > a then
i <- (i + 1)
(bm,v)
While waiting for answers, I decided to give my transformWhile idea a try and this is what became of it:
module SeqExt =
let rec foldWhile<'T,'S,'R> (transformer : 'S -> 'T -> 'S * 'R * bool ) (state : 'S) (sequence : seq<'T>) : 'R option =
if (Seq.length sequence) > 0 then
let rest = (Seq.skip 1 sequence)
let newState, resultValue, goOn = transformer state (Seq.head sequence)
if goOn && not (Seq.isEmpty rest) then
foldWhile transformer newState rest
else
Some(resultValue)
else
None
Some interactive testing showed that it works for some trivial stuff, so I decided to write a new version of alphabeta, which now looks like this:
let rec alphabeta depth alpha beta fork (position : ReversiPosition) (maximize : bool) : (SquareName option * int) =
match depth with
| 0 -> (None, snd (eval position))
| _ ->
let allMoves =
allSquares
|> Seq.map (fun sq -> (sq,tryMove (position.ToMove) sq position))
|> Seq.filter (fun pos -> match snd pos with | Some(_) -> true | None -> false )
|> Seq.map (fun opos -> match opos with | (sq,Some(p)) -> (sq,p) | _ -> failwith("only Some(position) expected here."))
let len = Seq.length allMoves
match len with
| 0 -> (None, snd (eval position))
| _ ->
if maximize then
let result = SeqExt.foldWhile
( fun (state : int * int * SquareName option * int ) move ->
let curAlpha,curBeta,curMove,curValue = state
let x,y = alphabeta (depth-1) curAlpha curBeta false (snd move) false
let newBm,newScore =
if y > curValue then
(Some(fst move), y)
else
(curMove,curValue)
let newAlpha = max curAlpha newScore
let goOn = curBeta > newAlpha
((newAlpha,curBeta,newBm,newScore),(newBm,newScore),goOn)
) (alpha,beta,None,System.Int32.MinValue) allMoves
match result with
| Some(r) -> r
| None -> failwith("This is not possible! Input sequence was not empty!")
else
let result = SeqExt.foldWhile
( fun (state : int * int * SquareName option * int ) move ->
let curAlpha,curBeta,curMove,curValue = state
let x,y = alphabeta (depth-1) curAlpha curBeta false (snd move) true
let newBm,newScore =
if y < curValue then
(Some(fst move), y)
else
(curMove,curValue)
let newBeta = min curBeta newScore
let goOn = newBeta > curAlpha
((curAlpha,newBeta,newBm,newScore),(newBm,newScore),goOn)
) (alpha,beta,None,System.Int32.MaxValue) allMoves
match result with
| Some(r) -> r
| None -> failwith("This is not possible! Input sequence was not empty!")
Is that looking like something you functional programming pros would do? Or what would you do?
While the brute force search I had before was tail recursive (no call stack building up), this pure functional version is no longer tail recursive. Can anyone find a way to make it tail recursive again?
I am familiar neither with the algorithm, nor with with F#, so I translated the pseudocode from Wikipedia to a purely functional variant:
function alphabeta(node, depth, α, β, maximizingPlayer)
if depth == 0 or node is a terminal node
return the heuristic value of node
if maximizingPlayer
return take_max(children(node), depth, α, β)
else
return take_min(children(node), depth, α, β)
function take_max(children, depth, α, β)
v = max(v, alphabeta(head(children), depth - 1, α, β, FALSE))
new_α = max(α, v)
if β ≤ new_α or tail(children) == Nil
return v
else
return take_max(tail(children), depth, α, β))
function take_min(children, depth, α, β)
v = min(v, alphabeta(head(children), depth - 1, α, β, TRUE))
new_β = min(β, v)
if new_β ≤ α or tail(children) == Nil
return v
else
return take_min(tail(children), depth, α, β))
The trick is to turn the foreach with break into a recursion with appropriate base case. I assumed that children(node) returns a cons list of nodes, which can be deconstructed using head/tail and tested for Nil.
Obviously, I can't test this, but I think it contains the right ideas (and it is almost Python...).
Also, maybe this is a case for memoization -- but that depends on the domain (which I am not familiar with). Parallelization is probably more difficult with this kind of recursion; for that, you maybe could build up a list of vs and alphas/betas in parallel (since the calls to alphabeta are probably the most expensive part), replacing the recursions with takeWhiles on those lists.
A deeply functional approach is described in John Hughes, Why functional programming matters.
Moreover, you could have a look at the implementations to Russell & Norvig, Artificial Intelligence - A modern approach
in Lisp (by Norvig himself!),
in Haskell (by #chris-taylor),
in CoffeeScript (by myself).
I need to check if a list starts with another, shorter list. The function, when using when guards is trivial:
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| x::xs, y::ys when x = y -> startsWith xs ys
| _ -> false
let lst1 = [ 1; 2; 1 ]
let lst2 = [ 1; 2; 1; 2; 3; ]
let lst3 = [ 1; 3; 1; 2; 3; ]
let c1 = startsWith lst1 lst2 // true
let c2 = startsWith lst1 lst3 // false
But whatever I tried along the lines of an Active Pattern:
let (|HeadsMatch|) (l1 : ('a) list) (l2 : ('a) list) =
if l1.Head = l2.Head then Some(l1.Tail, l2.Tail) else None
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| HeadsMatch /* need to capture the result */ -> startsWith t1 t2
| _ -> false
I could not make to compile. How to make a version of this function using Active pattern? And if this is not possible, can you explain why?
P.S. Any other nice ways to write the above function?
EDIT: I took the snippet from Daniel's answer to not distract from the real question.
EDIT: My problems started in the beginning. I have defined the active pattern function as
let (|HeadsMatch|_|) lst1 lst2 =
but it should have been
let (|HeadsMatch|_|) (lst1, lst2) =
In which case it would match as in the accepted answer.
I suppose the nicest way might be
let startsWith = Seq.forall2 (=)
If you want to write it from scratch, you need to match on both lists:
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| x::xs, y::ys when x = y -> startsWith xs ys
| _ -> false
If you want to write it with an active pattern for learning purposes, using Tarmil's definition it would be
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| HeadsMatch(xs, ys) -> startsWith xs ys
| _ -> false
There are two errors in the definition of your active pattern:
It's a partial active pattern (since it is possible that it doesn't match) so the syntax is (|HeadsMatch|_|).
You need to take the two lists as a pair, since you want to match lst1, lst2.
With these, the code will compile. But it will throw an exception at runtime, because you use .Head and .Tail on lists when you don't know if they have any element; you're not defining the behavior if one of the lists is empty.
Here is an idiomatic implementation of HeadsMatch:
let (|HeadsMatch|_|) (lst1, lst2) =
match (lst1, lst2) with
| (x :: xs, y :: ys) when x = y -> Some (xs, ys)
| _ -> None
Without guard:
let (|HeadsMatch|_|) (lst1, lst2) =
match (lst1, lst2) with
| (x :: xs, y :: ys) ->
if x = y then Some (xs, ys) else None
| _ -> None
As a side-note, your first implementation has the same problem. The following will throw a runtime exception:
startsWith [1;2] [1]
because you don't check that lst2 is not empty before using .Head and .Tail on it. In general, you should avoid these two methods almost all the time.
this code i got is from Alexander Battisti about how to make a tree from a list of data:
let data = [4;3;8;7;10;1;9;6;5;0;2]
type Tree<'a> =
| Node of Tree<'a> * 'a * Tree<'a>
| Leaf
let rec insert tree element =
match element,tree with
| x,Leaf -> Node(Leaf,x,Leaf)
| x,Node(l,y,r) when x <= y -> Node((insert l x),y,r)
| x,Node(l,y,r) when x > y -> Node(l,y,(insert r x))
| _ -> Leaf
let makeTree = List.fold insert Leaf data
then i want to implement this code to my binary search tree code
let rec BinarySearch tree element =
match element,tree with
| x,Leaf -> BinarySearch (Node(Leaf,x,Leaf)) x
| x,Node(l,y,r) when x<=y ->
BinarySearch l y
| x,Node(l,y,r) when x>y ->
BinarySearch r y
| x,Node(l,y,r) when x=y ->
true
| _ -> false
then i use my search code like this:
> BinarySearch makeTree 5;;
and the result is none because it's like i got an infinite looping
can someone help me? if my code is wrong, please help me to correct it, thank you
The solution by Yin is how I would write it too.
Anyway, here is a solution that is closer to your version and (hopefully) explains what went wrong:
let rec BinarySearch tree element =
match element,tree with
| x, Leaf ->
// You originally called 'BinarySearch' here, but that's wrong - if we reach
// the leaf of the tree (on the path from root to leaf) then we know that the
// element is not in the tree so we return false
false
| x, Node(l,y,r) when x<y ->// This needs to be 'x<y', otherwise the clause would be
// matched when 'x=y' and we wouldn't find the element!
BinarySearch l element // Your recursive call was 'BinarySearch l y' but
// that's wrong - you want to search for 'element'
| x, Node(l,y,r) when x>y ->
BinarySearch r element
| x,Node(l,y,r) -> // You can simplify the code by omitting the 'when'
true // clause (because this will only be reached when
// x=y. Then you can omit the last (unreachable) case
let rec BinarySearch tree element =
match tree with
| Leaf -> false
| Node(l, v, r) ->
if v = element then
true
elif v < element then
BinarySearch r element
else
BinarySearch l element
BinarySearch makeTree 5
Is there a built-in function which does the following?
let rec listsEqual xl yl f =
match xl, yl with
| [], [] -> true
| [], _ | _, [] -> false
| xh::xt, yh::yt -> if f xh yh then listsEqual xt yt f else false
Updated, further elaboration: and in general is there any way to tap in to structural comparison but using a custom comparison function?
List.forall2 : (('a -> 'b -> bool) -> 'a list -> 'b list -> bool)
But it takes f before the lists. You can create your function like this:
let listsEqual x y f =
if List.length x = List.length y then
List.forall2 f x y
else
false
Remember that List.forall2 assumes the lengths are the same.
Concerning Seq.compareWith, you wrote:
not quite, two problems 1) expects the
two sequences be of the same type, 2)
doesn't short circuit
2) is wrong, the function really does a court-circuit.
1) is true. Take Seq.compareWith from F# library, modify (or remove) the type annotation and it will work for sequences of different types.
[<CompiledName("CompareWith")>]
let compareWith (f:'T1 -> 'T2 -> int) (source1 : seq<'T1>) (source2: seq<'T2>) =
//checkNonNull "source1" source1
//checkNonNull "source2" source2
use e1 = source1.GetEnumerator()
use e2 = source2.GetEnumerator()
let rec go () =
let e1ok = e1.MoveNext()
let e2ok = e2.MoveNext()
let c = (if e1ok = e2ok then 0 else if e1ok then 1 else -1)
if c <> 0 then c else
if not e1ok || not e2ok then 0
else
let c = f e1.Current e2.Current
if c <> 0 then c else
go ()
go()
Now, you can send an email to fsbugs (# microsoft.com) and ask them to remove the type constraint in the next F# release.
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.