(for those browsing.. there is an immutable priority queue in constant
time when favorable, but not unrealistic conditions)
I woke up this morning dreaming about this queue and also recognized
that count is linear. I have changed it to be constant.
(defn priority-cons [priority data queue]
(defstruct element :priority :data)
(let [elem (struct element priority data)
queue-first
(if (nil? queue)
nil
(queue 'ffirst))
queue-rest
(cond
(nil? queue)
nil
(nil? elem)
(queue 'rest)
(>= priority (queue-first :priority))
queue
:else
(priority-cons priority data (queue 'rest)))
count
(cond
(nil? queue)
0
(nil? elem)
(queue 'count)
:else
(inc (queue 'count)))]
(fn [op]
(cond (= op 'count)
count
(= op 'first)
(cond
(nil? queue)
data
(nil? elem)
nil
(>= priority (queue-first :priority))
data
:else
(queue-first :data))
(= op 'ffirst)
(cond
(nil? queue)
elem
(nil? elem)
nil
(>= priority (queue-first :priority))
elem
:else
queue-first)
(= op 'rest)
queue-rest
))))
I am beginning to wonder about insertion though. You say that
insertion is linear and it recurses, but I'm seeing exponential time
in practice. For instance, because the argument queue is a function
that has been fully evaluated (meaning that calling any op on it is
constant time), each of the function calls should be constant in
helping to build the new function. The time to insert seems to be
bogged down simply by the creation of the function which grows in size
exponentially. Maybe I'm mistaken?
(def rnd (java.util.Random.))
(time (loop [count 100000]
(if (= count 0)
nil
(do
(.nextInt rnd 100)
(priority-cons 10 "hello" nil)
(recur (dec count))))))
(time (loop [queue nil count 3200]
(if (= count 0)
nil
(do
(recur
(priority-cons (.nextInt rnd 100) "hello" queue)
(dec count))))))
In playing with depth of the queue it is obvious that no one would
ever use this. :) It appears that in practice the queue takes up
exponentially amounts of memory. It seems to reach nearly 1GB with
3200 elements. I'm also guessing that the exponential amount of space
is why for every doubling of length it takes roughly 4 times as long.
This is definitely worse than linear.
best run times for increasing length of x
x time
25 .786
50 2.2
100 6
200 27
400 101
800 571
1600 3426
3200 11842
And to be through I wrote an implementation that is similar to your
answer. This one does not grow exponentially in space. It still
suffers from terrible performance with any large number of entries.
(defstruct element :priority :data)
(defn priq-add [priority data queue]
(let [elem (struct element priority data)]
(loop [queue queue acc []]
(cond (nil? queue)
(conj acc elem)
(>= priority ((first queue) :priority))
(if (nil? acc)
(cons elem queue)
(concat acc (cons elem queue)))
:else
(recur (rest queue) (conj acc (first queue)))))))
(def rnd (java.util.Random.))
(time (loop [queue nil count 12800]
(if (= count 0)
nil
(do
(let [nextInt (.nextInt rnd 100)]
(recur
(priq-add nextInt "hello" queue)
(dec count)))))))
And to be really through, I finally found a solution that is basically
linear in insertion and removal assuming the span of priorities is
around n/100 and evenly dispersed.
(defn priq-add [priority data queue]
(let [priority (* -1 priority)
[cnt queue] queue]
(if (nil? queue)
(list 1 (sorted-map priority (list data)))
(let [pri-list (queue priority)
new-pri-list
(if (nil? pri-list)
(list data)
(lazy-cons data pri-list))]
(list (inc cnt) (assoc queue priority new-pri-list))))))
; returns list of (data, new-queue)
(defn priq-remove [queue]
(if (nil? queue)
nil
(let [[cnt queue] queue
key (first (keys queue))
value (queue key)
data (first value)
new-queue
(if (= (count value) 1)
(dissoc queue key)
(assoc queue key (rest value)))
]
(if (= cnt 1)
(list data nil)
(list data (list (dec cnt) new-queue))))))
(defn priq-count [queue]
(if (nil? queue)
0
(first queue)))
(def rnd (java.util.Random.))
(def big-q (time (loop [queue nil cnt 1000000]
(if (= cnt 0)
queue
(do
(let [nextInt (.nextInt rnd 10000)]
(recur
(priq-add nextInt "hello" queue)
(dec cnt))))))))
(time (loop [queue big-q]
(if (= (priq-count queue) 1)
nil
(recur (nth (priq-remove queue) 1)))))
This one is able to handle 1,000,000 consecutive insertions in about
10 seconds on my machine. And the corresponding removal of all entries
takes about 7 seconds on my machine. This solution was really good and
even better than the mutable solution which I have below. I'm tired of
messing with this, so I'm not going to try and make the mutable
version go any faster.
(defstruct element :priority :data :previous-element :next-element)
(defn add-before [elem new-elem]
(cond (nil? elem)
new-elem
(nil? new-elem)
elem
:else
(if (nil? @(elem :previous-element))
(dosync
(ref-set (elem :previous-element) new-elem)
(ref-set (new-elem :next-element) elem)
new-elem)
(dosync
(let [elem-prev @(elem :previous-element)]
(ref-set (elem-prev :next-element) new-elem)
(ref-set (new-elem :previous-element) elem-prev)
(ref-set (elem :previous-element) new-elem)
(ref-set (new-elem :next-element) elem) new-elem)))))
(defn add-after [elem new-elem]
(cond (nil? elem)
new-elem
(nil? new-elem)
elem
:else
(if (nil? @(elem :next-element))
(dosync
(ref-set (elem :next-element) new-elem)
(ref-set (new-elem :previous-element) elem)
elem)
(dosync
(let [elem-next @(elem :next-element)]
(ref-set (elem-next :previous-element) new-elem)
(ref-set (new-elem :next-element) elem-next)
(ref-set (elem :next-element) new-elem)
(ref-set (new-elem :previous-element) elem) elem)))))
(defn remove-self [elem]
(let [prev-element @(elem :previous-element)
next-element @(elem :next-element)]
(cond (nil? elem)
nil
(and (nil? prev-element) (nil? next-element))
nil
(and (nil? prev-element) (not (nil? next-element)))
(dosync
(ref-set (elem :next-element) nil)
(ref-set (next-element :previous-element) nil)
next-element)
(and (not (nil? prev-element)) (nil? next-element))
(dosync
(ref-set (elem :previous-element) nil)
(ref-set (prev-element :next-element) nil)
prev-element)
:else ;both not null
(dosync
(ref-set (elem :previous-element) nil)
(ref-set (elem :next-element) nil)
(ref-set (prev-element :next-element) next-element)
(ref-set (next-element :previous-element) prev-element)
prev-element))))
(defn new-element [priority data]
(struct element priority data (ref nil) (ref nil)))
(defstruct priority-queue :count :head :tail)
(defn new-queue []
(struct priority-queue (ref 0) (ref nil) (ref nil)))
(defn qadd [queue priority data]
(let [new-elem (new-element priority data)
inc-count #(ref-set (queue :count) (inc @(queue :count)))
]
(if (nil? @(queue :head))
(dosync
(ref-set (queue :head) new-elem)
(ref-set (queue :tail) new-elem)
(inc-count))
(loop [elem @(queue :head)]
(cond
(< (elem :priority) priority)
(dosync
(add-before elem new-elem)
(inc-count)
(if (= elem @(queue :head))
(ref-set (queue :head) new-elem)))
(= elem @(queue :tail))
(dosync
(add-after elem new-elem)
(inc-count)
(ref-set (queue :tail) new-elem))
:else
(recur @(elem :next-element))))) )
queue)
(defn qcount [queue]
@(queue :count))
(defn qremove [queue]
(if (or (nil? queue) (nil? @(queue :head)))
nil
(dosync
(let [old-head @(queue :head)
new-head (remove-self old-head)]
(ref-set (queue :count) (dec @(queue :count)))
(ref-set (queue :head) new-head)
(if (and (not (nil? new-head)) (nil? @(new-head :next-
element)))
(ref-set (queue :tail) new-head))
(old-head :data)))))
;---test for speed
(def big-q (new-queue))
(def rnd (java.util.Random.))
(time (loop [cnt 10000]
(if (= cnt 0)
nil
(let [nextInt (.nextInt rnd 20)]
(qadd big-q nextInt "hello")
(recur (dec cnt))))))
(time (loop []
(if (= (qcount big-q) 1)
nil
(do
(qremove big-q)
(recur)))))
;useful for testing mutable priority queue
(defn print-forward [element]
(loop [element element count 0]
(if (or (nil? element) (> count 8))
nil
(do
(let [print-element #(print (%1 :priority) (%1 :data))
prev-element @(element :previous-element)
next-element @(element :next-element)]
(print count ": ") (print-element element) (println)
(print " --- prev --- ")
(if (nil? prev-element)
nil
(print-element prev-element))
(println)
(print " --- next --- ")
(if (nil? next-element)
nil
(print-element next-element))
(println))
(recur @(element :next-element) (inc count))))))
On Mar 1, 3:36 am, Achim Passen <achim.pas...@gmail.com> wrote:
> Hi,
>
> that's a nice example of using closures to store data!
>
> (f)first and rest look like constant time to me. count is linear time,
> but could easily be made constant time by storing the counts instead
> of recursing.
>
> Insertion is linear time though, plus it recurses, resulting in stack
> sizes in the order of the length of the queue.
>
> Here's a version that's roughly equivalent (including the recursion
> problem), but uses maps instead of closures:
>
> (defn prio-insert [queue elem prio]
> (if (> prio (:prio queue (Integer/MIN_VALUE)))
> {:first elem
> :prio prio
> :count (inc (:count queue 0))
> :rest queue}
> (let [new-rest (prio-insert (:rest queue) elem prio)]
> (assoc queue
> :rest new-rest
> :count (inc (:count new-rest))))))
>
> user=> (def pq (prio-insert nil 3 4))
> #'user/pq
> user=> pq
> {:first 3, :prio 4, :count 1, :rest nil}
> user=> (def pq (prio-insert pq 2 10))
> #'user/pq
> user=> pq
> {:first 2, :prio 10, :count 2, :rest {:first 3, :prio 4, :count
> 1, :rest nil}}
> user=> (def pq (prio-insert pq 4 1))
> #'user/pq
> user=> pq
> {:first 2, :prio 10, :count 3, :rest {:first 3, :prio 4, :count
> 2, :rest {:first 4, :prio 1, :count 1, :rest nil}}}
> user=> (:first (:rest pq))
> 3
>
> Kind regards,
> achim
>
> Am 01.03.2009 um 06:31 schrieb zoglma...@gmail.com:
>
>
>
> > After helping tutor some students earlier in the week on the subject
> > of priority queues, I ended up implementing it in Clojure as a mutable
> > data structure. It was straight forward, but curiosity struck and I
> > implemented the priority queue as an immutable data structure. I'm
> > pretty sure that 'ffirst 'first 'count and 'rest have a constant time
> > complexity, but it is a little hard to wrap my mind around this code.
> > Is it really constant time?
>
> > ;----- immutiable priority queue -----
>
> > (defn priority-cons [priority data queue]
> > (defstruct element :priority :data)
> > (let [elem (struct element priority data)
> > queue-first
> > (if (nil? queue)
> > nil
> > (queue 'ffirst))
> > queue-rest
> > (cond
> > (nil? queue)
> > nil
> > (nil? elem)
> > (queue 'rest)
> > (>= priority (queue-first :priority))
> > queue
> > :else
> > (priority-cons priority data (queue 'rest)))]
> > (fn [op]
> > (cond (= op 'count)
> > (cond
> > (nil? queue)
> > 1
> > (nil? elem)
> > (queue 'count)
> > :else
> > (inc (queue 'count)))
> > (= op 'first)
> > (cond
> > (nil? queue)
> > data
> > (nil? elem)
> > nil
> > (>= priority (queue-first :priority))
> > data
> > :else
> > (queue-first :data))
> > (= op 'ffirst)
> > (cond
> > (nil? queue)
> > elem
> > (nil? elem)
> > nil
> > (>= priority (queue-first :priority))
> > elem
> > :else
> > queue-first)
> > (= op 'rest)
> > queue-rest
> > ))))
>
> > ;--- testing code
>
> > (defn print-priority-queue [queue]
> > (loop [queue queue]
> > (if (nil? queue)
> > nil
> > (do
> > (println (queue 'first))
> > (recur (queue 'rest))))))
>
> > (def a (priority-cons 10 "hello" nil))
> > (print-priority-queue a)
> > (a 'count)
>
> > (def b (priority-cons 20 "hello2" a))
> > (print-priority-queue b)
> > (b 'count)
>
> > (def c (priority-cons 15 "hello-m" b))
> > (print-priority-queue c)
> > (c 'count)
>
> > ((c 'rest) 'count)
> > (((c 'rest) 'rest) 'first)
> > (((c 'rest) 'rest) 'count)
> > (((c 'rest) 'rest) 'rest)
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Clojure" group.
To post to this group, send email to clojure@googlegroups.com
To unsubscribe from this group, send email to
clojure+unsubscr...@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
