どう書く.orgで解けなかった問題の続き。

id:smeghead:20070731:muzu のコメント欄で、nkmrtksさんに教えてもらい(ありがとうございます)、ようやく自分の書いたコードで答えらしきものを導き出せるようになりました。

でも実際、nkmrtksさん*1のコードを動かしてテストコードを作り、解説のとおりに書いただけなので、全然、自分の力ではないですorz.

テストコード書きやすいように工程毎、関数に区切ってます。冗長だったり、無駄な処理とかもありますが、今日はここで力つきました。あと、ちょっとごにょごにょやってから、投稿しようと思います。

(defconstant *pairs* (loop for i from 1 to 13
append (loop for j from 1 to 13
when (<= i j)
collect (cons i j))))
(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 processA-1 (pairs)
(loop for pair in pairs
when (uniq-if-not pair #'number-A-knows pairs)
collect it))
(defun processB-1 (pairs)
(loop for pair in pairs
when (uniq-if-not pair #'number-B-knows pairs)
collect it))
(defun processB-2 (pairs)
(let (sum-list same-sum-list)
(setq sum-list (remove-duplicates (mapcar #'number-B-knows (processB-1 pairs))))
(setq same-sum-list (loop for n in sum-list
collect (loop for pair in pairs
when (eql n (number-B-knows pair))
collect pair)))
(setq same-sum-list (remove-if
#'(lambda (lst)
(member-if-not
#'(lambda (x)
(member x (processA-1 pairs) :test #'equal))
lst))
same-sum-list))
(apply #'nconc same-sum-list)))
(defun processA-2 (pairs)
(let ((lst (processB-2 pairs)))
(loop for x in lst
when (uniq-if x #'number-A-knows lst)
collect it)))
(defun processB-3 (pairs)
(let ((lst (processA-2 pairs)))
(loop for x in lst
when (uniq-if x #'number-B-knows lst)
collect it)))