sbst←{⎕IO ⎕ML←0 1                       ⍝ Simple Binary Search Trees.

    put←{                               ⍝ tree ⍺ with key=value ⍵.
        ⍺≡0:(⍵(0 0))0                   ⍝ null: new node.
        ((nxt _)subs)(key _)←⍺ ⍵        ⍝ node and search key/val.
        nxt≡key:(⍵ subs)0               ⍝ match: new value.
        ⍺ ∇ search ⍵                    ⍝ natch: try subtrees.
    }                                   ⍝ :: t ∇ k v → t _

    get←{                               ⍝ value for key ⍵ from tree ⍺.
        ⍺≡0:⍺'?'                        ⍝ null: key not in tree: no value.
        ((nxt val)_)(key _)←⍺ ⍵         ⍝ node and search key.
        nxt≡key:⍺ val                   ⍝ match: tree & value.
        ⍺ ∇ search ⍵                    ⍝ natch: try subtrees.
    }                                   ⍝ :: t ∇ k _ → _ v

    rem←{                               ⍝ tree ⍺ without key ⍵.
        ⍺≡0:⍺ 0                         ⍝ null: key not in tree: no change.
        ((nxt _)subs)(key _)←⍺ ⍵        ⍝ node and key.
        ~nxt≡key:⍺ ∇ search ⍵           ⍝ natch: value.
        0 0≡subs:0 0                    ⍝ leaf: done.              X~X → Y
        0∊subs:((subs⍳0)⊃⌽subs)0        ⍝ one null: use other.    /       \
        (rrot ⍺)∇ ⍵                     ⍝ remove from rgt-rotn:  Y         X~X
    }                                   ⍝ :: t ∇ k _ → t _
                                        ⍝                       B   →   A
    rrot←{                              ⍝ right rotation.      / \     / \
        B((A(p q))r)←⍵                  ⍝ unpack nodes.       A   r   p   B
        A(p(B(q r)))                    ⍝ repack nodes.      / \         / \
    }                                   ⍝ :: ∇ t → t        p   q       q   r

    search←{                            ⍝ search subtree ⍺ for key ⊃⍵.
        inf(lft rgt)←⍺                  ⍝ parts of node.
        dir←1-2×>/⍋↑⊃¨inf ⍵             ⍝ search direction: ¯1 1
        wise←{(2×⍺)↑3⍴⍵}                ⍝ parameterise direction.
        _ nxt←dir wise lft rgt          ⍝ nxt subtree to search.
        sub val←nxt ⍺⍺ ⍵                ⍝ new subtree.
        subs←dir wise lft sub rgt       ⍝ lft and rgth subtrees.
        (inf subs)val                   ⍝ new node and value.
    }                                   ⍝ :: t (t ∇ k v → t v) ∇∇ k v → t v

    fmt←{                               ⍝ formatted tree ⍵.
        null←0 0⍴''                     ⍝ format of null tree.
        ⍵≡0:null                        ⍝ null tree: null format.
        (key val)subs←⍵                 ⍝ node info.
        key_val←↑,/⍕¨key'='val          ⍝ formatted key=value
        fmts←{⊖⍵}\'┌└'{                 ⍝ hang subtrees by ┌─ ─┐ branches.
            0 0≡⍴⍵:⍵                    ⍝ null: done.
            mask←∧\' '=⊃↓⌽⍉⍵            ⍝ mask of leading blanks.
            ⍉⌽↑(⊂⌽⍺,mask/'│'),↓⌽⍉⍵      ⍝ subtree suspended by branch.
        }¨{⊖⍵}\∇¨subs                   ⍝ formatted subtrees.
        case←~null null≡¨fmts           ⍝ non-null subtree cases.
        join←(2⊥case)⊃'∘┐┘┤'            ⍝ subtree joining char.
        join≡'∘':↑,↓key_val             ⍝ leaf: done.
        dent←' '⊣¨key_val               ⍝ subtree padding.
        pads←{↓↑,/dent,⊂⍵}¨fmts         ⍝ left-padded subtrees.
        ↑↑{⍺,(↓key_val,join),⍵}/pads    ⍝ formatted tree.
    }                                   ⍝ :: ∇ t → [-;]

    vec←{                               ⍝ vector of key=value pairs.
        ⍵≡0:⍬                           ⍝ null tree: null vector.
        key_val(lft rgt)←⍵              ⍝ key=val and subtrees.
        (∇ lft),(⊂key_val),∇ rgt        ⍝ left_vec, key=val, right_vec.
    }                                   ⍝ :: ∇ t → [k v]

    chk←{                               ⍝ tree stats / integrity check.
        0=≡⍵:(0≡⍵)0 0 0 ⍬               ⍝ null: ok ht=0 sz=0 depth=0 range=⍬.
        (key _)subs←⍵                   ⍝ node info and subtrees.
        stats←(⍺+1)∇¨subs               ⍝ subtree stats.
        oks szs dps hts krs←↓⍉↑stats    ⍝ individual stats.
        keys←↑key{⍺,(⊂⍺⍺),⍵}/krs        ⍝ subtree key ranges.
        okkey←{⍵≡⍳⍴⍵}⍋↑keys             ⍝ left keys << key >> right keys.
        okstr←2 2≡(⍴⍵),⍴⊃⌽⍵             ⍝ good node struct.
        ok←okkey∧okstr∧∧/oks            ⍝ good tree.
        sz←1++/szs                      ⍝ subtree size.
        dp←⍺++/dps                      ⍝ total node depth.
        ht←1+⌈/hts                      ⍝ node height.
        kr←⌽2⍴¯1⌽keys                   ⍝ key range for subtree.
        ⍺>0:ok sz dp ht kr              ⍝ subtree: ok size tot_dep height range.
        ok sz(⌊0.5+dp÷sz)ht             ⍝ root: ok size mean_depth height.
    }                                   ⍝ :: ∇ t → y s d h {r}

    bal←{                               ⍝ dsw-balancing.
        vine size←0 0 list ⍵            ⍝ vine of 0-leaves and size.
        log←⌊2⍟size+1                   ⍝ largest complete tree ≤ ⍵.
        rem←1+size-2*log                ⍝ no of surplus nodes.
        cmps←¯2+2*1+⍳log                ⍝ compression vector.
        ↑cmp/(1↓cmps,2×rem),⊂vine       ⍝ compression reduction → balanced tree.
    }                                   ⍝ :: ∇ t → t

    cmp←{                               ⍝ compress of alternate vine sections.
        ⍺=0:⍵                           ⍝ far enough: terminal leaf.
        inf(lft rgt)←⍵                  ⍝ parts of node.
        lev←(⍺-1)∇ lft                  ⍝ leftmost vine leaf.
        2|⍺:inf(lev rgt)                ⍝ copying of alternate vine sections.
        rrot inf(lev rgt)               ⍝ rotation of alternate vine sections.
    }                                   ⍝ :: n ∇ v → t

    list←{                              ⍝ list (0-vine) from tree ⍵.         /
        0≡⍵:⍺                           ⍝ null: accumlated vine.    /       C
        inf(lft rgt)←⍵                  ⍝ node info & subtrees.    B   →   /
        lev s←⍺ ∇ lft                   ⍝ left vine & size,       / \     B
        (inf(lev 0))(s+1)∇ rgt          ⍝ ++ right vine.         A   C   /
    }                                   ⍝ :: v ∇ t → v s                A

    op←⍺⍺{f←⍺⍺ ⋄ ⊃⎕CR'f'}0              ⍝ operand label.

    '∪'≡op:⊃⍺ put ⍵                     ⍝ insert/replace value in tree.
    '⍎'≡op:⊃⌽⍵ get ⍺ 0                  ⍝ search for value for key.
    '~'≡op:⊃⍺ rem ⍵ 0                   ⍝ remove key=value from tree.
    '⍕'≡op:fmt ⍵                        ⍝ formatted tree.
    '∊'≡op:vec ⍵                        ⍝ vector of key=value pairs.
    '?'≡op:4↑0 chk ⍵                    ⍝ tree stats and integrity check.
    '='≡op:bal ⍵                        ⍝ balanced tree ⍵.
}

code_colours

test script

Back to: notes

Back to: Workspaces