Arc Forumnew | comments | leaders | submitlogin
2 points by akkartik 4414 days ago | link | parent

Ah, I figured it out:

  (def bhpq (h (o < <))
    (obj top     (best ~< (list (+ h 1) -1))
         height  h
         buckets (table)
         < <))

  (def bhpq-push (priority elt bhpq)
    (unless (<= 0 priority bhpq!height)
      (err (+ "Priority must be between 0 and " bhpq!height ":") priority))
    (zap [best bhpq!< (list _ priority)] bhpq!top)
    (push elt bhpq!buckets.priority))

  (def bhpq-peek (bhpq)
    (car (bhpq!buckets bhpq!top)))

  ; still O(h), but probably does a lot more consing than the original
  (def bhpq-pop (bhpq)
    (do1 (pop (bhpq!buckets bhpq!top))
         (unless (bhpq!buckets bhpq!top)
           (= bhpq!top (best bhpq!< (keys bhpq!buckets))))))
I'm not sure it's an improvement, but it was a fun exercise to go through :)


2 points by fallintothis 4414 days ago | link

Spiffy! Definitely reads a lot better.

You're right about the consing, though. It seems like there should be a lazy way of doing keys. But then, best hard-codes calls to both car and cdr upon the sequence. So, it looks like we'd be resigned to doing it by hand, and I'm not sure it's any better:

  (unless (bhpq!buckets bhpq!top)
    (= bhpq!top nil)
    (each (priority elt) bhpq!buckets
      (when (bhpq!< priority bhpq!top)
        (= bhpq!top priority))))
Ah, but this has made me notice an issue with the best keys approach to begin with: once we empty out the queue, !top will be nil, which won't compare correctly on the next bhpq-push.

  arc> (= q (bhpq 10))
  #hash((top . 11) (buckets . #hash()) (height . 10) (< . #<procedure:<>))
  arc> (bhpq-push 1 'hi q)
  (hi)
  arc> (bhpq-pop q)
  hi
  arc> (bhpq-push 1 'bye q)
  Error: "<: expects type <real number> as 2nd argument, given: nil; other arguments were: 1"
Conundrum. Suppose the answer is to factor out the (best ~< (list (+ h 1) -1)) so that we can get a fitting default value for !top:

  ; Top element of the abstract comparison operator bhpq!< (though we assume
  ; the operator compares integers!).
  (def bhpq-top (bhpq (o < bhpq!<) (o h bhpq!height))
    (best ~< (list (+ h 1) -1)))

  (def bhpq (h (o < <))
    (obj top     (bhpq-top nil < h)
         height  h
         buckets (table)
         < <))

  (def bhpq-push (priority elt bhpq)
    (unless (<= 0 priority bhpq!height)
      (err (+ "Priority must be between 0 and " bhpq!height ":") priority))
    (zap [best bhpq!< (list _ priority)] bhpq!top)
    (push elt bhpq!buckets.priority))

  (def bhpq-peek (bhpq)
    (car (bhpq!buckets bhpq!top)))

  ; Not as concise, but less consing/breaking
  (def bhpq-pop (bhpq)
    (do1 (pop (bhpq!buckets bhpq!top))
         (unless (bhpq!buckets bhpq!top)
           (= bhpq!top (bhpq-top bhpq))
           (each (priority elt) bhpq!buckets
             (when (bhpq!< priority bhpq!top)
               (= bhpq!top priority))))))

-----