Old R2 `step` function, ported to Red, for incrementing alpha-numeric strings.

step.red

Red []

step-ctx: context [

	digit=: charset [#"0" - #"9"]
	alpha=: charset [#"A" - #"Z" #"a" - #"z"]
	alpha-num=: union alpha= digit=

	; Could do this with charsets.
	range-start-char?: func [val] [to logic! find "0Aa" val]
	range-end-char?:   func [val] [to logic! find "9Zz" val]

	; Can't use a charset, because we can't find an index from that.
	step-chars: "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
	step-char=: charset step-chars
	
	; Should this be case sensitive?
	step: function [ ; INCR SUCC ADVANCE NEXT-STR, inspired by Ruby's succ method.
		{"Increments" strings; skips non-alpha-num characters.}
		series [any-string!] "(modified)"
		/back		; new experiment
		/local =ch
	][
		offset: pick [1 -1] not back
		
		if empty? series [return series]

		;carry?: does [found? find "9Zz" =ch]
		carry?: does [range-end-char? =ch]

		; This gives us the new "rollover digit" to add, when we need
		; to grow a string. Zeros rolling to ones is the exception to
		; the rule; otherwise, we just add the same char that's there
		; (the starting char for a range).
		range-start-char: func [val] [
			select/skip/case [#"0" #"1"  #"A" #"A"  #"a" #"a"] val 2
		]

		; If all the alpha-numeric characters caused a carry,
		; and if the first char in the string is alpha-numeric,
		; we grow the string, extending the number of "digits".
		; If the first char is *not* alpha-numeric, we don't
		; grow the string, which gives us a "rollover to zero"
		; behavior.
		grow-if-necessary: does [
			if range-start-char? last series [
				append series range-start-char last series
			]
		]
		; Increment a char val, rolling over if necessary.
		step-val: func [val] [
			either find "9Zz" val [
				;!! Doesn't support /back yet
				select/skip/case [#"9" #"0"  #"Z" #"A"  #"z" #"a"] val 2
			][
				;add val offset				; doesn't limit to range chars
				pick step-chars offset + index? find/case step-chars val
				;select step-chars val		; doesn't support /back, which is a new experiment
			]
		]
		
		; Reverse the series, so we can parse left to right.
		reverse series
		; Ensure local capture, since we use `copy` to set it when parsing.
		=ch: none

		catch [
			parse/case series [
				some [
					change set =ch step-char= (step-val =ch)
					; Carry? means the char we just found will cause
					; a "carry" to the next digit, so we keep going;
					; otherwise, we're done.
					(if not carry? [throw 'done])
					; Skip over unmapped chars.
					| skip
				]
			]
			; If we stopped carrying at some point, we won't get here.
			grow-if-necessary
		]
		; We reversed the series to parse it, so reverse it again.
		reverse series
	]

	step-test-ctx: context [
		test-step: func [val expected-result] [
			if expected-result <> step copy val [
				print ["Test Failed:" mold val mold step copy val]
			]
		]
		foreach [val res] [
			""    ""
			"!"   "!"
			"!@#$%^&*()" "!@#$%^&*()"
			"aa"  "ab"
			"aaa" "aab"
			"az"  "ba"
			"aZ"  "bA"
			"zz"  "aaa"
			"#zz" "#aa"
			"ZZ"  "AAA"
			"!ZZ" "!AA"
			"001" "002"
			"009" "010"
			"099" "100"
			"999"       "1000"
			"~999"      "~000"
			"123@999"   "124@000"
			"1.2.3"     "1.2.4"
			"001#1.2.9" "001#1.3.0"
			"001#9.9.9" "002#0.0.0"
			"001-zzz"   "002-aaa"
		] [test-step val res]
	]

;	; Should this be case sensitive?
;	step: function [ ; INCR SUCC ADVANCE NEXT-STR, inspired by Ruby's succ method.
;		{"Increments" strings; skips non-alpha-num characters.}
;		series [any-string!] "(modified)"
;	][
;		if empty? series [return series]
;
;		;carry?: does [found? find "9Zz" =val]
;		carry?: does [range-end-char? =val]
;
;		; This gives us the new "rollover digit" to add, when we need
;		; to grow a string. Zeros rolling to ones is the exception to
;		; the rule; otherwise, we just add the same char that's there
;		; (the starting char for a range).
;		range-start-char: func [val] [
;			select/skip/case [#"0" #"1"  #"A" #"A"  #"a" #"a"] val 2
;		]
;
;		; If all the alpha-numeric characters caused a carry,
;		; and if the first char in the string is alpha-numeric,
;		; we grow the string, extending the number of "digits".
;		; If the first char is *not* alpha-numeric, we don't
;		; grow the string, which gives us a "rollover to zero"
;		; behavior.
;		grow-if-necessary: does [
;			if range-start-char? last series [
;				append series range-start-char last series
;			]
;		]
;		; Increment a char val, rolling over if necessary.
;		step-val: func [val] [
;			either find "9Zz" val [
;				select/skip/case [#"9" #"0"  #"Z" #"A"  #"z" #"a"] val 2
;			] [add val 1]
;		]
;		
;		; Reverse the series, so we can parse left to right.
;		reverse series
;		; Ensure local capture, since we use `copy` to set it when parsing.
;		=val: none
;
;		catch [
;			parse/case series [
;				some [
;					mark: copy =val alpha-num= (
;						change mark step-val to char! =val
;						; Carry? means the char we just found will cause
;						; a "carry" to the next digit, so we keep going;
;						; otherwise, we're done.
;						if not carry? [throw]
;					)
;					; We just skip over non-alph-num chars in the current
;					; design.
;					| skip
;				]
;			]
;			; If we stopped carrying at some point, we won't get here.
;			grow-if-necessary
;		]
;		; We reversed the series to parse it, so reverse it again.
;		reverse series
;	]
;
;	step-test-ctx: context [
;		test-step: func [val expected-result] [
;			if expected-result <> step copy val [
;				print ["Test Failed:" mold val mold step copy val]
;			]
;		]
;		foreach [val res] [
;			""    ""
;			"!"   "!"
;			"!@#$%^&*()" "!@#$%^&*()"
;			"aa"  "ab"
;			"aaa" "aab"
;			"az"  "ba"
;			"aZ"  "bA"
;			"zz"  "aaa"
;			"#zz" "#aa"
;			"ZZ"  "AAA"
;			"!ZZ" "!AA"
;			"001" "002"
;			"009" "010"
;			"099" "100"
;			"999"       "1000"
;			"~999"      "~000"
;			"123@999"   "124@000"
;			"1.2.3"     "1.2.4"
;			"001#1.2.9" "001#1.3.0"
;			"001#9.9.9" "002#0.0.0"
;			"001-zzz"   "002-aaa"
;		] [test-step val res]
;	]

	;     step: func [series [series!]] [ ; INCR
	;         digit=: charset [#"0" - #"9"]
	;         alpha=: charset [#"A" - #"Z" #"a" - #"z"]
	;         alpha-num=: union alpha= digit=
	;         carry?: none ;does [find "9Zz" =val]
	;         step-val: func [val /no-carry] [
	; ;             print ['step-val no-carry val]
	; ;             if all [carry?  not no-carry] [
	; ;                 print ['carrying val]
	; ;                 ;val: add val 1
	; ;                 ;print val
	; ;                 probe ['recur val: step-val/no-carry val]
	; ;             ]
	;             ;carry? false
	;             probe do any [
	;                 select/case [
	;                     #"9" [carry?: true  #"0"]
	;                     #"Z" [carry?: true  #"A"]
	;                     #"z" [carry?: true  #"a"]
	;                 ] val
	;                 [add val 1]
	;             ]
	;         ]
	;         series: back tail series
	;         while [not head? series] [
	;             carry?: false
	;             if find alpha-num= =val: first series [
	;                 change series step-val =val
	;                 if not carry? [break]
	;             ]
	;             series: back series
	;         ]
	;         if carry? [insert series step-val first series]
	;         head series
	;     ]
	;     test-step: func [val] [print [val step copy val]]
	;     test-step "aa"
	;     test-step "aaa"
	;     test-step "az"
	;     test-step "aZ"
	;     test-step "zz"
	;     test-step "ZZ"
	;     test-step "001"
	;     test-step "009"
	;     test-step "099"
	;     test-step "999"
	;
	;     step: func [series [series!]] [ ; INCR
	;         either any-string? series [
	;         ][
	;         ]
	;     ]

	;     ; STEP using FOR instead of PARSE. This passes all the tests, but it's
	;     ; about 35% slower than the parse-based version.
	;     step: func [ ; INCR SUCC ADVANCE NEXT-STR, inspired by Ruby's succ method.
	;         {"Increments" strings; skips non-alpha-num characters.}
	;         series [any-string!]
	;         /local digit= alpha= alpha-num= =val carry? step-val mark
	;                range-start-char range-start-char? grow-if-necessary
	;     ][
	;         if empty? series [return series]
	;         digit=: charset [#"0" - #"9"]
	;         alpha=: charset [#"A" - #"Z" #"a" - #"z"]
	;         alpha-num=: union alpha= digit=
	;         carry?: does [found? find "9Zz" =val]
	;         range-start-char?: func [val] [found? find "0Aa" val]
	;         ; This gives us the new "rollover digit" to add, when we need
	;         ; to grow a string. Zeros rolling to ones is the exception to
	;         ; the rule; otherwise, we just add the same char that's there
	;         ; (the starting char for a range).
	;         range-start-char: func [val] [
	;             select/skip/case [#"0" #"1"  #"A" #"A"  #"a" #"a"] val 2
	;         ]
	;         ; If all the alpha-numeric characters caused a carry,
	;         ; and if the first char in the string is alpha-numeric,
	;         ; we grow the string, extending the number of "digits".
	;         ; If the first char is *not* alpha-numeric, we don't
	;         ; grow the string, which gives us a "rollover to zero"
	;         ; behavior.
	;         grow-if-necessary: does [
	;             if range-start-char? first series [
	;                 insert series range-start-char first series
	;             ]
	;         ]
	;         ; Increment a char val, rolling over if necessary.
	;         step-val: func [val] [
	;             either find "9Zz" val [
	;                 select/skip/case [#"9" #"0"  #"Z" #"A"  #"z" #"a"] val 2
	;             ] [add val 1]
	;         ]
	;         catch [
	;             for i length? series 1 -1 [
	;                 =val: series/:i ; carry? usese =val
	;                 if find alpha-num= =val [
	;                     change at series i step-val =val
	;                     ; Carry? means the char we just found will cause
	;                     ; a "carry" to the next digit, so we keep going;
	;                     ; otherwise, we're done
	;                     if not carry? [throw]
	;                 ]
	;             ]
	;             ; If we stopped carrying at some point, we won't get here.
	;             grow-if-necessary
	;         ]
	;         series
	;     ]

	step-back: function [ ; DECR PRED PREV-STR; opposite of STEP
		{"Decrements" strings; skips non-alpha-num characters. Returns NONE if unable to step value back.}
		series [any-string!] "(modified)"
		/local =val
	][
		if empty? series [return series]

		;carry?: does [found? find "0Aa" =val]
		carry?: does [range-start-char? =val]
		;range-end-char?: func [val] [found? find "9Zz" val]
		
		; If all the alpha-numeric characters caused a carry,
		; and if the first char in the string is alpha-numeric,
		; we shrink the string, extending the number of "digits".
		; If the first char is *not* alpha-numeric, we don't
		; shrink the string, which gives us a "rollover to zero"
		; behavior.
		;!! We do NOT shrink leading zeros in the current implementation.
		;   It's something to consider, but numerics throw out of the carry
		;   case, so we don't shrink it. 
		shrink-if-necessary: does [
			if range-end-char? last series [
				remove series
			]
		]
		; Increment a char val, rolling over if necessary.
		step-val: func [val] [
			either find "0Aa" val [
				select/skip/case [#"0" #"9"  #"A" #"Z"  #"a" #"z"] val 2
			] [subtract val 1]
		]
		
		; Reverse the series, so we can parse left to right.
		reverse series
		; Ensure local capture, since we use `copy` to set it when parsing.
		=val: none

		catch [
			parse/case series [
				some [
					mark: copy =val alpha-num= (
						change mark step-val to char! =val
						; Carry? means the char we just found will cause
						; a "carry" to the next digit, so we keep going;
						; otherwise, we're done.
						if not carry? [throw]
					)
					; We just skip over non-alph-num chars in the current
					; design.
					| skip
				]
			]
			; If we stopped carrying at some point, we won't get here.
			shrink-if-necessary
		]
		; We reversed the series to parse it, so reverse it again.
		reverse series
	]
	; test-step-back: func [val expected-result] [
	;     if expected-result <> step-back copy val [
	;         print [
	;             "Test Failed:" mold val 
	;             "produced:" mold step-back copy val 
	;             "expected:" mold expected-result
	;         ]
	;     ]
	; ]
	; foreach [val res] [
	;     ""            ""
	;     "!"           "!"
	;     "!@#$%^&*()"  "!@#$%^&*()"
	;     "ab"          "aa"
	;     "aab"         "aaa"
	;     "ba"          "az"
	;     "bA"          "aZ"
	;     "aaa"         "zz"
	;     "#aa"         "#zz"
	;     "AAA"         "ZZ"
	;     "!AA"         "!ZZ"
	;     "002"         "001"
	;     "010"         "009"
	;     "100"         "099"
	;     "1000"        "0999"
	;     "~000"        "~999"
	;     "124@000"     "123@999"
	;     "1.2.4"       "1.2.3"
	;     "001#1.3.0"   "001#1.2.9"
	;     "002#0.0.0"   "001#9.9.9"
	;     "002-aaa"     "001-zzz"
	; ] [test-step-back val res]
]