I have a type defination:
type FsTree = Node of (string * FsTree) list
I create an empty node:
let createEmptyFsTree () : FsTree = Node[]
I would love to build a tree from a path of string list, for example:
let fs1 = create ["MainNode";"nodeA";"nodeB"] (createEmptyFsTree())
let fs2 = create ["MainNode";"nodeC";"nodeD"] fs1
let fs3 = create ["MainNode";"nodeC";"nodeE"] fs2
The result will be:
Node [("MainNode", Node [
("nodeA", Node [("nodeB", Node [])]);
("nodeC", Node [
("nodeD", Node[]);
("nodeE", Node[])])])]
This is my code so far. I have been stuck for 2 days. Please help.
let create (p : string list) (fs : FsTree) =
let rec create (p : string list) (fs : FsTree) =
match fs with
| Node n -> match p, n with
| h :: t, (name, rsNode) :: rsTree when name = h -> Node([(h, (create t rsNode))] # rsTree)
| _, lNode :: rsTree -> Node([lNode]#rsTree)
| h :: t, [] -> Node ([h, (create t (createEmptyFsTree()))])
| [],[] -> Node[]
create p fs
I am only able to create the tree from the first path passed:
Node [("MainNode", Node [("nodeA", Node [("nodeB", Node [])])])]
The difficulty of this problem is that there are several structures (the path is a list, each node is a list and a subtree) that need to be traversed recursively at the same time in order for it to work. Doing so in just one function becomes very hard to figure out.
That is why I like to simplify the problem by breaking it down into smaller parts. Here we are going to use 2 mutually recursive functions (notice the syntax). First I am going to rename the functions so that I understand better what they do. I also avoid repeating the same name for functions and variables as it is confusing. My first function will only deal with traversing the path p:
let rec addPath (p : string list) (Node ns) =
match p with
| [] -> Node ns
| hp :: tp -> Node (addHeadPath hp tp ns)
I use pattern matching on the second parameter (Node ns) to get the list of subnodes, that is because the next function will traverse that list.
In my match expression I like to take care first of the empty list case which is the end of the recursion. The second case separates the head and tail and sends them to another function to deal with it:
and addHeadPath hp tp ns =
match ns with
| [] -> [hp, addPath tp (Node[]) ]
| (nn, st) :: tn when nn = hp -> (nn, addPath tp st ) :: tn
| hn :: tn -> hn :: addHeadPath hp tp tn
addHeadPathTo is mutually recursive with addPathTo so I tie them together with and instead of another let rec.
Again the empty case is dealt with first which returns a list with one node and calls addPathTo to add the rest of the path. The second case is when the node already exists in which case we add the rest of the path to the subtree st. The third case keeps looking into the list of nodes by calling itself recursively.
You invoke it this way:
createEmptyFsTree()
|> addPath ["MainNode";"nodeA";"nodeB"]
|> addPath ["MainNode";"nodeC";"nodeD"]
|> addPath ["MainNode";"nodeC";"nodeE"]
|> printfn "%A"
Related
I have a Tree type:
type Tree<'value> =
| Node of value: 'value * children: ConsList<Tree<'value>>
| Leaf of value: 'value
And a fold function for it:
let rec fold folder acc tree =
let f = fold folder
match tree with
| Leaf value -> folder acc value
| Node(value, children) -> ConsList.fold f (folder acc value) children
ConsList in case you need it:
type ConsList<'value> =
| Cons of head: 'value * tail: ConsList<'value>
| Empty
let rec fold folder acc lst =
let f = fold folder
match lst with
| Empty -> acc
| Cons (hd, tl) -> f (folder acc hd) tl
I need a foldBack function, meaning the function passes through the nodes from left to right from top to bottom, starting from the root.
I ended up on this:
let rec foldBack folder acc tree =
let f = fold folder
match tree with
| Leaf value -> f acc value
| Node(value, children) -> f value (f acc *children*)
Children with ** type is expected to be Tree<'a> but has type ConsList<Tree<Tree<'a>>>
For back folds it is common to have accumulator as a function which receives intermediate folded value of sub-branch and returns new folded value with respect to the current element. Thus iterating through the tree normally from top to bottom you literally construct the computation which when receives the terminal elements will compute the bottom to top fold.
You can look for continuation passing style topic more yourself. This approach is also used to optimize for tail-call recursion because function you accumulating is the chain of function objects which doesn't affect stack.
Here is what I've done so far (I replaced ConsList with normal List type, because otherwise it would require to create the foldBack for it as well, which you can try yourself)
type ConsList<'t> = 't list
type Tree<'value> =
| Node of value: 'value * children: ConsList<Tree<'value>>
| Leaf of value: 'value
let foldBack seed folder (tree: 't Tree) =
let rec fold acc tree =
match tree with
| Leaf value ->
let acc' inner = folder (acc inner) value
acc'
| Node (value, children) ->
let acc' inner = List.foldBack (fold acc) children inner
let acc'' inner = folder (acc' inner) value
acc''
fold id tree seed
let treeSample =
Node ("node1", [
Leaf "subnode1";
Node ("node1.1", [
Leaf "subnode1.1";
Node("node1.2", [
Leaf "leaf1.2"
])
])
])
treeSample|>foldBack ">>seed<<" (fun value acc -> $"{value} -> {acc}" )
val it: string = ">>seed<< -> leaf1.2 -> node1.2 -> subnode1.1 -> node1.1 -> subnode1 -> node1"
I am new to Haskell and I am having issues with syntax. What I want to do is given data and a tree of this datatype, find the path to the corresponding node in the tree. I believe my logic for the function is correct but I am not sure how to make it valid Haskell. I have tried changing tabs to spaces.
-- | Binary trees with nodes labeled by values of an arbitrary type.
data Tree a
= Node a (Tree a) (Tree a)
| End
deriving (Eq,Show)
-- | One step in a path, indicating whether to follow the left subtree (L)
-- or the right subtree (R).
data Step = L | R
deriving (Eq,Show)
-- | A path is a sequence of steps. Each node in a binary tree can be
-- identified by a path, indicating how to move down the tree starting
-- from the root.
type Path = [Step]
pathTo :: Eq a => a -> Tree a -> Maybe Path
pathTo a End = Nothing
pathTo a (Node b l r)
| a == b = Just []
| case (pathTo a l) of
Just p -> Just [L:p]
Nothing -> case (pathTo a r) of
Just p -> Just [R:p]
Nothing -> Nothing
This is the error:
parse error (possibly incorrect indentation or mismatched brackets)
The underlying problem here is that this does not look like a guard: a guard is an expression with type Bool, this determines if the guard "fires" or not. Here this is likely `otherwise:
pathTo :: Eq a => a -> Tree a -> Maybe Path
pathTo a End = Nothing
pathTo a (Node b l r)
| a == b = Just []
| otherwise = case (pathTo a l) of
Just p -> Just (L:p)
Nothing -> case (pathTo a r) of
Just p -> Just (R:p)
Nothing -> Nothing
This also revealed some extra mistakes: Just [L:p] is a Maybe [[Step]], you likely wanted to use Just (L:p), the same applies for Just [R:p].
You furthermore do not need to use nested cases, you can work with the Alternative typeclass:
import Control.Applicative((<|>))
pathTo :: Eq a => a -> Tree a -> Maybe Path
pathTo a End = Nothing
pathTo a (Node b l r)
| a == b = Just []
| otherwise = ((L:) <$> pathTo a l) <|> ((R:) <$> pathTo a r)
Here x <|> y will take x if it is a Just …, and y otherwise. We use (L:) <$> … to prepend the list wrapped in the Just data constructor, or return Nothing in case … is Nothing.
I want to take two streams of integers in increasing order and combine them into one stream that contains no duplicates and should be in increasing order. I have defined the functionality for streams in the following manner:
type 'a susp = Susp of (unit -> 'a)
let force (Susp f) = f()
type 'a str = {hd : 'a ; tl : ('a str) susp }
let merge s1 s2 = (* must implement *)
The first function suspends computation by wrapping a computation within a function, and the second function evaluates the function and provides me with the result of the computation.
I want to emulate the logic of how you go about combining lists, i.e. match on both lists and check which elements are greater, lesser, or equal and then append (cons) the integers such that the resulting list is sorted.
However, I know I cannot just do this with streams of course as I cannot traverse it like a list, so I think I would need to go integer by integer, compare, and then suspend the computation and keep doing this to build the resulting stream.
I am at a bit of a loss how to implement such logic however, assuming it is how I should be going about this, so if somebody could point me in the right direction that would be great.
Thank you!
If the the input sequences are sorted, there is not much difference between merging lists and sequences. Consider the following merge function on lists:
let rec merge s t =
match s, t with
| x :: s , [] | [], x :: s -> x :: s
| [], [] -> s
| x :: s', y :: t' ->
if x < y then
x :: (merge s' t)
else if x = y then
x :: (merge s' t')
else
y :: (merge s t')
This function is only using two properties of lists:
the ability to split the potential first element from the rest of the list
the ability to add an element to the front of the list
This suggests that we could rewrite this function as a functor over the signature
module type seq = sig
type 'a t
(* if the seq is non-empty we split the seq into head and tail *)
val next: 'a t -> ('a * 'a t) option
(* add back to the front *)
val cons: 'a -> 'a t -> 'a t
end
Then if we replace the pattern matching on the list with a call to next, and the cons operation with a call to cons, the previous function is transformed into:
module Merge(Any_seq: seq ) = struct
open Any_seq
let rec merge s t =
match next s, next t with
| Some(x,s), None | None, Some (x,s) ->
cons x s
| None, None -> s
| Some (x,s'), Some (y,t') ->
if x < y then
cons x (merge s' t)
else if x = y then
cons x (merge s' t')
else
cons y (merge s t')
end
Then, with list, our implementation was:
module List_core = struct
type 'a t = 'a list
let cons = List.cons
let next = function
| [] -> None
| a :: q -> Some(a,q)
end
module List_implem = Merge(List_core)
which can be tested with
let test = List_implem.merge [1;5;6] [2;4;9]
Implementing the same function for your stream type is then just a matter of writing a similar Stream_core module for stream.
I've been trying to implement a function that takes a list of integers and then return a list of lists of integers which are non-decreasing.
i.e
let ls = [ 1;2;3;5;6;3;2;5;6;2]
I should get [[1;2;3;5;6];[3];[2;5;6];[2]]
How should i approach this ? i'm a total noob at functional programming.
I can think of the steps needed:
1. Start a new sublist, compare each element with the one next to it. if it is greater then add to list. if not, start a new list and so on.
From what I've learned so far from the book Functional Programming with f# ( which i just started a few days ago), I could possibly use pattern matching and a recursive function maybe to go through the list comparing two elements
something like this :
let rec nonDecreasing list =
match list with
| (x,y) :: xs when x <= y ->
how would I go about to create the sublists using pattern matching ?
or have i approached the question wrongly?
Since there's already a solution using fold, here's another answer using foldBack, so you don't have to reverse it. Now you can backout a pure recursive solution.
let splitByInc x lls = // x is an item from the list, lls is a list of lists
match lls with
| y::xs -> // split the list of lists into head and tail
match y with
| h::_ when x <= h -> (x::y)::xs // take the head, and compare it with x, then cons it together with the rest
| _ -> [x]::lls // in the other case cons the single item with the rest of the list of lists
| _ -> [[x]] // nothing else to do, return the whole thing
let ls = [ 1;2;3;5;6;3;2;5;6;3]
List.foldBack splitByInc ls [] //foldBack needs a folder function, a list and a starting state
Edit:
Here's a really simplified example, you could write a recursive sum and compare it with the fold version:
let sumList x y =
x + y
List.foldBack sumList ls 0 //36
To better understand what splitByInc does, try it out with these examples:
splitByInc 4 [[5;6;7]] // matches (x::y)::xs
splitByInc 4 [] // matches [[x]]
splitByInc 4 [[1;2;3]] // matches [x]::lls
That's basically the same answer as the one given by #s952163 but maybe more readable by removing the nested match and also more general by adding a comparison function to do the "packing".
let packWhile predicate list =
let folder item = function
| [] -> [[ item ]]
| (subHead :: _ as subList) :: accTail
when predicate item subHead -> (item :: subList) :: accTail
| accList -> [ item ] :: accList
List.foldBack folder list []
// usage (you can replace (<=) by (fun x y -> x <= y) if it's clearer for you)
packWhile (<=) [1;2;3;5;6;3;2;5;6;3]
// you can also define a function to bake-in the comparison
let packIncreasing list = packWhile (<=) list
packIncreasing [1;2;3;5;6;3;2;5;6;3]
I'd use a fold, where your 'State is a tuple containing the previous value, the list of lists, and the current non-decreasing list you're working on.
let ls = [ 1;2;3;5;6;3;2;5;6;3]
let _, listOfLists, currList =
((Int32.MinValue, [], []), ls) ||>
List.fold(fun (prev, listOfLists, currList) t ->
if t < prev then //decreasing, so store your currList and start a new one
t, currList::listOfLists, [t]
else //just add t to your currList
t, listOfLists, t::currList)
let listOfLists = currList::listOfLists //cleanup: append final sublist
let final = List.rev(List.map List.rev listOfLists) //cleanup: reverse everything
printfn "%A" final
Note you'll have to clean up, adding the final list to the list-of-lists, and then reversing the full list-of-lists and each sublist once you've done the fold.
This is hurting my brain!
I want to recurse over a tree structure and collect all instances that match some filter into one list.
Here's a sample tree structure
type Tree =
| Node of int * Tree list
Here's a test sample tree:
let test =
Node((1,
[Node(2,
[Node(3,[]);
Node(3,[])]);
Node(3,[])]))
Collecting and filtering over nodes with and int value of 3 should give you output like this:
[Node(3,[]);Node(3,[]);Node(3,[])]
The following recursive function should do the trick:
// The 'f' parameter is a predicate specifying
// whether element should be included in the list or not
let rec collect f (Node(n, children) as node) =
// Process recursively all children
let rest = children |> List.collect (collect f)
// Add the current element to the front (in case we want to)
if (f n) then node::rest else rest
// Sample usage
let nodes = collect (fun n -> n%3 = 0) tree
The function List.collect applies the provided function to all elements of the
list children - each call returns a list of elements and List.collect
concatenates all the returned lists into a single one.
Alternatively you could write (this maay help understanding how the code works):
let rest =
children |> List.map (fun n -> collect f n)
|> List.concat
The same thing can be also written using list comprehensions:
let rec collect f (Node(n, children) as node) =
[ for m in children do
// add all returned elements to the result
yield! collect f m
// add the current node if the predicate returns true
if (f n) then yield node ]
EDIT: Updated code to return nodes as pointed out by kvb.
BTW: It is generally a good idea to show some code that you tried to write so far. This helps people understand what part you didn't understand and so you'll get more helpful answers (and it is also considered as polite)
A more complex tail recursive solution.
let filterTree (t : Tree) (predicate : int -> bool) =
let rec filter acc = function
| (Node(i, []) as n)::tail ->
if predicate i then filter (n::acc) tail
else filter acc tail
| (Node(i, child) as n)::tail ->
if predicate i then filter (n::acc) (tail # child)
else filter acc (tail # child)
| [] -> acc
filter [] [t]
Just for showing usage of F# Sequences Expression (maybe not the best approach, Tomas's solution more likely better I think):
type Tree =
| Node of int * Tree list
let rec filterTree (t : Tree) (predicate : int -> bool) =
seq {
match t with
| Node(i, tl) ->
if predicate i then yield t
for tree in tl do
yield! filterTree tree predicate
}
let test = Node (1, [ Node(2, [ Node(3,[]); Node(3,[]) ]); Node(3,[]) ])
printfn "%A" (filterTree test (fun x -> x = 3))
When my brain hurts cuz it's stuck up a tree, I try to say what I want as simply and clearly as I can:
Given a tree of info, list all sub-trees matching a predicate (in this case, info = 3).
One straightforward way to do it is to list all nodes of the tree, then filter on the predicate.
type 'info tree = Node of 'info * 'info tree list
let rec visit = function
| Node( info, [] ) as node -> [ node ]
| Node( info, children ) as node -> node :: List.collect visit children
let filter predicate tree =
visit tree
|> List.filter (fun (Node(info,_)) -> predicate info)
Here's the tree filter run against the OP's sample data:
let result = filter (fun info -> info = 3) test
One thing that surprised me is how easily the code works for any 'info type with the appropriate predicate:
let test2 =
Node(("One",
[Node("Two",
[Node("Three",[Node("Five",[]);Node("Three",[])]);
Node("Three",[])]);
Node("Three",[])]))
let res2 = filter (fun info -> info = "Three") test2
Alternatively, if you wanted to list the info rather than the sub-trees, the code is breath-takingly simple:
let rec visit = function
| Node( info, [] ) -> [ info ]
| Node( info, children ) -> info :: List.collect visit children
let filter predicate tree =
visit tree
|> List.filter predicate
which supports the same queries but only returns the 'info records, not the tree structure:
let result = filter (fun info -> info = 3) test
> val result : int list = [3; 3; 3; 3]
Tomas's approach looks standard, but doesn't quite match your example. If you actually want the list of matching nodes rather than values, this should work:
let rec filter f (Node(i,l) as t) =
let rest = List.collect (filter f) l
if f t then t::rest
else rest
let filtered = filter (fun (Node(i,_)) -> i=3) test
Here is an over engineered solution but it shows seperation of concerns with Partial Active Patterns. This isn't the best example for partial active patterns but it was a fun exercise nonetheless. Match statements are evaluated in order.
let (|EqualThree|_|) = function
| Node(i, _) as n when i = 3 -> Some n
| _ -> None
let (|HasChildren|_|) = function
| Node(_, []) -> None
| Node(_, children) as n -> Some children
| _ -> None
let filterTree3 (t : Tree) (predicate : int -> bool) =
let rec filter acc = function
| EqualThree(n)::tail & HasChildren(c)::_ -> filter (n::acc) (tail # c)
| EqualThree(n)::tail -> filter (n::acc) tail
| HasChildren(c)::tail -> filter acc (tail # c)
| _::tail -> filter acc tail
| [] -> acc
filter [] [t]