A foldBack function for Tree in F# - f#

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"

Related

How to solve issue with insert function of f# trees

Please, I need some help with creating an insert function for a tree. The value in a given string list should be inserted to every branch and leaf in a tree. I have tried to solve this issue and have a very close answer but I am not able to write the function correctly to insert all the string values.
Code:
type Tree = Leaf of string | Branch of (string * Tree) list
let rec insertTree (lst : string list) (tree : Tree) : Tree =
match lst, tree with
| a::b::c::[], y ->
match y with
| Leaf(n) -> Branch[(a, Branch[(n, Leaf(c))])]
| Branch[(x, p)] -> Branch[(x, Branch[(a, Branch[(b, insertTree (c::[]) p)])])]
| _ -> insertTree (b::c::[]) y
| _ , y -> tree
Test: insertTree ["4"; "5";"6"] (Branch [("1", (Branch[("2", Leaf("3"))]))])
Gives: Branch [("1", Branch [("4", Branch [("5", Branch [("2", Leaf "3")])])])]
I want this instead:
(Branch [("1", (Branch[("2", (Branch[("3",(Branch[("4",(Branch[("5", Leaf("6"))]))]))]))]))])
I'm going to assume you just want to append the list in order to the final leaf and that all branches will have at most a single element in its list.
let insertTree (lst : string list) (tree : Tree) : Tree =
let rec insertSingleIntotree x t =
match t with
| Leaf(n) -> Branch[(n,Leaf x)]
| Branch[(n,p)] -> Branch[(n, insertSingleIntotree x p)]
| _ -> failwith "no idea what should happen here!"
lst
|> List.fold (fun acc x -> insertSingleIntotree x acc) tree

How do I make the function return a float list?

Please, how do I make this function return the value of every branch and leaf as a float list? I have tried several methods with Tail recursion but I am not able to return the head I cannot loop through the branch and leaf.
type 'a Tree = | Leaf of 'a | Branch of 'a Tree * 'a Tree
let medianInTree (lst: float Tree) :float list=
let rec medianInTree' (a : float Tree) acc =
match lst with
| Leaf(n) -> n :: acc
| Branch(Leaf(xx), Leaf(xs)) -> xx :: [xs]
| Branch(Leaf(x), Branch(Leaf(xx), Leaf(xs))) ->
let acc = medianInTree'(Leaf(x)) acc
medianInTree' (Branch(Leaf(xx), Leaf(xs))) acc
| Branch(_, _) -> []
medianInTree' lst []
Question: medianInTree (Branch(Leaf(2.0), Branch(Leaf(3.0), Leaf(5.0))))
I want this result: [2.0;3.0;5.0]
using an accumulator, you can do something like this:
let flatten tree =
let rec toList tree acc =
match tree with
| Leaf a -> a :: acc
| Branch(left, right) ->
let acc = toList left acc
toList right acc
toList tree [] |> List.rev
But doing so, the recursive call to process the left branch is not tail recursive.
To insure tail recursion while processing tree structures, you have to use continuations.
let flatten tree =
let rec toList tree cont acc =
match tree with
| Leaf a -> cont (a :: acc)
| Branch(left, right) -> toList left (fun l ->
toList right (fun r ->
cont r) (cont l)) acc
toList tree id [] |> List.rev
Which can be simplified as:
let flatten tree =
let rec toList tree cont acc =
match tree with
| Leaf a -> cont (a :: acc)
| Branch (left, right) -> toList left (toList right cont) acc
toList tree id [] |> List.rev
Your main bug is using match with lst instead of on a. I made it a bit simpler as well.
let medianInTree (lst: float Tree) :float list=
let rec medianInTree' (a : float Tree)=
match a with
| Leaf(n) -> [n]
| Branch(l, r) -> (medianInTree' l) # (medianInTree' r)
medianInTree' lst

F# from list of list to set of set

So I have a function which computes the powerset of a set:
let rec powerset = function
| [] -> [[]]
| x::xs -> List.collect (fun subset -> [subset; x::subset]) (powerset xs)
This returns 'a list list.
Now I'm trying to make a function which gives me all the subsets with a certain length k.
let rec allSubsets n k =
let powersetN = Set.ofList (powerset [1..n])
let subsets ps =
Set.filter (fun e -> Set.count e = k) ps
subsets powersetN
The thing is, powersetN is a Set<int list>, whereas subsets expect a Set<Set<'a>>.
The obvious solution of course would be to create the powerset as an actual set instead of a list, but I haven't been able to come up with a way to do this.
Any hints?

F#: Recursive collect and filter over N-ary Tree

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]

Merge/join seq of seqs

Slowly getting the hang of List matching and tail recursion, I needed a function which 'stitches' a list of lists together leaving off intermediate values (easier to show than explain):
merge [[1;2;3];[3;4;5];[5;6;7]] //-> [1;2;3;4;5;6;7]
The code for the List.merge function looks like this:
///Like concat, but removes first value of each inner list except the first one
let merge lst =
let rec loop acc lst =
match lst with
| [] -> acc
| h::t ->
match acc with
| [] -> loop (acc # h) t
| _ -> loop (acc # (List.tl h)) t //first time omit first value
loop [] lst
(OK, it's not quite like concat, because it only handles two levels of list)
Question: How to do this for a Seq of Seqs (without using a mutable flag)?
UPDATE (re comment from Juliet):
My code creates 'paths' composed of 'segments' which are based on an option type:
type SegmentDef = Straight of float | Curve of float * float
let Project sampleinterval segdefs = //('clever' code here)
When I do a List.map (Project 1.) ListOfSegmentDefs, I get back a list where each segment begins on the same point where the previous segment ends. I want to join these lists together to get a Path, keeping only the 'top/tail' of each overlap - but I don't need to do a 'Set', because I know that I don't have any other duplicates.
This is essentially the same as your first solution, but a little more succinct:
let flatten l =
seq {
yield Seq.hd (Seq.hd l) (* first item of first list *)
for a in l do yield! (Seq.skip 1 a) (* other items *)
}
[Edit to add]:
If you need a List version of this code, use append |> Seq.to_list at the end of your method:
let flatten l =
seq {
yield Seq.hd (Seq.hd l) (* first item of first list *)
for a in l do yield! (Seq.skip 1 a) (* other items *)
} |> Seq.to_list
let merge = function
| [] -> []
| xs::xss -> xs # [for _::xs in xss do yield! xs]
or:
let merge = function
| [] -> []
| xs::xss -> xs # List.collect List.tail xss

Resources