465 Eric Normand Newsletter

00 Single letter swaps.md

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/

Are the letters in the target string unique?

(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]
  )

(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)))

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!

(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}]
  )

(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})
)

(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))

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"]

(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)))

(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"])

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.

(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))

(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)))

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])

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! 🙏

(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))))))

(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 !

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))))