dft{⎕IO ⎕ML←0 1                            ⍝ Display of function tree.

    trav←{                                  ⍝ traverse, accumulating subtrees.
        ~(,¨2 3)∨.≡⊂⍴⍵:leaf ⍵               ⍝ not a derv or train: done.
        '['≡1⊃⍵:∇(⊃⍵)('[',(⍕2⊃⍵),']')       ⍝ axis: special treatment
        isop 1⊃⍵:{                          ⍝ derived fn:
            2=⍴⍵:mop ⍵                      ⍝ monadic operator
            3=⍴⍵:dop ⍵                      ⍝ dyadic operator.
        }∇¨⍵                                ⍝ formatted subtrees.
        isfn⊃⌽⍵:train ∇¨⍵                   ⍝ train:
        leaf ⍵                              ⍝ neither: give up.
    }

    train←{                                 ⍝ function train.
        subs←↑mesh/⍵                        ⍝ enmeshed subtrees.
        topsapts⊃↓subs                     ⍝ anchor points.
        jptsmid(2=+/tops),tops            ⍝ joining points.
        xvec←{(3×⍵)++\⍵}jpts                ⍝ character index vector.
        deco(¯2+⍴⍵)⊃' ── ┌┴┐ ' ' ── ┌┼┐ '  ⍝ plumbing chars.
        (xvec⊃¨⊂deco)subs                  ⍝ subtree matrix.
    }

    mop←{                                   ⍝ operator with one operand.
        land oper←↓¨⍵                       ⍝ derived function components.
        tab←+/∧\(land)∊' ┌─┐'              ⍝ indentation for top line.
        legdog×⌈spread÷2                   ⍝ length of dog-leg.
        pad(tab+dog+leg)/' '               ⍝ padding for operator.
        toprpad∘,¨oper                     ⍝ tabbed operator.
        decodog⊃' │  ' ' ┌─┘'              ⍝ plumbing chars.
        jointab 1 leg dog/deco             ⍝ dog-leg or straight join.
        ↑(topr,↓join),land                  ⍝ subtree matrix.
    }

    dop←{                                   ⍝ operator with two operands.
        land oper rand←⍵                    ⍝ derived function components.
        subsland mesh rand                 ⍝ merged subtrees.
        topsmid apts⊃↓subs                 ⍝ anchor points.
        xvec←{(3×⍵)++\⍵}tops                ⍝ character index vector.
        headxvec⊃¨⊂' ── ┌┴┐ '              ⍝ forked subtree joiner.
        otab(head⍳'┴')/' '                 ⍝ operator padding.
        ↑(otab∘,¨↓oper),↓headsubs          ⍝ subtree matrix.
    }

    mesh←{                                  ⍝ meshed left and right subtrees.
        lbr rbr←⊂[1 2]↑(⌽⍺)⍵                ⍝ sub branches with same no of rows.
        lft rgt←{+/∧\' '=⍵}¨lbr rbr         ⍝ left and rgt adjacent blanks.
        sep←⌊/lft+rgt                       ⍝ narrowest separation.
        dpllftsep                         ⍝ chars to drop from left subtree.
        dpr←0⌈sep-dpl                       ⍝   ..      ..      right   ..
        lvec←⌽¨dpl↓¨↓lbr                    ⍝ left rows.
        rvecdpr↓¨(spread/' ')∘,¨↓rbr       ⍝ right rows, padded with min gap.
        trim←{(~∧\∧⌿⍵=' ')/⍵}               ⍝ trim off outer blank cols.
        ⌽trimtrimlvecrvec               ⍝ meshed subtrees.
    }

    leaf←{                                  ⍝ format leaf.
        1∊'←{'⍷⊃↓⍵:∇↑noname↓⍵               ⍝ dfn without name.
        dots←{(⍵⍳⍺)⊃¨⊂⍵,'·'}                ⍝ dots for blanks.
        {⍵ dots(,⍵)~' '}⎕FMT ⍵              ⍝ char matrix.
    }

    noname←{                                ⍝ without dfn name.
        a←⊃⍵                                ⍝ first line.
        xa⍳'{'                             ⍝ length of 'name←'.
        ~'⍝'∊a:(xa),1↓⍵                   ⍝ no comment: without name.
        ca⍳'⍝'                             ⍝ position of line[0] comment.
        dx(ca),(x⍴' '),ca               ⍝ name← removed, comment adjusted.
        (d),1↓⍵
    }

    isfn←{                                  ⍝ is function?
        0=≡⍵:⍵∊pfns                         ⍝ primitive function:
        dfnop ⍵:1                           ⍝ dfn:
        ~(,¨2 3)∨.≡⊂⍴⍵:0                    ⍝ not a derv or train.
        isop 1⊃⍵:1                          ⍝ derv.
        ∇⊃⌽⍵                                ⍝ derv or train.
    }

    isop←{                                  ⍝ is operator?
        (⊂⍵)pops:1                         ⍝ primitive operator:
        ']['≡2↑¯1⌽⍵:1                       ⍝ axis: [1 2 ..]
        ~dfnop ⍵:0                          ⍝ not a d-op:
        1∊↑'⍺⍺' '⍵⍵'⍷¨⊂⍵                    ⍝ is a d-op.
    }

    mid←{⍵∨(⍳⍴⍵){⍺=⌊(+/⍵/⍺)÷2}⍵}            ⍝ mask with midpoint
    trim←{⍵-¯1⌽1 1⍷⍵}⍣≡                     ⍝ for ('abc',)
    aptstrim(~∘(∊∘' ┌─┐'))                ⍝ anchor points for sub-trees.
    dfnop←{'}'≡⊃⌽~∘' ',⍵}                   ⍝ dfn or dop

    pops←'/\⌿⍀.¨∘⍨&⌶@⍣[⌸⍠⍤⌺'                ⍝ primitive ops.
    pf0←'+-×÷⌊⌈|*⍟<≤=≥>≠∨∧⍱⍲!?~○'           ⍝ primitive fns (scalar).
    pf1←'⊢⊣⌷/⌿\⍀∊⍴↑↓⍳⊂⊃∩∪⊥⊤,⍒⍋⍉⌽⊖⌹⍕⍎⍪≡≢⍷⍸⊆' ⍝ primitive fns (other).
    pfnspf0,pf1                            ⍝ primitive fns.

    spread←1⌈⍵                              ⍝ horizontal spread.
    ⍺←1 ⋄ dog←⍺                             ⍝ dog-leg for monadic operators.

    fn←⍺⍺ ⋄ trav ⎕CR'fn'                    ⍝ display of function tree.
}
code_colours

test script

Back to: notes

Back to: Workspaces