[Gd-chatter] r10740 - in trunk/libraries: priority-queue timer
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue May 16 00:37:20 CEST 2006
Author: hannes
Date: Tue May 16 00:37:18 2006
New Revision: 10740
Modified:
trunk/libraries/priority-queue/library.dylan
trunk/libraries/priority-queue/priority-queue.dylan
trunk/libraries/timer/timer-exports.dylan
trunk/libraries/timer/timer-test.dylan
trunk/libraries/timer/timer.dylan
Log:
Bug: 7299
*implement custom element-setter for <priority-queue> which keeps an index up to date
*remove! can now be done in O(1) :)
*some useful wrapper for <timer> (esp: make(<timer>, in: 2.3))
Modified: trunk/libraries/priority-queue/library.dylan
==============================================================================
--- trunk/libraries/priority-queue/library.dylan (original)
+++ trunk/libraries/priority-queue/library.dylan Tue May 16 00:37:18 2006
@@ -9,5 +9,5 @@
define module priority-queue
use common-dylan;
- export <priority-queue>;
+ export <priority-queue>, <priority-queueable-mixin>;
end module priority-queue;
Modified: trunk/libraries/priority-queue/priority-queue.dylan
==============================================================================
--- trunk/libraries/priority-queue/priority-queue.dylan (original)
+++ trunk/libraries/priority-queue/priority-queue.dylan Tue May 16 00:37:18 2006
@@ -11,6 +11,9 @@
virtual slot size :: <integer>, init-value: 0;
end class;
+define open class <priority-queueable-mixin> (<object>)
+ slot %index :: false-or(<integer>) = #f;
+end;
define method size (pq :: <priority-queue>) => (size :: <object>)
pq.heap.size;
end method size;
@@ -20,44 +23,56 @@
size-setter(size, pq.heap);
end;
-define method remove!(pq :: <priority-queue>, my-element, #key test = \==, count = 0)
+define method element (pq :: <priority-queue>, elt, #key default) => (ele)
+ element(pq.heap, elt, default: default);
+end;
+
+//renamed to my-element-setter, otherwise would be added to generic
+define method my-element-setter (new-value, pq :: <priority-queue>, key) => (nv)
+ element-setter(new-value, pq.heap, key);
+ new-value.%index := key;
+end;
+
+define method remove!(pq :: <priority-queue>, elt, #key test = \==, count = 0)
=> (pq :: <priority-queue>)
- let coll = pq.heap;
- let index = find-key(coll, curry(test, my-element), skip: count);
- coll[index] := coll[pq.size - 1];
- coll.size := coll.size - 1;
- if (coll.size > 0)
+ let index = elt.%index;
+ my-element-setter(pq[pq.size - 1], pq, index);
+ pq.size := pq.size - 1;
+ if (pq.size > 1 & pq.size > index)
top-down(pq, index);
end;
pq;
end;
define method add!(pq :: <priority-queue>, value) => (pq :: <priority-queue>)
+ if (value.%index)
+ error("Timer can not be activated twice");
+ end;
let index :: <integer> = pq.size;
pq.size := pq.size + 1;
- pq.heap[index] := value;
+ my-element-setter(value, pq, index);
bottom-up(pq, index);
pq;
end method add!;
define method bottom-up(pq :: <priority-queue>, index :: <integer>) => ();
- let bubble = pq.heap[index];
+ let bubble = pq[index];
let super-index :: <integer> = ash(index, -1);
- while(index > 0 & pq.comparison-function(pq.heap[super-index], bubble))
- pq.heap[index] := pq.heap[super-index];
+ while(index > 0 & pq.comparison-function(bubble, pq[super-index]))
+ my-element-setter(pq[super-index], pq, index);
index := super-index;
super-index := ash(index + 1, -1) - 1;
end while;
- pq.heap[index] := bubble;
+ my-element-setter(bubble, pq, index);
end method bottom-up;
define method pop(pq :: <priority-queue>) => (first-element :: <object>);
- let first-element = pq.heap[0];
+ let first-element = pq[0];
- pq.heap[0] := pq.heap[pq.size - 1];
+ my-element-setter(pq[pq.size - 1], pq, 0);
pq.size := pq.size - 1;
if(pq.size > 1)
top-down(pq, 0);
@@ -66,25 +81,25 @@
end method pop;
define method top-down(pq :: <priority-queue>, index :: <integer>) => ();
- let bubble = pq.heap[index];
+ let bubble = pq[index];
let sub-index = ash(index + 1, 1) - 1;
block(return)
while(sub-index + 1 < pq.size)
- if(pq.comparison-function(pq.heap[sub-index], pq.heap[sub-index + 1]))
+ if(pq.comparison-function(pq[sub-index + 1], pq[sub-index]))
sub-index := sub-index + 1;
end if;
- if(pq.comparison-function(pq.heap[sub-index], bubble))
+ if(pq.comparison-function(bubble, pq[sub-index]))
return();
end if;
- pq.heap[index] := pq.heap[sub-index];
+ my-element-setter(pq[sub-index], pq, index);
index := sub-index;
sub-index := ash(index + 1, 1) - 1;
end while;
- if(sub-index < pq.size & pq.comparison-function(bubble, pq.heap[sub-index]))
- pq.heap[index] := pq.heap[sub-index];
+ if(sub-index < pq.size & pq.comparison-function(pq[sub-index], bubble))
+ my-element-setter(pq[sub-index], pq, index);
index := sub-index;
end if;
end block;
- pq.heap[index] := bubble;
+ my-element-setter(bubble, pq, index);
end method top-down;
Modified: trunk/libraries/timer/timer-exports.dylan
==============================================================================
--- trunk/libraries/timer/timer-exports.dylan (original)
+++ trunk/libraries/timer/timer-exports.dylan Tue May 16 00:37:18 2006
@@ -16,5 +16,5 @@
use date;
use threads;
- export foo;
+ export <timer>, cancel;
end module;
Modified: trunk/libraries/timer/timer-test.dylan
==============================================================================
--- trunk/libraries/timer/timer-test.dylan (original)
+++ trunk/libraries/timer/timer-test.dylan Tue May 16 00:37:18 2006
@@ -1,16 +1,15 @@
module: timer
define method main ()
- let date = current-date();
- let timer1 = make(<timer>,
- timestamp: date + make(<day/time-duration>, seconds: 1),
- event: print-date);
- let timer3 = make(<timer>,
- timestamp: date + make(<day/time-duration>, seconds: 3),
- event: print-date);
- let timer10 = make(<timer>,
- timestamp: date + make(<day/time-duration>, seconds: 10),
- event: print-date);
+ let timer1 = make(<timer>, in: 1, event: print-date);
+ let timer3 = make(<timer>, in: 3, event: print-date);
+ let timer8 = make(<timer>, in: 8, event: print-date);
+ let timer10 = make(<timer>, in: 10, event: print-date);
+ let timer11 = make(<timer>, in: 11.8, event: print-date);
+ let timer12 = make(<timer>, in: 12, event: print-date);
+ sleep(11);
+ cancel(timer11);
+ sleep(3);
end;
define method print-date ()
@@ -20,5 +19,4 @@
begin
main();
- sleep(23.5);
-end;
\ No newline at end of file
+end;
Modified: trunk/libraries/timer/timer.dylan
==============================================================================
--- trunk/libraries/timer/timer.dylan (original)
+++ trunk/libraries/timer/timer.dylan Tue May 16 00:37:18 2006
@@ -3,11 +3,29 @@
author:
copyright:
-define class <timer> (<object>)
+define class <timer> (<priority-queueable-mixin>)
slot timestamp :: <date>, required-init-keyword: timestamp:;
slot event :: <function>, required-init-keyword: event:;
end;
+define method make (timer == <timer>,
+ #next next-method,
+ #rest rest,
+ #key in,
+ #all-keys) => (timer :: <timer>)
+ if (in)
+ let (sec, microsec) = truncate(in);
+ apply(next-method,
+ timer,
+ timestamp: current-date() + make(<day/time-duration>,
+ seconds: sec,
+ microseconds: round(microsec * 1000000)),
+ rest)
+ else
+ apply(next-method, timer, rest)
+ end;
+end;
+
define method initialize (timer :: <timer>,
#next next-method,
#rest rest, #key,
@@ -52,7 +70,7 @@
=> (seconds :: <real>)
let (days, hours, minutes, seconds, microseconds)
= decode-duration(day/time-duration);
- minutes * 60 + seconds + microseconds / 1000.0;
+ minutes * 60 + seconds + microseconds / 1000000.0;
end;
define function worker-function (timer-manager :: <timer-manager>)
@@ -62,13 +80,13 @@
let timeout = if (timer-manager.queue.size > 0)
decode-seconds(timer-manager.queue.first.timestamp - time);
end;
- wait-for(timer-manager.notification, timeout: timeout);
- while (timer-manager.queue.size > 0 &
- time > timer-manager.queue.first.timestamp)
+ if (timeout & timeout < 0)
let timer = pop(timer-manager.queue);
release(timer-manager.lock);
timer.event();
wait-for(timer-manager.lock);
+ else
+ wait-for(timer-manager.notification, timeout: timeout);
end;
end;
release(timer-manager.lock);
More information about the chatter
mailing list