Program to Simulate Musical Chairs In Haskell Assignment Solution.

Instructions

Objective

Write a Haskell assignment program to simulate Musical chairs.

Requirements and Specifications

N players want to sit on (N-1) chairs. An emcee (the announcer) turns the music on and off, and comments on who wins, who loses, and so on. Each round, when the music turns off, all active players try to sit in the chairs, but one will not be able to find a chair. The emcee announces that that player has lost, and the next round begins with one fewer chairs and one fewer players, until there is one winner.

Requirements

• the number of players is the first command-line argument to the whole program. When not present, your code must default to N = 10.
• The emcee is a separate thread, which exists for the duration of the game.
• Each player is a separate thread. Each player has a 'name', from P1 through PN. These player threads exist for the duration of the game, they are not recreated each round.
• Each chair is a separate resource (e.g., an object). The chairs are named C1 through C(N-1). It must be possible for multiple players to obtain different chairs at the same time.
• If you have any sort of global lock on all chairs (meaning that only one player at a time can access them) then you are not fulfilling the requirements of this assignment. A common example of a global lock would be that the chairs are not just in an array, but that the only way to find a chair to access is through some method call that 'controls' the array, or if the entire array is synchronized/locked while an individual is looking for a chair.
• each round, whichever player did not manage to obtain a chair is out. The remaining player threads get to play in the next round, and the highest-numbered chair is removed. This means that we always have chairs C1 through C(k-1), but not necessarily players P1 through Pk. In the last round, it's always chair C1, but it could/should be any two of the original players.
• it's entirely up to you to decide what algorithm your players use to find chairs. They may rely upon the numbering system of the chairs and their own numbers, or randomly try chairs, or any other strategy that you can design, so please keep it simple and get the assignment done before trying anything too fancy. As long as each player is able to find each open chair eventually, it is fine. Writing up this approach is part of the required (short) document at the end.
• Your code must be able to handle different numbers of contestants, given as an integer as the first command-line argument. When no argument was given, use 10 players as a default.

Notes and Suggestions

• It is okay to include some extra coordination points as desired between the emcee and players, as long as the find-a-seat phase is initiated by changing the music and the players are able to access different chairs at the same time. In a real game of musical chairs, the emcee would somehow have to inspect all the chairs and identify the person who isn't sitting, so there's a bit of a linear computation to be done here and there.
• option: I added a second command-line argument to my implementation for an output file name. When omitted, everything is printed to standard out, but when present, I save the contents to that file.
• printing interleaved messages can be difficult in various languages, because multiple threads are competing for the standard output. If you are having any issues with interlaced characters from multiple messages, then you need to introduce something to coordinate the message printing. I tend to have only one resource (or thread) in charge of actual printing, and everyone else sends messages they'd like to print to that resource whenever they'd like.
• because most of our program ends up printing things, it's entirely possible that printing may be the bottleneck of our program.
• It's not just expected that each run will produce varied outcomes and varied orders of sitting, but keep in mind that the two separate actions of find-chair and print-sat-message also may be further apart in time than you expect. A later sat-message doesn't mean that's when they sat, only that that's when the message got printed!
• Much more so than in single-threaded programming, if you have a ton of debug-style print statements, they will affect the timing of your program. Removing them can absolutely uncover some nasty race condition bugs.

Screenshots of output

Source Code

