Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Created April 27, 2021 14:50
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save ericnormand/41680eb7155151f903947768e420891e to your computer and use it in GitHub Desktop.
424 PurelyFunctional.tv Newsletter

Sock pairs

After doing laundry, your socks are unmatched to their pairs. You need to match them!

Write a function that takes a collection of values and makes pairs if they are equal. If there is not a match for a particular value, return it as well.

(pair-match []) ;=> {:pairs [] :unmatched []}
(pair-match [1 2 1]) ;=> {:pairs [[1 1]] :unmatched [2]}
(pair-match [1 2 3 1 2 3 1 1 2]) ;=> {:pairs [[1 1] [2 2] [3 3] [1 1]] 
                                 ;=>  :unmatched [2]}

Note: It's like socks. If you have 3 blue socks, that's one pair and one unmatched. If you have 4 blue socks, that's two pairs.

Thanks to this site for the problem idea, where it is rated Hard in Ruby. The problem has been modified.

Please submit your solutions as comments on this gist.

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

@safehammad
Copy link

safehammad commented Apr 27, 2021

I also felt this was asking for use of the partition-X functions. But it makes keeping sock order a bit too messy.

(defn pair-match [xs]
  (->> (sort xs)
       (partition-by identity)
       (mapcat (partial partition-all 2))
       (group-by count)
       ((fn [{pairs 2 unmatched 1}] {:pairs pairs :unmatched (flatten unmatched)}))))

@vpetruchok
Copy link

