Always seem to gradually go brain-dead as the holiday approaches.*sigh*
The general idea is for the new interval to overwrite the entries
in the current list.
The list is sorted on 'from' consisting of (from attributes)
with the next entry in the list indicating the end of the interval.
Somewhat akin to run-length encoding.
Precondition (start<end)
Works AFAICT, but is there a better way?
(defun end-interval(list end previous)
(let ((head (car list)))
(cond ((null list)
(error "End parameter(~A) is out of range" end))
((< (car head) end)
(end-interval (cdr list) end (cdr head)))
((= (car head) end) list)
(t
(cons (cons end previous) list)))))
(defun insert-interval(list start end args &optional previous)
(let ((head (car list)))
(cond ((null list)
(error "Start parameter(~A) is out of range" start))
((< (car head) start)
(cons head
(insert-interval (cdr list) start end args (cdr
head))))
((= (car head) start)
(cons (cons start args)
(end-interval (cdr list) end (cdr head))))
(t
(cons (cons start args)
(end-interval list end previous))))))
CL > (insert-interval '((0 :foo)(32 :bar)(48)) 0 4 '(:baz :top))
((0 :BAZ :TOP) (4 :FOO) (32 :BAR) (48))
CL > (insert-interval '((0 :foo)(32 :bar)(48)) 2 4 '(:baz :top))
((0 :FOO) (2 :BAZ :TOP) (4 :FOO) (32 :BAR) (48))
CL > (insert-interval '((0 :foo)(32 :bar)(48)) 0 32 '(:baz :top))
((0 :BAZ :TOP) (32 :BAR) (48))
CL > (insert-interval '((0 :foo)(32 :bar)(48)) 0 33 '(:baz :top))
((0 :BAZ :TOP) (33 :BAR) (48))
----
Geoff
* "Geoffrey Summerhayes" <························@t46g2000cwa.XXXXXX.com> :
|
| The general idea is for the new interval to overwrite the entries
| in the current list.
|
| The list is sorted on 'from' consisting of (from attributes)
| with the next entry in the list indicating the end of the interval.
| Somewhat akin to run-length encoding.
|
| Precondition (start<end)
|
| Works AFAICT, but is there a better way?
Finally got around to using LOOP to figure out a worse way :)
(defun insert-interval (list start end new-attribs)
(loop with x ;X is non nil if we are inside the new interval
for (a b . rest) on list
for (from . attribs) = a and (to) = b
if (<= from start to)
do (assert (null x)) (setq x t)
and if (< from start) collect a end
and collect (cons start new-attribs)
else unless x collect a
if (<= from end to)
do (assert x)
and if (< end to) collect (cons end attribs) and do (setq x nil) end
if (endp rest) unless x collect b else collect (list end)
while rest))
[lightly tested. Does it meet your spec?]
--
Madhu
Madhu wrote:
> * "Geoffrey Summerhayes" <························@t46g2000cwa.XXXXXX.com> :
> |
> | The general idea is for the new interval to overwrite the entries
> | in the current list.
> |
> | The list is sorted on 'from' consisting of (from attributes)
> | with the next entry in the list indicating the end of the interval.
> | Somewhat akin to run-length encoding.
> |
> | Precondition (start<end)
> |
> | Works AFAICT, but is there a better way?
>
> Finally got around to using LOOP to figure out a worse way :)
>
> (defun insert-interval (list start end new-attribs)
> (loop with x ;X is non nil if we are inside the new interval
> for (a b . rest) on list
> for (from . attribs) = a and (to) = b
>
> if (<= from start to)
> do (assert (null x)) (setq x t)
> and if (< from start) collect a end
> and collect (cons start new-attribs)
> else unless x collect a
>
> if (<= from end to)
> do (assert x)
> and if (< end to) collect (cons end attribs) and do (setq x nil) end
>
> if (endp rest) unless x collect b else collect (list end)
> while rest))
Almost, changed the first clause to:
if (and (<= from start to) (null x))
do (setq x t)...
As for testing, even with different optimization flags, the loop was
the loser on both size and speed with LW. Cute, though.
---
Geoff