/extra/sequences/abbrev/abbrev.factor

http://github.com/abeaumont/factor · Factor · 23 lines · 14 code · 7 blank · 2 comment · 2 complexity · 75f62af0cd87c7d4542a782fc50b7882 MD5 · raw file 

    

  1. ! Copyright (C) 2009 Maximilian Lupke.
    2. 

  2. ! See http://factorcode.org/license.txt for BSD license.
    3. 

  3. USING: arrays assocs fry kernel math.ranges sequences ;
    4. 

  4. IN: sequences.abbrev
    5. 

  5. 

  6. <PRIVATE
    7. 

  7. 

  8. : prefixes ( seq -- prefixes )
    9. 

  9.     dup length [1,b] [ head ] with map ;
    10. 

  10. 

  11. : (abbrev) ( seq -- assoc )
    12. 

  12.     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
    13. 

    14. 

  14. : assoc-merge ( assoc1 assoc2 -- assoc3 )
    15. 

  15.     [ '[ over _ at dup [ append ] [ drop ] if ] assoc-map ] keep swap assoc-union ;
    16. 

    17. 

  17. PRIVATE>
    18. 

  18. 

  19. : abbrev ( seqs -- assoc )
    20. 

  20.     [ (abbrev) ] map H{ } [ assoc-merge ] reduce ;
    21. 

  21. 

  22. : unique-abbrev ( seqs -- assoc )
    23. 

  23.     abbrev [ nip length 1 = ] assoc-filter ;
    24.