Set, the card game: Difference between revisions

Added Common Lisp
imported>Rowsety Moid
(Added Acornsoft Lisp)
imported>Rowsety Moid
(Added Common Lisp)
Line 194:
[ONE RED SOLID SQUIGGLE] [THREE RED SRIPED DIAMOND] [TWO RED OPEN OVAL]
-------------------------
</pre>
 
=={{header|Common Lisp}}==
 
The [[Set puzzle]] task is so similar that the [[Set puzzle#Common_Lisp|Common Lisp solution]] there could be used with only slight modification. Here we take a somewhat more different approach by creating the deck as a vector, so that it can be shuffled more efficiently, rather than taking a random sample from the deck represented as a list.
 
Compare [[#Acornsoft_Lisp|Acornsoft Lisp]] above.
 
<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))
(let* ((deck (make-deck))
(deal (take n-cards (shuffle deck)))
(sets (find-sets deal)))
(show-cards deal)
(show-sets sets)))
 
(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 make-deck ()
(let ((deck (make-array (list (expt 3 4))))
(i -1))
(dolist (n numbers deck)
(dolist (sh shadings)
(dolist (c colours)
(dolist (sy symbols)
(setf (svref deck (incf i))
(list n sh c sy))))))))
 
;;; Utilities
 
(defun shuffle (deck)
(loop for i from (1- (length deck)) downto 0
do (rotatef (elt deck i)
(elt deck (random (1+ i))))
finally (return deck)))
 
(defun take (n seq) ; returns a list
(loop for i from 0 below n
collect (elt seq i)))
 
(defun all-same (values)
(every #'eql values (rest values)))
 
(defun all-different (values)
(every (lambda (v) (= (count v values) 1))
values))
 
(defun transpose (list-of-rows)
(apply #'mapcar #'list list-of-rows))
</syntaxhighlight>
 
{{Out}}
 
Depending on which Common Lisp you use, calling <code>(play)</code> might output:
 
<pre>
12 cards
three solid purple diamond
one striped green squiggle
two striped purple diamond
three open purple diamond
three striped red squiggle
one solid green squiggle
three open purple oval
two open green squiggle
two solid red diamond
three open red squiggle
three solid red oval
two solid green squiggle
 
1 sets
 
one striped green squiggle
three open purple oval
two solid red diamond
</pre>
 
Anonymous user