From 2e9c55756cd359b3140eb2f1e0ac47ba3c644131 Mon Sep 17 00:00:00 2001 From: Hao Hu Date: Tue, 3 Nov 2026 20:25:37 +0100 Subject: [PATCH] Fix issue #39 misc time-complexity items (8 files) huffman: binary heap keyed [weight,min-leaf,id], no per-merge re-sort. offline_caching: eviction scans cache once, no per-eviction sort. offline_minimum: binary search for first extract after insert. approx_agreement: sort once per round, hoist trimmed mean. cpu_scheduling: RR ready queue via head index + amortized compaction. distance_vector: on-demand poison-reverse lookup, no N^3 table. pl_resolution: hash-set clause membership instead of linear scan. prufer: sorted-set min-leaf heap for encode and decode. AI-Tool: Muse Code (Meta Muse Spark) --- src/combinatorics/prufer/prufer.clj | 24 ++++++------ .../offline_minimum/solution.clj | 6 ++- .../consensus/approx_agreement.clj | 6 +-- src/dp/huffman/huffman.clj | 39 +++++++++++++++---- src/dp/offline_caching/offline_caching.clj | 2 +- src/search/pl_resolution/pl_resolution.clj | 13 +++++-- src/systems/cpu_scheduling/solution.clj | 21 ++++++---- .../distance_vector_routing/solution.clj | 7 ++-- 8 files changed, 78 insertions(+), 40 deletions(-) diff --git a/src/combinatorics/prufer/prufer.clj b/src/combinatorics/prufer/prufer.clj index 2079aac..eb9c006 100644 --- a/src/combinatorics/prufer/prufer.clj +++ b/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*))] diff --git a/src/data_structure/offline_minimum/solution.clj b/src/data_structure/offline_minimum/solution.clj index 100c71d..ce6100b 100644 --- a/src/data_structure/offline_minimum/solution.clj +++ b/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) diff --git a/src/distributed/consensus/approx_agreement.clj b/src/distributed/consensus/approx_agreement.clj index 91ec86f..86c3761 100644 --- a/src/distributed/consensus/approx_agreement.clj +++ b/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*)) diff --git a/src/dp/huffman/huffman.clj b/src/dp/huffman/huffman.clj index 632f557..dd1eb87 100644 --- a/src/dp/huffman/huffman.clj +++ b/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))))] diff --git a/src/dp/offline_caching/offline_caching.clj b/src/dp/offline_caching/offline_caching.clj index 8f1acca..3933f64 100644 --- a/src/dp/offline_caching/offline_caching.clj +++ b/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)))))) diff --git a/src/search/pl_resolution/pl_resolution.clj b/src/search/pl_resolution/pl_resolution.clj index c4d220c..40cafa5 100644 --- a/src/search/pl_resolution/pl_resolution.clj +++ b/src/search/pl_resolution/pl_resolution.clj @@ -21,7 +21,7 @@ (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) @@ -29,11 +29,16 @@ 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)))))) diff --git a/src/systems/cpu_scheduling/solution.clj b/src/systems/cpu_scheduling/solution.clj index 372aeee..bf1133b 100644 --- a/src/systems/cpu_scheduling/solution.clj +++ b/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)) diff --git a/src/systems/distance_vector_routing/solution.clj b/src/systems/distance_vector_routing/solution.clj index b769503..00647c9 100644 --- a/src/systems/distance_vector_routing/solution.clj +++ b/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)