Rail-Fence Cypher (Amateur Hour at the Factor Lounge)

Hi folks. Decided to learn a stack based language - considered forth for a time but felt that I didn't often have a domain where it would be useful (I learn most of my fun languages, eventually, by writing all my little day to day shell scripts in them). Stack based languages are both wildly different and surprisingly similar to applicative languages. My code is still very amateurish (in particular there is a combinator I kept wanting but couldn't find - it would apply a quotation to n elements on the stack and leave the results in the same place), but I think I am getting the hang of it. True to its name, factoring code is much easier when all the variable binding and associated cruft is implicit. There is something to be said for that. The problem is the rail-fence cypher, which you can read about here. My solution is nothing special, so far as reasoning goes and I use a Matlab accented trick to undo the cypher. I don't know if there is a smarter way.

USING: sequences quotations grouping lists arrays fry ;

: make< ( n -- quotation )
         1 { dup < } insert-nth >quotation ;
: ->n ( n -- seq )
         make< 0 swap [ 1 + dup 1 - ] [ ] produce swap drop ;
: nth-or ( or i seq -- i-or )
         dup length pick swap < [ nth swap drop ] [ drop drop ] if ;
: prefix-if-not-f ( seq it -- seq )
         dup [ prefix ] [ drop ] if ;
: nths-if ( seq-seq n -- nths )
         '[ f _ rot nth-or prefix-if-not-f ]
         swap sequence>cons swap { } swap foldl reverse ;  
: invert-about ( n a -- o )
         dup dup '[ dup _ <= [ ] [ _ - _ swap - ] if ] call ;
: inverter ( a -- quot )
         [ invert-about ] curry ;

: height-sequence ( str n -- str n hs )
         over length ->n over 1 - 2 * [ mod ] curry map
         over 1 - inverter map pick zip ;
: height= ( pair n -- bool ) swap first = ;
: fing-heights= ( n seq -- seq ) swap [ height= ] curry filter ;
: construct-height-filter-quot ( seq -- quot )
         [ fing-heights= ] curry [ [ second ] map prefix ] compose ;
: railfence ( str n -- enc )
         height-sequence
         construct-height-filter-quot
         swap ->n sequence>cons swap { } swap
         foldl reverse concat >string swap drop ;

: index-array ( enc n -- array )
         over length ->n >string swap railfence >array swap zip ;
: compare-pairs ( o1 o2 -- r )
         first swap first swap <=> ;
: ~railfence ( enc n -- str )
         index-array [ compare-pairs ] sort [ second ] map >string ;