Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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/

@steffan-westcott
Copy link

steffan-westcott commented Apr 27, 2021

(defn pair-match [xs]
  (loop [pairs [] unmatched [] xs xs]
    (if-let [x (first xs)]
      (if (.contains unmatched x)
        (recur (conj pairs [x x]) (vec (remove #{x} unmatched)) (rest xs))
        (recur pairs (conj unmatched x) (rest xs)))
      {:pairs pairs :unmatched unmatched})))

It seems sock order isn't so well defined, so this may be permissable:

(defn pair-match [xs]
  (let [freqs (frequencies xs)]
    {:pairs (mapcat (fn [[x freq]] (repeat (quot freq 2) [x x])) freqs)
     :unmatched (keep (fn [[x freq]] (when (odd? freq) x)) freqs)}))

@nwjsmith
Copy link

nwjsmith commented Apr 27, 2021

(defn pair-match
  "Takes a collection and makes pairs if they are equal. Returns unmatched
  values too."
  [coll]
  (reduce (fn [{:keys [unmatched pairs]} x]
            (let [match? (contains? unmatched x)]
              {:pairs (if match? (conj pairs [x x]) pairs)
               :unmatched ((if match? disj conj) unmatched x)}))
          {:pairs [] :unmatched #{}}
          coll))

@i0cus
Copy link

i0cus commented Apr 27, 2021

(defn pair-match
  ([xs]
   (pair-match {:unmatched #{} :pairs []} xs))
  ([{:keys [pairs unmatched] :as m} xs]
   (if-let [f (first xs)]
     (if (contains? unmatched f)
       (recur {:pairs (conj pairs [f f]) :unmatched (disj unmatched f)} (next xs))
       (recur (update m :unmatched conj f) (next xs)))
     (update m :unmatched vec))))

Probably better done by (loop []):

defn pair-match
  [xs]
  (loop [pairs [] unmatched #{} xs xs]
    (if-let [f (first xs)]
      (if (contains? unmatched f)
        (recur (conj pairs [f f]) (disj unmatched f) (next xs))
        (recur pairs (conj unmatched f) (next xs)))
      {:pairs pairs :unmatched (vec unmatched)})))

@alex-gerdom
Copy link

alex-gerdom commented Apr 27, 2021

Didn't mess with converting outputs into vectors, but shouldn't be too much of an issue.

(defn pair-match [coll]
  (let [pairs (->> (group-by identity coll)
                   (vals)
                   (mapcat #(partition-all 2 %)))]
    {:pairs (filter #(= (count %) 2) pairs)
     :unmatched (apply concat (filter #(= (count %) 1) pairs))}))

@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

vpetruchok commented Apr 27, 2021

(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

ZaymonFC commented Apr 28, 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)))))

@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

diavoletto76 commented Apr 28, 2021

(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

stevenpkent commented Apr 29, 2021

(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

ericnormand commented May 3, 2021

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