extra/sequences/abbrev/abbrev.factor

   1 ! Copyright (C) 2009 Maximilian Lupke.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs fry kernel math.ranges sequences ;
   4 IN: sequences.abbrev
   5
   6 <PRIVATE
   7
   8 : prefixes ( seq -- prefixes )
   9     dup length [1,b] [ head ] with map ;
  10
  11 : (abbrev) ( seq -- assoc )
  12     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
  13
  14 : assoc-merge ( assoc1 assoc2 -- assoc3 )
  15     [ '[ over _ at [ append ] when* ] assoc-map ] keep swap assoc-union ;
  16
  17 PRIVATE>
  18
  19 : abbrev ( seqs -- assoc )
  20     [ (abbrev) ] map H{ } [ assoc-merge ] reduce ;
  21
  22 : unique-abbrev ( seqs -- assoc )
  23     abbrev [ nip length 1 = ] assoc-filter ;