[REBOL] Re: Algorithm challenge: compacting intege...
From: Paavo:Nevalainen:saunalahti:fi at: 28-Jan-2007 23:21
Humor alert!
I decided to do what a usual salaryman would do, i.e. a lot of slow code!
And documentation and unit tests (not complete though).
The cumulator pattern is sometimes useful, when one prepares
to test a single "tic" of the loop in a unit test.
I have indicated the "internal" functions or methods with the initial "_",
just a convention when modules are not yet here.
=================================================
; these two "beautifying" functions from some "module" ...
case: function [{
Find a condition and evaluates what follows it.
Usage: case/default [ cond1 do-block1 ...][default-do-block]
}
[throw]
cases [block!] "Block of cases to evaluate."
/default
case "Default case if no others are found."
][ condition body
][
while [not empty? cases][
set [condition cases] do/next cases
if condition [
body: first cases
break
]
cases: next cases
]
if not body [body: any [case]]
do body
]
_test: function [
boiler [string! block!]
val
][
str
][
if block? boiler [str: rejoin boiler]
print rejoin [boiler ": " mold val]
return val
]
;-=--0_---____------------------------------------
compact: function [{
compact [1 2 3 5 2001 2002 2003 2004 2007 ..] --> [1x3 5 2001x4 2007 ..]
}
ys [block!]
][
cumulator y
][
cumulator: make object! [
result: make block! []
interval-first: none
interval-last: none
_to-string: does [
return rejoin [
"result: " mold self/result
" x1: " self/interval-first
" x2: " self/interval-last
]
]
tic: func [
y
][
; print reduce [mold self/_to-string " y: " y]
case/default [
; the start case!
none? self/interval-first [
self/interval-first: y
]
; an interval found :)
; [.. y1-1 none] ** [y1 y2 ..] --> [.. y0 y0+1]
all [none? self/interval-last (y - 1) = self/interval-first][
self/interval-last: y
]
; a solo number found :(
; [.. y0 none] ** [y1 y2 ..] --> [[.. y0] y1 none] ** [y2 ..]
none? self/interval-last [
append self/result self/interval-first
self/interval-first: y
]
; interval keeps growing! :D
; [.. y y1-1] ** [y1 y2 ..] --> [.. y y1] ** [y2 ..]
self/interval-last = (y - 1) [
self/interval-last: y
]
][ ; well, this interval did not last to the very end :|
self/_add-interval
self/interval-first: y
]
]
finalize: does [
either none? self/interval-last [
if not none? self/interval-first [
append self/result self/interval-first
]
][
self/_add-interval
]
]
; an internal method...
_add-interval: does [ ; adds a new interval to the result
append self/result to-pair reduce [
self/interval-first
self/interval-last + 1 - self/interval-first
]
self/interval-first: none
self/interval-last: none
]
]
foreach y ys [cumulator/tic y]
cumulator/finalize
return cumulator/result
]
_decompact: function [
p [pair!]
][
out y dummy
][
out: make block! []
y: p/1
repeat dummy p/2 [
append out y
y: y + 1
]
return out
]
decompact: function [{
decompact [1x3 5 2001x4 2007 ..] --> [1 2 3 5 2001 2002 2003
2004 2007 ..]
}
xs [block!]
][
out
][
out: make block! []
foreach x xs [
append out either pair? x [_decompact x][x]
]
return out
]
;------------------------------,..,,.,..,,..,11,.,.-----------
test: has [
result0 result1 result2
][
result1:
_test
rejoin ["compact " mold result0: [1 2 3 5 2001 2002 2003
2004 2007]]
compact result0
_test
"compact [] "
compact []
result2:
_test
["decompact compact " mold result0]
decompact result1
_test
"compact decompact ... ??"
compact decompact result1
_test
rejoin [(mold result0) " = " (mold result2) "? "]
(mold result0) = (mold result2)
]
