merge some trees

treeMerge.fsx

open System.Collections.Generic

type Tree = { Value : int; Children : Tree Set }

//-------------------------------------------------------------------------------------------------

/// get the primary key from a node
/// placeholder : if the value cannot be used as a primary key, this bit should be changed
let getKey tree = 
   tree.Value

/// gets the value given a primary key
let getValue key = 
   key

//-----

/// adds the nodes from a tree to a dictionnary
let addNodes (childrens:Dictionary<_,_>) tree =
   let rec extract tree =
      let newChildrens = 
         match childrens.ContainsKey (getKey tree) with 
         | false -> 
            Set.map getKey tree.Children
         | true -> 
            tree.Children
            |> Set.map getKey
            |> Set.union childrens.[getKey tree] 
      childrens.[getKey tree] <- newChildrens
      Set.iter extract tree.Children
   childrens

/// rebuild a tree from a root and a dictionnary of nodes
/// stores the rebuilded nodes to avoid doing the same task twice
let rec rebuild (rebuildedTrees:Dictionary<_,_>) (childrens:Dictionary<_,_>) rootKey =
   match rebuildedTrees.ContainsKey rootKey with 
   | true -> // this tree has already been build, no need to work twice
      rebuildedTrees.[rootKey]
   | false -> // unknown root : building and saving it for later retrieval
      let tree = { Value = getValue rootKey; Children = Set.map (rebuild rebuildedTrees childrens) childrens.[rootKey] }
      rebuildedTrees.[rootKey] <- tree 
      tree

//-------------------------------------------------------------------------------------------------

/// merge a list of trees and returns a list (of equal length) of merged trees
let merge treeList =
   let roots = List.map getKey treeList
   let childrens = List.fold addNodes (Dictionary()) treeList
   let rebuildedTrees = Dictionary()
   List.map (rebuild rebuildedTrees childrens) roots