Morse Code in Factor

I am getting the hang of this. This is a string>morse code and morse code>string converter as per this programming praxis problem. My implementation ignores extra whitespace in the morse code stream.

USING: ascii lists sequences regexp ;

: ch>morse ch>upper ( char -- morse-str )
         { { CHAR: 0 [ "— — — — —" ] }
           { CHAR: 1 [ "• — — — —" ] }
           { CHAR: 2 [ "• • — — —" ] }
           { CHAR: 3 [ "• • • — —" ] }
           { CHAR: 4 [ "• • • • —" ] }
           { CHAR: 5 [ "• • • • •" ] }
           { CHAR: 6 [ "— • • • •" ] }
           { CHAR: 7 [ "— — • • •" ] }
           { CHAR: 8 [ "— — — • •" ] }
           { CHAR: 9 [ "— — — — •" ] }
           { CHAR: A [ "• —" ] } 
           { CHAR: B [ "— • • •" ] }
           { CHAR: C [ "— • — •" ] } 
           { CHAR: D [ "— • •" ] } 
           { CHAR: E [ "• • •" ] }
           { CHAR: F [ "• • — •" ] }
           { CHAR: G [ "— — •" ] }
           { CHAR: H [ "• • • •" ] } 
           { CHAR: I [ "• •" ] } 
           { CHAR: J [ "• — — —" ] } 
           { CHAR: K [ "— • —" ] } 
           { CHAR: L [ "• — • •" ] } 
           { CHAR: M [ "— —" ] } 
           { CHAR: N [ "— •" ] } 
           { CHAR: O [ "— — —" ] } 
           { CHAR: P [ "• — — •" ] } 
           { CHAR: Q [ "— — • —" ] } 
           { CHAR: R [ "• — •" ] } 
           { CHAR: S [ "• • •" ] } 
           { CHAR: T [ "—" ] } 
           { CHAR: U [ "• • —" ] } 
           { CHAR: V [ "• • • —" ] } 
           { CHAR: W [ "• — —" ] } 
           { CHAR: X [ "— • • —" ] }  
           { CHAR: Y [ "— • — —" ] }  
           { CHAR: Z [ "— — • •" ] } [ drop " " ] } case ;

: morse>ch ( morse-substring -- char )
         { { "— — — — —" [ CHAR: 0 ] }
           { "• — — — —" [ CHAR: 1 ] }
           { "• • — — —" [ CHAR: 2 ] }
           { "• • • — —" [ CHAR: 3 ] }
           { "• • • • —" [ CHAR: 4 ] }
           { "• • • • •" [ CHAR: 5 ] }
           { "— • • • •" [ CHAR: 6 ] }
           { "— — • • •" [ CHAR: 7 ] }
           { "— — — • •" [ CHAR: 8 ] }
           { "— — — — •" [ CHAR: 9 ] }
           { "• —" [ CHAR: A ] } 
           { "— • • •" [ CHAR: B ] }
           { "— • — •" [ CHAR: C ] } 
           { "— • •" [ CHAR: D ] } 
           { "• • •" [ CHAR: E ] }
           { "• • — •" [ CHAR: F ] }
           { "— — •" [ CHAR: G ] }
           { "• • • •" [ CHAR: H ] } 
           { "• •" [ CHAR: I ] } 
           { "• — — —" [ CHAR: J ] } 
           { "— • —" [ CHAR: K ] } 
           { "• — • •" [ CHAR: L ] } 
           { "— —" [ CHAR: M ] } 
           { "— •" [ CHAR: N ] } 
           { "— — —" [ CHAR: O ] } 
           { "• — — •" [ CHAR: P ] } 
           { "— — • —" [ CHAR: Q ] } 
           { "• — •" [ CHAR: R ] } 
           { "• • •" [ CHAR: S ] } 
           { "—" [ CHAR: T ] } 
           { "• • —" [ CHAR: U ] } 
           { "• • • —" [ CHAR: V ] } 
           { "• — —" [ CHAR: W ] } 
           { "— • • —" [ CHAR: X ] }  
           { "— • — —" [ CHAR: Y ] }  
           { "— — • •" [ CHAR: Z ] }
           [ drop 32 ] } case ;


: string>morse ( string -- morse-string )
         sequence>cons { } [ ch>morse suffix ] foldl
         "  " join ;

: morse>string ( morse-string -- string )
         R/ [ ]{2,}/ re-split
         [ >string morse>ch ] map >string ; 

The Python Tail Call Hullabu

Guido Van Rossum has done it again, causing a great blogging uproar over his decision to keep tail call elimination out of Python. The argument boils down to Van Rossum feeling as though tail calls encourage a kind of non-obvious style of programming and make debugging more complicated anyway (you can read the whole thing here. Those few (none) of you who have followed this blog might guess, given my penchant for functional languages, that I am on the pro-tail-call-elimination group and, I suppose, I probably am¹. However, my position is perhaps more nuanced, at least enough that I thought it worth explicating. The problem might be cast into relief by pointing out we'd really like, as programmers of an abstract bent, to ignore the existence of the computer our code is running on entirely. Even the Turing machine, arguably the least abstract conception of computing, has an infinite amount of tape. The lambda calculus doesn't have any machine aspect at all - no memory, processors, none of that crap. In a completely abstract world, the difference between a tail call and a call in a non-tail position is immaterial - you have an infinite amount of stack (or whatever it is) to accumulate, and all that really matters is whether the computation terminates (and not even that, if you are working on streams or some other meaningfully infinite data structure). In real life, much to the chagrin of us abstract types, computers have a finite amount of call stack and all sorts of other limitations. But the elimination of tail calls lets us pretend, in certain cases and for certain, carefully crafted algorithms, that the limitation of the stack does not exist. There is a grace and elegance to this which is very attractive, which is why we like it. But it also is clunky and weird. Why, after all, should a tail call be different than a call in a non-tail position? In Scheme, nothing distinguishes a tail call syntactically or semantically (at least not without bursting the bubble of abstraction around the language). As far as the abstract nature of programming is concerned tail and non-tail calls are identical. So even though tail calls let us code in a way which seems abstract, they are really coding to an optimization. In other words, the most abstract of us are spending a lot of time thinking about a non-abstract question anyway. The tail call is a sort of a farce. It is this very reality which I think the non-abstract crowd claims is confusing, and when I really think about it, I can see the point. I'd still like it in Python, but I guess I might just have moved on to other languages. ¹ I'd rather have proper lambdas first.

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 ;