使用lisp循环宏进行高级循环

时间:2018-05-31 23:37:24

标签: loops macros common-lisp

假设您有一个由列表组成的列表。例如,列表A:(list '(1 2 3) '(1 4 3) )。此外,您将获得一个列表B:'(0 2 3)。任务是:确定A的哪个子列表最匹配B.请注意,匹配意味着列表中相同位置的相同整数。因此,对于这种情况,答案是子列表'(1 2 3 )。如何使用lisp循环宏自动执行此操作?以下是我的尝试。

(defun select-most-specific-list (listA listB)
  (loop with candidate_sublist = '()
        for sublist in  listA
        do (loop for number1 in sublist
                 for number2 in listB
                 when (= number1 number2)
                 do (setq candidate_sublist sublist)
                 finally (return candidate_list))))

我给出了以下输入:

(select-most-specific-list (list '(1 2 3) '(1 4 3) ) '(0 2 3))

我得到NIL。 另外,我几乎可以肯定我的逻辑错了。通过上述输入,我希望它能够提供'(1 4 3)而不是正确答案'(1 2 3)。这是因为仔细观察我的逻辑会显示我没有存储所有比较的结果。因此,最后一次成功的比较错误地决定了最具体的子列表。我怎样才能做到这一点?

2 个答案:

答案 0 :(得分:4)

问题

(loop for number1 in sublist
      for number2 in listB
      when (= number1 number2)
      do (setq candidate_sublist sublist)
      finally (return candidate_list))

只要列表中有两个数字匹配,就会替换candidate_sublist,即使它比之前的绑定更糟糕。假设candidate_sublist(0 2 3),它等于输入列表(你不能比那更相似)。然后,迭代下一个候选者(0 9 9)。使用(= 0 0)后的代码,您可以更改candidate_sublist。在做出决定之前,你必须检查两个被比较列表中的所有值。

距离函数

您正尝试在列表中定义比较函数:如果列表更类似到列表,则列表更好 。这可以通过依赖距离函数来实现。 以下是足够好的:

(defun distance (a b)
  (count nil (mapcar #'= a b)))

或者,循环:

(defun distance (a b)
  (loop
     for aa in a
     for bb in b
     count (/= aa bb)))

因此,两个列表之间的差异越大,距离越远。

部分订单

但是,此比较定义了部分顺序,因为您可以轻松地拥有两个与输入同等接近的列表。 例如,给出以下列表:

(0 1 2)

(1 1 2)(0 1 1)都有相同数量的匹配值。

您不能只返回一个最佳答案,否则您将根据任意标准选择一个(例如实施细节,例如列表的遍历顺序)。 我要做的是计算与输入列表距离相等的所有列表。

(defun closest-lists (list candidates)
  (loop
     for candidate in candidates
     for distance = (distance list candidate)
     for better = T then (< distance min-distance)
     for min-distance = (if better distance min-distance)
     for best-matches = (cond
                          (better (list candidate))
                          ((= distance min-distance) (cons candidate best-matches))
                          (t best-matches))
     finally (return (values best-matches min-distance))))

概括

如@ Gwang-Jin Kim的评论所述,如果我们将closest-lists函数添加为参数,它甚至可以与其他距离函数一起使用。遵循sort的命名约定,我们可以定义一个predicate参数来指定比较函数,并使用key参数来指定如何检索要比较的值(得分)。然后,我们的函数实际上与列表无关,可以重命名为更通用:

(defun filter-by-score (candidates predicate &key (key #'identity))
  "Keep elements from CANDIDATES having the same best rank according to PREDICATE.

PREDICATE should return non-NIL if its first argument precedes its
second one. Elements are compared according the value returned by
applying KEY. The KEY function is guaranteed to be applied once only
for each element in CANDIDATES."
  (loop
     for candidate in candidates
     for score = (funcall key candidate)
     for better = T then (funcall predicate score best-score)
     for best-score = (if better score best-score)
     for best-items = (cond
                          (better (list candidate))
                          ((funcall predicate best-score score) best-items)
                          (t (cons candidate best-items)))
     finally (return (values best-items best-score))))

然后,我们之前的功能可以表示为:

(filter-by-score candidates #'< :key (lambda (u) (distance list u)))

但我们也可以这样做:

CL-USER> (filter-by-score '("a" "ab" "cd" "ed" "fe" "aaa" "bbb" "nnn") 
                          #'> :key #'length)
("nnn" "bbb" "aaa")
3

甚至:

CL-USER> (import 'alexandria:curry)
CL-USER> (ql:quickload :levenshtein)
CL-USER> (filter-by-score '("boat" "baobab" "brain" "biscuit")
                          #'<
                          :key (curry #'levenshtein:distance "ball"))
("brain" "boat")
3

答案 1 :(得分:2)

我把它分解为:

(defun similarity (list1 list2)
   (loop for number1 in list1                             
         for number2 in list2                             ;thanks @Rainer Joswig!
         count (= number1 number2)))                      ;and @jkiiski!

(defun most-similar-list (lists qry-list &key (dist-func #'similarity))
  (let* ((simils        (loop for l in lists               ;thanks @coredump!
                              collect (funcall dist-func l qry-list)))
         (max-simil     (reduce #'max simils))              ;thanks @Rainer Joswig!
         (idx-max-simil (position max-simil simils :test #'=)))
    (elt lists idx-max-simil)))

您的示例

(most-similar-list (list '(1 2 3) '(1 4 3) ) '(0 2 3))
;; (1 2 3)

<强>附录

如何定义distance

;; (defun distance (list1 list2)
;;   (apply '+ (loop for number1 in list1    ;reduce is better! by @Rainer Joswig
;;                   for number2 in list2    ;because of the limit of arg numbers
;;                   collect (if (= number1 number2) 1 0)))) ;for apply (max ~50
;; - the exact number is implementation-dependent - see comments by him)

更一般(收集所有最小距离/最相似的元素 - 如@coredump所示)

使用来自的功能 我为变量测试修改的Position of All Matching Elements in List

(defun all-positions (qry-el l &key (test #'=))
  (loop for el in l
        and pos from 0
        when (funcall test el qry-el)
          collect pos))

然后是解决方案:

(defun select-most-similar (lists qry-list &key (dist-func #'distance))
  (let* ((dists        (loop for l in lists               ;thanks @coredump!
                             collect (funcall dist-func l qry-list)))
         (max-dist     (reduce #'max dists))              ;thanks @Rainer Joswig!
         (max-dist-idxs (all-positions max-dist dists :test #'=)))
    (loop for i in max-dist-idxs
          collect (nth i lists))))

或者采用@ coredump的功能和概括(我用的不是min而是max):

(defun similarity (l1 l2)
  (loop for e1 in l1
        for e2 in l2
        count (= e1 e2)))

(defun most-specific-lists (lists one-list &key (dist-func #'similarity))
  (loop for l in lists
        for dist = (funcall dist-func l one-list)
        for max-dist = dist then (max dist max-dist)
        for max-dist-l = (list l) then 
          (cond ((= dist max-dist) (cons l max-dist-l))
                ((> dist max-dist) (list l))
                (t max-dist-l))
        finally (return (values max-dist-l max-dist))))