{- Name: ________________ (other header-comments you'd like to add) -} module Homework8 where import Control.Monad -- many useful functions import Control.Concurrent -- threadDelay, forkIO, MVar..., Chan... import Data.IORef -- newIORef, readIORef, writeIORef import System.Environment -- getArgs import System.Random -- randomRIO, if you attempt a random seating import Debug.Trace {- -- download BoundedChan from hackage if you want to use this one. -- You'll get: BC.BoundedChan, BC.newBoundedChan, BC.readChan, BC.writeChan, e -- import qualified Control.Concurrent.BoundedChan as BC -} -- Definition of the chair object data Chair = Chair { chairName :: String -- name of this chair , chairPlayer :: Maybe String -- player sitting in this chair } -- Thread for each player playerThread :: Int -> MVar Bool -> Chan Chair -> MVar Int -> MVar [Char] -> IO () playerThread i music chairs remaining outputs = loop where loop = let playerName = "P" ++ show i in do m <- readMVar music -- read current music state if m then do -- if music playing -- state we are ready to start x <- takeMVar remaining putMVar remaining (x + 1) -- wait for music to stop waitForMusicOff loop else findChair playerName -- emcee has turned music off, find a chair findChair playerName = do -- get a random chair nr <- randomRIO (1, 10) :: IO Int rotate chairs nr -- skip 1 to 10 random chairs chair <- readChan chairs -- try to take a chair case chairPlayer chair of Nothing -> do -- if not taken, take it writeChan chairs (chair {chairPlayer = Just playerName}) -- remove thread from active threads x <- takeMVar remaining putMVar remaining (x - 1) -- indicate we have taken it putMVar outputs $ playerName ++ " sat in " ++ chairName chair waitForEmcee playerName -- wait until emcee says round is over loop -- repeat _ -> do -- if chair taken writeChan chairs chair -- do not take chair x <- readMVar remaining -- check if there are other threads playing if x == 1 then do -- if we are the last one -- we didn't find a chair x <- takeMVar remaining putMVar remaining (x - 1) -- indicate we are done searching putMVar outputs $ playerName ++ " lost" -- print we lost return () -- end thread else findChair playerName -- try finding a chair again waitForEmcee playerName = do m <- readMVar music -- read current music state unless m $ do waitForEmcee playerName -- else, wait until game is started over waitForMusicOff = do m <- readMVar music -- read current music state when m $ do waitForMusicOff -- wait until music is off rotate chairs n = when (n > 0) $ do chair <- readChan chairs -- read and write channel to advance to next chair writeChan chairs chair rotate chairs (n - 1) -- Thread for the emcee emceeThread :: Int -> MVar [Char] -> IO () emceeThread n outputs = do putMVar outputs $ "BEGIN " ++ show n ++ " players" chairs <- newChan -- channel to save music <- newMVar True -- music player: True=on, False=off remaining <- newMVar 0 -- indicates threads still searching for a chair -- generate n - 1 chairs saving them in the chair channel mapM_ (writeChan chairs . newChair) [1..(n - 1)] -- generate n threads mapM_ (\i -> forkIO (playerThread i music chairs remaining outputs)) [1..n] startRound 1 n music chairs remaining last -- start rounds putMVar outputs "END" return () where startRound i n music chairs remaining last = do putMVar outputs $ "\nround " ++ show i -- play the music so threads go through chairs _ <- takeMVar music putMVar music True -- wait for all players to be ready waitForPlayersReady remaining (n - i + 1) -- turn off the music so threads take chairs putMVar outputs "music off" _ <- takeMVar music putMVar music False -- wait for all threads to get a chair (or fail to get one) waitForSeatedPlayers remaining if n > i + 1 then do -- reset chairs for next round removing the last one resetChairs (n - i) ("C" ++ show (n - i)) chairs -- start next round startRound (i + 1) n music chairs remaining last else do chair <- readChan chairs -- read the last player in the chair case chairPlayer chair of Just name -> do putMVar outputs $ "\n" ++ name ++ " wins!" return () Nothing -> do -- this should never happen putMVar outputs "\nERROR!" return () newChair i = Chair {chairName = "C" ++ show i, chairPlayer = Nothing} resetChairs m cs chairs = when (m > 0) $ do chair <- readChan chairs if chairName chair == cs then -- if it's the chair we look for resetChairs (m - 1) cs chairs -- don't add to chairs and recurse else do -- else, restore to list, removing player association writeChan chairs (chair {chairPlayer = Nothing}) resetChairs (m - 1) cs chairs -- recurse waitForSeatedPlayers remaining = do -- wait for threads to find a seat or to lose it threadDelay (10*1000) x <- readMVar remaining when (x > 0) $ waitForSeatedPlayers remaining -- if any thread is still active, loop waitForPlayersReady remaining m = do -- wait for all threads to be ready for round threadDelay (10*1000) x <- readMVar remaining unless (x == m) $ waitForPlayersReady remaining m -- if not all threads are ready, loop -- grabs things from the MVar and putStrLn's them. Quits when END is found announcer :: MVar String -> IO () announcer outputs = do msg <- takeMVar outputs putStrLn msg if msg == "END" -- if we see the last message... then return () -- then we're done. else announcer outputs -- else, recurse -- Main function main :: IO () main = do outputs <- newEmptyMVar args <- getArgs case args of (x:_) -> forkIO $ emceeThread (read x::Int) outputs _ -> forkIO $ emceeThread 10 outputs announcer outputs