正しい文(クイズ) in Common Lisp DouKaku?

「この文は0が□個，1が□個，...，9が□個あります」
が正しくなるように□を埋めてください．数値は10進数とします．
一般のn(<=16で可)進数でも解いてみてください．

たとえば2進数なら
「この文は0が11個，1が100個あります」
となります．

いい方法が思いつかなかったため多重ループ生成 & eval してしまいました。

入る数字は n=2 なら 8 未満、n>2 なら n^2 未満と評価できました。
というわけで理論上は停止性を保障できています。

;; format の部分はもっときれいにやる方法がないものでしょうか……

(defun bound (n) (if (= n 2) 8 (* n n)))

(defun solution-p (n &rest nums)
  (let ((s (format nil (format nil "~~{~~~DR~~}" n) nums)))
    (loop for i from 0 below n and a in nums
      unless (= (1- a) (count (digit-char i n) s)) return nil
      finally (return t))))

(defun gen-solver (n i bound chars vars)
  (if (= i n)
      `(if (solution-p ,n ,@vars)
           (format t "この文は~@?あります~%"
                   (format nil "~~@{~~Cが~~~DR個~~^，~~}" ,n)
                   ,@(apply #'nconc (mapcar #'list chars vars))))
    `(loop for ,(nth i vars) from 0 below ,bound do
       ,(gen-solver n (1+ i) bound chars vars))))

(defun solve (n)
  (let ((code (gen-solver n 0 (bound n)
                          (loop for i from 0 below n collect (digit-char i n))
                          (loop repeat n collect (gensym)))))
    ;; (eval code)
    (funcall (compile nil (eval `(lambda () ,code))))
    ))

n>2 のときは n+2 未満しか入らないかな？あと、文に表れる数字の個数を使って枝刈りできますね。これで n=8 のときが1分で終わりました。 n<=8 での出力結果はすべて shiro さんの #4367 と同じです。

(defun bound (n) (if (= n 2) 8 (+ n 2)))

(defun check (n &rest nums)
  (<= (reduce (lambda (s x) (+ s (- x (floor (log x n)) 1))) nums
              :initial-value 0)
      n))

(defun solution-p (n &rest nums)
  (let ((s (format nil (format nil "~~{~~~DR~~}" n) nums)))
    (loop for i from 0 below n and a in nums
      unless (= (1- a) (count (digit-char i n) s)) return nil
      finally (return t))))

(defun gen-solver (n i bound chars vars)
  (if (= i n)
      `(if (solution-p ,n ,@vars)
           (format t "この文は~@?あります~%"
                   (format nil "~~@{~~Cが~~~DR個~~^，~~}" ,n)
                   ,@(apply #'nconc (mapcar #'list chars vars))))
    `(loop for ,(nth i vars) from 1 below ,bound
       ,@(if (> n (1+ i)) `(while (check ,n ,@(subseq vars 0 i))) ()) do
       ,(gen-solver n (1+ i) bound chars vars))))

(defun solve (n)
  (let ((code (gen-solver n 0 (bound n)
                          (loop for i from 0 below n collect (digit-char i n))
                          (loop repeat n collect (gensym)))))
    ;; (eval code)
    (funcall (compile nil (eval `(lambda () ,code))))
    ))

DouKaku?

正しい文(クイズ)

Posted feedbacks - Common Lisp

Index

Feed

Other

Link

Pathtraq