F# 如何从嵌套集创建树?

F# How create tree from nested sets?

我的数据库中有嵌套集数据,需要将其转换为树数据结构:

type Item = {
    Id: int
    Left: int
    Right: int
    Level: int
}
type Items = Item list
type Tree = {Parent: Item; Childrens: Tree list}

我失败的尝试:

  1. 获取 childrens 项作为根项并创建树的根
  2. 从步骤 1 中为每个 child 搜索 childrens,构建新树
  3. 重复第 2 步,直到将所有项目(嵌套集)转换为树
let predicate p c = (c.Level = p.Level + 1) && (c.Left > p.Left) && (c.Right < p.Right)
let initLeaf item = {Parent = item; Childrens = []}
let initLeafs = List.map (fun x -> initLeaf x)
let getChildrens parent = List.filter (fun x -> predicate parent x)

let build (initList: Item list) =
    let sortedList = initList |> List.sortBy (fun x -> x.Left)
    let getChildrens2 parent = 
        let items = sortedList |> getChildrens parent
        if not (List.isEmpty items) then items |> initLeafs else []
    let root = initLeaf sortedList.Head
    
    let rec loop (tree: Tree) =
        let childrens =
            match tree.Childrens with
                | [] -> 
                    getChildrens2 tree.Parent
                | x ->
                    x |> List.collect (fun y -> loop y)
        loop {tree with Childrens = childrens}
    loop root
let res = build items

这是我的尝试。该示例取自 Wikipedia。 我将 Item.Id 的类型更改为 string 以获得更好的输出可读性, 但是这个方法仍然适用

[<StructuredFormatDisplay("'{Id}'(L:{Left} R:{Right})")>]
type Item = {Id: string; Left: int; Right: int; Level: int}
type Tree = {Node: Item; Children: Tree list}

let lst : Item list = [
  { Id="Clothing"; Left=1; Right=22; Level=0 }
  { Id="Men's"; Left=2; Right=9; Level=1 }
  { Id="Women's"; Left=10; Right=21; Level=1 }
  { Id="Suits"; Left=3; Right=8; Level=2 }
  { Id="Slacks"; Left=4; Right=5; Level=3 }
  { Id="Jackets"; Left=6; Right=7; Level=3 }
  { Id="Dresses"; Left=11; Right=16; Level=2 }
  { Id="Skirts"; Left=17; Right=18; Level=2 }
  { Id="Blouses"; Left=19; Right=20; Level=2 }
  { Id="Evening Gowns"; Left=12; Right=13; Level=3 }
  { Id="Sun Dresses"; Left=14; Right=15; Level=3 }
]

let sorted = lst |> List.sortBy (fun x -> x.Left)
let rootItem :: unassinged = sorted

let isParentOf p c = (c.Level = p.Level + 1) && (c.Left > p.Left) && (c.Right < p.Right)

let rec buildTree (xs : Item list) (item : Item) : Tree * Item list =
  let children, rest = List.partition (isParentOf item) xs
  let subtrees, rest = List.mapFold buildTree rest children
  let tree = {Node = item; Children = subtrees}
  tree, rest

let tree, _ = buildTree unassinged rootItem

输出(截断):

val tree : Tree =
  { Node = 'Clothing'(L:1 R:22)
    Children =
              [{ Node = 'Men's'(L:2 R:9)
                 Children =
                           [{ Node = 'Suits'(L:3 R:8)
                              Children =
                                        [{ Node = 'Jackets'(L:6 R:7)
                                           Children = [] };
                                         { Node = 'Slacks'(L:4 R:5)
                                           Children = [] }] }] };
               { Node = 'Women's'(L:10 R:21)
...

编辑:这是我能想到的最短的尾递归版本。

let buildTree1 (root : Item) : Tree =
  let rec go (pending : Item list) (m: Map<Item, Tree>) : Map<Item, Tree> =
    match pending with
    | [] -> m
    | x :: xs ->
      let children = List.filter (isParentOf x) unassinged
      if List.isEmpty children then
        let mUpd = Map.add x {Node=x; Children = []} m
        go xs mUpd
      else
        let pendingChildren = List.filter (fun y -> not <| Map.containsKey y m) children
        match pendingChildren with
        | [] ->
          let subtrees = List.map (fun x -> m.[x]) children
          let mUpd = Map.add x {Node=x; Children = subtrees} m
          go xs mUpd
        | ps -> go (ps @ (x :: xs)) m
  go [root] Map.empty |> Map.find root

let tree = buildTree1 rootItem

也许可以使用连续传递样式对其进行改进。