re: Interleaving strings

Pascal J. Bourguignon wrote:

Eric Wolf <e...@boese-wolf.eu> writes:

Hi there!

 

I want to have a function, which interleaves strings. So if the input is
"aaa" "bbb" the result should be "ababab". If the input is "aaaa" "bbb"
"cc" the result shall be "abcabcaba". So you just put a character from
the first string into the result string then you put a character from
the second string into the result strings and so, until all input
strings are exhausted.

 

This is what I came up with, but I'm wondering, if there aren't better
ways in *Common Lisp*, which I'm not able to see. (Comings from C++ and
the likes):

 

(defun interleave-strings (&rest args)
  (if args
      (let* ((result-length (apply #'+ (mapcar #'length args)))
             (erg (make-array `(,result-length)
                              :element-type 'character
                              :fill-pointer 0)))
        ;;prepare the input, so we can count the used characters in a string
        ;;and know, when it is exhausted.
        (setf args (mapcar #'(lambda (arg)
                               (list 0 (length arg) arg))
                           args))
        ;;keep the last cons cell in mind        
        (let  ((last (last args)))
          ;;create a circular list, so we can wrap around
          (setf (cdr last) args)
          ;;loop over the circular list, keeping the actual position and the
          ;;position before
          (do* ((oldpos last pos)
               (pos args (cdr pos))
               (elem (car args) (car pos)))
              ((null elem) erg)
            (vector-push (char (third elem) (first elem)) erg)
            (incf (first elem))
            (if (not (< (first elem) (second elem)))
                (if (eql pos oldpos)
                    ;;if its the last remaining item, clear the circular list
                    (setf oldpos nil
                          pos nil)
                    ;;if there are more then one item, delete one entry
                    (setf (cdr oldpos) (cdr pos)
                          pos oldpos))))))
      ""))  

 

Please comment and suggest better ways.

 

Yours sincerely,

 

Eric

 
(defun interleave-strings (&rest strings)
  (with-output-to-string (*standard-output*)
    (loop
       :with indexes = (make-array (length strings) :initial-element 0)
       :with len     = (reduce (function max) strings :key (function length))

Note his error.  He assigns a value to len and then
never uses it.

       :for done     = t
       :do (map-into indexes (lambda (string index)
                               (when (< index (length string))
                                 (princ (aref string index))
                                 (incf index)
                                 (setf done nil))
                               index)
                     strings indexes)
       :until done)))

A good example of the wrong way to program.

There are two ways of constructing a software design: One way is
to make it so simple that there are obviously no deficiencies,
and the other way is to make it so complicated that there are no
obvious deficiencies.
  --- Charles Antony Richard Hoare

 
(defun test/interleave-strings ()
  (assert (string= (interleave-strings  "aaa" "bbb") "ababab"))
  (assert (string= (interleave-strings  "aaaa" "bbb" "cc") "abcabcaba"))
  :success)

newLISP

(define (interleave-strings)
  (let (result ""   strings (copy $args))
    (until (for-all empty? strings)
      (dotimes (i (length strings))
        (unless (empty? (nth i strings))
          (push (pop (nth i strings)) result -1))))
    result))

(interleave-strings "aa" "bbbbb" "c")

"abcabbbb"