packS←{⎕IO ⎕ML←1 3                 ⍝ Shannon-Fano packing

    cmp←{
        u←∪,⍵ ⋄ bu{+/⍺=⍵}¨⊂,⍵ ⋄ i←⍒buvu[i] ⋄ bb[i]

        bv←{(⍵≠2)⊂⍵}∊⍬{
            1=≢⍵:2,⍺ ⋄ a(⊂⍺),¨0 1
            2=⍴⍵:a ∇¨⍵
            n←{1⌈+/0=((+/⍵)<2×+\⍵)}⍵ ⋄ a ∇¨(n↑⍵)(n↓⍵)
        }b

        z(⍴,⍵)bv[1] ⋄ q←,⍵

        {0}(1↓uv){((⍺=q)/z)←⊂⍵}¨1↓bv:

        (⍴⍵)uv(∊⍴¨bv)(0∨(bv),∊z)
    }

    exp←{
        (r uv lv d)←⍵
        bv(lv/⍳⍴lv)(+/lv)d

        r⍴''{
            0∊⍴⍵:⍺
            i←1{q←⍺⊃bvq(q)↑⍵:⍺ ⋄ (⍺+1)∇ ⍵}⍵
            (⍺,iuv)(ibv)↓⍵
        }(+/lv)d
    }

    ⍺←1 ⋄ ⍺:cmp ⍵ ⋄ exp ⍵
}
code_colours

test script

Back to: notes

Back to: Workspaces