sequences.abbrev: Initial commit

extra/sequences/abbrev/abbrev-tests.factor

@@ -0,0 +1,26 @@
+USING: assocs sequences.abbrev tools.test ;
+IN: sequences.abbrev.tests
+
+[ { "help" "hello" } ] [
+    "he" { "apple" "hello" "help" } abbrev at
+] unit-test
+
+[ f ] [
+    "he" { "apple" "hello" "help" } unique-abbrev at
+] unit-test
+
+[ { "apple" } ] [
+    "a" { "apple" "hello" "help" } abbrev at
+] unit-test
+
+[ { "apple" } ] [
+    "a" { "apple" "hello" "help" } unique-abbrev at
+] unit-test
+
+[ f ] [
+    "a" { "hello" "help" } abbrev at
+] unit-test
+
+[ f ] [
+    "a" { "hello" "help" } unique-abbrev at
+] unit-test

extra/sequences/abbrev/abbrev.factor

@@ -0,0 +1,23 @@
+! 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 )
+    dup length [1,b] [ dupd head ] map nip ;
+
+: (abbrev) ( seq -- assoc )
+    [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
+
+: assoc-merge ( assoc1 assoc2 -- assoc3 )
+    swap over '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ;
+
+PRIVATE>
+
+: abbrev ( seqs -- assoc )
+    [ (abbrev) ] map H{ } [ assoc-merge ] reduce ;
+
+: unique-abbrev ( seqs -- assoc )
+    abbrev [ nip length 1 = ] assoc-filter ;

extra/sequences/abbrev/authors.txt

@@ -0,0 +1 @@
+Maximilian Lupke