aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

131
Task/Set-puzzle/C++/set-puzzle.cpp Normal file
View file

@ -0,0 +1,131 @@
#include <time.h>
#include <algorithm>
#include <iostream>
#include <iomanip>
#include <vector>
#include <string>
enum color {
red, green, purple
};
enum symbol {
oval, squiggle, diamond
};
enum number {
one, two, three
};
enum shading {
solid, open, striped
};
class card {
public:
card( color c, symbol s, number n, shading h ) {
clr = c; smb = s; nbr = n; shd = h;
}
color getColor() {
return clr;
}
symbol getSymbol() {
return smb;
}
number getNumber() {
return nbr;
}
shading getShading() {
return shd;
}
std::string toString() {
std::string str = "[";
str += clr == red ? "red " : clr == green ? "green " : "purple ";
str += nbr == one ? "one " : nbr == two ? "two " : "three ";
str += smb == oval ? "oval " : smb == squiggle ? "squiggle " : "diamond ";
str += shd == solid ? "solid" : shd == open ? "open" : "striped";
return str + "]";
}
private:
color clr;
symbol smb;
number nbr;
shading shd;
};
typedef struct {
std::vector<size_t> index;
} set;
class setPuzzle {
public:
setPuzzle() {
for( size_t c = red; c <= purple; c++ ) {
for( size_t s = oval; s <= diamond; s++ ) {
for( size_t n = one; n <= three; n++ ) {
for( size_t h = solid; h <= striped; h++ ) {
card crd( static_cast<color> ( c ),
static_cast<symbol> ( s ),
static_cast<number> ( n ),
static_cast<shading>( h ) );
_cards.push_back( crd );
}
}
}
}
}
void create( size_t countCards, size_t countSets, std::vector<card>& cards, std::vector<set>& sets ) {
while( true ) {
sets.clear();
cards.clear();
std::random_shuffle( _cards.begin(), _cards.end() );
for( size_t f = 0; f < countCards; f++ ) {
cards.push_back( _cards.at( f ) );
}
for( size_t c1 = 0; c1 < cards.size() - 2; c1++ ) {
for( size_t c2 = c1 + 1; c2 < cards.size() - 1; c2++ ) {
for( size_t c3 = c2 + 1; c3 < cards.size(); c3++ ) {
if( testSet( &cards.at( c1 ), &cards.at( c2 ), &cards.at( c3 ) ) ) {
set s;
s.index.push_back( c1 ); s.index.push_back( c2 ); s.index.push_back( c3 );
sets.push_back( s );
}
}
}
}
if( sets.size() == countSets ) return;
}
}
private:
bool testSet( card* c1, card* c2, card* c3 ) {
int
c = ( c1->getColor() + c2->getColor() + c3->getColor() ) % 3,
s = ( c1->getSymbol() + c2->getSymbol() + c3->getSymbol() ) % 3,
n = ( c1->getNumber() + c2->getNumber() + c3->getNumber() ) % 3,
h = ( c1->getShading() + c2->getShading() + c3->getShading() ) % 3;
return !( c + s + n + h );
}
std::vector<card> _cards;
};
void displayCardsSets( std::vector<card>& cards, std::vector<set>& sets ) {
size_t cnt = 1;
std::cout << " ** DEALT " << cards.size() << " CARDS: **\n";
for( std::vector<card>::iterator i = cards.begin(); i != cards.end(); i++ ) {
std::cout << std::setw( 2 ) << cnt++ << ": " << ( *i ).toString() << "\n";
}
std::cout << "\n ** CONTAINING " << sets.size() << " SETS: **\n";
for( std::vector<set>::iterator i = sets.begin(); i != sets.end(); i++ ) {
for( size_t j = 0; j < ( *i ).index.size(); j++ ) {
std::cout << " " << std::setiosflags( std::ios::left ) << std::setw( 34 )
<< cards.at( ( *i ).index.at( j ) ).toString() << " : "
<< std::resetiosflags( std::ios::left ) << std::setw( 2 ) << ( *i ).index.at( j ) + 1 << "\n";
}
std::cout << "\n";
}
std::cout << "\n\n";
}
int main( int argc, char* argv[] ) {
srand( static_cast<unsigned>( time( NULL ) ) );
setPuzzle p;
std::vector<card> v9, v12;
std::vector<set> s4, s6;
p.create( 9, 4, v9, s4 );
p.create( 12, 6, v12, s6 );
displayCardsSets( v9, s4 );
displayCardsSets( v12, s6 );
return 0;
}

75
Task/Set-puzzle/Haskell/set-puzzle.hs Normal file
View file

