We are using the Labelled Transition System Analyser in class, and we're supposed to fix the following:
ROTATOR = in_PAUSED.
in_PAUSED = (Run -> in_RUN | Pause -> in_PAUSED | Interrupt -> STOP).
in_RUN = (Pause -> in_PAUSED || {Run,Rotate} -> in_RUN).
I know that the actions Run, Pause, Interrupt should follow the conventions of starting with lower case, and similarly processes being identified using uppercase.
ROTATOR = In_PAUSED.
In_PAUSED = (run -> In_RUN | pause -> In_PAUSED | interrupt -> STOP).
In_RUN = (pause -> In_PAUSED || {run,rotate} -> In_RUN).
However, after I compile this, I get an error: ERROR line:3 - ) expected. I don't really know how to fix it after this.
This is the answer
ROTATOR = In_PAUSED ,
In_PAUSED = ( run -> In_RUN | pause -> In_PAUSED | interrupt -> STOP ) ,
In_RUN = ( pause -> In_PAUSED | {run , rotate} -> In_RUN ) .
LOLOL I am in the same class.
Related
Suppose I have a function in Haskell which may not always terminate. Is there a way to make the program halt itself if it's taking too long to compute?
Example:
import qualified Data.Map as Map
walkmap :: Int -> Map.Map Int Int -> Int
walkmap x m = case Map.lookup x m of
Nothing -> x
Just y -> walkmap y m
main :: IO ()
main = do
let ma = Map.fromList [(0,1), (1,2)]
let mb = Map.fromList [(0,1), (1,0)]
print $ walkmap 0 ma
print $ walkmap 0 mb
walkmap ma 0 should return 2 right away, but walkmap mb 0 would loop forever. I know it's impossible to know for sure if the function would halt or not, what I'd like to know is if there's a way to set a time limit (say, 10 seconds) for that computation.
The answer to the question as asked looks like this:
timeout (10*1000000) (evaluate (walkmap 0 mb)) >>= print
But the answer to the "avoid cycles in a lookup" question that's behind it is Brent's remarkable tortoise and hare algorithm. (Beware! I have only tested this code on your exact two test cases. There could be bugs lurking in it. You should read about the algorithm behind the link and code review (or re-implement) it yourself.)
walkmap :: Ord a => a -> Map.Map a a -> Maybe a
walkmap a m = case Map.lookup a m of
Nothing -> Just a
Just a' -> go a a' (iterate (2*) 1)
where
-- p for pause
go a a' ps | a == a' = Nothing
go a a' (p:ps) = case Map.lookup a' m of
Nothing -> Just a'
Just a''
| p == 0 -> go a' a'' ps
| otherwise -> go a a'' (p-1:ps)
I've done some research but couldn't find anything. I don't understand how a function like this works:
func :: Maybe (Int) -> Maybe (Int)
How am I supposed to do the pattern matching? I've tried this but it didn't work:
func Just a = Just a | otherwise = Nothing
func Nothing = Just Nothing | otherwise = Nothing
How can I make this work?
Error message:
exercises6.hs:83:22: error: parse error on input ‘|’
|
83 | func Just a = Just a | otherwise = Nothing
| ^
You pattern match on the two possible cases. A Maybe a has two data constructors: a Nothing, and a Just … with … the value it wraps. There is no | otherwise part when you do pattern matching. The pipe character (|) is used for guards [lyah].
So you can for example increment the value in a Just with:
func :: Maybe Int -> Maybe Int
func (Just x) = Just (x+1)
func Nothing = Nothing
The brackets around Just x are required here, as #chepner says. Otherwise it will be parsed as if Just is the first parameter, and x is a second parameter.
Since Maybe is an instance of the Functor typeclass, you can make use of fmap :: Functor f => (a -> b) -> f a -> f b here:
func :: Maybe Int -> Maybe Int
func = fmap (1+)
The program below works if run with runhaskell or if compiled but not with -O2. If compiled with -O2 it seems to hang.
I'm using GHC 7.10.2.
I've changed the min/max iterations to 10 and 20 respectively. It will
generate anywhere from 20 to 100 MB of output into the file test.out.
Run time is about 15 - 60 secs.
Program Explanation
Below is a multi-threaded program that has a pool of workers and a manager. The workers generate traces to be used in plotting a Buddhabrot, put it in a queue, and a manager periodically empties the queue and writes the data to disk. When a certain amount of data has been generated, the program stops.
But when the program runs the manager thread only does one check, and then it gets stuck (the worker threads are still running). However, if I remove the part where the manager thread writes to file, then everything seems to work. I just don't understand why...
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
( forever
, unless
)
import Control.Monad.Loops
import System.IO
import System.Random
import qualified Data.Binary as B
import qualified Data.ByteString.Lazy as BS
type Coord = (Double, Double)
type Trace = [Coord]
-- | Represents a rectangle in the complex plane, bounded by a lower left
-- coordinate and an upper right coordinate.
data Plane
= Plane { ll :: Coord, ur :: Coord }
deriving (Show)
-- | Adds two coordinates.
(+.) :: Coord -> Coord -> Coord
(r1, i1) +. (r2, i2) = (r1 + r2, i1 + i2)
-- | Multiplies two coordinates.
(*.) :: Coord -> Coord -> Coord
(r1, i1) *. (r2, i2) = (r1*r2 - i1*i2, r1*i2 + r2*i1)
-- | Computes the square of a coordinate.
square :: Coord -> Coord
square (r, i) = (r*r - i*i, 2*r*i)
-- | Distance from origin to a given coordinate.
distFromOrigin :: Coord -> Double
distFromOrigin (r, i) = r*r + i*i
-- | A structure for passing data to the worker threads.
data WorkerData
= WorkerData { wdMinIt :: Int
, wdMaxIt :: Int
, wdTraceQueue :: TQueue Trace
-- ^ A queue of traces to be written to disk.
}
-- | A structure for passing data to the manager thread.
data ManagerData
= ManagerData { mdOutHandle :: Handle
-- ^ Handle to the output file.
, mdNumTraces :: Integer
-- ^ Number of traces to gather.
, mdTraceQueue :: TQueue Trace
-- ^ A queue of traces to be written to disk.
}
-- | Encodes an entity to binary bytestring.
encode :: B.Binary a => a -> BS.ByteString
encode = B.encode
-- | Writes a lazy bytestring to file.
writeToFile :: Handle -> BS.ByteString -> IO ()
writeToFile = BS.hPut
mkManagerData :: TQueue Trace -> IO ManagerData
mkManagerData t_queue =
do let out_f = "test.out"
out_h <- openBinaryFile out_f WriteMode
let num_t = 1000
return $ ManagerData { mdOutHandle = out_h
, mdNumTraces = num_t
, mdTraceQueue = t_queue
}
mkWorkerData :: TQueue Trace -> IO WorkerData
mkWorkerData t_queue =
do let min_it = 10 -- 1000
max_it = 20 -- 10000
return $ WorkerData { wdMinIt = min_it
, wdMaxIt = max_it
, wdTraceQueue = t_queue
}
-- | The actions to be performed by the manager thread.
runManager :: ManagerData -> IO ()
runManager m_data =
do execute 0
return ()
where execute count =
do new_traces <- purgeTQueue $ mdTraceQueue m_data
let new_count = count + (toInteger $ length new_traces)
putStrLn $ "Found " ++ (show $ new_count) ++ " traces so far. "
if length new_traces > 0
then do putStrLn $ "Writing new traces to file..."
_ <- mapM (writeToFile (mdOutHandle m_data))
(map encode new_traces)
putStr "Done"
else return ()
putStrLn ""
unless (new_count >= mdNumTraces m_data) $
do threadDelay (1000 * 1000) -- Sleep 1s
execute new_count
-- | The actions to be performed by a worker thread.
runWorker :: WorkerData -> IO ()
runWorker w_data =
forever $
do c <- randomCoord
case computeTrace c (wdMinIt w_data) (wdMaxIt w_data) of
Just t -> atomically $ writeTQueue (wdTraceQueue w_data) t
Nothing -> return ()
-- | Reads all values from a given 'TQueue'. If any other thread reads from the
-- same 'TQueue' during the execution of this function, then this function may
-- deadlock.
purgeTQueue :: Show a => TQueue a -> IO [a]
purgeTQueue q =
whileJust (atomically $ tryReadTQueue q)
(return . id)
-- | Generates a random coordinate to trace.
randomCoord :: IO Coord
randomCoord =
do x <- randomRIO (-2.102613, 1.200613)
y <- randomRIO (-1.237710, 1.239710)
return (x, y)
-- | Computes a trace, using the classical Mandelbrot function, for a given
-- coordinate and minimum and maximum iteration count. If the length of the
-- trace is less than the minimum iteration count, or exceeds the maximum
-- iteration count, 'Nothing' is returned.
computeTrace
:: Coord
-> Int
-- ^ Minimum iteration count.
-> Int
-- ^ Maximum iteration count.
-> Maybe Trace
computeTrace c0 min_it max_it =
if isUsefulCoord c0
then let step c = square c +. c0
computeIt c it = if it < max_it
then computeIt (step c) (it + 1)
else it
computeTr [] = error "computeTr: empty list"
computeTr (c:cs) = if length cs < max_it
then computeTr (step c:(c:cs))
else (c:cs)
num_it = computeIt c0 0
in if num_it >= min_it && num_it <= max_it
then Just $ reverse $ computeTr [c0]
else Nothing
else Nothing
-- | Checks if a given coordinate is useful by checking if it belongs in the
-- cardioid or period-2 bulb of the Mandelbrot.
isUsefulCoord :: Coord -> Bool
isUsefulCoord (x, y) =
let t1 = x - 1/4
p = sqrt (t1*t1 + y*y)
is_in_cardioid = x < p - 2*p*p + 1/4
t2 = x + 1
is_in_bulb = t2*t2 + y*y < 1/16
in not is_in_cardioid && not is_in_bulb
main :: IO ()
main =
do t_queue <- newTQueueIO
m_data <- mkManagerData t_queue
w_data <- mkWorkerData t_queue
let num_workers = 1
workers <- mapM async (replicate num_workers (runWorker w_data))
runManager m_data
_ <- mapM cancel workers
_ <- mapM waitCatch workers
putStrLn "Tracing finished"
Why It Fails
After reviewing the answers below, I finally realized why it doesn't work as intended. The program does not hang, but the time it takes for the manager thread to encode a single trace is in the order of tens of seconds (and when encoded it consumes several megabytes)! This means that even if there are some tens of traces in the queue when exhausted -- on my machine the workers manage to produce about 250 traces before the queue is exhausted by the manger thread -- it will take forever before the next exhaust.
Hence it matters little what solution I choose unless the work of the manager thread is greatly reduced. For that, I will have to abandon my idea of dumping each individual trace to file and instead process it once generated.
The problem is two-fold:
(1) The manager thread doesn't process any
Traces until it has exhausted the queue.
(2) The worker thread can add elements to the queue very, very quickly.
This results in a race that the manager thread rarely wins. [ This also explains the observed behavior with -O2 - the optimization just made the worker thread faster. ]
Adding some debugging code shows that the worker can add
items to the queue in excess of 100K Traces per second.
Moreover, even though the manager is only interested in
writing out the first 1000 Traces, the worker doesn't
stop at this limit. So, under certain circumstances,
the manager is never able to exit this loop:
purgeTQueue q =
whileJust (atomically $ tryReadTQueue q)
(return . id)
The simplest way to fix the code is to have the
manager thread use readTQueue to read and process just one
item off the queue at a time. This will also block
the manager thread when the queue us empty obviating
the need to the manager thread to periodically sleep.
Changing purgeTQueue to:
purgeTQueue = do item <- atomically $ readTQueue (mdTraceQueue m_data)
return [item]
and removing the threadDelay from runManager fixes the problem.
Example code available in the Lib4.hs module at: https://github.com/erantapaa/mandel
I tried to create a thread which does a calculation of the fibonacci-numbers. That worked fine, but then I tried to create another thread that stops the calculation-thread if it takes more than x seconds to calculate.
Here is my code:
module TimedFuture : sig
type 'a t
val create : ('a -> 'b) -> 'a -> float -> 'b t
val get : 'a t -> 'a option
end = struct
type 'a t = 'a Event.channel
let create f a t =
let c = Event.new_channel () in
let rec loop f = f (); loop f in
let task () =
let b = f a in
loop (fun () -> Event.(sync (send c b)))
in
let start_calc_thread () =
let t1 = Thread.create task () in
while ((Unix.gettimeofday () -. t) < 1.0) do
Printf.printf "Thread should keep running: %f\n"
(Unix.gettimeofday () -. t);
done;
try Thread.kill t1 with t1 -> ();
Printf.printf "Thread stoped\n"
in
let _ = Thread.create start_calc_thread () in
c
let get c = Some Event.(sync (receive c))
end
let option_to_i o = match o with
| None -> 0
| Some x -> x
let test =
let rec f x = match x with
| 1 -> 1
| 2 -> 1
| _ -> f (x-1) + f (x-2)
in
let t = Unix.gettimeofday () in
let ff = TimedFuture.create f 40 t in
Printf.printf "\nResult: %i\n" (option_to_i (TimedFuture.get ff)),
ff
When I compile the code and run it, the calculation thread doesn't stop working, although I get the "Thread stopped" in terminal.
Do you see my fault?
A thread can be interrupted in only specific cancellation points, in particular, in points where a user code passes control back to the runtime, so that the latter can do its work. One particular cancellation point is allocation. Since your code doesn't allocate, and reasonably implemented Fibonacci will not allocate either, it is not possible to stop it. If your real algorithm indeed doesn't have cancellation points, then you should either add them explicitly or use processes. To add explicit cancellation point, one can just add Thread.yield.
I am testing out the simple pong game found here: https://github.com/shangaslammi/frp-pong
The problem is that the keyboard controls work very badly - the keys are very unresponsive and often have a delay of a few seconds. I assume that the author wrote the code for Windows because he included a .bat file and so this is a Linux-specific problem.
Why is this happening?
I am unsure of where the problem would be, but here is the file Keyboard.hs:
import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.UI.GLUT (Key(..), KeyState(..))
-- | Set of all keys that are currently held down
newtype Keyboard = Keyboard (Set Key)
-- | Create a new Keyboard
initKeyboard :: Keyboard
initKeyboard = Keyboard Set.empty
-- | Record a key state change in the given Keyboard
handleKeyEvent :: Key -> KeyState -> Keyboard -> Keyboard
handleKeyEvent k Down = addKey k
handleKeyEvent k Up = removeKey k
addKey :: Key -> Keyboard -> Keyboard
addKey k (Keyboard s) = Keyboard $ Set.insert k s
removeKey :: Key -> Keyboard -> Keyboard
removeKey k (Keyboard s) = Keyboard $ Set.delete k s
-- | Test if a key is currently held down in the given Keyboard
isKeyDown :: Keyboard -> Key -> Bool
isKeyDown (Keyboard s) k = Set.member k s
And setting the callbacks:
type KeyboardRef = IORef Keyboard
type TimeRef = IORef POSIXTime
type AccumRef = TimeRef
type PrevTimeRef = TimeRef
type GameRef = IORef (Rects, GameLogic)
type CallbackRefs = (AccumRef, PrevTimeRef, KeyboardRef, GameRef)
initCallbackRefs :: IO CallbackRefs
initCallbackRefs = do
accum <- newIORef secPerTick
prev <- getPOSIXTime >>= newIORef
keyb <- newIORef initKeyboard
cont <- newIORef ([],game)
return (accum, prev, keyb, cont)
-- | Update the Keyboard state according to the event
handleKeyboard :: CallbackRefs -> KeyboardMouseCallback
handleKeyboard (_, _, kb, _) k ks _ _ = modifyIORef kb (handleKeyEvent k ks)
The lack of a GLUT timer seemed to be the problem.
Here is a correctly working version by Rian Hunter:
https://github.com/rianhunter/frp-pong