Set puzzle: Difference between revisions
Content added Content deleted
imported>Rowsety Moid (Added Acornsoft Lisp) |
imported>Rowsety Moid (Added Common Lisp) |
||
Line 1,169: | Line 1,169: | ||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
=={{header|Common Lisp}}== |
|||
{{trans|Acornsoft Lisp}} |
|||
<syntaxhighlight lang="lisp"> |
|||
(defparameter numbers '(one two three)) |
|||
(defparameter shadings '(solid open striped)) |
|||
(defparameter colours '(red green purple)) |
|||
(defparameter symbols '(oval squiggle diamond)) |
|||
(defun play (&optional (n-cards 9)) |
|||
(find-enough-sets n-cards (floor n-cards 2))) |
|||
(defun find-enough-sets (n-cards enough) |
|||
(loop |
|||
(let* ((deal (random-sample n-cards (deck))) |
|||
(sets (find-sets deal))) |
|||
(when (>= (length sets) enough) |
|||
(show-cards deal) |
|||
(show-sets sets) |
|||
(return t))))) |
|||
(defun show-cards (cards) |
|||
(format t "~D cards~%~{~(~{~10S~}~)~%~}~%" |
|||
(length cards) cards)) |
|||
(defun show-sets (sets) |
|||
(format t "~D sets~2%~:{~(~@{~{~8S~}~%~}~)~%~}" |
|||
(length sets) sets)) |
|||
(defun find-sets (deal) |
|||
(remove-if-not #'is-set (combinations 3 deal))) |
|||
(defun is-set (cards) |
|||
(every #'feature-makes-set (transpose cards))) |
|||
(defun feature-makes-set (feature-values) |
|||
(or (all-same feature-values) |
|||
(all-different feature-values))) |
|||
(defun combinations (n items) |
|||
(cond |
|||
((zerop n) '(())) |
|||
((null items) '()) |
|||
(t (append |
|||
(mapcar (lambda (c) (cons (car items) c)) |
|||
(combinations (1- n) (cdr items))) |
|||
(combinations n (cdr items)))))) |
|||
;;; Making a deck |
|||
(defun deck () |
|||
;; The deck has to be made only once |
|||
(or (get 'deck 'cards) |
|||
(setf (get 'deck 'cards) (make-deck)))) |
|||
(defun make-deck () |
|||
(add-feature numbers |
|||
(add-feature shadings |
|||
(add-feature colours |
|||
(add-feature symbols |
|||
(list '())))))) |
|||
(defun add-feature (values deck) |
|||
(mapcan (lambda (value) |
|||
(mapcar (lambda (card) (cons value card)) |
|||
deck)) |
|||
values)) |
|||
;;; Utilities |
|||
(defun random-sample (n items) |
|||
(let ((len (length items)) |
|||
(taken '())) |
|||
(dotimes (_ n) |
|||
(loop |
|||
(let ((i (random len))) |
|||
(unless (find i taken) |
|||
(setq taken (cons i taken)) |
|||
(return))))) |
|||
(mapcar (lambda (i) (nth i items)) taken))) |
|||
(defun all-same (values) |
|||
(every #'eql values (rest values))) |
|||
(defun all-different (values) |
|||
(every (lambda (v) (= (count v values) 1)) |
|||
values)) |
|||
(defun transpose (rows) |
|||
(apply #'mapcar #'list rows)) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
Calling <code>(play 12)</code> will output: |
|||
<pre> |
|||
12 cards |
|||
two open red oval |
|||
three solid red squiggle |
|||
one striped red oval |
|||
three solid green squiggle |
|||
three solid green diamond |
|||
three solid red oval |
|||
one open purple squiggle |
|||
two solid red diamond |
|||
three open red squiggle |
|||
two striped green diamond |
|||
two striped red squiggle |
|||
three solid purple oval |
|||
6 sets |
|||
two open red oval |
|||
one striped red oval |
|||
three solid red oval |
|||
two open red oval |
|||
two solid red diamond |
|||
two striped red squiggle |
|||
three solid red squiggle |
|||
three solid green diamond |
|||
three solid purple oval |
|||
one striped red oval |
|||
two solid red diamond |
|||
three open red squiggle |
|||
three solid green squiggle |
|||
one open purple squiggle |
|||
two striped red squiggle |
|||
three solid red oval |
|||
one open purple squiggle |
|||
two striped green diamond |
|||
</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |