optimizing a brute force search for the card flipping game....

cardflip.clj

(ns clojure-playground.core)

(def samples
  {"0100110" "1 0 2 3 5 4 6"
   "01001100111" "No solution"
   "100001100101000"  "0 1 2 3 4 6 5 7 8 11 10 9 12 13 14"
   })

(def easy "0100110")
(def hard "001011011101001001000")
(def harder "1010010101001011011001011101111")
(def hardest "1101110110000001010111011100110")
(def bonus "010111111111100100101000100110111000101111001001011011000011000")


(defn str->cards [cards]
  (clojure.string/split cards #""))

(def cards (clojure.string/split cards-str #""))

(defn flip-card [cards index]
  (if (or (< index 0) (>= index (count cards)))
    cards
    (let [face (nth cards index)
          new-face (case face "0" "1" "1" "0"  face)]
      (assoc cards index new-face))))

(defn remove-card [cards index]
  (let [new-cards (assoc cards index ".")]
    (-> new-cards
        (flip-card (dec index))
        (flip-card (inc index)))))

(defn island? [cards]
  (->> cards
       (partition-by #{"."})
       (some (fn [xs]
               (every? #(= % "0") xs)))))

;;this is O(N).  Better option is to cache.
(defn get-indexes-of-cards-to-remove
  "Finds cards that are face up, and returns their indices as a list"
  [cards]
  (for [idx   (range (count cards))
        :when (= (nth cards idx) "1")]
    idx))

(defn neighbors [cards]
  (->> (for [idx  (get-indexes-of-cards-to-remove cards)]
         (let [flipped (remove-card cards idx)]
           (when-not (island? flipped)
             [idx flipped])))
       (keep identity)))

;;Allow us to swap out neighbor functions later
;;to test out better versions..
(defn step
  [acc cards & {:keys [nf] :or {nf neighbors}}]
  (if-let [nebs (seq (nf cards))]
    (some identity
          (for [[idx neb] nebs]
            (step (conj acc idx) neb :nf nf)))
    [acc cards]))

(defn solve [cards]
  (let [[draws _] (step [] cards)]
    (if (== (count draws) (count cards))
      (clojure.string/join \space draws )
      "No solution")))

;;Now...we can make this MUCH more tractable if we
;;keep track of our 1's in a constant time index somewhere.
;;I use metadata and just pack it along with the
;;cards vector...

;;hrrrmm, we get cotradictory answers if
;;we use a sorted set vs undordered, bug!
(defn indexed-cards [xs]
  (let [cards   (vec xs)
        indices #_(set (get-indexes-of-cards-to-remove cards))
                (into (sorted-set) (get-indexes-of-cards-to-remove cards))]
    (with-meta cards {:indices indices})))

;;bugfix: left out the case where we've flipped a card
;;that "was" in the open set, but is now 0, we need to
;;cover that case as well.
(defn smart-flip-card [cards index]
  (if (or (< index 0) (>= index (count cards)))
    cards
    (let [face (nth cards index)
          new-face (case face "0" "1" "1" "0"  face)]
      (-> cards
          (assoc  index new-face)
          (as-> cards   (vary-meta cards update :indices
                           #(if (= new-face "1")
                              (conj % index)
                              (disj % index)))
                        cards)))))

(defn smart-remove-card [cards index]
  (let [new-cards (assoc cards index ".")]
    (-> new-cards
        (vary-meta update :indices #(disj % index))
        (smart-flip-card (dec index))
        (smart-flip-card (inc index)))))

(defn smart-indices
  [cards]
  (-> cards meta :indices))

(defn smart-neighbors [cards]
  (->> (for [idx  (smart-indices cards)]
         (let [flipped (smart-remove-card cards idx)]
           (when-not (island? flipped)
             [idx flipped])))
       (keep identity)))
 
(defn smart-step [acc cards]
  (step acc (indexed-cards cards) :nf smart-neighbors))

(defn smart-solve [cards]
  (let [[draws _] (smart-step [] cards)]
    (if (== (count draws) (count cards))
      (clojure.string/join \space draws )
      "No solution")))

(defn do-moves [moves cards]
    (->> moves 
       (reduce (fn [acc idx]
                 (remove-card acc idx)) cards)))

(defn verify [moves cards]
  (->> cards
       (do-moves moves)
       (every? #{"."})))

(defn time-test []
  (println :testing-sample-data)
  (doseq [[k v] samples]
    (let [res (-> k  str->cards indexed-cards smart-solve)]
      (println {:input k :expected v :result res :matched? (= res v)})))
  
  (println :testing-challenge-data) 
  (doseq [input [easy hard harder hardest bonus]]
    (println [:solving input])
    (let [cards  (-> input str->cards indexed-cards)
          [draws xs] (smart-step [] cards)
          result (smart-solve cards)]
      (println [:verified? (if (= result "No solution")
                             :no-solution-cant-tell
                             (verify draws cards))])
      (time (println (smart-solve cards))))))


    ;; (time-test)
    ;; :testing-sample-data
    ;; {:input 0100110, :expected 1 0 2 3 5 4 6, :result 1 0 2 3 5 4 6, :matched? true}
    ;; {:input 01001100111, :expected No solution, :result No solution, :matched? true}
    ;; {:input 100001100101000, :expected 0 1 2 3 4 6 5 7 8 11 10 9 12 13 14, :result 0 1 2 3 4 6 5 7 8 11 10 9 12 13 14, :matched? true}
    ;; :testing-challenge-data
    ;; [:solving 0100110]
    ;; [:verified? true]
    ;; 1 0 2 3 5 4 6
    ;; "Elapsed time: 0.110616 msecs"
    ;; [:solving 001011011101001001000]
    ;; [:verified? true]
    ;; 2 1 0 3 5 4 6 8 7 11 10 9 12 13 17 16 15 14 18 19 20
    ;; "Elapsed time: 0.37215 msecs"
    ;; [:solving 1010010101001011011001011101111]
    ;; [:verified? :no-solution-cant-tell]
    ;; No solution
    ;; "Elapsed time: 0.609184 msecs"
    ;; [:solving 1101110110000001010111011100110]
    ;; [:verified? true]
    ;; 0 3 2 1 5 4 6 8 7 9 10 11 12 13 14 17 16 15 18 20 19 23 22 21 25 24 26 27 29 28 30
    ;; "Elapsed time: 0.852148 msecs"
    ;; [:solving 010111111111100100101000100110111000101111001001011011000011000]
    ;; [:verified? true]
    ;; 1 0 2 4 3 6 5 8 7 10 9 12 11 13 14 18 17 16 15 19 24 23 22 21 20 25 26 28 27 29 31 30 36 35 34 33 32 37 39 38 41 40 42 43 47 46 45 44 48 50 49 51 53 52 54 55 56 57 59 58 60 61 62
    ;; "Elapsed time: 1.850866 msecs"
    ;; nil