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 + +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