Question

我正在学习Lisp。我已经实现了一个通用的lisp函数，该函数合并了两个使用递归按字母顺序排序的字符串。这是我的代码，但有一些错误，我没弄明白。

(defun merge (F L)
    (if (null F)
        (if (null L)
            F         ; return f
            ( L ))    ; else return L
        ;else if
        (if (null L)
            F)        ; return F
    ;else if
    (if (string< (substring F 0 1) (substring L 0 1)
        (concat 'string (substring F 0 1) (merge (substring F 1 (length F)) L)))
    ( 
        (concat 'string (substring L 0 1) (merge F (substring L 1 (length L)) ))
    ))))

编辑：我只是想合并两个字符串，如; 输入是字符串a = adf和字符串b = beg 结果或输出应该是; abdefg

提前致谢。

Answer 1

使用string<是一种过度杀伤，应该使用char<代替，如Kaz所示。在每个步骤重新计算length将使该算法成为二次方，因此应该避免。使用sort“伪造它”使其成为O（n log n）而不是O（n）。始终使用concatenate 'string可能会导致不必要的遍历的额外成本。

这是一个自然的递归解决方案：

(defun str-merge (F L)
  (labels ((g (a b)
             (cond
               ((null a) b)
               ((null b) a)
               ((char< (car b) (car a))
                  (cons (car b) (g a (cdr b))))
               (t (cons (car a) (g (cdr a) b))))))
    (coerce (g (coerce F 'list) (coerce L 'list)) 'string)))

但是，Common Lisp没有tail call优化保证，更不用说tail recursion modulo cons优化保证（即使后者被描述为as early as 1974，使用“Lisp 1.6” rplaca和rplacd字段赋值运算符“）。所以我们必须将其作为循环手动编码：

(defun str-merge (F L &aux (s (list nil)) )
  (do ( (p s (cdr p))
        (a (coerce F 'list) (if q a (cdr a)))
        (b (coerce L 'list) (if q (cdr b) b))
        (q nil))
      ( (or (null a) (null b))
          (if a (rplacd p a) (rplacd p b))
          (coerce (cdr s) 'string))
    (setq q (char< (car b) (car a)))
    (if q
      (rplacd p (list (car b)))
      (rplacd p (list (car a))))))

Answer 2

根据您的评论判断，您似乎正在尝试将if用于一系列条件（例如其他一些语言中的一系列else if）。为此，您可能需要cond。

我用if替换了cond并清除了其他一些错误，并且它有效。

(defun empty (s) (= (length s) 0))

(defun my-merge (F L)
  (cond 
   ((empty F)
    (if (empty L)
      F 
      L)) 
   ((empty L)
    F)
   (t
    (if (string< (subseq F 0 1) (subseq L 0 1))
      (concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L)) 
      (concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))

您的测试用例按照您的要求出现：

* (my-merge "adf" "beg")

"abdefg"

Answer 3

有很多好的答案，为什么还要添加一个呢？好吧，下面的内容可能比其他答案更有效。

(defun merge-strings (a b)
  (let* ((lena (length a))
         (lenb (length b))
         (len (+ lena lenb))
         (s (make-string len)))
    (labels
        ((safe-char< (x y)
           (if (and x y) (char< x y)
               (not (null x))))
         (choose-next (x y)
           (let ((ax (when (< x lena) (aref a x)))
                 (by (when (< y lenb) (aref b y)))
                 (xy (+ x y)))
             (cond
               ((= xy len) s)
               ((safe-char< ax by)
                (setf (aref s xy) ax)
                (choose-next (1+ x) y))
               (t
                (setf (aref s xy) by)
                (choose-next x (1+ y)))))))
      (choose-next 0 0))))

(merge-strings "adf" "beg")

特别是在内存分配意义上它更有效 - 它只分配足够的内存来编写结果字符串，从不强制任何东西（从列表到字符串或从数组到字符串等）它可能看起来不是很漂亮，但是这是因为它试图只进行一次计算。

当然，这不是编写此功能的最有效方式，但编程绝对没有效率并不会让你走得太远。

Answer 4

一种递归的方式（根据评论修复 - 其他解决方案也可以获得IF形式）。

(defun merge-strings (a b)
  (concatenate 'string
               (merge-strings-under a b)))

(defun merge-strings-under (a b)
  (when (and
       (= (length a)
          (length b))
       (> (length a) 0))
    (append (if (string< (aref a 0) (aref b 0))
                (list (aref a 0) (aref b 0))
                (list (aref b 0) (aref a 0)))
            (merge-strings-under (subseq a 1)
                           (subseq b 1)))))

这是一种迭代的方法。

(concatenate 'string 
    (loop for i across "adf" for j across "beg" nconc (list i j)))

请注意，这些依赖于将字符串构建为字符列表，然后对其进行矢量化（字符串是字符向量）。

您还可以编写更多C-esque方法......

(defun merge-strings-vector (a b)
  (let ((retstr (make-array (list (+
                                   (length a)
                                   (length b)))
                            :element-type 'character)))
    (labels ((merge-str (a b i)
               (when (and
                    (= (length a)
                       (length b))
                    (/= i (length a)))
                 (setf (aref retstr (* 2 i)) (aref a i))
                 (setf (aref retstr (1+ (* 2 i))) (aref b i))
                 (merge-str a b (1+ i)))))

      (merge-str a b 0)
      retstr)))

请注意，这个 - 与其他2不同 - 在功能中有副作用。它也是，imo，更难以理解。

所有3个在SBCL 56上执行不同数量的周期;在我的大多数试验中，每个似乎需要6K到11K。我不确定为什么。

如何合并使用递归在lisp中按字母顺序排序的两个字符串

4 个答案: