Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Created April 5, 2021 19:05
Show Gist options
  • Save ericnormand/098143e8cdbecef0faeba92f730b9cba to your computer and use it in GitHub Desktop.
Save ericnormand/098143e8cdbecef0faeba92f730b9cba to your computer and use it in GitHub Desktop.
421 PurelyFunctional.tv Newsletter

Element promotion

Sometimes you have a list and you want to "promote" one element toward the front of the list. Essentially, you need to swap the element with its immediate predecessor (if it exists). Write a function promote that takes a predicate and a list. If the predicate is true, the element should be promoted.

Examples

(promote even? [1 3 5 6]) ;=> (1 3 6 5)
(promote even? []) ;=> ()
(promote even? [2 1]) ;=> (2 1)
(promote even? [0 2 4 6]) ;=> (0 2 4 6)
(promote even? [0 1 2 3 4 5 6]) ;=> (0 2 1 4 3 6 5)
(promote even? [1 2 2 2 2]) ;=> (2 2 2 2 1)

Thanks to Enzzo Cavallo for the challenge idea!

Please submit your solutions as comments on this gist.

To subscribe: https://purelyfunctional.tv/newsletter/

@miner
Copy link

miner commented Apr 6, 2021

Revised.

(defn promote [pred coll]
  (if (empty? coll)
    coll
    (reduce (fn [r x]
              (let [p (peek r)]
                (if (and (pred x) (not (pred p)))
                  (conj (pop r) x p)
                  (conj r x))))
            [(first coll)]
            (rest coll))))

@jaihindhreddy
Copy link

Using a stateful transducer:

(defn promotor [pred]
  (fn [rf]
    (let [v (volatile! [])]
      (fn
        ([] (rf))
        ([result]
          (let [[x :as buf] @v]
            (if (empty? buf)
              (rf result)
              (let [result (rf result x)]
                (if (reduced? result)
                  result
                  (rf result))))))
        ([result input]
          (if (pred input)
            (rf result input)
            (let [[x :as buf] @v]
              (vreset! v [input])
              (if (empty? buf)
                result
                (rf result x)))))))))


(defn promote [pred coll]
  (into [] (promotor pred) coll))

@vpetruchok
Copy link

(defn promote [pred coll]
  (loop [coll (seq coll)
         res  []]
    (if-let [x1 (first coll)]
      (if-let [x2 (second coll)]
        (cond
          (pred x1)
          (recur (rest coll) (conj res x1))

          (pred x2)
          (recur (conj (drop 2 coll) x1) (conj res x2))

          :default
          (recur (rest coll) (conj res x1)))
        
        (recur (rest coll) (conj res x1)))
      res)))

@vpetruchok
Copy link

(defn promote [pred coll]
  (let [xs      (transient coll)
        do-swap (fn [idx1 idx2]
                  (let [x1 (get xs idx1)
                        x2 (get xs idx2)]
                    (assoc! xs idx1 x2)
                    (assoc! xs idx2 x1)))
        promotable? (fn [idx]
                      (pred (get xs idx)))]
    (doseq [idx (range 1 (count xs))]
      (when (promotable? idx) 
        (let [prev-idx (dec idx)]
          (when-not (promotable? prev-idx)
            (do-swap idx prev-idx)))))
    (persistent! xs)))

@mchampine
Copy link

(defn swapat [pred c n]
  (let [s (get c (dec n))]
    (if (or (nil? s) (pred s)) c
      (assoc (assoc c n s) (dec n) (get c n)))))

