Why is my search function always outputting true? - functional-programming

let rec contains (x: int list)(y: int) : bool =
begin match x with
| [] -> false
| [y] -> true
| hd::tail -> (hd = y) && (contains tail y)
end
I'm not sure where I'm going wrong in my pattern matching but for any non-empty list I input, I keep getting "true" as my return type, when I want it to return true only if the input int exists in the list.

You have several problems.
The first is you use pattern matching to check if the list is exactly [y].
This is not how it works, it will actually match any list with exactly one element.
If you want to state equalities like that you can use when clauses.
let rec contains (l : int list) (y : int) : bool =
begin match l with
| [] -> false
| [z] when z = y -> true
| [z] -> false
| hd :: tl -> hd = y && contains tl y
end
The first [z] when z = y will trigger on a list containing exactly your y.
The second clause [z] will trigger on the rest.
Then, there is the problem of your last case: y belongs to hd :: tl if it is hd or if it belongs in tl. You used and, so that couldn't be right.
This gives us:
let rec contains (l : int list) (y : int) : bool =
begin match l with
| [] -> false
| [z] when z = y -> true
| [z] -> false
| hd :: tl -> hd = y || contains tl y
end
Of course this can even be simplified.
let rec contains (l : int list) (y : int) : bool =
begin match l with
| [] -> false
| hd :: tl -> hd = y || contains tl y
end
Indeed there is no need to make a special case of the list with one element.
[y] is the same as y :: [].
So to sum it up, if the element is in the head you got it, otherwise you go look in the tail, and so on until you reach the empty list which means you didn't find it.

Related

Functional Pattern to check Connect 4 board for winner

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.

Trying to use match statements in OCaml to write a function that checks if an element is in a list

I am new to OCaml and struggling to work with matches. I want to write a function that takes a list and a value and then returns true if the value is in that list and false if it is not. Here is my idea but I am struggling to get it to work.
let rec contains xs x =
match xs with
| [] -> false
| z :: zs ->
match x with
| z -> true
| _ -> contains zs x
When you use an identifier as a pattern, you will bind the value you match on to that identifier. I.e
match x with
| z -> true
will bind the value of x to the name z. You will also get a warning about z and the _ branch being unused.
You also don't need a second pattern match since it can be folded into the first:
let rec contains xs x =
match xs with
| [] -> false
| z :: _ when z = x -> true
| _ :: zs -> contains zs x

How to create a cached recursive type?

open System
open System.Collections.Generic
type Node<'a>(expr:'a, symbol:int) =
member x.Expression = expr
member x.Symbol = symbol
override x.GetHashCode() = symbol
override x.Equals(y) =
match y with
| :? Node<'a> as y -> symbol = y.Symbol
| _ -> failwith "Invalid equality for Node."
interface IComparable with
member x.CompareTo(y) =
match y with
| :? Node<'a> as y -> compare symbol y.Symbol
| _ -> failwith "Invalid comparison for Node."
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
type NodeDict<'a> = Dictionary<'a,Node<'a>>
let get_nodify_tag =
let mutable i = 0
fun () -> i <- i+1; i
let nodify (dict: NodeDict<_>) x =
match dict.TryGetValue x with
| true, x -> x
| false, _ ->
let x' = Node(x,get_nodify_tag())
dict.[x] <- x'
x'
let d = Dictionary(HashIdentity.Structural)
let nodify_ty x = nodify d x
let rec int_string_stream =
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]
In the above example, the int_string_stream gives a type error, but it neatly illustrates what I want to do. Of course, I want both sides to get tagged with the same symbol in nodify_ty. When I tried changing the Rec type to Node<Lazy<Ty>> I've found that it does not compare them correctly and each sides gets a new symbol which is useless to me.
I am working on a language, and the way I've dealt with storing recursive types up to now is by mapping Rec to an int and then substituting that with the related Ty in a dictionary whenever I need it. Currently, I am in the process of cleaning up the language, and would like to have the Rec case be Node<Ty> rather than an int.
At this point though, I am not sure what else could I try here. Could this be done somehow?
I think you will need to add some form of explicit "delay" to the discriminated union that represents your types. Without an explicit delay, you'll always end up fully evaluating the types and so there is no potential for closing the loop.
Something like this seems to work:
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
| Delayed of Lazy<Ty>
// (rest is as before)
let rec int_string_stream = Delayed(Lazy.Create(fun () ->
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]))
This will mean that when you pattern match on Ty, you'll always need to check for Delayed, evaluate the lazy value and then pattern match again, but that's probably doable!

create a register

