RosettaCodeData/Task/Twelve-statements/TXR/twelve-statements.txr
2016-12-05 22:15:40 +01:00

36 lines
1.2 KiB
Text

(defmacro defconstraints (name size-name (var) . forms)
^(progn (defvar ,size-name ,(length forms))
(defun ,name (,var)
(list ,*forms))))
(defconstraints con con-count (s)
(= (length s) con-count) ;; tautology
(= (countq t [s -6..t]) 3)
(= (countq t (mapcar (op if (evenp @1) @2) (range 1) s)) 2)
(if [s 4] (and [s 5] [s 6]) t)
(none [s 1..3])
(= (countq t (mapcar (op if (oddp @1) @2) (range 1) s)) 4)
(and (or [s 1] [s 2]) (not (and [s 1] [s 2])))
(if [s 6] (and [s 4] [s 5]) t)
(= (countq t [s 0..6]) 3)
(and [s 10] [s 11])
(= (countq t [s 6..9]) 1)
(= (countq t [s 0..con-count]) 4))
(defun true-indices (truths)
(mappend (do if @1 ^(,@2)) truths (range 1)))
(defvar results
(append-each ((truths (rperm '(nil t) con-count)))
(let* ((vals (con truths))
(consist [mapcar eq truths vals])
(wrong-count (countq nil consist))
(pos-wrong (+ 1 (or (posq nil consist) -2))))
(cond
((zerop wrong-count)
^((:----> ,*(true-indices truths))))
((= 1 wrong-count)
^((:close ,*(true-indices truths) (:wrong ,pos-wrong))))))))
(each ((r results))
(put-line `@r`))