(defn promote [pred coll]
  (let [spc (map first (filter #(pred (second %)) (map-indexed vector coll)))]
    (reduce (partial swapat pred) coll spc)))

@steffan-westcott
Copy link

Another solution using a stateful transducer:

(defn promote
  ([pred]
   (comp
     (fn [rf]
       (let [buf (volatile! [])]
         (fn
           ([] (rf))
           ([res] (rf (unreduced (rf res @buf))))
           ([res x]
            (if (pred x)
              (rf res [x])
              (let [y @buf]
                (vreset! buf [x])
                (rf res y)))))))
     cat))
  ([pred xs]
   (sequence (promote pred) xs)))

@i0cus
Copy link

i0cus commented Apr 7, 2021

Answer sponsored by lazy-seq gang:

  (defn promote [pred nums]
    (if (seq nums)
      (let [[n1 n2] (take 2 nums)]
        (if (nil? n2)
          (list n1)
          (if (pred n1)
            (cons n1 (lazy-seq (promote pred (drop 1 nums))))
            (if (pred n2)
              (cons n2 (lazy-seq (promote pred (cons n1 (drop 2 nums)))))
              (cons n1 (lazy-seq (promote pred (drop 1 nums))))))))
      (list)))

@steffan-westcott
Copy link

@i0cus Note the docs and design notes on lazy-seq advise putting the cons inside the lazy-seq body. That way, the entire sequence is lazy and not just the tail. Here's my spin on a lazy-seq solution:

(defn promote' [pred buf xs]
  (lazy-seq
    (if-let [xss (seq xs)]
      (let [x (first xss)
            rs (rest xss)]
        (if (pred x)
          (cons x (promote' pred buf rs))
          (concat buf (promote' pred [x] rs))))
      buf)))

(defn promote [pred xs]
  (promote' pred [] xs))

@diavoletto76
Copy link

(defn promote [f xs]
  (loop [[x1 x2 & xs] xs acc []]
    (cond (nil? x1) acc
          (nil? x2) (conj acc x1)
          (and (f x2) ((complement f) x1)) (recur (cons x1 xs) (conj acc x2))
          :else (recur (cons x2 xs) (conj acc x1)))))

@i0cus
Copy link

i0cus commented Apr 8, 2021

@steffan-westcott Oof, that's what I get for trying to flail a language feature that I stopped using long time ago, only to misrepresent my gang affiliation for some cheap gist cred. I really do like your version and its rather elegant single predicate split. Alas! ;-)

(defn promote [pred nums]
  (letfn [(promote' [[f s & r :as xss]]
            (lazy-seq
             (when f
               (if (or (pred f) (nil? s) (not (pred s)))
                 (cons f (promote' (rest xss)))
                 (cons s (promote' (cons f r)))))))]
    (promote' (seq nums))))

(Let's be honest, IRL I'd just loop it. Because of course I'll put lazy-seq in the wrong place. :P)

@krishnan-mani
Copy link

a first try, from a newbie at Clojure. The image i conjured up in my mind was one of the machines that runs along the railway track and replaces sleepers, hence the use of reduce

; an element can "creep up" 
; but only if the predicate is false for the preceding element, and true for itself

(defn promote-tuple? [pred tuple]
  (let [first-result-negated (not (pred (first tuple)))
        second-result (pred (second tuple))
        flag (and first-result-negated second-result)]
    {:promote? flag :tuple tuple}))

(defn promote-tuple [map-tuple]
  (let [{promote? :promote? tuple :tuple} map-tuple]
   (if promote? (reverse tuple) tuple)))

(defn promote-result [pred result-map x]
  (let [{result :result tail :tail} result-map]
    (if (nil? tail) {:result [] :tail x} 
      (let [next-tuple [tail x]
            promoted-tuple 
            (->> next-tuple
                 (promote-tuple? pred)
                 (promote-tuple))]
         {:result (conj result (first promoted-tuple)) 
          :tail (second promoted-tuple)}))))

(defn promote [pred coll] 
    (let [result-and-tail (reduce (partial promote-result pred) {:result []} coll)
          {result :result tail :tail} result-and-tail]
      (if (nil? tail) [] (conj result tail))))

@burnall
Copy link

burnall commented Apr 10, 2021

(defn promote [pred xs]
  (->> xs 
       (reduce (fn [[res tail] x]
                 (if (pred x)
                   [(conj res x) tail]
                   [(apply conj res tail) (list x)]))                 
               [[] nil])
       (apply concat)))

@sim-f
Copy link

sim-f commented Apr 11, 2021

(defn promote [pred ls]
  (sequence
   (loop [[x y & r :as l] ls
          rl []]
     (cond
       (empty? l) rl
       (nil? y) (conj rl x)
       (and (pred x)
            (pred y)) (recur r
                             (conj rl x y))
       (pred y) (recur
                 (cons x r)
                 (conj rl y))
       (not (pred y)) (recur
                       (cons y r)
                       (conj rl x))))))

@vmpj
Copy link

vmpj commented Apr 15, 2021

I enjoyed this challenge because it confronts you with the seemly obvious need to keep state while processing the collection. At least for me, an imperative solution seems so straight forward in my mind.

In this gist, I've seems several approaches to overcoming the problem e.g. loop, reduce, stateful transducer, recursion and some other clever ones that I struggle to understand.

I spend an embarrassing amount of time implementing two recursive solutions before settling on a straight forward brute force attempt that keeps state in a map.

(defn promote [pred coll]
  (->> coll
       (reduce (fn [{:keys [xs buffer]} x] 
                  (if (pred x) 
                    {:xs (conj xs x) :buffer buffer}
                    {:xs (conj xs buffer) :buffer x}))
               {:xs []})
       (#(conj (:xs %) (:buffer %)))
       (remove nil?))) 

I find it... practical!?

-----edit------
@miner you are correct. :-)

I adjusted my solution. I think my solution is less elegant but close to @burnall 's solution.

(defn promote [pred coll]
  (let [f (fn [{:keys [xs buffer]} x]
                    (if (pred x) 
                      {:xs (conj xs x) :buffer buffer}
                      {:xs (apply conj xs buffer) :buffer [x]}))]
      (as-> (reduce f {:xs []} coll) {:keys [xs buffer]}
            (seq (apply conj xs buffer)))))

@miner
Copy link

miner commented Apr 15, 2021

You have to be extra careful if you allow nils in your input collection.
(promote nil? [true nil false true nil nil])
;=> [nil true false nil nil true]

@KingCode
Copy link

KingCode commented Jun 12, 2021

(defn promote [pred xs]
  (->>
   (loop [[hd nxt & more :as all] xs acc []]
     (cond 
       (empty? all)
       acc 
       (= 1 (count all))
       (conj acc hd) 
       (or (pred hd) (not (pred nxt)))
       (recur (cons nxt more) (conj acc hd))
       :else 
       (recur (cons hd more) (conj acc nxt))))
   (apply list)))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment