" (textState subSt))) subSt ``` 'old' is the ServerState list of tuples removed from the TMVar. 'new' mirrors 'old', only with the change caused by 'changeScore'. ```haskell changeS :: Text -> Int -> Client -> Client changeS x y (a, b, c, d) | x == a = (a, b+y, c, d) | otherwise = (a, b, c, d) changeScore :: Text -> Int -> ServerState -> ServerState changeScore name k = map (changeS name k) ``` The Int argument can be 1 or -1, depending on what was chosen in 'newNums'. As you see, changeS changes the tuple corresponding to the player named 'x' and leaves the rest unchanged. Currently, it is mapped over the entire ServerState list, but it would be easy to map over only the group to which the player belongs. Here is how the sub-list is isolated: ```haskell subState :: Text -> Text -> [(Text,Int,Text,WS.Connection)] -> [(Text,Int,Text,WS.Connection)] subState name gr state | gr /= solo = [ (a,b,c,d) | (a,b,c,d) <- state, gr == c ] | gr == solo = [ (a,b,c,d) | (a,b,c,d) <- state, name == a] ``` 'solo' is the group name for players who have not joined a group. solo players don't get information about other solo players, so name is used to narrow down the result to only one item in the ServerState list. Group members who look at computer generated solutions are temporarily assigned to group 'solo'. When they close the solutions interface they rejoin their old group, keeping the score they had when they left to look at solution. The information arriving from the server is a comma-separated entity treated as a list of Char, a/k/a String. It gets separated at the commas to a list of type [String] and the item corresponding to the user's Group is converted to Text. It never had type Group, although the list comprehension treats it as the Group element in a ServerState tuple. Haskell's type safety gets diluted through its continual exchange of information with browsers. I'll have a little more to say about isolating groups in ServerState later. There was a time during development when the browsers had to screen messages. When I turned my attention to having the server send no more messages than necessary, it was pleasant to be coding Haskell again where list comprehensions and pattern matching tell the compiler what is wanted in the simplest possible terms, and the compiler complies with exactly what was requested. ##The timer The timer can be started either by clicking SCORE! or by clicking IMPOSSIBLE. SCORE! starts a ten-second coundown during which the first computation must be completed or a point will be forfeited. Completing the first computation before ten seconds have expired starts another ten-second countdown. If the result of the second computation is the number '20', the player is awarded a point; otherwise, another ten-second countdown begins. If the time expires or the computation doen not result in '20', a point is deducted. Otherwise the result is '20' and the player gains a point. Clicking Score starts a sixty-second countdown. If the time expires, the player gains one point. If, during the countdown, a player clicks SCORE! and computes the number '20', that player gains a point and the player who clicked IMPOSSIBLE loses two points. The SCORE! button is in B2's render function. it is defined as follows: ```js ``` style7() handles style for several buttons. The first two parameters are 'backgroundColor' and 'borderColor'. The third parameter matches 'display' in style7(). It's values are either 'none' or 'inline'. Player actions make it come and go. Clicking IMPOSSIBLE removes it and substiturs a button that looks just like it for use in iterrupting the 60-second countdown. Here is the click handler: ```js handleScore () { let name = this.state.name; let group = this.state.group; DES_ws.send( `CY#$42,${group},${name},${name}` ); } ``` The message "`CY#$42,${group},${name},${name}`" arrives at the server and is broadcast to all members of the sender's group. That is all the server does with it. It determines which sockets correspond to the members of the sender's group and sends the message to each of them. Here is what the browsers do with the message: ``` case "CY#$42": // Triggered by clicking "SCORE!". that.setState( { scoreClicker: extra, score: true, message: '', DS_T: 10, impossibleDisplay: 'none', solutionsDisplay: 'none', timerDisplay: 'inline', scoreDisplay: 'none', rollDisplay: 'none' } ) if (extra !== name) { that.setState({numDisplay: 'none'}) // Players can see calculations after wait. setTimeout ( function() { that.setState({solutionsDisplay: 'inline'}); },8000 ) } break; ``` If the countdown reaches 0, a message is circulated to all members of the group (through the server) setting the value of DS\_T in the following manner: ```js this.setState({DS\_T: `10 seconds expired. Deduct one point from ${scoreClicker}`}); this.setState({DS\_T: `60 seconds expired. One point for ${impossibleClicker}`}); this.setState( {DS_T: `10 seconds expired. One point awarded to ${that.state.impossibleClicker} One point deducted from ${this.state.interruptClicker}`} ``` This stops the clock by setting DS\_T to a string value. What is sent to the server, and the resulting messages broadcast to other group member, depends on whether the browser belongs to a player who clicked SCORE! to begin a round, a player who clicked IMPOSSIBLE, or a player who clicked SCORE! after IMPOSSIBLE was clicked. In any given round there will be only one player who clicked SCORE! since initially clicking SCORE! causes the IMPOSSIBLE button to disappear preventing the second SCORE! button from appearing. Clicking IMPOSSIBLE causes the first SCORE! button to disappear. Every player in the group has a timer, but only the ones with 'name == scoreClicker' or 'name == impossibleClicker' send messages updating the score board. Clicking SCORE! or IMPOSSIBLE sets the scoreClicker and impossibleClicker variables to the clicker's login name. As you see below, DS\_T > 0 causes the countdown to continue while DS\_T == 0 causes a message, or messages, to go out to the server. ```js setInterval( () => { let name = this.state.name; let group = this.state.group; let scoreClicker = this.state.scoreClicker; let impossibleClicker = this.state.impossibleClicker; let interruptClicker = this.state.interruptClicker let score = this.state.score; let impossible = this.state.impossible; let interrupt = this.state.interrupt; if ( this.state.DS_T > 0 ) { this.setState({ DS_T: this.state.DS_T - 1, timeSize: 40 }); this.setState({info: this.state.DS_T}); } if ( this.state.DS_T*1 === 0 ) { this.setState ({ message1: 0, // Wipes the old numbers. message2: 0, message3: 0, message4: 0, info: '', timeSize: 20, // Returns number display to normal size. rollDisplay: 'inline', // Displays the ROLL button. solutionsDisplay: 'inline', DS_t: -1 }) let z = scoreClicker === name; let z2 = impossibleClicker === name; let z3 = interruptClicker === name; let gr = group; if (!interrupt) { if (z) { DES_ws.send(`CG#$42,${gr},${name},-1`); DES_ws.send(`CH#$42,${gr},${name},10 seconds expired. Deduct one point from ${scoreClicker}`); } else if (z2) { DES_ws.send(`CG#$42,${gr},${name},1`); DES_ws.send(`CH#$42,${gr},${name},60 seconds expired. One point for ${impossibleClicker}`); } } else if (z3) { DES_ws.send(`CG#$42,${gr},${interruptClicker},-1`); DES_ws.send(`CH#$42,${group},${interruptClicker},10 seconds expired. One point awarded to ${that.state.impossibleClicker}. One point deducted from ${interruptClicker}.`); DES_ws.send(`CG#$42,${gr},${impossibleClicker},1`); } } }, 1000 ) } ``` That is the gist of how the timer works. Because DS\_t is a plain Javascript variable, it has no set type. That makes it convenient to stop the integer countdown by assigning a string value to DS\_t. The counter can't use a string, but it doesn't complain. It just stops counting. I won't present any more details here. I think they can be deduced by following the code and besides, most readers are interested in a general overview of how one person (me) used a Haskell Websockets server to create a multiplayer dice game with user-defined competition groups and chat rooms. ##More on How the server determines which players are sent broadcast messages. As previously mentioned, the server's broadcast function doesn't broadcast to every Client in the ServerState list. Instead, it broadcasts to each member of the group to which the sender of a triggering message belongs. So, for example, if the server receives the Message Board message 'CD#$42,GroupA,Fred,Fred: Hello out there.', it parses it just as it parses all incoming messages: ``` msg <- WS.receiveData conn let msgArray = splitOn "," (T.unpack msg) let group = T.pack (msgArray !! 1) let sender = T.pack (msgArray !! 2) let extra = T.pack (msgArray !! 3) let extraNum = read (msgArray !! 3) :: Int let range = get4 msgArray -- 7 items in msgArray ``` It then runs: ``` do st <- atomically $ readTMVar state let subSt = subState group st broadcast msg subSt ``` Here is the function 'subState' again: ``` subState :: Text -> Text -> [(Text,Int,Text,WS.Connection)] -> [(Text,Int,Text,WS.Connection)] subState name gr state | gr /= solo = [ (a,b,c,d) | (a,b,c,d) <- state, gr == c ] | gr == solo = [ (a,b,c,d) | (a,b,c,d) <- state, name == a] ``` That might not be the most efficient way to get the list of Client tupples belonging to the sender's group, but I think it is wonderfull that, in Haskell, we can simply say what we want and get it without further ado. The function matches every Client in the designated group unless the group is 'solo'. In that case, the unique player with the designated name is the sole member of the substate list. ``` A player wanting to change groups sends a string prefixed by 'CO#$42', The server deals with it as follows: ``` else if "CO#$42" `T.isPrefixOf` msg then mask_ $ do old <- atomically $ takeTMVar state let new = changeGroup sender extra old atomically $ putTMVar state new let subState1 = subState sender group new let subState2 = subState sender extra new let x = "CB#$42," `mappend` group `mappend` "," `mappend` sender `mappend` "," `mappend` T.concat (intersperse "

" (textState subState1)) let y = "CB#$42," `mappend` extra `mappend` "," `mappend` sender `mappend` "," `mappend` T.concat (intersperse "

" (textState subState2)) broadcast y subState2 if group /= "solo" then broadcast x subState1 else return () ``` 'changeGroup()' takes three arguments: 'sender', 'extra', and 'old'. 'extra' is the fourth element of the list produced by parsing the comma-separated string that arrives from the browser. In this case, it is the name of a group. old is the ServerState list before the group membership change. Here is 'changeGroup()': ``` changeGroup :: Text -> Text -> ServerState -> ServerState changeGroup name group = map (newGroup name group ``` As you see, it maps 'newGroup' over the ServerState list. Here is newGroup: ``` newGroup :: Text -> Text -> Client -> Client newGroup name group (a, b, c, d) | name == a = (a, 0, group, d) | otherwise = (a, b, c, d) ``` Notice that the new group member starts with a score of '0'. The exception to that rule occurs when a player re-joins a group after looking at computer-generated solutions. The code in such cases is: ``` newGroupKeepScore :: Text -> Text -> Client -> Client newGroupKeepScore name group (a, b, c, d) | name == a = (a, b, group, d) | otherwise = (a, b, c, d) changeGroupKeepScore :: Text -> Text -> ServerState -> ServerState changeGroupKeepScore name group = map (newGroupKeepScore name group) ``` The second member of the tupple is 'b', the old score, rather than always being '0'. 'group' in this function is 'solo' when a player displays soloutions and the old group, which is saved in the browser, when the solutions are hidden. After hiding the solutions, a player must wait until the next round to resume competition. Finally, here is the broadcast function, just as it first appeared in the Haskell Websockets library: ``` broadcast :: Text -> ServerState -> IO () broadcast message clients = do T.putStrLn message forM_ clients $ \(_ , _, _, conn) -> WS.sendTextData conn message ``` ##The Front End ## APPENDIX ### IMPOSSIBLES The essence of the Score calculation algorythm in the module Fm is contained in the "impossibles.hs" file. Fm has much formatting code, which is a distraction when evaluating the algorythm. impossibles.hs computes all dice combinations which cannot be made into the number "20" in two or three stages, as required by the game. In 1.5 seconds, it finds all 104 such combinations using a list comprehension on the seven list comprehensions which cover all possible computations. The five operations are defined as follows: ```haskell {-# LANGUAGE OverloadedStrings #-} import Data.List import System.CPUTime notWhole :: Double -> Bool notWhole x = fromIntegral (round x) /= x cat :: Double -> Double -> Double cat l m | (whole l) && (whole m) && m >= 0 && l /= 0 = read ((show $ fRound l) ++ (show $ fRound m)) | otherwise = 8.888 f :: Double -> String f x = show (round x) ops = [cat, (+), (-), (*), (/)] ``` The seven algorithms necessary to perform every possible computation are: ```haskell calc :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 (op1 a' b') c' == 20] calc2 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc2 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 a' (op1 b' c') == 20] calc3 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc3 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op1 a' b') (op2 c' d') == 20] calc4 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc4 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 (op1 a' b') c') d' == 20] calc5 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 a' (op1 b' c')) d' == 20] calc6 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 (op1 b' c') d') == 20] calc7 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 b' (op1 c' d')) == 20] ``` It is easy to see that there are seven ways to order two or three sequential computations on four numbers. They can be represented by ```javascript a bc ab c ab cd (a bc)d (ab c)d a(b cd) a(bc d) ``` Those are the combinations used in the seven calc functions. The list comprehension works on all permutations of the order of the four numbers in receives, so c ba is covered by a bc. Next, I wanted to find out if all seven algorithms are necessary to find at least one solution, so I wrote this: ```haskell {-# LANGUAGE OverloadedStrings #-} import Data.List import System.CPUTime notWhole :: Double -> Bool notWhole x = fromIntegral (round x) /= x cat :: Double -> Double -> Double cat l m | (whole l) && (whole m) && m >= 0 && l /= 0 = read ((show $ fRound l) ++ (show $ fRound m)) | otherwise = 8.888 f :: Double -> String f x = show (round x) ops = [cat, (+), (-), (*), (/)] calc :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 (op1 a' b') c' == 20] calc2 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc2 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 a' (op1 b' c') == 20] calc3 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc3 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op1 a' b') (op2 c' d') == 20] calc4 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc4 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 (op1 a' b') c') d' == 20] calc5 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 a' (op1 b' c')) d' == 20] calc6 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 (op1 b' c') d') == 20] calc7 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 b' (op1 c' d')) == 20] only_calc = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, not (null $ calc a b c d), null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, null $ calc6 a b c d, null $ calc7 a b c d ] only_calc2 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, not (null $ calc2 a b c d), null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, null $ calc6 a b c d, null $ calc7 a b c d ] only_calc3 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, not (null $ calc3 a b c d), null $ calc4 a b c d, null $ calc5 a b c d, null $ calc6 a b c d, null $ calc7 a b c d ] only_calc4 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, not (null $ calc4 a b c d), null $ calc5 a b c d, null $ calc6 a b c d, null $ calc7 a b c d ] only_calc5 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, not (null $ calc5 a b c d), null $ calc6 a b c d, null $ calc7 a b c d ] only_calc6 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, not (null $ calc6 a b c d), null $ calc7 a b c d ] only_calc7 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, null $ calc6 a b c d, not (null $ calc7 a b c d )] main = do print "*****************************___only_calc" t1 <- getCPUTime mapM_ print only_calc print " " print "*****************************___only_calc2" mapM_ print only_calc2 print " " print "*****************************___only_calc3" mapM_ print only_calc3 print " " print "*****************************___only_calc4" mapM_ print only_calc4 print " " print "*****************************___only_calc5" mapM_ print only_calc5 print " " print "*****************************___only_calc6" mapM_ print only_calc6 print " " print "*****************************___only_calc7" mapM_ print only_calc7 t2 <- getCPUTime let t = fromIntegral (t2-t1) * 1e-12 print t print " " ``` Here is what I got: ```javascript e@e:~/b0$ ./analysis_A "*****************************___only_calc" [1.0,3.0,11.0,15.0] [1.0,3.0,11.0,19.0] [1.0,6.0,9.0,20.0] [1.0,6.0,10.0,20.0] [1.0,6.0,11.0,20.0] [2.0,2.0,11.0,15.0] [2.0,2.0,11.0,17.0] [3.0,3.0,3.0,13.0] [3.0,3.0,7.0,17.0] [3.0,4.0,9.0,16.0] [3.0,4.0,11.0,14.0] [4.0,4.0,6.0,17.0] [5.0,5.0,5.0,11.0] [5.0,5.0,5.0,13.0] [5.0,5.0,5.0,17.0] " " "*****************************___only_calc2" " " "*****************************___only_calc3" [1.0,1.0,1.0,11.0] [1.0,1.0,7.0,17.0] [1.0,1.0,12.0,12.0] [1.0,6.0,6.0,6.0] [1.0,6.0,9.0,9.0] [3.0,3.0,6.0,6.0] [3.0,4.0,7.0,18.0] [3.0,6.0,7.0,14.0] [5.0,5.0,6.0,17.0] [5.0,6.0,6.0,6.0] " " "*****************************___only_calc4" [1.0,1.0,4.0,11.0] [1.0,4.0,9.0,9.0] [1.0,4.0,9.0,19.0] [1.0,5.0,11.0,11.0] [1.0,6.0,6.0,12.0] [1.0,6.0,11.0,11.0] [3.0,6.0,9.0,12.0] [6.0,6.0,7.0,18.0] [6.0,6.0,9.0,14.0] " " "*****************************___only_calc5" [1.0,3.0,8.0,20.0] [3.0,3.0,10.0,17.0] [3.0,4.0,10.0,16.0] " " "*****************************___only_calc6" " " "*****************************___only_calc7" 8.27113 " " ``` This shows that there is no solution that only calc2, only calc6, or only calc7 can find. Next, I checked all combinations of these three: ```javascript {-# LANGUAGE OverloadedStrings #-} import Data.List import System.CPUTime notWhole :: Double -> Bool notWhole x = fromIntegral (round x) /= x cat :: Double -> Double -> Double cat l m | (whole l) && (whole m) && m >= 0 && l /= 0 = read ((show $ fRound l) ++ (show $ fRound m)) | otherwise = 8.888 f :: Double -> String f x = show (round x) ops = [cat, (+), (-), (*), (/)] calc :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 (op1 a' b') c' == 20] calc2 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc2 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 a' (op1 b' c') == 20] calc3 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc3 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op1 a' b') (op2 c' d') == 20] calc4 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc4 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 (op1 a' b') c') d' == 20] calc5 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 a' (op1 b' c')) d' == 20] calc6 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 (op1 b' c') d') == 20] calc7 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 a' (op2 b' (op1 c' d')) == 20] only_calc2_or_6 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, not (null $ calc2 a b c d), null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, not (null $ calc6 a b c d), null $ calc7 a b c d ] only_calc2_or_7 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, not (null $ calc2 a b c d), null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, null $ calc6 a b c d, not (null $ calc7 a b c d) ] only_calc6_or_7 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, not (null $ calc6 a b c d), not (null $ calc7 a b c d )] only_calc2_or_6_or_7 = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, not (null $ calc2 a b c d), null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d, not (null $ calc6 a b c d), not (null $ calc7 a b c d )] main = do print "*****************************___only_calc2_or_6" t1 <- getCPUTime mapM_ print only_calc2_or_6 print " " print "*****************************___only_calc2_or_7" mapM_ print only_calc2_or_7 print " " print "*****************************___only_calc6_or_7" mapM_ print only_calc6_or_7 print " " print "*****************************___only_calc2_or_6_or_7" mapM_ print only_calc2_or_6_or_7 t2 <- getCPUTime let t = fromIntegral (t2-t1) * 1e-12 print t ``` And here is what I got: ```javascript e@e:~/b0$ ./analysis_B "*****************************___only_calc2_or_6" " " "*****************************___only_calc2_or_7" " " "*****************************___only_calc6_or_7" " " "*****************************___only_calc2_or_6_or_7" [2.0,5.0,12.0,12.0] 3.385727 ``` There are no rolls of the dice that can be found only by some pair of these functions, and (2,5,12,12) is the only roll that can be found by all three, but none of the other algorithms (calc, calc3, calc4, and calc5). Those four along with any one of calc2, calc6, or calc7, are sufficient to find at least one solution if a roll is solvable. A corollary is that if calc, calc2, calc3, calc4, and calc5 can't find a solution, calc6 and calc7 won't either. I tested this by removing calc6 and calc7 from impossibles.hs and renaming it impossibles2.hs. Like impossibles.hs, it found the 104 impossible rolls, only in 1.33 instead of 1.50 seconds. The module Fm uses the seven algorithms to find solutions to random rolls or numbers entered by Score players. It massages the output into a single line of Text with solutions separated by "br" in <> brackets. The browsers receive the Text as a Javascript string which, when appended to a div, displays the solutions neatly in a column. ### All 104 Impossible Rolls Here is the code for impossibles2.hs: ```haskell {-# LANGUAGE OverloadedStrings #-} import Data.List import System.CPUTime notWhole :: Double -> Bool notWhole x = fromIntegral (round x) /= x cat :: Double -> Double -> Double cat l m | (whole l) && (whole m) && m >= 0 && l /= 0 = read ((show $ fRound l) ++ (show $ fRound m)) | otherwise = 8.888 f :: Double -> String f x = show (round x) ops :: [Double -> Double -> Double] ops = [cat, (+), (-), (*), (/)] calc :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 (op1 a' b') c' == 20] calc2 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc2 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op2 a' (op1 b' c') == 20] calc3 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc3 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op1 a' b') (op2 c' d') == 20] calc4 :: Double -> Double -> Double -> Double -> [(Double, Double, Double, Double)] calc4 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 (op1 a' b') c') d' == 20] calc5 a b c d = [ (a',b',c',d') | [a',b',c',d'] <- nub(permutations [a,b,c,d]), op1 <- ops, op2 <- ops, op3 <- ops, op3 (op2 a' (op1 b' c')) d' == 20] impossibles = [ [a, b, c, d] | a <- [1..6], b <- [1..6], c <- [1..12], d <- [1..20], a <= b, b <= c, c <= d, null $ calc a b c d, null $ calc2 a b c d, null $ calc3 a b c d, null $ calc4 a b c d, null $ calc5 a b c d ] main = do t1 <- getCPUTime mapM_ print impossibles t2 <- getCPUTime let t = fromIntegral (t2-t1) * 1e-12 print t ```