Anonymous user
Set puzzle: Difference between revisions
Added Common Lisp
imported>Rowsety Moid (Added Acornsoft Lisp) |
imported>Rowsety Moid (Added Common Lisp) |
||
Line 1,169:
}</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}}==
| |||