escape-strings: Add escape-number-string.

[==[ string delimiters grow linearly with the number of escapes needed.

[0[
[00[
[000[ delimiters grow logarithmically and you can even choose whichever numbers
you need, not just the lowest ones. e.g. for value numbering

diff --git a/basis/escape-strings/escape-strings-tests.factor b/basis/escape-strings/escape-strings-tests.factor
index 93a388f9bd55836299c3bd0e3630a44635d13575..acfa60006687bce78d8c841a6a24c36ca998af6c 100644 (file)
--- a/basis/escape-strings/escape-strings-tests.factor
+++ b/basis/escape-strings/escape-strings-tests.factor
@@ -23,3 +23,12 @@ IN: escape-strings.tests
 { "[[]ab]=]]" } [ "]ab]=" escape-string ] unit-test
 { "[[]ab]==]]" } [ "]ab]==" escape-string ] unit-test
 { "[[]ab]===]]" } [ "]ab]===" escape-string ] unit-test
+
+{ "[[]]" } [ "" number-escape-string ] unit-test
+{ "[0[]]0]" } [ "]" number-escape-string ] unit-test
+{ "[[]0]]" } [ "]0" number-escape-string ] unit-test
+{ "[1[]0]]1]" } [ "]0]" number-escape-string ] unit-test
+{ "[0[]1]]0]" } [ "]1]" number-escape-string ] unit-test
+{ "[2[]0]1]]2]" } [ "]0]1]" number-escape-string ] unit-test
+{ "[00[]0]1]2]3]4]5]6]7]8]9]]00]" } [ "]0]1]2]3]4]5]6]7]8]9]" number-escape-string ] unit-test
+{ "[01[]0]1]2]3]4]5]6]7]8]9]00]]01]" } [ "]0]1]2]3]4]5]6]7]8]9]00]" number-escape-string ] unit-test
\ No newline at end of file

diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor
index 5fa76185546f641a6a05a54e40927f66bc5f24ca..9932ab33f37a4282a5a6fbeea5d8cc1c511182eb 100644 (file)
--- a/basis/escape-strings/escape-strings.factor
+++ b/basis/escape-strings/escape-strings.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2017 John Benediktsson, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs combinators kernel math math.order
-math.statistics sequences sets ;
+USING: ascii assocs combinators fry kernel math math.functions
+math.parser math.ranges math.statistics sequences sets sorting
+strings ;
 IN: escape-strings
 
 : find-escapes ( str -- set )
@@ -14,20 +15,57 @@ IN: escape-strings
         } case
     ] each 0 > [ over adjoin ] [ drop ] if ;
 
+: find-number-escapes ( str -- set )
+    [ HS{ } clone SBUF" " clone 0 ] dip
+    [
+        {
+            { [ dup CHAR: ] = ] [
+                drop 1 + dup 2 = [
+                    drop dup >string pick adjoin
+                    0 over set-length 1
+                ] when
+            ] }
+            { [ dup digit? ] [ [ dup 1 = ] dip '[ [ _ over push ] dip ] [ ] if ] }
+            [ 2drop 0 over set-length 0 ]
+        } cond
+    ] each 0 > [ >string over adjoin ] [ drop ] if ;
+
+: lowest-missing-number ( string-set -- min )
+    members dup
+    [ length ] histogram-by
+    dup keys length [0,b]
+    [ [ of ] keep over [ 10^ < ] [ nip ] if ] with find nip
+    [ '[ length _ = ] filter natural-sort ] keep ! remove natural-sort here
+    [
+        [ drop "" ] [
+            10^ <iota> [
+                [ swap ?nth dup [ string>number ] when ] keep = not
+            ] with find nip number>string
+        ] if-zero
+    ] keep CHAR: 0 pad-head ;
+
 : lowest-missing ( set -- min )
     members dup [ = not ] find-index
     [ nip ] [ drop length ] if ;
 
-: escape-string* ( str n -- str' )
-    CHAR: = <repetition>
+: surround-by-brackets ( str delim -- str' )
     [ "[" dup surround ] [ "]" dup surround ] bi surround ;
 
+: surround-by-equals-brackets ( str n -- str' )
+    CHAR: = <repetition> surround-by-brackets ;
+
 : escape-string ( str -- str' )
-    dup find-escapes lowest-missing escape-string* ;
+    dup find-escapes lowest-missing surround-by-equals-brackets ;
 
 : escape-strings ( strs -- str )
     [ escape-string ] map concat escape-string ;
 
+: number-escape-string ( str -- str' )
+    dup find-number-escapes lowest-missing-number surround-by-brackets ;
+
+: number-escape-strings ( strs -- str )
+    [ number-escape-string ] map concat number-escape-string ;
+
 : tag-payload ( str tag -- str' )
     [ escape-string ] dip prepend ;