Anonymous Anonymous - 6 months ago
748 0

No description

Other

chinese

(ns
  ^{:author q5275620}
  chinese-postman-problem.check)



(= true (
          (fn [g]

            (letfn [(connected? [g]
                      (loop [q (conj [] (ffirst g)) visited #{}]
                        (if (empty? q)
                          (let [rem (filter #(not (contains? visited %)) (flatten (for [e g] e)))]
                            (= empty? rem))
                          (let [v1 (peek q)
                                edges (filter (partial some #{v1}) g)
                                vertices (filter (partial not= v1) (flatten edges))
                                unvisited (filter #(not (contains? visited %)) vertices)]
                            (recur (into (rest q) unvisited) (into (conj visited v1) unvisited))))))]
              (connected? g)))


            #{[:a :b] [:b :c] [:c :d]
              [:x :y] [:d :a] [:b :e] [:x :a]}))



(fn [edges]
  (let [v (zipmap (distinct (flatten edges)) (repeat 0))
        degrees (vals (reduce
                        (fn [r [a b]]
                          (if (not= a b)
                            (-> r
                              (update-in [a] inc)
                              (update-in [b] inc))
                            r))
                        v edges))
        odd (count (filter odd? degrees))
        connected? (fn [edges]
                     (let [find (fn [union k] (or (some #(if (contains? % k) %) union) #{k}))]
                       (= 1 (count
                              (reduce (fn [r [a b]]
                                        (let [ua (find r a)
                                              ub (find r b)]
                                          (-> r
                                            (disj ua ub)
                                            (conj (clojure.set/union ua ub)))))
                                  #{} edges)))))]
    (and
      (or (= odd 2) (= odd 0))
      (connected? edges))))


(defn has-eulerian-path [y]
  (letfn [
           (near-edges [[_ y :as e] g]
             (if (nil? e) (into (set g) (map reverse g))
               (map (fn [[a b]] (if (= y b) [b a] [a b])) (filter #((set %) (last e)) g))))
           (remove-edge [e g]
             (let [[f n] (split-with #(and (not= e %) (not= (reverse e) %)) (vec g))]
               (apply concat [f (next n)])))

           (next-edge [v g]
             (let [n (near-edges v g)]
               (do (prn v g n)
                 (if (empty? n)
                   (empty? g)
                   (some #(next-edge % (remove-edge % g)) n)))))
           ]
    (true? (next-edge nil y))))


(fn eulerian [edges]
  (let [degrees (fn [edges]
                  (apply merge-with + {} (for [[a b] edges
                                               :when (not= a b)]
                                           {a 1 b 1})))
        gdeg (degrees edges)]
    (and
      (not (empty? gdeg))
      (->> (vals gdeg) (filter odd?) count (>= 2)))))