Also add a way to escape a string as either 'foo "foo" or [[foo]] depending on which delimiters will do the job.
Add a couple helper words to assocs.extras
--- /dev/null
+John Benediktsson
+Doug Coleman
--- /dev/null
+! Copyright (C) 2017 John Benediktsson, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test escape-strings ;
+IN: escape-strings.tests
+
+{ "[[asdf]]" } [ "asdf" escape-string ] unit-test
+{ "[[[[]]" } [ "[[" escape-string ] unit-test
+{ "[=[]]]=]" } [ "]]" escape-string ] unit-test
+
+{ "[===[]]]==][=[=]=]]===]" } [ "]]]==][=[=]=]" escape-string ] unit-test
+{ "[==[[=[=]=]]==]" } [ "[=[=]=]" escape-string ] unit-test
+{ "[[[a[]]" } [ "[a[" escape-string ] unit-test
+
+{ "[=[ab]]=]" } [ "ab]" escape-string ] unit-test
+
+{ "[==[[=[abcd]]=]]==]" } [ { "abcd]" } escape-strings ] unit-test
+{ "[==[[=[abcd]]]=]]==]" } [ { "abcd]]" } escape-strings ] unit-test
+
+{ "[==[]]ab]=]==]" } [ "]]ab]=" escape-string ] unit-test
+{ "[=[]]ab]==]=]" } [ "]]ab]==" escape-string ] unit-test
+{ "[=[]]ab]===]=]" } [ "]]ab]===" escape-string ] unit-test
+
+{ "[[]ab]=]]" } [ "]ab]=" escape-string ] unit-test
+{ "[[]ab]==]]" } [ "]ab]==" escape-string ] unit-test
+{ "[[]ab]===]]" } [ "]ab]===" escape-string ] unit-test
--- /dev/null
+! Copyright (C) 2017 John Benediktsson, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs assocs.extras combinators kernel math math.order
+math.statistics sequences sequences.extras sets ;
+IN: escape-strings
+
+: find-escapes ( str -- set )
+ [ HS{ } clone 0 0 ] dip
+ [
+ {
+ { CHAR: ] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] }
+ { CHAR: = [ dup 1 = [ [ 1 + ] dip ] when ] }
+ [ 3drop 0 0 ]
+ } case
+ ] each 0 > [ over adjoin ] [ drop ] if ;
+
+: lowest-missing ( set -- min )
+ members dup [ = not ] find-index
+ [ nip ] [ drop length ] if ;
+
+: escape-string* ( str n -- str' )
+ CHAR: = <repetition>
+ [ "[" dup surround ] [ "]" dup surround ] bi surround ;
+
+: escape-string ( str -- str' )
+ dup find-escapes lowest-missing escape-string* ;
+
+: escape-strings ( strs -- str )
+ [ escape-string ] map concat escape-string ;
+
+: escape-simplest ( str -- str' )
+ dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts {
+ { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] }
+ { [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] }
+ [ drop escape-string ]
+ } cond ;
\ No newline at end of file
! Copyright (C) 2012 John Benediktsson, Doug Coleman
! See http://factorcode.org/license.txt for BSD license
USING: arrays assocs assocs.private fry generalizations kernel
-math sequences ;
+math math.statistics sequences sequences.extras ;
IN: assocs.extras
: deep-at ( assoc seq -- value/f )
: flatten-values ( assoc -- assoc' )
dup any-multi-value? [ expand-values-set-at flatten-values ] when ;
+
+: intersect-keys ( assoc seq -- elts )
+ [ of ] with map-zip sift-values ; inline
+
+: values-of ( assoc seq -- elts )
+ [ of ] with map sift ; inline
+
+: counts ( seq elts -- counts )
+ [ histogram ] dip intersect-keys ;
\ No newline at end of file