四則逆算問題ランダム生成

gistfile1.lisp

(defparameter *problem-num* 10)
(if (> (length *args*) 0) (defparameter *problem-num* (parse-integer (car *args*))))
(setf *random-state* (make-random-state t))
(defun rand-elt (lst) (elt lst (random (length lst))))
(defun rand-range (min max) (let ((r (random (- max min)))) (+ r min)))
(defun 1+rand (m) (1+ (random m)))
(defun divisor-lst (num mindiv maxdiv)
  (let ((lst '()))
    (do ((n mindiv (1+ n)))
      ((or (>= n num)
           (>= n maxdiv)))
      (if (zerop (mod num n)) 
        (setq lst (append lst (list n)))))
    lst))
(defun create-formula-poland(answer maxlen) 
  (let ((remaindar 0) (stack ()))
    (labels ((pushform (op num)
               (if (zerop (length stack)) (setq remaindar num))
               (setq stack (append stack (list num)))
               (if op (progn (setq stack (append stack `(, op)))
                             (setq remaindar (funcall op remaindar num))))))
      (if (= maxlen 1)
        (pushform nil answer)
        (progn (pushform nil (1+rand answer))
               (labels ((choice-push(num)
                          (let ((divisor-lst (divisor-lst remaindar 2 100)))
                            (cond
                              ((and (> remaindar 1) (<= remaindar 20) (not (member '* stack)) (<= 25 (random 100))) (pushform '* (rand-range 2 11)))
                              ((<= 1 (length divisor-lst)) (pushform '/ (rand-elt divisor-lst)))
                              (t (pushform (rand-elt '(- +)) num))))))
                 (dotimes (random (1- maxlen)) (choice-push (1+rand answer))))
          (if (not (= remaindar answer)) 
            (if (< answer remaindar)
              (pushform '- (- remaindar answer))
              (pushform '+ (- answer remaindar))))))
      stack)))
(defun create-dummy-answers (answer dummy-num)
  (let ((lst ()))
    (loop until (= (length lst) dummy-num) collect 
          (let ((r (random 100)))
            (if (and (not (= r answer)) (not (member r lst))) 
              (setq lst (append lst (list r))))))
    lst))
(defun formula-to-problem (formula)
  (let ((answer-list ())
        (numbers (remove-if (lambda(x) (not (integerp x))) formula))) 
    (let ((answer (rand-elt numbers)))
      (setq answer-list (append answer-list (list answer)))
      (setq answer-list (append answer-list (create-dummy-answers answer 3)))
      (setq formula (mapcar (lambda (x) (if (and (integerp x) (eq answer x)) (progn (setq answer nil) '?) x)) formula))
      (list formula answer-list))))
(defun poland-to-normal(poland-lst)
  (let ((ret (list (car poland-lst))) (last-num (car poland-lst)) (last-op nil))
    (setq poland-lst (cdr poland-lst))
    (mapcar (lambda (x) (cond ((integerp x) (setq last-num x))
                              (t (progn (if (and (member x '(* /)) (member last-op '(+ -)))
                                          (setq ret (append '([) ret '(]))))
                                        (setq last-op x)
                                        (setq ret (append ret `(, x, last-num)))))))
            poland-lst) 
    ret))
(defun create-problem (answer) 
    (let ((problem-lst (formula-to-problem (poland-to-normal (create-formula-poland answer 3)))))
      (format
        t "\"~{~a~<~^ ~>~} = ~{~a~<~^ ~>~}\",~{~a~<~^,~>~}~%"
        (car problem-lst)
        (poland-to-normal (create-formula-poland answer (1+rand 2)))
        (cadr problem-lst))))
(dotimes (n *problem-num*) (create-problem (1+rand 100)))