From 8e9badd4f54e7d40f9276d340fdb6fd9a7bcee89 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 20 Jul 2009 01:31:26 +0200
Subject: [PATCH] sequences.abbrev: Initial commit

---
 extra/sequences/abbrev/abbrev-tests.factor | 26 ++++++++++++++++++++++
 extra/sequences/abbrev/abbrev.factor       | 23 +++++++++++++++++++
 extra/sequences/abbrev/authors.txt         |  1 +
 3 files changed, 50 insertions(+)
 create mode 100644 extra/sequences/abbrev/abbrev-tests.factor
 create mode 100644 extra/sequences/abbrev/abbrev.factor
 create mode 100644 extra/sequences/abbrev/authors.txt

diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor
new file mode 100644
index 0000000000..6e6739e09a
--- /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
index 0000000000..526737bd55
--- /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
index 0000000000..758ea89529
--- /dev/null
+++ b/extra/sequences/abbrev/authors.txt
@@ -0,0 +1 @@
+Maximilian Lupke