Question

这很复杂，我希望有一种更简单的方法。

我正在将一个新生成的社交网站“建议连接”列表与“阻止建议”列表进行比较。第一个列表看起来像这样：

((12 :mutuals 8 :ranking 8)(43 :mutuals 2 :mutual-groups (2) :ranking 4) ... )

第一个值是用户ID，每个子列表的cdr中的plist基本上是为什么建议这个人的“原因”。

第二个列表如下：

((12 . 2) (3 . 4) (43 . 3) ...)

汽车是用户ID，而cdr是他们被“阻止”用户建议时的排名。

我想为第一个列表中的每个子列表找到一种方法，将其与阻止的建议列表进行比较。有三种可能的结果：

没有相应的条目=＆gt;将建议留在清单中。
存在相应的条目，并且排名字段是5或更高=＆gt;将建议留在列表中，并从其索引中删除被阻止的建议。
有相应的条目，但排名相同或在5 =＆gt;范围内。从建议列表中删除建议。

我目前执行此操作的代码使用LOOP。这是我尽可能拼写出来的最好方式。

（目前在LET块中，但最终将在defun中。函数(remove-suggestion)是我自己的函数，用于修改哈希表。）

    (let ((userid 10753) ; my userid in this program, for example
          (suggestion-list '((12 :mutuals 8 :ranking 8)(43 :mutuals 2 :mutual-groups (2) :ranking 4) (4 :mutuals 10 :ranking 10)))
          (blocked-list '((12 . 2) (3 . 4) (43 . 3)))
      (remove nil
        (loop for suggestion in suggestion-list
              for sug-id = (car suggestion)
              for sug-rank = (getf (cdr suggestion) :ranking)
              collect
                (loop for (block-id . block-rank) in blocked-list
                      until (= block-id sug-id)
                      finally
                       (if (/= block-id sug-id (return suggestion)
                         (when (>= (- sug-rank block-rank) 5)
                           (progn
                             (remove-suggestion block-id userid :blocked t)
                             (return suggestion))))))))

当我在REPL中评估这个时，我得到：

((12 :mutuals 8 :ranking 8)) (4 :mutuals 10 :ranking 10))

这是完全正确的，因为即使用户12之前被阻止，他们的排名上升所以他们被保留。用户43被删除，因为他们的排名不够高。用户4被保留，因为阻止列表中没有相应的条目。

我真的希望有办法更干净地做到这一点。也许使用remove，remove-if，mapcar和/或lambda的某种组合？

我知道我可以使用defparameter存储有问题的列表，然后使用

(remove suggested-contact <location> :key #'car)

这是我以前做的，但我不太喜欢这个概念。

如果你到最后，恭喜！

Answer 1

好的，你可以用2 remove-if s - 1为每个列表做到这一点。

第一个：

(remove-if (lambda (e)
             (let ((blocked (assoc (first e)
                                   '((12 . 2) (3 . 4) (43 . 3) ...)))
               (and blocked (< (cdr blocked) 5))))
           '((12 :mutuals 8 :ranking 8)
             (43 :mutuals 2 :mutual-groups (2) :ranking 4)
             ...))

第二个：

(remove-if (lambda (e)
             (and (member (car e)
                          '((12 :mutuals 8 :ranking 8)
                            (43 :mutuals 2 :mutual-groups (2) :ranking 4)
                            ...)
                          :key 'first)
                  (>= (cdr e) 5))
           '((12 . 2) (3 . 4) (43 . 3) ...))

Answer 2

感谢Vsevolod，这是我的闪亮新功能，我很确定，我可以一次性完成我需要的所有功能。我还使用了一个照应and来消除let块。

(defun remove-blocked-suggestions (suggestion-list &optional (userid *userid*))

  (remove-if #'(lambda (suggestion)
                 (aand (assoc (car suggestion) (db userid :blocked-suggestions))
                       (if (< (- (getf (cdr suggestion) :ranking)
                                 (cdr it)) 5)
                         t
                         (progn
                           (remove-suggestion (car it) userid :blocked t)
                           nil))))
             suggestion-list))

通过将它们与Common Lisp中的alist进行比较来删除列表中的子列表

2 个答案: