+1 (315) 557-6473 

Program to Simulate Musical Chairs In Haskell Assignment Solution.


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.
  • 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
Program to simulate Musical chairs in Haskell
Program to simulate Musical chairs in Haskell 1
Program to simulate Musical chairs in Haskell 2
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
        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
                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
                            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 ()
        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