Create an algorithm that ensures that for any given sequence there is no more than a run of 2 of the same type. Try to preserve the order as much as possible.

ewan-shuffle.clj

(ns user)
;@here if anyone wants a small friday challenge.  Create an algorithm that 
;ensures that for any given sequence there is no more than a run of 2 of the 
;same type. Try to preserve the order as much as possible. 
;ie: not a random shuffle.  There can be a continuous run of more than 2 
;at the end of the sequence
(def problem  [:a :a :a :a :a :a :b :b :c :a :b :b :b])

(def large-problem (doall (map (fn [_] 
                                 (->> #{:a :b :c}
                                      shuffle
                                      first))
                               (range 1000))))

(defn prepare-for-error-meassure
  [problem]
  (map-indexed  
    (fn [i x]
      (with-meta {:value x}
                 {:index i}))
    problem))

(defn meassure-error
  [solution]
  (reduce +
          (map-indexed 
            (fn [index x]
              (Math/pow (Math/abs (- index 
                                     (-> x meta :index)))
                        2))
            solution)))

(comment
  
  ; problem

  (-> problem
      prepare-for-error-meassure 
      ewan-shuffle-reference
      meassure-error)
  ; -> 30.0

  (-> problem
      prepare-for-error-meassure 
      ewan-shuffle
      meassure-error)
  ; -> 68


  ; large problem
  (-> large-problem
      prepare-for-error-meassure 
      ewan-shuffle-reference
      meassure-error)
  ; 442

  (-> large-problem
      prepare-for-error-meassure 
      ewan-shuffle
      meassure-error)
  ;950


  
  )


(defn ewan-shuffle
  [problem]
  (->> (partition-by identity problem)
       (map #(partition 2 2 nil %))
       (apply concat)
       ((fn [s] 
          (loop [product []
                 work s]
            (if (empty? work)
              ; we are done
              product
              ; more work
              (let [[same different] (split-with #(= (-> product last first) (first %))
                                                 work)]
                (if (empty? different)
                  ; they are all the same so we are done
                  (recur (concat product same) [])
                  ; pull out the first that is different and then follow up with the rest
                  (recur (concat product (take 1 different))
                         (concat same (rest different)))))))))
       flatten))


;; Reference implementation
(defn ewan-reducer
  [{:keys [result remainder]} incoming]
  (let [splice                         (fn [[x & xs] ys] (concat result [x] ys xs))
        [incoming-ok incoming-rejects] (split-at 2 incoming)]
    {:result (splice incoming-ok remainder) :remainder incoming-rejects}))

(defn ewan-shuffle-reference
  [original]
  (let [result (->> original
                (partition-by identity)
                 (reduce ewan-reducer {:result [] :remainder []}))
        new-list (concat (:result result) (:remainder result)) ]
    (if (= new-list original)
      new-list
      (ewan-shuffle-reference new-list))))