Fix #39 misc time items: heaps, hash-sets, no re-sorts

src/combinatorics/prufer/prufer.clj

@@ -8,36 +8,36 @@
     (if (str/blank? t) [] (vec (str/split t #"\s+")))))
 (defn parse-token [t] t)
 (defn as-long [t] (Long/parseLong t))
-(defn min-leaf [in-leaves]
-  (first (filter #(nth in-leaves %) (range (count in-leaves)))))
+(defn min-leaf [leaves]
+  (first leaves))
 (defn prufer-encode [n edges]
   (let [adj (loop [i 0 a (vec (repeat n #{}))]
               (if (>= i (count edges)) a
                 (let [[u v] (nth edges i)]
                   (recur (inc i) (assoc a u (conj (nth a u) v) v (conj (nth a v) u))))))
         deg (mapv count adj)]
-    (loop [i 0 adj adj deg deg inl (mapv #(= 1 %) deg) acc []]
+    (loop [i 0 adj adj deg deg leaves (into (sorted-set) (filter #(= 1 (nth deg %)) (range n))) acc []]
       (if (>= i (- n 2)) acc
-        (let [leaf (min-leaf inl)
-              nb (first (sort (nth adj leaf)))
+        (let [leaf (min-leaf leaves)
+              nb (first (nth adj leaf))
               adj2 (assoc adj leaf (disj (nth adj leaf) nb) nb (disj (nth adj nb) leaf))
               deg2 (assoc deg nb (dec (nth deg nb)))]
           (recur (inc i) adj2 deg2
-                 (assoc inl leaf false nb (= 1 (nth deg2 nb)))
+                 (cond-> (disj leaves leaf) (= 1 (nth deg2 nb)) (conj nb))
                  (conj acc nb)))))))
 (defn prufer-decode [n sq]
   (let [deg (loop [i 0 d (vec (repeat n 1))]
               (if (>= i (count sq)) d (recur (inc i) (assoc d (nth sq i) (inc (nth d (nth sq i)))))))]
-    (loop [i 0 deg deg inl (mapv #(= 1 %) deg) edges []]
+    (loop [i 0 deg deg leaves (into (sorted-set) (filter #(= 1 (nth deg %)) (range n))) edges []]
       (if (>= i (count sq))
-        (let [a (min-leaf inl)
-              inl2 (assoc inl a false)
-              b (min-leaf inl2)]
+        (let [a (min-leaf leaves)
+              leaves2 (disj leaves a)
+              b (min-leaf leaves2)]
           (sort (conj edges [(min a b) (max a b)])))
-        (let [v (nth sq i) leaf (min-leaf inl)
+        (let [v (nth sq i) leaf (min-leaf leaves)
               deg2 (assoc deg v (dec (nth deg v)))]
           (recur (inc i) deg2
-                 (assoc inl leaf false v (= 1 (nth deg2 v)))
+                 (cond-> (disj leaves leaf) (= 1 (nth deg2 v)) (conj v))
                  (conj edges [(min leaf v) (max leaf v)])))))))
 (defn -main []
   (let [toks (tokenize (slurp *in*))]

src/data_structure/offline_minimum/solution.clj

@@ -56,7 +56,11 @@
         [ans has _] (loop [rs (seq ins) ans (vec (repeat m 0)) has (vec (repeat m false)) p (vec (range (+ m 1)))]
                       (if (nil? rs) [ans has p]
                         (let [[[v t] & more] rs
-                              j0 (loop [j 0] (cond (>= j m) m (> (nth epos j) t) j :else (recur (+ j 1))))
+                              ;; first extract position strictly after t (epos is sorted)
+                              j0 (loop [lo 0 hi m]
+                                   (if (>= lo hi) lo
+                                     (let [mid (quot (+ lo hi) 2)]
+                                       (if (> (nth epos mid) t) (recur lo mid) (recur (+ mid 1) hi)))))
                               [p2 j] (dsu-find p j0)]
                           (if (< j m)
                             (recur more (assoc ans j v) (assoc has j true)

src/distributed/consensus/approx_agreement.clj

@@ -7,9 +7,9 @@
           vals (mapv #(Double/parseDouble %) (subvec (vec toks) 3 (+ 3 n)))
           result (loop [v vals r 0]
                    (if (>= r R) v
-                     (let [nv (mapv (fn [i] (let [recvd (sort v) lo f hi (- n f)]
-                                              (if (<= hi lo) (nth v i)
-                                                (/ (reduce + (subvec (vec recvd) lo hi)) (- hi lo))))) (range n))]
+                     (let [recvd (vec (sort v)) lo f hi (- n f)
+                           avg (when (> hi lo) (/ (reduce + (subvec recvd lo hi)) (- hi lo)))
+                           nv (mapv (fn [i] (if (<= hi lo) (nth v i) avg)) (range n))]
                        (recur nv (inc r)))))]
       (doseq [i (range n)] (println (fmt "P%d: %.6f" i (nth result i)))))))
 (-main (slurp *in*))

src/dp/huffman/huffman.clj

@@ -78,18 +78,41 @@
         (do (println 0) (println 0))
         (let [F (atom fr) MS (atom (vec (range n)))
               L (atom (mapv (fn [_] -1) (range n))) R (atom (mapv (fn [_] -1) (range n)))
-              key (fn [Fv MSv i] [(nth Fv i) (nth MSv i) i])
-              pq (atom (vec (sort-by (fn [i] [(nth fr i) i i]) (range n))))]
+              ;; total order on node ids: [weight, min-leaf, id]
+              lt? (fn [Fv MSv a b]
+                    (let [fa (nth Fv a) fb (nth Fv b)]
+                      (if (not= fa fb) (< fa fb)
+                        (let [ma (nth MSv a) mb (nth MSv b)]
+                          (if (not= ma mb) (< ma mb) (< a b))))))
+              hswap (fn [h i j] (let [t (nth h i)] (assoc h i (nth h j) j t)))
+              hpush (fn [h Fv MSv id]
+                      (loop [h (conj h id) i (dec (count h))]
+                        (if (zero? i) h
+                          (let [p (quot (dec i) 2)]
+                            (if (lt? Fv MSv (nth h i) (nth h p))
+                              (recur (hswap h i p) p) h)))))
+              ;; pop the minimum; returns [min-id new-heap]
+              hpop (fn [h Fv MSv]
+                     (let [top (nth h 0) last (peek h) h2 (pop h)]
+                       (if (empty? h2) [top h2]
+                         (loop [h (assoc h2 0 last) i 0]
+                           (let [l (+ 1 (* 2 i)) r (+ 2 (* 2 i)) c (count h)
+                                 m (if (and (< l c) (lt? Fv MSv (nth h l) (nth h i))) l i)
+                                 m (if (and (< r c) (lt? Fv MSv (nth h r) (nth h m))) r m)]
+                             (if (= m i) [top h] (recur (hswap h i m) m)))))))
+              ms0 (vec (range n))
+              pq (atom (reduce (fn [h i] (hpush h fr ms0 i)) [] (range n)))]
           (loop []
             (when (> (count @pq) 1)
-              (let [a (first @pq) b (second @pq)
-                    rest-pq (vec (drop 2 @pq))
-                    id (count @F)
-                    nF (conj @F (+ (nth @F a) (nth @F b)))
-                    nMS (conj @MS (min (nth @MS a) (nth @MS b)))]
+              (let [Fv @F MSv @MS
+                    [a h1] (hpop @pq Fv MSv)
+                    [b h2] (hpop h1 Fv MSv)
+                    id (count Fv)
+                    nF (conj Fv (+ (nth Fv a) (nth Fv b)))
+                    nMS (conj MSv (min (nth MSv a) (nth MSv b)))]
                 (reset! F nF) (reset! MS nMS)
                 (swap! L conj a) (swap! R conj b)
-                (reset! pq (vec (sort-by (fn [i] (key nF nMS i)) (conj rest-pq id))))
+                (reset! pq (hpush h2 nF nMS id))
                 (recur))))
           (let [root (first @pq)
                 dd (atom (mapv (fn [_] 0) (range (count @F))))]

src/dp/offline_caching/offline_caching.clj

@@ -92,7 +92,7 @@
                                               (if (< idx (count lst)) (nth lst idx) inf)))
                         best (reduce (fn [b c] (let [x (nu c) y (nu b)]
                                                  (if (or (> x y) (and (= x y) (< c b))) c b)))
-                                     (first (sort @cache)) (rest (sort @cache)))]
+                                     (first @cache) @cache)]
                     (swap! cache disj best)
                     (swap! cache conj p))))))
           (println @faults))))))

src/search/pl_resolution/pl_resolution.clj

@@ -21,19 +21,24 @@
          (norm-clause (concat (remove #(= % l1) ci) (remove #(= % l2) cj))))))
 
 (defn solve-one [clauses]
-  (loop [cls clauses round 0]
+  (loop [cls clauses seen (set clauses) round 0]
     (if (>= round 500)
       false
       (let [n (count cls)
             res (vec (for [i (range n) j (range (inc i) n)
                            r (resolvents (nth cls i) (nth cls j))] r))]
         (if (some empty? res)
           true
-          (let [added (vec (distinct (remove (fn [r] (or (taut? r) (some #(= % r) cls))) res)))]
+          (let [[added seen2] (loop [rs res seen2 seen out []]
+                                (if (empty? rs) [out seen2]
+                                  (let [r (first rs)]
+                                    (if (or (taut? r) (contains? seen2 r))
+                                      (recur (rest rs) seen2 out)
+                                      (recur (rest rs) (conj seen2 r) (conj out r))))))]
             (if (empty? added)
               false
               (let [cls2 (into cls added)]
-                (if (> (count cls2) 4000) false (recur cls2 (inc round)))))))))))
+                (if (> (count cls2) 4000) false (recur cls2 seen2 (inc round)))))))))))
 
 (defn parse-case [nums pos]
   (let [v (int (nth nums pos)) c (int (nth nums (+ pos 1)))]
@@ -53,7 +58,7 @@
         (let [[cls p] (parse-case nums pos)
               q (int (nth nums p))
               nq [(- q)]
-              cls2 (if (some #(= % nq) cls) cls (conj cls nq))]
+              cls2 (if (contains? (set cls) nq) cls (conj cls nq))]
           (.append sb (if (solve-one cls2) "RESOLUTION ENTAILED\n" "RESOLUTION NOT-ENTAILED\n"))
           (recur (inc p) (dec tcases) sb))))))
 

src/systems/cpu_scheduling/solution.clj

@@ -67,21 +67,26 @@
             (recur end (assoc done pick true) (assoc comp pick end) (conj order pick) (- left 1))))))))
 
 (defn sim-rr [arr burst idx n quantum]
-  (loop [now 0 ap 0 ready [] rem burst comp (vec (repeat n -1)) order [] left n]
+  ;; ready is a queue: live items are (subvec ready rh); compacted once
+  ;; the dead prefix reaches half so every op stays amortized O(1).
+  (loop [now 0 ap 0 ready [] rh 0 rem burst comp (vec (repeat n -1)) order [] left n]
     (if (zero? left) [comp order]
-      (let [[ap2 ready2] (loop [ap ap rd ready]
+      (let [[ready0 rh0] (if (and (pos? rh) (>= (* 2 rh) (count ready)))
+                           [(vec (subvec ready rh)) 0]
+                           [ready rh])
+            [ap2 ready2] (loop [ap ap rd ready0]
                            (if (and (< ap (count idx)) (<= (nth arr (nth idx ap)) now))
                              (recur (+ ap 1) (conj rd (nth idx ap))) [ap rd]))]
-        (if (empty? ready2)
-          (recur (nth arr (nth idx ap2)) ap2 ready2 rem comp order left)
-          (let [id (first ready2) rest-r (vec (rest ready2))
+        (if (>= rh0 (count ready2))
+          (recur (nth arr (nth idx ap2)) ap2 ready2 rh0 rem comp order left)
+          (let [id (nth ready2 rh0) rh1 (+ rh0 1)
                 run (min (nth rem id) quantum) now2 (+ now run) rem2 (assoc rem id (- (nth rem id) run))
-                [ap3 ready3] (loop [ap ap2 rd rest-r]
+                [ap3 ready3] (loop [ap ap2 rd ready2]
                                (if (and (< ap (count idx)) (<= (nth arr (nth idx ap)) now2))
                                  (recur (+ ap 1) (conj rd (nth idx ap))) [ap rd]))]
             (if (pos? (nth rem2 id))
-              (recur now2 ap3 (conj ready3 id) rem2 comp order left)
-              (recur now2 ap3 ready3 rem2 (assoc comp id now2) (conj order id) (- left 1)))))))))
+              (recur now2 ap3 (conj ready3 id) rh1 rem2 comp order left)
+              (recur now2 ap3 ready3 rh1 rem2 (assoc comp id now2) (conj order id) (- left 1)))))))))
 
 (defn solve [toks]
   (let [policy (read-int (nth toks 0))

src/systems/distance_vector_routing/solution.clj

@@ -39,8 +39,9 @@
 (def INFLL 4000000000000000000)
 
 (defn dv-round [N cost nbr dist nx]
-  (let [adv (mapv (fn [i] (mapv (fn [nb] (mapv (fn [d] (if (and (= (nth (nth nx i) d) nb) (not= d i)) INFLL (nth (nth dist i) d))) (range N))) (range N)))
-                  (range N))]
+  ;; advertised value of nb's route to d as heard by i (split horizon
+  ;; with poison reverse), computed on demand instead of an N^3 table.
+  (let [advd (fn [nb i d] (if (and (= (nth (nth nx nb) d) i) (not= d nb)) INFLL (nth (nth dist nb) d)))]
     (loop [i 0 nd dist nn nx ch false]
       (if (>= i N) [nd nn ch]
         (let [[nd2 nn2 ch2] (loop [d 0 a nd b nn c ch]
@@ -49,7 +50,7 @@
                                   (let [[best bn] (loop [nbs (nth nbr i) bst INFLL bbn -1]
                                                     (if (empty? nbs) [bst bbn]
                                                       (let [nb (first nbs)
-                                                            av (nth (nth (nth adv nb) i) d)
+                                                            av (advd nb i d)
                                                             cand (if (>= av (quot INFLL 2)) INFLL (+ (nth (nth cost i) nb) av))]
                                                         (recur (rest nbs)
                                                                (if (or (< cand bst) (and (= cand bst) (or (= bbn -1) (< nb bbn)))) cand bst)