sequences.abbrev: Initial commit

diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor
new file mode 100644 (file)
index 0000000..6e6739e
--- /dev/null
+++ b/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

diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor
new file mode 100644 (file)
index 0000000..526737b
--- /dev/null
+++ b/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 ;

diff --git a/extra/sequences/abbrev/authors.txt b/extra/sequences/abbrev/authors.txt
new file mode 100644 (file)
index 0000000..758ea89
--- /dev/null
+++ b/extra/sequences/abbrev/authors.txt
@@ -0,0 +1 @@
+Maximilian Lupke