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

    cmp←{
        u←∪,⍵ ⋄ b←u{+/⍺=⍵}¨⊂,⍵ ⋄ i←⍒b ⋄ uv←u[i] ⋄ b←b[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←⍺⊃bv ⋄ q≡(⍴q)↑⍵:⍺ ⋄ (⍺+1)∇ ⍵}⍵
            (⍺,i⊃uv)∇(⍴i⊃bv)↓⍵
        }(+/lv)↓d
    }

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

code_colours

test script

Back to: notes

Back to: Workspaces