find-waiting.lisp

;;; http://www.itmedia.co.jp/enterprise/articles/1004/03/news002_2.html

#+xyzzy
(require 'cmu_loop)

;; utils
(defmacro aif (test then &optional else)
  `(let ((it ,test)) (if it ,then ,else)))

(defmacro n-of (n expr)
  `(loop repeat ,n collect ,expr))

(defun range (start end)
  (loop for i from start to end collect i))

(defun rem1 (x xs)
  (loop for e on xs
    if (/= (car e) x) collect (car e) into acc
    else do (return (append acc (cdr e)))))

(defun setdiff (l1 l2)
  (loop for l = l2 then (rem1 n l)
    for n in l1
    finally (return l)))

(defun parse (str)
  (when (and (parse-integer str) (= (length str) 13))
    (sort (map 'list #'(lambda (c) (- (char-code c) 48)) str) #'<)))

(defun sortm (ms)
  (sort (copy-list ms) #'string<
	:key #'(lambda (s) (format () "~S" s))))

;; 七対子
(defun 7eyesp (ps)
  (let ((r (find-if #'(lambda (n) (= (count n ps) 1)) ps))
	(pairs (remove-if #'(lambda (n) (/= (count n ps) 2))
			  (remove-duplicates ps))))
    (when (and r (= (length pairs) 6))
      (values (list r) (mapcar #'(lambda (n) (list n n)) pairs)))))

(defun available (n all)
  (if (< (count n all) 4) n))

;; 和了牌
(defun wanted (rest all)
  (let* ((a (car rest)) (b (cadr rest))
	 (c (if b
		(case (- b a)
		  (0 (list (available a all)))
		  (1 (list (if (> a 1) (available (1- a) all))
			   (if (< b 9) (available (1+ b) all))))
		  (2 (list (available (1+ a) all))))
	      (list (available a all)))))
    (remove-if #'null c)))

;; main
(defun find-waiting (str)
  (let ((ps (parse str)) results)
    (labels
	((rec (melds rest &aux (len (length rest)))
	   (if (> len 2)
	       (dolist (n (remove-duplicates rest))
		 (dolist (m (list* (n-of 3 n) (range n (+ n 2))
				   (if (= len 4) (list (n-of 2 n)))))
		   (aif (setdiff m rest)
		       (rec `(,m ,@melds) it))))
	     (aif (wanted rest ps)
		 (pushnew (list (sortm melds) rest it)
			  results :test 'equal)))))
      (multiple-value-bind (r pairs) (7eyesp ps)
	(when r (rec pairs  r)))
      (rec () ps))
    (format t "~{~&~{~{(~{~A~})~} [~{~A~}] : {~{~A~^,~}}~}~}" results)))


(find-waiting "1112345678999")

; =>
; (11)(345)(678)(999) [12] : {3}
; (11)(123)(678)(999) [45] : {3,6}
; (11)(123)(456)(999) [78] : {6,9}
; (123)(456)(789)(99) [11] : {1}
; (11)(123)(456)(789) [99] : {9}
; (111)(456)(789)(99) [23] : {1,4}
; (111)(345)(678)(999) [2] : {2}
; (111)(234)(789)(99) [56] : {4,7}
; (111)(234)(678)(999) [5] : {5}
; (111)(234)(567)(99) [89] : {7}
; (111)(234)(567)(999) [8] : {8}