Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Last active May 27, 2022 15:26
Show Gist options
  • Save ericnormand/d60a16f9e3e244aba3017e4f9af5533b to your computer and use it in GitHub Desktop.
Save ericnormand/d60a16f9e3e244aba3017e4f9af5533b to your computer and use it in GitHub Desktop.
465 Eric Normand Newsletter

Single letter swaps

Write a function that takes a sequence of strings and a target string. For each string in the sequence, determine if it is equal to the target string after exactly one letter swap. Return the sequence of letter pairs that are swapped, or nil if it doesn't exist.

Example

(letter-swaps ["bacd" "abdc" "abcde" "abcc" "abcd"] "abcd")
  ;=> [#{\a \b} #{\c \d} nil nil nil]

Swapping a and b in "bacd" gives you the target string. Swapping c and d in "abdc" gives you the target string. But there is no way to swap to get an extra e. And trading a d for a c is not possible. Finally, the last string has no swaps, and exactly one is required.

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

Please submit your solutions as comments on this gist.

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

@wevre
Copy link

wevre commented Apr 17, 2022

Are the letters in the target string unique?

@dominicfreeston
Copy link

dominicfreeston commented Apr 17, 2022

(defn find-swap [cand ref]
  (when (= (sort cand) (sort ref))
    (let [[swap & others] (->> (map (comp set list) cand ref)
                               (filter #(= 2 (count %))))]
      (when (= [swap] others)
        swap))))

(defn letter-swaps [coll ref]
  (mapv #(find-swap % ref) coll))

(comment
  (letter-swaps ["bacd" "abdc" "adcb" "dbca" "abcde" "abcc" "abcf" "abgh" "badc" "abcd" "bacdabcd"] "abcd")
  ;; => [#{\a \b} #{\c \d} #{\b \d} #{\a \d} nil nil nil nil nil nil nil]
  )

@steffan-westcott
Copy link

steffan-westcott commented Apr 17, 2022

(defn letter-swap [xs ys]
  (when (= (count xs) (count ys))
    (let [[[a b] & other-swaps] (remove #(apply = %) (map vector xs ys))]
      (when (= [[b a]] other-swaps)
        #{a b}))))

(defn letter-swaps [coll s]
  (mapv letter-swap coll (repeat s)))

@dominicfreeston
Copy link

dominicfreeston commented Apr 17, 2022

Oh! Does the swap not have to be sequential? i.e. should the answer to "dbca" be nil or #{\a \d}?

EDIT: According to the original PHP problem, the answer should be #{\a \d}, i.e. the swap doesn't have to be of two sequential characters. Which means my solution is not only clunky, it's also wrong 😭

Still, useful practice 😅

@wevre FWIW according to that original problem you can assume the letters in the target to be unique

EDIT: Updated mine, but it's really just a variation on @steffan-westcott's solution, which I think is super elegant!

@PEZ
Copy link

PEZ commented Apr 18, 2022

(defn letter-swaps-1 [s target]
  (when-not (or
             (= s target)
             (not= (count s) (count target))
             (not= (sort s) (sort target)))
    (let [diffs (->> target
                     (map (fn [c1 c2]
                            (when-not (= c1 c2)
                              #{c1 c2}))
                          s)
                     (remove nil?))]
      (when (and (= 2 (count diffs))
                 (apply = diffs))
        (first diffs)))))

(defn letter-swaps [c target]
  (mapv (fn [s] (letter-swaps-1 s target)) c))

(comment
  (letter-swaps ["bacd" "abdc" "adcb" "abcde" "abcc" "abcd" "dbca"] "abcd")
  ;; => [#{\a \b} #{\c \d} #{\b \d} nil nil nil #{\a \d}]
  )

@wevre
Copy link

wevre commented Apr 18, 2022

(defn swaps [s t]
  (let [[a b :as mismatches] (->> (map vector s t)
                                  (filter (partial apply not=)))]
    (when (and (= (count s) (count t))
               (= 2 (count mismatches))
               (= a (reverse b)))
      (set a))))

(comment
  (map #(swaps % "abcd") ["bacd" "abdc" "adcb" "bcda" "bac" "abcde" "abcc" "abcd" "dbca"])
  ;; => (#{\a \b} #{\c \d} #{\b \d} nil nil nil nil nil #{\a \d})
)

@JonathanHarford
Copy link

(defn letter-swaps [s src]
  (map (fn [cmp]
         (let [[fst snd & rst] (->> cmp
                                    (interleave src)
                                    (partition-all 2)
                                    (reduce
                                     (fn [acc [x y]]
                                       (cond-> acc
                                         (not= x y) (conj [x y])))
                                     []))]
           (when (and (empty? rst)
                      (= fst (reverse snd)))
             (set fst)))) s))

@Sinha-Ujjawal
Copy link

Sinha-Ujjawal commented Apr 19, 2022

Solution in haskell-

letterSwap :: String -> String -> Maybe (Char, Char)
letterSwap target string =
  case filter (\(x, y) -> x /= y) $ zip target string of
    [(a, b), (c, d)] -> if length target == length string && a == d && b == c then Just (b, d) else Nothing
    _                -> Nothing

letterSwaps :: String -> [String] -> [Maybe (Char, Char)]
letterSwaps target = map (letterSwap target)

main :: IO ()
main = do
  print $ letterSwaps "abcd" ["bacd", "abdc", "abcde", "abcc", "abcd"]

A little change to use T.Text instead-

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.Text as T

letterSwap :: T.Text -> T.Text -> Maybe (Char, Char)
letterSwap target string =
  case filter (\(x, y) -> x /= y) $ T.zip target string of
    [(a, b), (c, d)] -> if T.length target == T.length string && a == d && b == c then Just (b, d) else Nothing
    _                -> Nothing

letterSwaps :: T.Text -> [T.Text] -> [Maybe (Char, Char)]
letterSwaps target = map (letterSwap target)

main :: IO ()
main = do
  print $ letterSwaps "abcd" ["bacd", "abdc", "abcde", "abcc", "abcd"]

@miner
Copy link

miner commented Apr 19, 2022

(defn letter-swaps [strs target]
  (let [tcnt (count target)
        swap (fn [s]
               (when (and (not= s target) (= (count s) tcnt) (> tcnt 1))
                 (let [dv (into [] (comp (remove (fn [i] (= (nth s i) (nth target i))))
                                         (take 3))
                                (range tcnt))]
                   (when (= (count dv) 2)
                     (let [d0 (dv 0)
                           d1 (dv 1)
                           s0 (nth s d0)
                           s1 (nth s d1)]
                       (when (and (= s0 (nth target d1)) (= s1 (nth target d0)))
                         #{s0 s1}))))))]
    (mapv swap strs)))

@Oklein1
Copy link

Oklein1 commented Apr 19, 2022

(defn letter-count [str1 str2]
  (let [seq-str1 (seq str1)
        seq-str2 (seq str2)
        [str1-f str1-s] seq-str1
        [str2-f str2-s] seq-str2]
   (when (= (count seq-str1) (count seq-str2))
     (cond
       (or (empty? str1) (empty? str2)) nil
       (and (= str1-f str2-s) (= str1-s str2-f)) #{str1-f str2-f}
       :else (recur (rest seq-str1) (rest seq-str2))))))


(mapv #(letter-count "abcd" %) ["bacd" "abdc" "abcde" "abcc" "abcd"])

@JonathanHarford
Copy link

2nd solution (the first failed on the "bac" case).

I tried rewriting it to match how I'd solve the problem as a human, then flattened the nested nightmare of ifs and merged two variables into one by abusing dynamic types.

(defn letter-swap
  "When input string is equal to the target string after exactly one letter swap,
  return the sequence of letter pairs that are swapped"
  [input target]
  (when (= (count input) (count target))
    (loop [[x & xs] input
           [y & ys] target
           swap     nil]
      (cond
        (not x)        (when (set? swap) swap)
        (= x y)        (recur xs ys swap)
        (set? swap)    nil
        (nil? swap)    (recur xs ys [x y])
        (= swap [y x]) (recur xs ys (set swap))))))

(is (= #{\a \b}
       (letter-swap "bacd" "abcd")))
(is (= #{\c \d}
       (letter-swap "abdc" "abcd")))
(is (= #{\b \d}
       (letter-swap "adcb" "abcd")))
(is (= nil
       (letter-swap "bcda" "abcd")))
(is (= nil
       (letter-swap "bac" "abcd")))
(is (= nil
       (letter-swap "abcde" "abcd")))
(is (= nil
       (letter-swap "abcc" "abcd")))
(is (= nil
       (letter-swap "abcd" "abcd")))
(is (= #{\a \d}
       (letter-swap "dbca" "abcd")))

(defn letter-swaps [s src]
  (map (partial letter-swap src) s))

(is (= [#{\a \b} #{\c \d} #{\b \d} nil nil nil nil nil #{\a \d}]
       (letter-swaps ["bacd" "abdc" "adcb" "bcda" "bac" "abcde" "abcc" "abcd" "dbca"] "abcd")))

I like that this solution doesn't look at the whole string if it doesn't need to.

@mchampine
Copy link

(defn swap-chars [s i j]
  (let [sv (vec s)]
    [(hash-set (sv i) (sv j))
     (apply str (assoc (assoc sv i (sv j)) j (sv i)))]))

(defn swapss [s]
  (let [cs (count s)
        x (range (dec cs))
        y (range 1 cs)
        z (reverse y)]
    (map (partial swap-chars s) (apply concat (map #(repeat %1 %2) z x))
         (apply concat (map #(range %1 %2) y (repeat cs))))))

(defn checkswap [swstr ostr]
  (ffirst (filter #(= swstr (second %)) (swapss ostr))))

(defn letter-swaps [sc s]
  (map (partial checkswap s) sc))

@bnii
Copy link

bnii commented Apr 20, 2022

(defn letter-swaps [strs target]
  (let [swapped (fn swapped [fstr sstr]
                  (let [[f s] (clojure.data/diff (seq fstr) (seq sstr))
                        fv (sort (remove nil? f))
                        sv (sort (remove nil? s))]
                    (when
                      (and
                        (= (count fv) (count sv) 2)
                        (= fv sv))
                      (set sv))))]
    (map (partial swapped target) strs)))

@miner
Copy link

miner commented Apr 20, 2022

Here are a couple of additional examples that I think should be true, but not all the implementations agree.

(= (letter-swaps ["abba" "bcba" "abab" "baba"] "abba") [nil nil #{\a \b} #{\a \b}])
(= (letter-swaps ["aa" "bb" "ba" "ab"] "aa") [nil nil nil nil])

@PEZ
Copy link

PEZ commented Apr 20, 2022

Hmmmm, mine does this with the second one, @miner:

(letter-swaps ["aa" "bb" "ba" "ab"] "aa") ; => [nil #{\a \b} nil nil]

I'll have to fix it, I agree.

EDIT: Now fixed. ✅ Thanks! 🙏

@jonasseglare
Copy link

(defn letter-swaps [inputs target]
  (for [i inputs]
    (->> i
         (when (= (count target) (count i)))
         (map vector target)
         (group-by set)
         (remove #(= 1 (count (first %))))
         ((fn [[[x [a b]] & c]] (and a b (not c) x))))))

@joshlemer
Copy link

joshlemer commented May 1, 2022

(defn letter-swap [xs ys]
  (when (= (count xs) (count ys))
    (let [[[a b] & other-swaps] (remove #(apply = %) (map vector xs ys))]
      (when (= [[b a]] other-swaps)
        #{a b}))))

(defn letter-swaps [coll s]
  (mapv letter-swap coll (repeat s)))

This is so elegant, nice one @steffan-westcott !

@KingCode
Copy link

Using sets and =/not= to weed out most candidates.

(defn single-swap? [kand xs]
  (let [swaps (and (= (set kand) (set xs))
                   (not= kand xs)
                   (->> xs (map vector kand)
                        (sequence (comp
                                   (map (fn [[k x]]
                                          (when (not= k x) k)))
                                   (filter identity)))))]
    (when (and swaps (= 2 (count swaps)))
      (set swaps))))

(defn letter-swaps [kands str]
  (->> kands
       (map #(single-swap? % str))))

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