Created
October 25, 2014 18:10
-
-
Save yottahmd/87c101091e2b8fe52993 to your computer and use it in GitHub Desktop.
四則逆算問題ランダム生成
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment