This is a question that extends F# Recursive Tree Validation, which I had nicely answered yesterday.
This question concerns inserting a child in an existing tree. This is the updated type I'd like to use:
type Name = string
type BirthYear = int
type FamilyTree = Person of Name * BirthYear * Children
and Children = FamilyTree list
My last question concerned checking the validity of the tree, this was the solution I decided to go with:
let rec checkAges minBirth = function
| Person(_,b,_) :: t -> b >= minBirth && checkAges b t
| [] -> true
let rec validate (Person(_,b,c)) =
List.forall isWF c && checkAges (b + 16) c
Now I would like to be able to insert a Person Simon as a child of specific Person Hans in the following form
insertChildOf "Hans" simon:Person casperFamily:FamilyTree;;
So, input should be parent name, child and the family tree. Ideally it should then return a modified family tree, that is FamilyTree option
What I am struggling with is to incorporating the validate function to make sure it is legal, and a way to insert it properly in the list of children, if the insertion Person is already a parent - maybe as a seperate function.
All help is welcome and very appreciated - thanks! :)
After your comment here's a code that will behave as expected:
let insert pntName (Person(_, newPrsnYear, _) as newPrsn) (Person (n,y,ch)) =
let rec ins n y = function
| [] -> if y < newPrsnYear && n = pntName then Some [newPrsn] else None
| (Person (name, year, childs) as person) :: bros ->
let tryNxtBros() = Option.map (fun x -> person::x) (ins n y bros)
if y < newPrsnYear && n = pntName then // father OK
if newPrsnYear < year then // brother OK -> insert here
Some (newPrsn::person::bros)
else tryNxtBros()
else // keep looking, first into eldest child ...
match ins name year childs with
| Some i -> Some (Person (name, year, i) :: bros)
| _ -> tryNxtBros() // ... then into other childs
Option.map (fun x -> Person (n, y, x)) (ins n y ch)
As in my previous answer I keep avoiding using List functions since I don't think they are a good fit in a tree structure unless the tree provides a traverse.
I might be a bit purist in the sense I use either List functions (with lambdas and combinators) or pure recursion, but in general I don't like mixing them.
Related
I'm new to functional programming and I'm trying to implement a basic algorithm using OCAML for course that I'm following currently.
I'm trying to implement the following algorithm :
Entries :
- E : a non-empty set of integers
- s : an integer
- d : a positive float different of 0
Output :
- T : a set of integers included into E
m <- min(E)
T <- {m}
FOR EACH e ∈ sort_ascending(E \ {m}) DO
IF e > (1+d)m AND e <= s THEN
T <- T U {e}
m <- e
RETURN T
let f = fun (l: int list) (s: int) (d: float) ->
List.fold_left (fun acc x -> if ... then (list_union acc [x]) else acc)
[(list_min l)] (list_sort_ascending l) ;;
So far, this is what I have, but I don't know how to handle the modification of the "m" variable mentioned in the algorithm... So I need help to understand what is the best way to implement the algorithm, maybe I'm not gone in the right direction.
Thanks by advance to anyone who will take time to help me !
The basic trick of functional programming is that although you can't modify the values of any variables, you can call a function with different arguments. In the initial stages of switching away from imperative ways of thinking, you can imagine making every variable you want to modify into the parameters of your function. To modify the variables, you call the function recursively with the desired new values.
This technique will work for "modifying" the variable m. Think of m as a function parameter instead.
You are already using this technique with acc. Each call inside the fold gets the old value of acc and returns the new value, which is then passed to the function again. You might imagine having both acc and m as parameters of this inner function.
Assuming list_min is defined you should think the problem methodically. Let's say you represent a set with a list. Your function takes this set and some arguments and returns a subset of the original set, given the elements meet certain conditions.
Now, when I read this for the first time, List.filter automatically came to my mind.
List.filter : ('a -> bool) -> 'a list -> 'a list
But you wanted to modify the m so this wouldn't be useful. It's important to know when you can use library functions and when you really need to create your own functions from scratch. You could clearly use filter while handling m as a reference but it wouldn't be the functional way.
First let's focus on your predicate:
fun s d m e -> (float e) > (1. +. d)*.(float m) && (e <= s)
Note that +. and *. are the plus and product functions for floats, and float is a function that casts an int to float.
Let's say the function predicate is that predicate I just mentioned.
Now, this is also a matter of opinion. In my experience I wouldn't use fold_left just because it's just complicated and not necessary.
So let's begin with my idea of the code:
let m = list_min l;;
So this is the initial m
Then I will define an auxiliary function that reads the m as an argument, with l as your original set, and s, d and m the variables you used in your original imperative code.
let rec f' l s d m =
match l with
| [] -> []
| x :: xs -> if (predicate s d m x) then begin
x :: (f' xs s d x)
end
else
f' xs s d m in
f' l s d m
Then for each element of your set, you check if it satisfies the predicate, and if it does, you call the function again but you replace the value of m with x.
Finally you could just call f' from a function f:
let f (l: int list) (s: int) (d: float) =
let m = list_min l in
f' l s d m
Be careful when creating a function like your list_min, what would happen if the list was empty? Normally you would use the Option type to handle those cases but you assumed you're dealing with a non-empty set so that's great.
When doing functional programming it's important to think functional. Pattern matching is super recommended, while pointers/references should be minimal. I hope this is useful. Contact me if you any other doubt or recommendation.
I'm writing a function called after which takes a list of integers and two integers as parameters. after list num1 num2 should return True if num1 occurs in the list and num2 occurs in list afternum1. (Not necessarily immediately after).
after::[Int]->Int->Int->Bool
after [] _ _=False
after [x:xs] b c
|x==b && c `elem` xs =True
|x/=b && b `elem` xs && b `elem` xs=True
This is what I have so far,my biggest problem is that I don't know how to force num2 to be after num1.
There's a few different ways to approach this one; while it's tempting to go straight for recursion on this, it's nice to
avoid using recursion explicitly if there's another option.
Here's a simple version using some list utilities. Note that it's a Haskell idiom that the object we're operating over is usually the last argument. In this case switching the arguments lets us write it as a pipeline with it's third argument (the list) passed implicitly:
after :: Int -> Int -> [Int] -> Bool
after a b = elem b . dropWhile (/= a)
Hopefully this is pretty easy to understand; we drop elements of the list until we hit an a, assuming we find one we check if there's a b in the remaining list. If there was no a, this list is [] and obviously there's no b there, so it returns False as expected.
You haven't specified what happens if 'a' and 'b' are equal, so I'll leave it up to you to adapt it for that case. HINT: add a tail somewhere ;)
Here are a couple of other approaches if you're interested:
This is pretty easily handled using a fold;
We have three states to model. Either we're looking for the first elem, or
we're looking for the second elem, or we've found them (in the right order).
data State =
FindA | FindB | Found
deriving Eq
Then we can 'fold' (aka reduce) the list down to the result of whether it matches or not.
after :: Int -> Int -> [Int] -> Bool
after a b xs = foldl go FindA xs == Found
where
go FindA x = if x == a then FindB else FindA
go FindB x = if x == b then Found else FindB
go Found _ = Found
You can also do it recursively if you like:
after :: Int -> Int -> [Int] -> Bool
after _ _ [] = False
after a b (x:xs)
| x == a = b `elem` xs
| otherwise = after a b xs
Cheers!
You can split it into two parts: the first one will find the first occurrence of num1. After that, you just need to drop all elements before it and just check that num2 is in the remaining part of the list.
There's a standard function elemIndex for the first part. The second one is just elem.
import Data.List (elemIndex)
after xs x y =
case x `elemIndex` xs of
Just i -> y `elem` (drop (i + 1) xs)
Nothing -> False
If you'd like to implement it without elem or elemIndex, you could include a subroutine. Something like:
after xs b c = go xs False
where go (x:xs) bFound
| x == b && not (null xs) = go xs True
| bFound && x == c = True
| null xs = False
| otherwise = go xs bFound
Recently, I am reading the book Purely-functional-data-structures
when I came to “Exercise 3.2 Define insert directly rather than via a call to merge” for Leftist_tree。I implement a my version insert.
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x left (insert y right)
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
And for verifying if it works, I test it and the merge function offered by the book.
let rec merge m n = match (m, n) with
| (h, E) -> h
| (E, h) -> h
| (T (_, x, a1, b1) as h1, (T (_, y, a2, b2) as h2)) ->
if (Elem.compare x y) < 0
then makeT x a1 (merge b1 h2)
else makeT y a2 (merge b2 h1)
Then I found an interesting thing.
I used a list ["a";"b";"d";"g";"z";"e";"c"] as input to create this tree. And the two results are different.
For merge method I got a tree like this:
and insert method I implemented give me a tree like this :
I think there's some details between the two methods even though I follow the implementation of 'merge' to design the 'insert' version. But then I tried a list inverse ["c";"e";"z";"g";"d";"b";"a"] which gave me two leftist-tree-by-insert tree. That really confused me so much that I don't know if my insert method is wrong or right. So now I have two questions:
if my insert method is wrong?
are leftist-tree-by-merge and leftist-tree-by-insert the same structure? I mean this result give me an illusion like they are equal in one sense.
the whole code
module type Comparable = sig
type t
val compare : t -> t -> int
end
module LeftistHeap(Elem:Comparable) = struct
exception Empty
exception Same_elem
type heap = E | T of int * Elem.t * heap * heap
let rank = function
| E -> 0
| T (r ,_ ,_ ,_ ) -> r
let makeT x a b =
if rank a >= rank b
then T(rank b + 1, x, a, b)
else T(rank a + 1, x, b, a)
let rec merge m n = match (m, n) with
| (h, E) -> h
| (E, h) -> h
| (T (_, x, a1, b1) as h1, (T (_, y, a2, b2) as h2)) ->
if (Elem.compare x y) < 0
then makeT x a1 (merge b1 h2)
else makeT y a2 (merge b2 h1)
let insert_merge x h = merge (T (1, x, E, E)) h
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x left (insert y right)
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
let rec creat_l_heap f = function
| [] -> E
| h::t -> (f h (creat_l_heap f t))
let create_merge l = creat_l_heap insert_merge l
let create_insert l = creat_l_heap insert l
end;;
module IntLeftTree = LeftistHeap(String);;
open IntLeftTree;;
let l = ["a";"b";"d";"g";"z";"e";"c"];;
let lh = create_merge `enter code here`l;;
let li = create_insert l;;
let h = ["c";"e";"z";"g";"d";"b";"a"];;
let hh = create_merge h;;
let hi = create_insert h;;
16. Oct. 2015 update
by observing the two implementation more precisely, it is easy to find that the difference consisted in merge a base tree T (1, x, E, E) or insert an element x I used graph which can express more clearly.
So i found that my insert version will always use more complexity to finish his work and doesn't utilize the leftist tree's advantage or it always works in the worse situation, even though this tree structure is exactly “leftist”.
and if I changed a little part , the two code will obtain the same result.
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x E t
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
So for my first question: I think the answer is not exact. it can truly construct a leftist tree but always work in the bad situation.
and the second question is a little meaningless (I'm not sure). But it is still interesting for this condition. for instance, even though the merge version works more efficiently but for construct a tree from a list without the need for insert order like I mentioned (["a";"b";"d";"g";"z";"e";"c"], ["c";"e";"z";"g";"d";"b";"a"] , if the order isn't important, for me I think they are the same set.) The merge function can't choose the better solution. (I think the the tree's structure of ["a";"b";"d";"g";"z";"e";"c"] is better than ["c";"e";"z";"g";"d";"b";"a"]'s )
so now my question is :
is the tree structure that each sub-right spine is Empty is a good structure?
if yes, can we always construct it in any input order?
A tree with each sub-right spine empty is just a list. As such a simple list is a better structure for a list. The runtime properties will be the same as a list, meaning inserting for example will take O(n) time instead of the desired O(log n) time.
For a tree you usually want a balanced tree, one where all children of a node are ideally the same size. In your code each node has a rank and the goal would be to have the same rank for the left and right side of each node. If you don't have exactly 2^n - 1 entries in the tree this isn't possible and you have to allow some imbalance in the tree. Usually a difference in rank of 1 or 2 is allowed. Insertion should insert the element on the side with smaller rank and removal has to rebalance any node that exceeds the allowed rank difference. This keeps the tree reasonably balanced, ensuring the desired runtime properties are preserved.
Check your text book what difference in rank is allowed in your case.
Ok, I have written a binary search tree in OCaml.
type 'a bstree =
|Node of 'a * 'a bstree * 'a bstree
|Leaf
let rec insert x = function
|Leaf -> Node (x, Leaf, Leaf)
|Node (y, left, right) as node ->
if x < y then
Node (y, insert x left, right)
else if x > y then
Node (y, left, insert x right)
else
node
I guess the above code does not have problems.
When using it, I write
let root = insert 4 Leaf
let root = insert 5 root
...
Is this the correct way to use/insert to the tree?
I mean, I guess I shouldn't declare the root and every time I again change the variable root's value, right?
If so, how can I always keep a root and can insert a value into the tree at any time?
This looks like good functional code for inserting into a tree. It doesn't mutate the tree during insertion, but instead it creates a new tree containing the value. The basic idea of immutable data is that you don't "keep" things. You calculate values and pass them along to new functions. For example, here's a function that creates a tree from a list:
let tree_of_list l = List.fold_right insert l Leaf
It works by passing the current tree along to each new call to insert.
It's worth learning to think this way, as many of the benefits of FP derive from the use of immutable data. However, OCaml is a mixed-paradigm language. If you want to, you can use a reference (or mutable record field) to "keep" a tree as it changes value, just as in ordinary imperative programming.
Edit:
You might think the following session shows a modification of a variable x:
# let x = 2;;
val x : int = 2
# let x = 3;;
val x : int = 3
#
However, the way to look at this is that these are two different values that happen to both be named x. Because the names are the same, the old value of x is hidden. But if you had another way to access the old value, it would still be there. Maybe the following will show how things work:
# let x = 2;;
val x : int = 2
# let f () = x + 5;;
val f : unit -> int = <fun>
# f ();;
- : int = 7
# let x = 8;;
val x : int = 8
# f ();;
- : int = 7
#
Creating a new thing named x with the value 8 doesn't affect what f does. It's still using the same old x that existed when it was defined.
Edit 2:
Removing a value from a tree immutably is analogous to adding a value. I.e., you don't actually modify an existing tree. You create a new tree without the value that you don't want. Just as inserting doesn't copy the whole tree (it re-uses large parts of the previous tree), so deleting won't copy the whole tree either. Any parts of the tree that aren't changed can be re-used in the new tree.
Edit 3
Here's some code to remove a value from a tree. It uses a helper function that adjoins two trees that are known to be disjoint (furthermore all values in a are less than all values in b):
let rec adjoin a b =
match a, b with
| Leaf, _ -> b
| _, Leaf -> a
| Node (v, al, ar), _ -> Node (v, al, adjoin ar b)
let rec delete x = function
| Leaf -> Leaf
| Node (v, l, r) ->
if x = v then adjoin l r
else if x < v then Node (v, delete x l, r)
else Node (v, l, delete x r)
(Hope I didn't just spoil your homework!)
I've run into a small problem here. I wrote the Tortoise and Hare cycle detection algorithm.
type Node =
| DataNode of int * Node
| LastNode of int
let next node =
match node with
|DataNode(_,n) -> n
|LastNode(_) -> failwith "Error"
let findCycle(first) =
try
let rec fc slow fast =
match (slow,fast) with
| LastNode(a),LastNode(b) when a=b -> true
| DataNode(_,a), DataNode(_,b) when a=b -> true
| _ -> fc (next slow) (next <| next fast)
fc first <| next first
with
| _ -> false
This is working great for
let first = DataNode(1, DataNode(2, DataNode(3, DataNode(4, LastNode(5)))))
findCycle(first)
It shows false. Right. Now when try to test it for a cycle, I'm unable to create a loop!
Obviously this would never work:
let first = DataNode(1, DataNode(2, DataNode(3, DataNode(4, first))))
But I need something of that kind! Can you tell me how to create one?
You can't do this with your type as you've defined it. See How to create a recursive data structure value in (functional) F#? for some alternative approaches which would work.
As an alternative to Brian's solution, you might try something like:
type Node =
| DataNode of int * NodeRec
| LastNode of int
and NodeRec = { node : Node }
let rec cycle = DataNode(1, { node =
DataNode(2, { node =
DataNode(3, { node =
DataNode(4, { node = cycle}) }) }) })
Here is one way:
type Node =
| DataNode of int * Lazy<Node>
| LastNode of int
let next node = match node with |DataNode(_,n) -> n.Value |LastNode(_) -> failwith "Error"
let findCycle(first) =
try
let rec fc slow fast =
match (slow,fast) with
| LastNode(a),LastNode(b) when a=b->true
| DataNode(a,_), DataNode(b,_) when a=b -> true
| _ -> fc (next slow) (next <| next fast)
fc first <| next first
with
| _ -> false
let first = DataNode(1, lazy DataNode(2, lazy DataNode(3, lazy DataNode(4, lazy LastNode(5)))))
printfn "%A" (findCycle(first))
let rec first2 = lazy DataNode(1, lazy DataNode(2, lazy DataNode(3, lazy DataNode(4, first2))))
printfn "%A" (findCycle(first2.Value))
Even though both Brian and kvb posted answers that work, I still felt I needed to see if it was possible to achieve the same thing in a different way. This code will give you a cyclic structure wrapped as a Seq<'a>
type Node<'a> = Empty | Node of 'a * Node<'a>
let cyclic (n:Node<_>) : _ =
let rn = ref n
let rec next _ =
match !rn with
| Empty -> rn := n; next Unchecked.defaultof<_>
| Node(v, x) -> rn := x; v
Seq.initInfinite next
let nodes = Node(1, Node(2, Node(3, Empty)))
cyclic <| nodes |> Seq.take 40 // val it : seq<int> = seq [1; 2; 3; 1; ...]
The structure itself is not cyclic, but it looks like it from the outside.
Or you could do this:
//removes warning about x being recursive
#nowarn "40"
type Node<'a> = Empty | Node of 'a * Lazy<Node<'a>>
let rec x = Node(1, lazy Node(2, lazy x))
let first =
match x with
| Node(1, Lazy(Node(2,first))) -> first.Value
| _ -> Empty
Can you tell me how to create one?
There are various hacks to get a directly cyclic value in F# (as Brian and kvb have shown) but I'd note that this is rarely what you actually want. Directly cyclic data structures are a pig to debug and are usually used for performance and, therefore, made mutable.
For example, your cyclic graph might be represented as:
> Map[1, 2; 2, 3; 3, 4; 4, 1];;
val it : Map<int,int> = map [(1, 2); (2, 3); (3, 4); (4, 1)]
The idiomatic way to represent a graph in F# is to store a dictionary that maps from handles to vertices and, if necessary, another for edges. This approach is much easier to debug because you traverse indirect recursion via lookup tables that are comprehensible as opposed to trying to decipher a graph in the heap. However, if you want to have the GC collect unreachable subgraphs for you then a purely functional alternative to a weak hash map is apparently an unsolved problem in computer science.