Created
January 7, 2013 01:46
-
-
Save mscurtescu/4471639 to your computer and use it in GitHub Desktop.
Set Card Game (http://www.setgame.com/set/) helper.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import qualified Data.List as List | |
data Shape = Oval | Squiggle | Diamond deriving (Show, Eq, Bounded, Enum, Ord) | |
data Color = Red | Purple | Green deriving (Show, Eq, Bounded, Enum, Ord) | |
data Number = One | Two | Three deriving (Show, Eq, Bounded, Enum, Ord) | |
data Shading = Solid | Striped | Outlined deriving (Show, Eq, Bounded, Enum, Ord) | |
data Card = Card Shape Color Number Shading deriving (Show, Eq, Ord) | |
isSet :: Card -> Card -> Card -> Bool | |
isSet (Card s1 c1 n1 h1) (Card s2 c2 n2 h2) (Card s3 c3 n3 h3) = isSetFeature s1 s2 s3 && isSetFeature c1 c2 c3 && isSetFeature n1 n2 n3 && isSetFeature h1 h2 h3 | |
isSetFeature :: (Eq a) => a -> a -> a -> Bool | |
isSetFeature a b c | |
| a == b && b == c = True | |
| a /= b && b /= c && a /= c = True | |
| otherwise = False | |
completeSet :: Card -> Card -> Card | |
completeSet (Card s1 c1 n1 h1) (Card s2 c2 n2 h2) = Card (completeSetFeature s1 s2) (completeSetFeature c1 c2) (completeSetFeature n1 n2) (completeSetFeature h1 h2) | |
completeSetFeature :: (Enum a, Bounded a, Eq a) => a -> a -> a | |
completeSetFeature a b | |
| a == b = a | |
| otherwise = head [c | c <- [minBound..maxBound], c /= a && c /= b] | |
findSets :: [Card] -> [(Card, Card, Card)] | |
findSets cs = filter (\(c1, c2, c3) -> isSet c1 c2 c3) [(c1, c2, c3) | c1 <- cs, c2 <- cs, c3 <- cs, c2 > c1, c3 > c2] | |
cardFromString :: String -> Card | |
cardFromString s = Card (shapeFromString s) (colorFromString s) (numberFromString s) (shadingFromString s) | |
shapeFromString :: String -> Shape | |
shapeFromString s | |
| elem 'O' s = Oval | |
| elem 'S' s = Squiggle | |
| elem 'D' s = Diamond | |
colorFromString :: String -> Color | |
colorFromString s | |
| elem 'r' s = Red | |
| elem 'p' s = Purple | |
| elem 'g' s = Green | |
numberFromString :: String -> Number | |
numberFromString s | |
| elem '1' s = One | |
| elem '2' s = Two | |
| elem '3' s = Three | |
shadingFromString :: String -> Shading | |
shadingFromString s | |
| elem '#' s = Solid | |
| elem '=' s = Striped | |
| elem '@' s = Outlined | |
exampleSets = [ | |
(Card Oval Red Two Outlined, Card Oval Red Two Striped, Card Oval Red Two Solid), | |
(Card Squiggle Green One Striped, Card Oval Purple Two Striped, Card Diamond Red Three Striped), | |
(Card Oval Purple One Striped, Card Diamond Green Two Solid, Card Squiggle Red Three Outlined) ] | |
testExampleSets :: Bool | |
testExampleSets = List.all (\(c1, c2, c3) -> isSet c1 c2 c3) exampleSets | |
exampleNotSets :: [(Card, Card, Card)] | |
exampleNotSets = [ | |
(Card Diamond Green One Solid, Card Diamond Purple One Outlined, Card Diamond Red One Outlined), | |
(Card Squiggle Red Two Solid, Card Squiggle Red Two Striped, Card Squiggle Green Two Outlined) ] | |
testExampleNotSets :: Bool | |
testExampleNotSets = not $ List.all (\(c1, c2, c3) -> isSet c1 c2 c3) exampleNotSets | |
testAll :: Bool | |
testAll = testExampleSets && testExampleNotSets | |
puzzle20121229 :: [String] | |
puzzle20121229 = ["Op1#", "Sp1#", "Or3@", "Or1#", | |
"Dg1#", "Or2=", "Or1=", "Dr1#", | |
"Dg2@", "Sp1@", "Sg2=", "Sr1#"] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
See my fork: https://gist.github.com/4471939 comments are in-line.