Set puzzle: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
m (→{{header|Wren}}: Minor tidy) |
||
| (9 intermediate revisions by 4 users not shown) | |||
Line 75:
:purple, three, oval, open
<br><br>
=={{header|Acornsoft Lisp}}==
<syntaxhighlight lang="lisp">
(setq numbers '(one two three))
(setq shadings '(solid open striped))
(setq colours '(red green purple))
(setq symbols '(oval squiggle diamond))
(defun play ((n-cards . 9))
(find-enough-sets n-cards (quotient n-cards 2)))
(defun find-enough-sets (n-cards enough (deal) (sets))
(loop
(setq deal (random-sample n-cards (deck)))
(setq sets (find-sets deal))
(while (lessp (length sets) enough)
(show-cards deal)
(printc)
(show-sets sets))))
(defun show-cards (cards)
(printc (length cards) '! cards)
(map printc cards))
(defun show-sets (sets)
(printc (length sets) '! sets)
(map '(lambda (set)
(printc)
(map printc set))
sets))
(defun find-sets (deal)
(keep-if 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
(mapc '(lambda (c) (cons (car items) c))
(combinations (sub1 n) (cdr items)))
(combinations n (cdr items))))))
'( Making a deck )
(defun deck ()
' ( The deck has to be made only once )
(cond ((get 'deck 'cards))
(t (put '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)
(flatmap '(lambda (value)
(mapc '(lambda (card) (cons value card))
deck))
values))
'( Utilities )
(defun all-same (values)
(every '(lambda (v) (eq v (car values)))
values))
(defun all-different (values)
(every '(lambda (v) (onep (count v values)))
values))
(defun count (v values (n . 0))
(loop (until (null values) n)
(cond ((eq (car values) v) (setq n (add1 n))))
(setq values (cdr values))))
(defun every (test suspects)
(or (null suspects)
(and (test (car suspects))
(every test (cdr suspects)))))
(defun transpose (rows)
(apply mapc (cons list rows)))
(defun reverse (list (result . ()))
(map '(lambda (e) (setq result (cons e result)))
list)
result)
(defun append (a b)
(reverse (reverse a) b))
(defun flatmap (_f_ _list_)
(cond ((null _list_) '())
(t (append (_f_ (car _list_))
(flatmap _f_ (cdr _list_))))))
(defun keep-if (_p_ _items_ (_to_keep_))
(map '(lambda (_i_)
(cond ((_p_ _i_)
(setq _to_keep_ (cons _i_ _to_keep_)))))
_items_)
(reverse _to_keep_))
</syntaxhighlight>
{{Out}}
Calling <code>(play)</code> will output:
<pre>
9 cards
(three open red oval)
(three solid green diamond)
(two solid red squiggle)
(one open red oval)
(two striped green oval)
(one striped red diamond)
(three solid purple oval)
(one solid purple oval)
(three solid purple diamond)
4 sets
(three open red oval)
(two solid red squiggle)
(one striped red diamond)
(three open red oval)
(two striped green oval)
(one solid purple oval)
(three solid green diamond)
(two solid red squiggle)
(one solid purple oval)
(one open red oval)
(two striped green oval)
(three solid purple oval)
</pre>
=={{header|Ada}}==
Line 1,020 ⟶ 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}}==
Line 1,197 ⟶ 1,484:
purple one squiggle striped
green three diamond striped</pre>
=={{header|EasyLang}}==
<syntaxhighlight>
attr$[][] &= [ "one " "two " "three" ]
attr$[][] &= [ "solid " "striped" "open " ]
attr$[][] &= [ "red " "green " "purple" ]
attr$[][] &= [ "diamond" "oval" "squiggle" ]
#
subr init
for card = 0 to 80
pack[] &= card
.
.
proc card2attr card . attr[] .
attr[] = [ ]
for i to 4
attr[] &= card mod 3 + 1
card = card div 3
.
.
proc printcards cards[] . .
for card in cards[]
card2attr card attr[]
for i to 4
write attr$[i][attr[i]] & " "
.
print ""
.
print ""
.
proc getsets . cards[] set[] .
set[] = [ ]
for i to len cards[]
card2attr cards[i] a[]
for j = i + 1 to len cards[]
card2attr cards[j] b[]
for k = j + 1 to len cards[]
card2attr cards[k] c[]
ok = 1
for at to 4
s = a[at] + b[at] + c[at]
if s <> 3 and s <> 6 and s <> 9
ok = 0
.
.
if ok = 1
set[] &= cards[i]
set[] &= cards[j]
set[] &= cards[k]
.
.
.
.
.
proc run ncards nsets . .
#
repeat
init
cards[] = [ ]
for i to ncards
ind = random len pack[]
cards[] &= pack[ind]
pack[ind] = pack[len pack[]]
len pack[] -1
.
getsets cards[] set[]
until len set[] = 3 * nsets
.
print "Cards:"
printcards cards[]
print "Sets:"
for i = 1 step 3 to 3 * nsets - 2
printcards [ set[i] set[i + 1] set[i + 2] ]
.
.
run 9 4
print " --------------------------"
run 12 6
</syntaxhighlight>
=={{header|EchoLisp}}==
Line 3,785 ⟶ 4,151:
('green', 'three', 'oval', 'open'),
('purple', 'three', 'squiggle', 'solid'))]</pre>
=={{header|Quackery}}==
<code>cards</code>, <code>sets</code>, and <code>echocard</code> are defined at [[Set, the card game#Quackery]].
<syntaxhighlight lang="Quackery"> [ temp put
[ dup cards dup
sets dup size
temp share != while
2drop again ]
swap
say "Cards:" cr
witheach echocard
cr
say "Sets:" cr
witheach
[ witheach echocard cr ]
drop
temp release ] is task ( n n --> )
basic task
cr
advanced task</syntaxhighlight>
{{out}}
<pre>BASIC
Cards:
three striped purple ovals
two solid green squiggles
two open green squiggles
one open purple squiggle
three striped red squiggles
two striped red ovals
one solid purple squiggle
two solid red diamonds
two open purple diamonds
Sets:
two open green squiggles
three striped red squiggles
one solid purple squiggle
two solid green squiggles
two striped red ovals
two open purple diamonds
two solid green squiggles
one open purple squiggle
three striped red squiggles
three striped purple ovals
one solid purple squiggle
two open purple diamonds
ADVANCED
Cards:
one open green oval
two solid purple squiggles
one striped red diamond
three solid purple diamonds
two solid green squiggles
two open purple squiggles
two open green ovals
two striped red squiggles
two open green diamonds
two striped red ovals
three open purple ovals
one open red oval
Sets:
two open green ovals
three open purple ovals
one open red oval
two solid green squiggles
two open purple squiggles
two striped red squiggles
one striped red diamond
two solid green squiggles
three open purple ovals
one striped red diamond
three solid purple diamonds
two open green diamonds
two solid purple squiggles
two open green diamonds
two striped red ovals
one open green oval
three solid purple diamonds
two striped red squiggles
</pre>
=={{header|Racket}}==
Line 4,348 ⟶ 4,812:
def nCards: $(1);
def nSets: $(2);
{sets: []} -> #
when <{sets: <[]($nSets..)>}> do $ !
otherwise
Line 4,356 ⟶ 4,820:
templates formatCard
def colours: colour´1:['red', 'green', 'purple'];
def symbols: symbol´1:['oval', 'squiggle', 'diamond'];
def numbers: number´1:['one', 'two', 'three'];
def shadings: shading´1:['solid', 'open', 'striped'];
$ -> '$colours($.colour);-$symbols($.symbol);-$numbers($.number);-$shadings($.shading);' !
end formatCard
Line 4,372 ⟶ 4,836:
end formatSets
[9,4] -> setPuzzle -> formatSets -> !OUT::write</syntaxhighlight>
{{out}}
<pre>
Line 4,615 ⟶ 5,078:
{{libheader|Wren-math}}
{{libheader|Wren-sort}}
<syntaxhighlight lang="
import "./trait" for Comparable
import "./fmt" for Fmt
import "./str" for Str
import "./math" for Nums
import "./sort" for Sort
import "random" for Random
| |||