Rosetta Code

Set puzzle: Difference between revisions

Page Discussion

Set puzzle (view source)

Revision as of 03:08, 7 July 2015

437 bytes added ,  8 years ago
m
→‎{{header|REXX}}: added/changed whitespace and comments, removed some superfluous logic statements.
No edit summary
m (→‎{{header|REXX}}: added/changed whitespace and comments, removed some superfluous logic statements.)
Line 2,208:
 
The particular set of cards dealt (show below) used Regina 3.90 under a Windows/XP environment.
<lang rexx>/*REXX program finds "sets" (solutions) for the SET puzzle (game). */
parse arg game seed . /*get optional # cards to deal. and seed*/
if game ==',' | game=='' then game=9 /*Not specified? Then use the default.*/
if seed==',' | seed=='' then seed=77 /* " " " " " " */
call aGame 0 /*with tell=0,: suppress the output. */
call aGame 1 /*with tell=1,: allow display " " output. */
exit sets /*stick a fork in it, we're all done. */
/*──────────────────────────────────AGAME subroutine────────────────────subroutine──────────────────────────*/
aGame: tell=arg(1); good=game%2 /*enable or /disable the showing of output. */
/* [↑] the GOOD var is the right # sets.*/
do seed=seed until good==sets /*generate deals until good # of sets.*/
call random ,,seed /*repeatability for lastthe invoke.RANDOM invokes.*/
call genFeatures /*generate various card game features. */
call genDeck /*generate a deck (with 81 "cards").*/
call dealer game /*deal a number of cards (for the game). */
call findSets game%2 /*find # of sets from the dealt cards. */
end /*until*/ /* [↓] when leaving, SETS is right num#.*/
return /*return to invoker of this subsubroutine. */
/*──────────────────────────────────DEALER subroutine───────────────────subroutine─────────────────────────*/
dealer: call sey 'dealing' game "cards:",,. /*shuffle and deal the cards. */
do cards=1 until cards==game /*keep dealing 'tiluntil donefinished.*/
_=random(1,words(##)); ##=delword(##,_,1) /*pick card; delete ita card. */
@.cards=deck._ /*add itthe card to the tableau.*/
call sey right('card' cards,30) " " @.cards /*display the card to screen. */
do j=1 for words(@.cards) /* [↓] define cells for card.cards*/
@.cards.j=word(@.cards,j) /*define a cell for a card.*/
end /*j*/
end /*cards*/
return
/*──────────────────────────────────DEFFEATURES subroutine──────────────subroutine────────────────────*/
defFeatures: parse arg what,v; _=words(v) /*obtain what is to define.be defined*/
if _\==values then do; call sey 'error,' what "features ¬=" values,.,.
exit -1
end /* [↑] check for typos./errors*/
do k=1 for words(values) /*define all possibles.the possible vals*/
call value what'.'k, word(values,k) /*define a card feature. */
end /*k*/
return
/*──────────────────────────────────GENDECK subroutine──────────────────subroutine────────────────────────*/
genDeck: #=0; ##= /*#: cards in deck; ##=: shuffle aid.*/
do num=1 for values; xnum = word(numbers, num)
do col=1 for values; xcol = word(colors, col)
do sym=1 for values; xsym = word(symbols, sym)
do sha=1 for values; xsha = word(shadings, sha)
#=#+1; ##=## #; deck.#=xnum xcol xsym xsha /*create a card.*/
end /*sha*/
end /*num*/
end /*sym*/
end /*col*/
return /*#: the number of cards in the deck. */
/*──────────────────────────────────GENFEATURES subroutine──────────────subroutine────────────────────*/
genFeatures: features=3; groups=4; values=3 /*define # featsfeatures,grps groups, vals.*/
numbers = 'one two three' ; call defFeatures 'number', numbers
colors = 'red green purple' ; call defFeatures 'color', colors
symbols = 'oval squiggle diamond' ; call defFeatures 'symbol', symbols
shadings= 'solid open striped' ; call defFeatures 'shading', shadings
return
/*──────────────────────────────────GENPOSS subroutine──────────────────subroutine────────────────────────*/
genPoss: p=0; sets=0; sep=' ───── '; !.= /*define some REXX variables. */
do i=1 for game /* [↓] the IFs eliminate dupsduplicates.*/
do j=i+1 to game; if j==i then iterate
do k=j+1 to game; if k==j | k==i then iterate
p=p+1; !.p.1=@.i; !.p.2=@.j; !.p.3=@.k
end /*k*/
end /*j*/
end /*i*/ /* [↑] buildgenerate the permutation list. */
return
/*──────────────────────────────────FINDSETS subroutine─────────────────subroutine───────────────────────*/
findSets: parse arg n; call genPoss /*N: the number of sets to findbe found. */
call sey /*find any sets generatedthat above.were generated [↑]*/
do j=1 for p /*P: is the #number of possible sets. */
do f=1 for features
do g=1 for groups; !!.j.f.g=word(!.j.f, g)
end /*g*/
end /*f*/
ok=1 /*everything is peachy─kean (OK ) so far. */
do g=1 for groups; _=!!.j.1.g /*generatebuild strings to holehold posspossibilities. */
equ=1 /* [↓] handles all the equal featsfeatures. */
do f=2 to features while equ; equ=equ & _==!!.j.f.g
end /*f*/
dif=1
__=!!.j.1.g /* [↓] handles all unequal feats features.*/
do f=2 to features while \equ
dif=dif & (wordpos(!!.j.f.g,__)==0)
__=__ !!.j.f.g /*append to the string for next test. */
end /*f*/
ok=ok & (equ | dif) /*now, see if all are equal |or unequal.*/
end /*g*/
 
if \ok then iterate /*Is this set OK? Nope, then skip it.*/
sets=sets+1 /*bump the number of the sets found. */
call sey right('set' sets": ",15) !.j.1 sep !.j.2 sep !.j.3
end /*j*/
 
call sey sets 'sets found.',.
return
/*──────────────────────────────────SEY subroutine──────────────────────subroutine────────────────────────────*/
sey: if \tell then return /*should¬ outputtell? be suppressed? Then suppress the output. */
if arg(2)==. then say; say arg(1); if arg(3)==. then say; return</lang>
'''output''' when using the default input:
<pre>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/224929"