factor/extra/sequences/abbrev/abbrev.factor

24 lines
634 B
Factor
Raw Normal View History

2009-07-19 19:31:26 -04:00
! Copyright (C) 2009 Maximilian Lupke.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs fry kernel math.ranges sequences ;
IN: sequences.abbrev
<PRIVATE
: prefixes ( seq -- prefixes )
2009-07-19 19:40:20 -04:00
dup length [1,b] [ head ] with map ;
2009-07-19 19:31:26 -04:00
: (abbrev) ( seq -- assoc )
[ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
: assoc-merge ( assoc1 assoc2 -- assoc3 )
2009-11-05 23:22:21 -05:00
[ '[ over _ at dup [ append ] [ drop ] if ] assoc-map ] keep swap assoc-union ;
2009-07-19 19:31:26 -04:00
PRIVATE>
: abbrev ( seqs -- assoc )
[ (abbrev) ] map H{ } [ assoc-merge ] reduce ;
: unique-abbrev ( seqs -- assoc )
abbrev [ nip length 1 = ] assoc-filter ;