2

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

我正在将社交网站的新生成的“建议连接”列表与“阻止的建议”列表进行比较。第一个列表如下所示：

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

第一个值是用户id，每个子列表的cdr中的plist本质上就是推荐这个人的“理由”。

第二个列表如下所示：

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

car 是用户 id，cdr 是他们被“阻止”用户建议时的排名。

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

  • 将没有相应的条目 => 将建议留在列表中。
  • 有一个相应的条目并且排名字段高于或等于 5 => 将建议留在列表中并从其索引中删除被阻止的建议。
  • 有相应的条目但排名相同或在 5 以内 => 从建议列表中删除该建议。

我当前执行此操作的代码使用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)

这是我以前做过的，但从概念上讲我不喜欢那样。

如果你坚持到最后，恭喜！

4

2 回答 2

2

好的，您可以remove-if为每个列表使用 2 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) ...))
于 2014-01-31T20:25:44.263 回答
0

感谢 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))
于 2014-02-02T18:34:09.000 回答