0

我正在学习 Lisp。我已经实现了一个 Common 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。

提前致谢。

4

4 回答 4

3

正如 Kaz 所示，使用string<是一种过度杀伤力，char<应改为使用。在每一步重新计算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 没有尾调用优化保证，更不用说尾递归模 cons优化保证（即使后者早在 1974 年就被描述，使用“Lisp 1.6rplaca和rplacd字段赋值运算符”）。因此，我们必须将其手动编码为自上而下的输出列表构建循环：

(defun str-merge (F L &aux (s (list nil)) )     ; head sentinel
  (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))              ;         FTW!
    (setq q  (char<  (car b)  (car a)))   ; the test result
    (if q
      (rplacd p (list (car b)))
      (rplacd p (list (car a))))))
于 2012-04-25T07:50:24.310 回答
2

从您的评论来看，您似乎正在尝试使用if一系列条件（如else if其他一些语言中的一系列 s ）。为此，您可能需要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"
于 2012-04-24T21:16:18.637 回答
2

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

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

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

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

于 2012-04-26T18:32:03.853 回答
-1

一种递归方式（根据评论修复 - 其他解决方案也可以获得 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 风格的方法...

(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，它也更难以理解。

在 SBCL 56 上执行所有 3 个循环需要不同数量的循环；在我的大部分试验中，每个似乎都在 6K 到 11K 之间。我不确定为什么。

于 2012-04-24T20:56:19.250 回答