September Morn Update

Task/Set-puzzle/Haskell/set-puzzle.hs

@@ -1,75 +1,103 @@
-import Data.List
-import System.Random
 import Control.Monad.State
+       (State, evalState, replicateM, runState, state)
+import System.Random (StdGen, newStdGen, randomR)
+import Data.List (find, nub, sort)
 
 combinations :: Int -> [a] -> [[a]]
-combinations 0 _      = [[]]
-combinations _ []     = []
-combinations k (y:ys) = map (y:) (combinations (k - 1) ys) ++ combinations k ys
+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 Color
+  = Red
+  | Green
+  | Purple
+  deriving (Show, Enum, Bounded, Ord, Eq)
 
-data Card = Card {
-              color :: Color,
-              symbol :: Symbol,
-              count :: Count,
-              shading :: Shading
-            } deriving (Show)
+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
+  let total = length . nub . sort . flip map cs
+  in notElem 2 [total color, total symbol, total count, total shading]
 
 -- 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))
+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)
+getHand n =
+  state $
+  \gen ->
+     let az = [minBound .. maxBound]
+         deck =
+           [ Card co sy ct sh
+           | co <- az
+           , sy <- az
+           , ct <- az
+           , sh <- az ]
+         (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)
+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 ""
+  putStrLn $
+    "Showing hand of " ++
+    show cardCount ++ " cards with " ++ show solutionCount ++ " solutions."
+  gen <- newStdGen
+  let Just z =
+        find ((solutionCount ==) . length . filter isSet . combinations 3) $
+        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
+  showSolutions 9 4
+  showSolutions 12 6

Task/Set-puzzle/Julia/set-puzzle.julia

@@ -0,0 +1,43 @@
+using Random, IterTools, Combinatorics
+
+function SetGameTM(basic = true)
+    drawsize = basic ? 9 : 12
+    setsneeded = div(drawsize, 2)
+    setsof3 = Vector{Vector{NTuple{4, String}}}()
+    draw = Vector{NTuple{4, String}}()
+    deck = collect(Iterators.product(["red", "green", "purple"], ["one", "two", "three"],
+        ["oval", "squiggle", "diamond"], ["solid", "open", "striped"]))
+
+    while length(setsof3) != setsneeded
+        empty!(draw)
+        empty!(setsof3)
+        map(x -> push!(draw, x), shuffle(deck)[1:drawsize])
+        for threecards in combinations(draw, 3)
+            canuse = true
+            for i in 1:4
+                u = length(unique(map(x->x[i], threecards)))
+                if u != 3 && u != 1
+                    canuse = false
+                end
+            end
+            if canuse
+                push!(setsof3, threecards)
+            end
+        end
+    end
+
+    println("Dealt $drawsize cards:")
+    for card in draw
+        println("    $card")
+    end
+    println("\nFormed these cards into $setsneeded sets:")
+    for set in setsof3
+        for card in set
+            println("    $card")
+        end
+        println()
+    end
+end
+
+SetGameTM()
+SetGameTM(false)