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