(defn pair-match [items]
  (let [partitioned (->> items
                     (group-by identity)
                     vals
                     (map #(partition-all 2 %))
                     (apply concat))
        pair?       (fn [group] (= (count group) 2))]
    {:pairs     (filter pair? partitioned)
     :unmatched (flatten (filter (complement pair?) partitioned))}))


(defn pair-match [items]
  (->> items
       (group-by identity)
       (reduce-kv (fn [r k vs]
                    (assoc r k [(int (/ (count vs) 2)) (rem (count vs) 2)]))
                  {})
       (reduce-kv (fn [r k vs]
                    (let [number-of-pairs (first vs)
                          number-of-unmatched (second vs)]
                      (-> r
                          (update :pairs concat (repeat number-of-pairs [k k]))
                          (update :unmatched concat (repeat number-of-unmatched k)))))
                  {:pairs [] :unmatched []})))

@ZaymonFC
Copy link

@safehammad I ended up with something very similar!

(defn pair-match [xs]
  (->> (sort xs)
       (partition-by identity)
       (mapcat (partial partition-all 2))
       (group-by (fn [x] (if (= (count x) 2) :pairs :unmatched)))))

@sztamas
Copy link

sztamas commented Apr 28, 2021

(defn pair-match [coll]
  (reduce (fn [{:keys [pairs unmatched] :as res} x]
            (if (unmatched x)
              {:pairs     (conj pairs [x x])
               :unmatched (disj unmatched x)}
              (assoc res :unmatched (conj unmatched x))))
          {:pairs [] :unmatched #{}}
          coll))

Note: Unmatched can be a set as having the same item in it twice isn't possible.

@KingCode
Copy link

KingCode commented Apr 28, 2021

Mine includes the conversion clutter - I too prefer a set to store the stray socks:

(defn pair-match [xs]
  (->> xs
       (reduce (fn [[pairs unmatched] x]
                 (if (unmatched x)
                   [(conj pairs [x x]), (disj unmatched x)]
                   [pairs, (conj unmatched x)]))
               [[] #{}])
       ((fn [[ps u]]
          {:pairs ps 
           :unmatched (vec u)}))))

(require '[clojure.set :as set])
(defn pair-match [xs]
  (let [pm (fn pm [xs]
             (case (count xs) 
               (0 1) [[] (set xs)]
               (let [mid (-> xs count (quot 2))
                     [lps lu] (pm (subvec xs 0 mid)) 
                     [rps ru] (pm (subvec xs mid))
                     new-matches (seq (set/intersection lu ru))]
                 [(-> lps (into rps) 
                      (into (map #(vector % %))
                            new-matches))
                  (-> lu (set/union ru) 
                      (#(apply disj % new-matches)))])))]
    ((fn [[pairs unmatched]] {:pairs pairs :unmatched (vec unmatched)})
     (pm xs))))

@diavoletto76
Copy link

(defn remove-first [x xs]
  (let [[n m] (split-with (partial not= x) xs)] 
    (into [] (concat n (rest m)))))

(defn stack [{:keys [pairs unmatched]} x]
  (let [rest (remove-first x unmatched)]
    (if (= (count unmatched) (count rest))
      {:pairs pairs :unmatched (conj rest x)}
      {:pairs (conj pairs [x x]) :unmatched rest})))

(defn pair-match [xs]
  (reduce stack {:pairs [] :unmatched []} xs))

@stevenpkent
Copy link

(defn pair-match
  [socks]
  (let [sock-groups (vals (group-by identity socks))]
    {:pairs (vec (map #(vec (take 2 %)) (filter #(>= (count %) 2) sock-groups)))
     :unmatched (vec (map #(first %) (filter #(odd? (count %)) sock-groups)))}))

@burnall
Copy link

burnall commented Apr 29, 2021

Unmatched is set, not a big deal.

(defn pair-match [socks]
  (reduce (fn [{:keys [pairs unmatched]} sock]
             (if (unmatched sock)
                {:pairs (conj pairs [sock sock]), :unmatched (disj unmatched sock)}
                {:pairs pairs, :unmatched (conj unmatched sock)}))
          {:pairs [], :unmatched #{}}
          socks))

@miner
Copy link

miner commented Apr 30, 2021

(defn pair-match [socks]
  (reduce-kv (fn [m k cnt] (-> m
                               (update :pairs into (repeat (quot cnt 2) [k k]))
                               (cond-> (odd? cnt) (update :unmatched conj k))))
               {:pairs [] :unmatched []}
           (frequencies socks)))

@shofel
Copy link

shofel commented May 2, 2021

Hello! It looks like I abused the threading macro :D
Could you, please give an advice to resolve this? Or it's not as bad after all?

(ns pf424sockpairs.core
  (:require [clojure.set]))

(defn pair-match
  "Given a bulk of socks, match pairs."
  [xs]
  (as-> xs _
    (->> _
         (group-by identity) (map last)
         (mapcat (partial partition-all 2))
         (group-by count))
    (-> _
        (clojure.set/rename-keys {1 :unmatched 2 :pairs})
        (update :unmatched flatten)
        (update :pairs vec))))

@shofel
Copy link

shofel commented May 2, 2021

@safehammad I ended up with something very similar!

(defn pair-match [xs]
  (->> (sort xs)
       (partition-by identity)
       (mapcat (partial partition-all 2))
       (group-by (fn [x] (if (= (count x) 2) :pairs :unmatched)))))

@ZaymonFC Looks like this doesn't pass the tests.

@shofel
Copy link

shofel commented May 2, 2021

Unmatched as a set feels right 👍

(defn pair-match
  "Given a bulk of socks, match pairs. Iteratively."
  [xs]
  (let [makes-pair? (fn [acc x] (contains? (:unmatched acc) x))
        start-pair (fn [acc x] (update acc :unmatched conj x))
        promote-pair (fn [acc x] (-> acc
                                     (update :unmatched disj x)
                                     (update :pairs conj [x x])))]
    (as-> xs _
      (reduce (fn [acc x]
              (cond
                (makes-pair? acc x) (promote-pair acc x)
                :else (start-pair acc x)))
            {:pairs [] :unmatched #{}}
            _)
      (update _ :unmatched vec))))

@ericnormand
Copy link
Author

As a monoid:

(defn ->pairs [v]
  {:pairs [] :unmatched #{v}})

(defn pairs-merge [a b]
  (let [matches (clojure.set/intersection (:unmatched a)
                                          (:unmatched b))]
    {:pairs (-> (:pairs a)
                (into (:pairs b))
                (into (map (juxt identity identity) matches)))
     :unmatched (-> (:unmatched a)
                    (clojure.set/union (:unmatched b))
                    (clojure.set/difference matches))}))

(defn pair-match [coll]
  (->> coll
       (map ->pairs)
       (reduce pairs-merge {:pairs [] :unmatched #{}})))

As reduction:

(defn pairs-conj [{:keys [pairs unmatched]} v]
  (if (contains? unmatched v)
    {:pairs (conj pairs [v v]) :unmatched (disj unmatched v)}
    {:pairs pairs              :unmatched (conj unmatched v)}))

(defn pair-match [coll]
  (reduce pairs-conj {:pairs [] :unmatched #{}} coll))

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