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/

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