DouKaku?

(defun number-A-knows (pair)
  (if (null pair) nil (* (car pair) (cdr pair))))

(defun number-B-knows (pair)
  (if (null pair) nil (+ (car pair) (cdr pair))))

(defun uniq-if (item fn lst)
  "itemが、lstのpairにfnを適応した結果中に1度だけ現れる場合に、itemを返す。それ以外はnil"
  (if (eql (loop for x in lst 
                 when (equal (funcall fn item)
                             (funcall fn x))
                 count t)
           1)
    item))
(defun uniq-if-not (item fn lst)
  "itemが、lstのpairにfnを適応した結果中に2度以上現れる場合に、itemを返す。それ以外はnil"
  (if (> (loop for x in lst
               when (equal (funcall fn item)
                           (funcall fn x))
               count t)
         1)
    item))

(defun pair-A-dosenot-know-lst (pairs)
  "Aさん「(この情報だけでは)分かりません」"
  (loop for pair in pairs
        when (uniq-if-not pair #'number-A-knows pairs)
        collect it))
(defun pair-B-dosenot-know-lst (pairs)
  "Bさん「私も分かりません．」"
  (loop for pair in pairs
        when (uniq-if-not pair #'number-B-knows pairs)
        collect it))
(defun pair-B-knows-A-dosenot-know-lst (pairs)
  "Bさん「ただ，Aさんが『分かりません』というのは分かっていました」"
  (let* ((pair-A-dosenot-know-lst (pair-A-dosenot-know-lst pairs))
         (number-A-knows-lst (remove-duplicates 
                               (mapcar #'number-B-knows (pair-B-dosenot-know-lst pairs))))
         (A-lst-lst-expected-by-B (loop for n in number-A-knows-lst
                                        collect (loop for pair in pairs
                                                      when (eql n (number-B-knows pair))
                                                      collect pair))))
    (apply #'nconc (remove-if 
                     #'(lambda (lst)
                         (notevery
                           #'(lambda (x)
                               (member x pair-A-dosenot-know-lst :test #'equal))
                           lst))
                     A-lst-lst-expected-by-B))))
(defun pair-A-finds-answer-lst (pairs)
  "それを聞いたAさん「それなら，分かりました」"
  (let ((lst (pair-B-knows-A-dosenot-know-lst pairs)))
    (loop for x in lst
          when (uniq-if x #'number-A-knows lst)
          collect it)))
(defun pair-B-finds-answer-lst (pairs)
  "それを聞いたBさん「それなら，私も分かりました」"
  (let ((lst (pair-A-finds-answer-lst pairs)))
    (loop for x in lst
          when (uniq-if x #'number-B-knows lst)
          collect it)))

(defun answer (n)
  (let ((pairs (loop for i from 1 to n
                     append (loop for j from 1 to n
                                  when (<= i j)
                                  collect (cons i j)))))
    (pair-B-finds-answer-lst pairs)))