Iterating over strings

Question

I have two strings of the same length which differ in exactly one character and I want a string of all the characters which are pairwise equal. So basically something like this which evaluates to a string instead of a list of characters:

(loop for a across "abcd"
      for b across "abce"
      when (char= a b) collect a)

Although performance isn't an issue here, I found it cumbersome to have a (coerce ... 'string) around it.

So I came up with something like

(loop with result = ""
      for a across "abcd"
      for b across "abce"
      when (char= a b)
        do (setf result (concatenate 'string result (string a)))
      finally (return result))

which does the job but looks not very elegant to me.

(map 'string (lambda (a b) (when (char= a b) a)) "abcd" "abce")

looks nicer but is not working because NIL is not a character when aand bare not equal.

Is there a more elegant idiom to iterate over a string and get a string back?

Answer 1

Once I asked about Pythonic join in Common Lisp. @Sylwester answered nicely in https://stackoverflow.com/a/50651643/9690090 a definition using format. We modify this definition to:

(defun join (l &key (sep ""))
  (format nil (format nil "~a~a~a" "~{~a~^" sep "~}") l))

(I just changed default separator to "" to not to have to use it.)

Now, you can wrap this join around your very first solution.

Or around @WillNess's solution.

(join (mapcar (lambda (a b) (if (char= a b) a "")) "abcef" "abcdf"))
;; => "abcf"

Without join

Joining strings

If we don't want to do it without this function join, we could also apply reduce:

(reduce (lambda (a b) (format nil "~A~A" a b))
  (map 'list (lambda (a b) (if (char= a b) (string a) "")) "abcef" "abcdf"))

Joining characters

One can also do as well:

(reduce (lambda (a b) (format nil "~A~A" a b))
  (map 'list (lambda (a b) (if (char= a b) a #\null)) "abcef" "abcdf"))

Answer 2

One could also use:

(loop for a across "abcdf"
      for b across "abcef"
      when (char= a b) collect a into res     ;; `res` = `result`
      finally (return (coerce res 'string)))  ;; => "abcf"

This captures all common characters of both strings.

If you want loop to break upon the very first mismatch:

(loop for a across "abcdf"
      for b across "abcef"
      when (char= a b) collect a into res
      else return (coerce res 'string))     ;; => "abc"

In this way, you have all the coercion inside the loop expression.

Answer 3

A "lispy" solution:

[7]> (map 'list #'(lambda (a b) (if (char= a b) (string a) ""))
          "abcef" "abcdf")

("a" "b" "c" "" "f")

[6]> (apply #'concatenate 'string 
       (map 'list #'(lambda (a b) (if (char= a b) (string a) ""))
            "abcef"
            "abcdf"))
"abcf"

Using apply is usually frowned upon since it's supposed to have a hard limit to the number of the arguments.

On the other hand, this calls the library function concatenate, and it could conceivably be implemented wisely for the 'string output type, avoiding quadratic behavior.

The usually advisable alternative to apply, reduce, is more likely to cause the quadratic behavior here, because ostensibly it is oriented to pairwise reductions.

Or perhaps they will be both equally good or bad in this regard. Still, if you know your strings aren't too long, this solution will be acceptable anyway.

Answer 4

I was thinking, one could find out first position which differs, firstly, by applying char= on each element of the strings:

(map 'list #'char= "abcd" "abce")
;; => (T T T NIL)

And subsequently returning the index of first occurrence of NIL:

(position nil (map 'list #'char= "abcd" "abce"))
;; => 3

Subsequently, one could slice the common string using subseq:

(subseq "abcd" 0 3)
;; => "abc"

So, alltogether:

(defun common-string (x y)
  (subseq x 0 (position nil (map 'list #'char= x y))))

it works:

(common-string "abcdf" "abcef")
;; => "abc"  

Although f is common, since it appears after the first difference d and e, it gets ignored.

Recursion

More efficient might be recursion.

(defun common-string (s1 s2)
  (let ((list1 (coerce s1 'list))
        (list2 (coerce s2 'list)))
    (labels ((recur (l1 l2 &optional (res ""))
               (cond ((char= (car l1) (car l2))
                      (recur (cdr l1) (cdr l2) (format nil "~a~a" res (car l1))))
                     (t res))))
      (helper list1 list2))))

Answer 5

The ITERATE loop replacement library lets you specify a type in its version of collect to specify what to return instead of the default list:

CL-USER> (iter
           (for a in-string "abcd")
           (for b in-string "abce")
           (when (char= a b)
             (collect a result-type string)))
"abc"

Also note it has an iteration form specialized for strings (in-string), though the generic vector form (in-vector) would work too.

Answer 6

Another way (it does not assume anything about elements position)

    (defun only-matching (seq1 seq2)
      (remove-if-not (lambda (c) (find c seq1)) seq2))

    CL-USER> (only-matching "abcd" "abce")
    "abc"
    CL-USER> (only-matching "abdc" "abec")
    "abc"`

or

(coerce
 (intersection (coerce "abdc" 'list)
               (coerce "abec" 'list))
 'string)

which does not preserve order also

Note: remove-if-not is deprecated 'officially'.

Answer 7

Use map to loop over multiple lists simultaneously

(map 'string #'(lambda (a b) (if (char= a b) a #\Rubout)) "abce" "abcd")

'string coerces resulting list into a string. #\Rubout get's coerced to a zero-length string. #\Backspace would even delete the last character.

Answer 8

Another possibility is to use mismatch as in the comment of David Hodge:

CL-USER> (defun f(a b)
           (let ((pos (mismatch a b)))
             (concatenate 'string (subseq a 0 pos) (subseq a (1+ pos)))))
F
CL-USER> (f "abcdefg" "abcxefg")
"abcefg"

Answer 9

(loop with result = ""
      for a across "abcd"
      for b across "abce"
      when (char= a b)
        do (setf result (concatenate 'string result (string a)))
      finally (return result))

Repeated concatenate are not a that good idea for longer strings.

Alternatives:

Loop into a list and coercing to a string

CL-USER 3 > (loop for a across "abcd"
                  and b across "abce"
                  when (char= a b) collect a into list
                  finally (return (coerce list 'string)))
"abc"

Using stream and converting it to a string

CL-USER 4 > (with-output-to-string (*standard-output*)
              (loop for a across "abcd"
                    and b across "abce"
                    when (char= a b) do (write-char a)))
"abc"

Using an adjustable string

CL-USER 5 > (loop with string = (make-array 0
                                            :element-type 'character
                                            :adjustable t
                                            :fill-pointer 0)
                  for a across "abcd"
                  for b across "abce"
                  when (char= a b) do (vector-push-extend a string)
                  finally (return string))
"abc"