Trim a Multiway Tree - what is a better solution?

Question

I was wondering whether anyone could offer a more simplified solution or improvements to my code for the following problem.

Say we have a tree with branches going to some depth "d" And we would like to trim this tree, such that we preserve "n" branches at depth d and then another n branches at depth d-1; then another n branches at d-2 etc...

In my solution I needed to resort to a dictionary to keep track of the number of branches and ref variable depth to keep track of and reducing the depth level

Would be very interested to know a simpler, more elegant solution, or any hints / tips to improve what I have

Data Structure

type MultiTree = | MNode of int * list<MultiTree>

Test Tree

let Mtree2 = MNode (0,
                    [MNode (1,[MNode (2,[MNode (3,[])])]);
                    MNode (1,[MNode (2,[MNode (3,[])])]);
                    MNode (1,[MNode (2,[MNode (3,[])])]);
                    MNode (1,[MNode (2,[MNode (3,[])])]);
                    MNode (1,[MNode (2,[MNode (3,[])])]);
                    MNode (1,[MNode (2,[MNode (3,[])])])])

Trim Tree Function

let trimTree noLosses depth t=
    let mlimit = ref depth
    let dict = Dictionary()

    let fn k =
        match dict.TryGetValue(k) with
        | true, l -> dict.[k] <- l + 1
        |_ -> dict.Add(k,1)
        if dict.[k] >= noLosses then mlimit := !mlimit - 1 else mlimit := !mlimit

    let rec loop d t  = 
        match t with
            | MNode(i,sub) when d > !mlimit ->  
                fn !mlimit      
                MNode(i, List.map (loop (d+1)) [])
            | MNode(i,sub) -> MNode(i, List.map (loop (d+1)) sub)
    loop 1  t


let Mtree2trimmed = Mtree2 |> trimTree 3 2

Result

Using Thomas P's "printTree" function this is nicely visualized

let printt tree =
let rec loop depth (MNode(n, sub)) =
    printfn "%s %A" depth n
    for s in sub do loop (depth + "  ") s
loop "" tree

Output -

printt Mtree2

 0
   1
     2
       3
   1
     2
       3
   1
     2
       3
   1
     2
       3
   1
     2
       3
   1
     2
       3

Output -

printt Mtree2trimmed

 0
   1
     2
   1
     2
   1
     2
   1
   1
   1

So if you've made it this far - any advice?

Cheers!

Answer 1

This problem is called mapreduce. The basic approach is the following:

1. Mark your data with a supplementary data structure;
2. Process based on supplementary data;
3. Reduce to remove those items that should not be in the final result; Also, eliminate supplementary data as they are not needed anymore.

Let's mark each branch with to supplementary values:

• depth (0=topmost branch)
• sequential (for each subtree, starting with 0)

In order to accomplish that, I have changed the definition of your tree so that it was generic:

type MultiTree<'T> = | MNode of 'T * list<MultiTree<'T>>

And now:

let rec mapper depth sequential = function
    | MNode(value, sub) ->
        MNode( (depth, sequential, value),
               (sub |> List.mapi (fun i value -> mapper (depth+1) i value))
             )

let tree1 = MNode (0,
                    [MNode (1,[MNode (2,[])]);
                    MNode (3,[]);])

printfn "Original data"
tree1 |> printt
printfn "Mapped data"
tree1 |> mapper 0 0 |> printt

The result would be:

Original data
 0
   1
     2
   3
Mapped data
 (0, 0, 0)
   (1, 0, 1)
     (2, 0, 2)
   (1, 1, 3)

Now, when the data is marked, we may apply whatever filter we want. Here are three examples, plus a bit larger tree to demonstrate all possibilities:

// Take only first n branches at every level
let rec filter1 n = function
    // first subtrees pass (up to "noLosses" count)
    | MNode( (depth, sequential, value), sub)
        when sequential < n
                            -> Some(MNode(value, List.choose (filter1 n) sub))
    // the rest are skipped
    | _                     -> None

// Take "d" levels of branches unchanged, at higher levels take only second branch
let rec filter2 d = function
    | MNode( (depth, sequential, value), sub)
        when depth < d      // lower depth - pass

        || sequential = 1   // at higher levels, take only the second branch (=1)
                            -> Some(MNode(value, List.choose (filter2 d) sub))
    // the rest are skipped
    | _                     -> None

// Take only first n branches at every level;
// "n" is a list to identify maximal element at each level
let rec filter3 ns ts =
    match ns, ts with
    // Empty "noLosse" list -> no value
    | [], _                      -> None
    // if the sequential order of Tree branch is less than
    // the corresponding value in "ns" list, let the value pass the filter
    | nsHead :: nsTail, MNode((_, sequential, value), sub)
        when sequential < nsHead -> Some(MNode(value, List.choose (filter3 nsTail) sub))
    // the rest are skipped
    | _, _                       -> None

printfn "Original data"
tree2 |> printt
printfn "Filter1 applied"
tree2 |> mapper 0 0 |> filter1 2 |> Option.iter printt
printfn "Filter2 applied"
tree2 |> mapper 0 0 |> filter2 2 |> Option.iter printt
printfn "Filter3 applied"
tree2 |> mapper 0 0 |> filter3 [4; 4; 2] |> Option.iter printt

Note, we need Option.iter because the filter may return None value.

Outputs:

Original data
 1
   11
     111
       1111
       1112
       1113
   12
     121
       1211
     122
       1221
       1222
       1223
     123
     124
   13
     131
       1211
   14
     141
       1411
   15
     151
       1511
   16
     161
       1611
Filter1 applied
 1
   11
     111
       1111
       1112
   12
     121
       1211
     122
       1221
       1222
Filter2 applied
 1
   11
   12
     122
       1222
   13
   14
   15
   16
Filter3 applied
 1
   11
     111
   12
     121
     122
   13
     131
   14
     141

An important note, this approach is not optimized for performance. Its primary idea is to show how to split the task into a sequence of smaller tasks so that the actual filtering is literally a simple match case.