@ -0,0 +1,75 @@
import Data.List
import System.Random
import Control.Monad.State
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations _ [] = []
combinations k (y:ys) = map (y:) (combinations (k - 1) ys) ++ combinations k ys
data Color = Red | Green | Purple deriving (Show, Enum, Bounded, Ord, Eq)
data Symbol = Oval | Squiggle | Diamond deriving (Show, Enum, Bounded, Ord, Eq)
data Count = One | Two | Three deriving (Show, Enum, Bounded, Ord, Eq)
data Shading = Solid | Open | Striped deriving (Show, Enum, Bounded, Ord, Eq)
data Card = Card {
color :: Color,
symbol :: Symbol,
count :: Count,
shading :: Shading
} deriving (Show)
-- Identify a set of three cards by counting all attribute types.
-- if each count is 3 or 1 ( not 2 ) the the cards compose a set.
isSet :: [Card] -> Bool
isSet cs =
let colorCount = length $ nub $ sort $ map color cs
symbolCount = length $ nub $ sort $ map symbol cs
countCount = length $ nub $ sort $ map count cs
shadingCount = length $ nub $ sort $ map shading cs
in colorCount /= 2 && symbolCount /= 2 && countCount /= 2 && shadingCount /= 2
-- Get a random card from a deck. Returns the card and removes it from the deck.
getCard :: State (StdGen, [Card]) Card
getCard = state $ \(gen, cs) -> let (i, newGen) = randomR (0, length cs - 1) gen
(a,b) = splitAt i cs
in (head b, (newGen, a ++ tail b))
-- Get a hand of cards. Starts with new deck and then removes the
-- appropriate number of cards from that deck.
getHand :: Int -> State StdGen [Card]
getHand n = state $ \gen ->
let deck = [Card co sy ct sh |
co <- [minBound..maxBound],
sy <- [minBound..maxBound],
ct <- [minBound..maxBound],
sh <- [minBound..maxBound]]
(a,(newGen, _)) = runState (replicateM n getCard) (gen,deck)
in (a, newGen)
-- Get an unbounded number of hands of the appropriate number of cards.
getManyHands :: Int -> State StdGen [[Card]]
getManyHands n = (sequence.repeat) (getHand n)
-- Deal out hands of the appropriate size until one with the desired number
-- of sets is found. then print the hand and the sets.
showSolutions :: Int -> Int -> IO ()
showSolutions cardCount solutionCount = do
putStrLn $ "Showing hand of " ++ show cardCount ++ " cards with " ++ show solutionCount ++ " solutions."
gen <- newStdGen
let Just z = find (\ls -> length (filter isSet $ combinations 3 ls) == solutionCount) $
evalState (getManyHands cardCount) gen
mapM_ print z
putStrLn ""
putStrLn "Solutions:"
mapM_ putSet $ filter isSet $ combinations 3 z where
putSet st = do
mapM_ print st
putStrLn ""
-- Show a hand of 9 cards with 4 solutions
-- and a hand of 12 cards with 6 solutions.
main :: IO ()
main = do
showSolutions 9 4
showSolutions 12 6

2
Task/Set-puzzle/J/set-puzzle-1.j
View file

