[REBOL] [algo] Intervals and parsing
From: didec:tiscali at: 11-Mar-2004 18:24
[algo] Intervals and parsing
Hi all,
For one of my apps, I have to manage a very long list of integer!
I need to know if an integer! is in the list, and i need to add it to the list.
To avoid an infinite block of integer! that will overflow the memory for nothing, and
considering the fact that most of the values will follow themselve,
I use an intervals dialect and some funcs.
The values are stored in a block, but consecutives values are replaced by first and last
values separate by a minus sign "-".
I.e. : [0 1 2 3 4 5 10 11 12 13 15 19 20 21 22]
become [0 - 5 10 - 13 15 19 - 22]
I use 2 functions, one to check if a value exists in list, and one to add the value to
the list.
I post the funcs here for 2 reasons :
1) Maybe someone would need it
2) Maybe someone can do better or simpler
Anyway, comments are welcome
DideC
----- SCRIPT -----
REBOL [
title: "Manage list of integer intervals"
author: "Didier Cadieu"
date: 11-march-2004
version: 1.0
]
intervals: context [
where: none
included?: func [
"Return true if Val is inside an intervals block."
itv [block!] "Block of integers / intervals (x - y)"
val [integer!] "Value to search"
/local pos brk
] [
res: where: brk: none
parse itv [
any [
pos: set i1 integer! '- set i2 integer! (
if any [
all [i1 <= val val <= i2 res: true]
all [any [i1 - val = 1 val - i2 = 1] where: pos]
all [val < i1 not brk where: pos]
] [brk: true]
) |
pos: set i1 integer! (
if any [
all [i1 = val res: true]
all [1 = abs i1 - val where: pos]
all [val < i1 not brk where: pos]
] [brk: true]
)
] pos: end (any [brk res where: pos])
]
res
]
include: func [
"Change intervals block to include Val."
itv [block!] "Block of integers / intervals (x - y)"
val [integer!] "Value to include"
/local pos brk
] [
brk: none
parse itv [
any [
pos: set i1 integer! '- set i2 integer! (
any [
brk
all [i1 <= val val <= i2 brk: true]
all [i1 - val = 1 change pos val brk: true]
all [val - i2 = 1 change next next pos val brk: true]
all [val < i1 insert pos val brk: true]
]
) |
pos: set i1 integer! (
any [
brk
all [i1 = val brk: true]
all [i1 - val = 1 insert pos reduce [val '-] brk: true]
all [val - i1 = 1 insert next pos reduce ['- val] brk: true]
all [val < i1 insert pos val brk: true]
]
)
] pos: end (any [brk insert pos val])
]
regroup itv
]
regroup: func [
"Simplify intervals block if possible"
itv [block!] "Block of integers / intervals (x - y)"
/local pos brk
] [
brk: none
parse itv [
any [
pos: set i1 integer! set i2 integer! (
any [
brk
all [i2 - i1 = 1 (
remove pos
if all [not tail? next pos '- = second pos] [remove/part pos 2]
brk: true)
]
]
) | skip
]
]
]
]
;***** some manual tests
; Type "ii num" to test a num in IT interval
; Type "ato num" to test inclusion of num in IT. IT is never changed.
it: [-1 1 4 - 5 7 - 10 12 20 - 22 30 ]
ii: func [val] [
intervals/included? it val
prin res prin " "
probe intervals/where
]
ato: func [val /local it2] [
intervals/include it2: copy it val
probe head it2
]
;***** Some automatic Tests
random/seed now/time/precise
i: copy []
test1: does [
print "--- Test1 : includes values ---"
loop 50 [intervals/include i v: random 40 print [v "->" mold i]]
ask "Press enter to continue"
print "^/"
]
test2: does [
print "--- Test2 : check if values are included?---"
probe i
loop 50 [print [v: (random 50) - 5 "?" either intervals/included? i v ["yes"][" no"]]]
ask "Press enter to continue"
print "^/"
]
test1 test2
print {Type "test1" or "test2" to redo a test}
halt