I have to create a type tree which would be used to store words, like every node of the tree would hold a letter and the list of the next characters (so words with the same root would share the same "part/branch of the tree). the tree is basically a n-ary one, used as a dictionnary.
All using Caml language
Well, I don't know if it's a homework or not but I'll still answer :
First, we need to define a signature type for letters.
module type LS = sig
type t
val compare : t -> t -> int
end
Then, we need to define our structure :
module Make (L : LS) = struct
module M = Map.Make(L)
type elt = L.t list
type t = { word : bool; branches : t M.t }
let empty = { word = false; branches = M.empty }
let is_empty t = not t.word && M.is_empty t.branches
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (M.find c t.branches)
with Not_found -> false
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try M.find c t.branches with Not_found -> empty in
{ t with branches = M.add c (add cl b) t.branches }
end
Now, step by step :
module Make (L : LS) = struct is a functor that will return a new module if we give it a module of type LS as an argument
module M = Map.Make(L)
type elt = L.t list
type t = { word : bool; branches : t M.t }
This is the complex point, once you have it, everything begins clear. We need to represent a node (as you can see in the Wikipedia page of tries). My representation is this : a node is
a truth value stating that this node represent a word (which means that all the letters from the root to this node form a word)
the branches that goes from it. To represent this branches, I need a dictionary and luckily there's a Map functor in OCaml. So, my field branches is a field associating to some letters a trie (which is why I wrote that branches : t M.t). An element is then a list of letters and you'll find out why I chose this type rather than a string.
let empty = { word = false; branches = M.empty } the empty trie is the record with no branches (so, just the root), and this root is not a word (so word = false) (same idea for is_empty)
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (M.find c t.branches)
with Not_found -> false
Here it becomes interesting. My word being a list of letters, if I want to know if a word is in my trie, I need to make a recursive functions going through this list.
If I reached the point where my list is empty it means that I reached a node where the path from the root to it is composed by all the letters of my word. I just need to know, then, if the value word at this node is true or false.
If I still have at least one letter I need to find the branch corresponding to this letter.
If I find this branch (which will be a trie), I just need to make a recursive call to find the rest of the word (cl) in it
If I don't find it I know that my word doesn't exist in my trie so I can return false.
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try M.find c t.branches with Not_found -> empty in
{ t with branches = M.add c (add cl b) t.branches }
Same idea. If I want to add a word :
If my list is empty it means that I added all the letters and I've reached the node corresponding to my word. In that case, if word is already true it means that this word was already added, I don't do anything. If word is false I just return the same branch (trie) but with word equal to true.
If my list contains at least a letter c, I find in the current node the branch corresponding to it (try M.find c t.branches with Not_found -> empty) and I there's no such branch, I just return an empty one and then I recursively add the rest of my letters to this branch and add this new branch to the branches of my current node associated to the letter c (if this branch already existed, it will be replaced since I use a dictionary)
Here, we start with the empty trie and we add the word to, top and tea.
In case we don't want to use functors, we can do it this way :
type elt = char list
type t = { word : bool; branches : (char * t) list }
let empty = { word = false; branches = [] }
let is_empty t = not t.word && t.branches = []
let find c l =
let rec aux = function
| [] -> raise Not_found
| (c', t) :: tl when c' = c -> t
| _ :: tl -> aux tl
in aux l
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (find c t.branches)
with Not_found -> false
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try find c t.branches with Not_found -> empty in
{ t with branches = (c, (add cl b)) :: t.branches }

Convert tree to list

How can I convert a tree to a list:
So far I have the following code but its giving several issues:
type 'a tree = Lf | Br of 'a * 'a tree * 'a tree;;
let rec elementRight xs = function
| LF ->false
| Br(m,t1,t2) -> if elementRight xs t1 = false then t1::xs else element xs t1;; //cannot find element
let rec elementLeft xs = function
| LF ->false
| Br(m,t1,t2) -> if elementLeft xs t2 = false then t2::xs else element xs t2 ;; //cannot find element
let rec element xs = function
| LF ->[]
| Br(m,t1,t2) -> xs::(elementRight xs t1)::(elementRight xs t2)::(elementLeft xs t1)::(elementLeft xs t2);;
There are a number of problems with your code:
You shouldn't have ;; at the end of lines (I'm guessing this means you're copy and pasting into the repl, you should really use an fsx file instead and use "send to repl").
This: | LF ->false is returning a bool, while this: | Br(m,t1,t2) -> if elementRight xs t1 = false then t1::xs else element xs t1 is returning an 'a list. An expression can only have one type, so returning two is a compile error. I'm guessing what you really are meaning to do is have the leaf return [] and then check for empty list in your branch case something like this:
let rec elementRight xs = function
| LF ->[]
| Br(m,t1,t2) -> if elementRight xs t1 = List.empty then t1::xs else element xs t1
3 . when using mutually recursive functions you need to use the and keyword for all declarations but the first like this:
let rec elementRight xs = function
...
and elementLeft xs = function
...
and element xs = function
...

Resources