@ -9,7 +9,7 @@ Deck=: > ; <"1 { i.@#&.> Features
sayCards=: (', ' joinstring Features {&>~ ])"1
drawRandom=: ] {~ (? #)
isSet=: *./@:(1 3 e.~ [: #@~."1 |:)"2
getSets=: ([: (] #~ isSet) ] {~ 3 comb #)
getSets=: [: (] #~ isSet) ] {~ 3 comb #
countSets=: #@:getSets
set_puzzle=: verb define

146
Task/Set-puzzle/REXX/set-puzzle.rexx
View file

@ -1,99 +1,99 @@
/*REXX program finds "sets" (solutions) for the SET puzzle (game). */
parse arg game seed . /*get optional # cards to deal. */
if game ==',' | game=='' then game=9 /*Not specified? Then use default*/
if seed==',' | seed=='' then seed=77 /* " " " " " */
call aGame 0 /*with tell=0, suppress output. */
call aGame 1 /*with tell=1, allow output. */
exit sets /*stick a fork in it, we're done.*/
/*──────────────────────────────────AGAME subroutine────────────────────*/
aGame: tell=arg(1); good=game%2 /*enable or disable the output. */
/* [↑] GOOD is the right # sets.*/
do seed=seed until good==sets /*generate deals until good# sets*/
call random ,,seed /*repeatability for last invoke. */
call genFeatures /*generate various card features.*/
call genDeck /*generate a deck (with 81 cards)*/
call dealer game /*deal a number of cards (game). */
call findSets game%2 /*find sets from the dealt cards.*/
end /*until*/ /*when leaving, SETS is right num*/
return /*return to invoker of this sub. */
/*──────────────────────────────────DEALER subroutine───────────────────*/
dealer: call sey 'dealing' game "cards:",,. /*shuffle and deal cards*/
do cards=1 until cards==game /*keep dealing 'til done*/
_=random(1,words(##)); ##=delword(##,_,1) /*pick card; delete it. */
@.cards=deck._ /*add it to the tableau.*/
call sey right('card' cards,30) " " @.cards /*display card to screen*/
do j=1 for words(@.cards) /*define cells for card.*/
@.cards.j=word(@.cards,j) /*define a cell for card*/
/*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: display " " */
exit sets /*stick a fork in it, we're all done. */
/*──────────────────────────────────AGAME subroutine──────────────────────────*/
aGame: tell=arg(1); good=game%2 /*enable/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 the 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 #.*/
return /*return to invoker of this subroutine.*/
/*──────────────────────────────────DEALER subroutine─────────────────────────*/
dealer: call sey 'dealing' game "cards:",,. /*shuffle and deal the cards. */
do cards=1 until cards==game /*keep dealing until finished.*/
_=random(1,words(##)); ##=delword(##,_,1) /*pick card; delete a card. */
@.cards=deck._ /*add the 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 cards*/
@.cards.j=word(@.cards,j) /*define a cell for a card.*/
end /*j*/
end /*cards*/
return
/*──────────────────────────────────DEFFEATURES subroutine──────────────*/
defFeatures: parse arg what,v; _=words(v) /*obtain what to define.*/
/*──────────────────────────────────DEFFEATURES subroutine────────────────────*/
defFeatures: parse arg what,v; _=words(v) /*obtain what is to be defined*/
if _\==values then do; call sey 'error,' what "features ¬=" values,.,.
exit -1
end /* [↑] check for typos.*/
do k=1 for words(values) /*define all possibles. */
call value what'.'k, word(values,k) /*define a card feature.*/
exit -1
end /* [↑] check for typos/errors*/
do k=1 for words(values) /*define all the possible vals*/
call value what'.'k, word(values,k) /*define a card feature. */
end /*k*/
return
/*──────────────────────────────────GENDECK 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.*/
/*──────────────────────────────────GENDECK 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 deck.*/
/*──────────────────────────────────GENFEATURES subroutine──────────────*/
genFeatures: features=3; groups=4; values=3 /*define # feats,grps,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 /*#: the number of cards in the deck. */
/*──────────────────────────────────GENFEATURES subroutine────────────────────*/
genFeatures: features=3; groups=4; values=3 /*define # features, 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──────────────────*/
genPoss: p=0; sets=0; sep=' ───── '; !.= /*define some REXX variables.*/
do i=1 for game /* [↓] the IFs eliminate dups.*/
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
/*──────────────────────────────────GENPOSS subroutine────────────────────────*/
genPoss: p=0; sets=0; sep=' ───── '; !.= /*define some REXX variables. */
do i=1 for game /* [↓] the IFs eliminate duplicates.*/
do j=i+1 to game
do k=j+1 to game
p=p+1; !.p.1=@.i; !.p.2=@.j; !.p.3=@.k
end /*k*/
end /*j*/
end /*i*/ /* [↑] build permutation list. */
end /*i*/ /* [↑] generate the permutation list. */
return
/*──────────────────────────────────FINDSETS subroutine─────────────────*/
findSets: parse arg n; call genPoss /*N: the number of sets to find.*/
call sey /*find any sets generated above. */
do j=1 for p /*P is the # of possible sets. */
/*──────────────────────────────────FINDSETS subroutine───────────────────────*/
findSets: parse arg n; call genPoss /*N: the number of sets to be found. */
call sey /*find any sets that 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)
do g=1 for groups; !!.j.f.g=word(!.j.f, g)
end /*g*/
end /*f*/
ok=1 /*everything is OK so far. */
do g=1 for groups; _=!!.j.1.g /*generate strings to hole poss. */
equ=1 /* [↓] handles all equal feats. */
do f=2 to features while equ; equ=equ & _==!!.j.f.g
ok=1 /*everything is peachy─kean (OK) so far*/
do g=1 for groups; _=!!.j.1.g /*build strings to hold possibilities. */
equ=1 /* [↓] handles all the equal features.*/
do f=2 to features while equ; equ=equ & _==!!.j.f.g
end /*f*/
dif=1
__=!!.j.1.g /* [↓] handles all unequal feats*/
__=!!.j.1.g /* [↓] handles all unequal features.*/
do f=2 to features while \equ
dif=dif & wordpos(!!.j.f.g,__)==0
__=__ !!.j.f.g /*append to string for next test.*/
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 equal | unequal*/
ok=ok & (equ | dif) /*now, see if all are equal or unequal.*/
end /*g*/
if \ok then iterate /*Is this set OK? Nope, skip it.*/
sets=sets+1 /*bump the number of sets found. */
call sey right('set' sets": ",15) !.j.1 sep !.j.2 sep !.j.3
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.',.
call sey sets 'sets found.',.
return
/*──────────────────────────────────SEY subroutine──────────────────────*/
sey: if \tell then return /*should output be suppressed? */
if arg(2)==. then say; say arg(1); if arg(3)==. then say; return
/*──────────────────────────────────SEY subroutine────────────────────────────*/
sey: if \tell then return /*¬ tell? Then suppress the output. */
if arg(2)==. then say; say arg(1); if arg(3)==. then say; return