1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- Fortgeschrittene Funktionale Programmierung,
-- LMU, TCS, Wintersemester 2015/16
-- Steffen Jost, Alexander Isenko
--
-- Übungsblatt 10. 23.12.2015
--
-- Thema: Software Transactional Memory
--
-- Hinweis:
-- Heute gibt es nur eine größere Aufgabe!
-- Wer damit fertig ist, sollte im Anschluß zuvor
-- übersprunge Aufgaben behandeln.
--
-- Für diese Übung reicht auch ein Rechner mit einem Kern.
--
-- A10-1 The Santa Claus problem
--
-- Heute wollen wir uns von Haskell ganz nebenläufig
-- in eine weihnachtliche Stimmung versetzen lassen:
--
-- Der Weihnachtsmann schläft friedlich am Nordpol.
-- Er läßt sich jedoch nur in zwei Situationen wecken:
-- 1) Alle seine 9 Rentiere sind bereits aus dem Karibik-Urlaub
-- zurückgekommen. Dann ist es bereits höchste Zeit,
-- diese an den Schlitten zu binden und die Geschenke
-- auzuliefern, denn die Rentiere möchten möglichst viel Zeit
-- in der Karibik verbringen und kommen ungern früher als
-- nötig zum Nordpol zurück. (Deswegen beeilen sich die
-- Rentiere auch so beim Ausliefern aller Geschenke!)
-- 2) Einige seiner elf Elfen haben Probleme mit
-- Innovationsmanagement oder Fertigungstechnik
-- für die Produktion der Geschenke und verlangen
-- ein Executive Meeting.
-- Da die Elfen immer irgendwelche Probleme haben,
-- läßt sich der Weihnachtsmann nur wecken, wenn
-- mindestens 3 Elfen nach einem Meeting verlangen;
-- Falls nur ein oder zwei Elfen ein Gesprächsbedürfnis
-- hegen, so müssen diese ruhig und erfurchtsvoll im
-- Vorzimmmer abwarten.
-- Da andererseits Meetings mit mehr als 3 Elfen
-- absolut unproduktiv sind, müssen alle Elfen ab dem
-- vierten ebenfalls warten, bis der Weihnachtsmann das
-- vorherige Meeting beendet hat (waren es z.B. insgesamt
-- 5 Elfen, dann müssen der vierte und fünfte Elf natürlich
-- erneut auf einen sechsten Elfen warten).
-- Der Weihnachtsmann beendet immer zuerst eine angefangene Aufgabe,
-- bevor er eine neue Aufgabe beginnt.
-- Treten beide Ereignisse gleichzeitig ein, so gibt er den Rentieren
-- den Vorrang, da die Geschenke ja pünktlich ausgeliefert werden müssen.
--
-- Diese Problem wollen wir in Haskell mithilfe der
-- Implementationstechnik "Software Transactional Memory"
-- modellieren.
--
--
-- Diese Aufgabenstellung stammt aus "A new excercise in concurrency"
-- von John A. Trono, SIGCSE Bulletin, 26:8-10, 1994.
--
-- Eine elegante Lösung dieses Problems unter Verwendung von
-- Software Transactional Memory wird detailliert behandelt von
-- Simon Peyton Jones im Kapitel "Beautiful Concurrency"
-- aus dem Buch "Beautiful Code" von Greg Wilson und Andy Oram, O'Reilly, 2007.
--
--
-- Das Gerüst in dieser Datei macht bereits einige Vorschläge,
-- doch Sie dürfen ALLES ABÄNDERN, z.B. zusätzliche Funktionsargumente
-- zum Übergeben von TVars werden vermutlich notwendig sein, etc.
--
-- Versuchen Sie zuerst einmal, Santa & die Rentiere
-- zu synchronisieren und deaktivieren Sie die Elfen.
--
-- Die zentrale Frage lautet:
-- Wie viele TVars welcher Art werden gebraucht?
--
-- Am Ende dieser Datei befinden sich weitere Hinweise.
-- Schauen Sie dort nach, falls Sie nicht weiter wissen.
--
module Main where
import Data.List
import Control.Concurrent.STM
import Control.Concurrent
import Control.Monad
import System.Random
import System.IO
import Control.DeepSeq
import qualified Data.Set as Set
import Data.Set (Set)
newtype ElfId = Elf Integer
deriving (Num, Enum, Show, Eq, Ord, NFData)
newtype RaindeerId = Raindeer Integer
deriving (Num, Enum, Show, Eq, Ord, NFData)
data GroupState id = GroupState
{ waiting :: TVar [id]
, working :: TVar (Set id)
}
data State = State
{ elfs :: GroupState ElfId
, raindeers :: GroupState RaindeerId
, outChan :: Chan String
}
initState :: IO State
initState = State
<$> initGroupState
<*> initGroupState
<*> newChan
initGroupState :: IO (GroupState a)
initGroupState = GroupState
<$> newTVarIO []
<*> newTVarIO Set.empty
main :: IO ()
main = initState >>= main'
main' :: State -> IO ()
main' state@(State{..}) = do
mapM_ (forkIO . elf state) [1..11]
mapM_ (forkIO . rentier state) [1..9]
forkIO $ santa state
hSetBuffering stdin NoBuffering
forkIO $ forever $ readChan outChan >>= putStrLn
mloop
where
mloop = getChar >>= flip unless mloop . (== 'q')
santa :: State -> IO ()
santa State{..} = forever . join . atomically $ deliver `orElse` meeting
where
deliver = do
check . (>= 9) . length =<< readTVar (waiting raindeers)
mapM_ (flip setWorking raindeers) =<< readTVar (waiting raindeers)
return $ do
writeChan outChan "Ho! Ho! Ho! Hüja Rentiere!"
atomically $ check . Set.null =<< readTVar (working raindeers)
meeting = do
check . (>= 3) . length =<< readTVar (waiting elfs)
mapM_ (flip setWorking elfs) =<< take 3 <$> readTVar (waiting elfs)
return $ do
writeChan outChan "Ho! Ho! Ho! Besprechung eröffnet!"
atomically $ check . Set.null =<< readTVar (working elfs)
elf :: State -> ElfId -> IO ()
elf State{..} eid = forever $ do
writeChan outChan $ show eid ++ " arbeitet."
randomDelay 6
writeChan outChan $ show eid ++ " ist traurig."
atomically $ setWaiting eid elfs
atomically $ check =<< isWorking eid elfs
writeChan outChan $ show eid ++ " hat Besprechung."
randomDelay 1
writeChan outChan $ show eid ++ " hat Besprechung verlassen."
atomically $ unregister eid elfs
rentier :: State -> RaindeerId -> IO ()
rentier State{..} rid = forever $ do
writeChan outChan $ show rid ++ " ist im Urlaub."
randomDelay 8
writeChan outChan $ show rid ++ " ist zurück."
atomically $ setWaiting rid raindeers
atomically $ check =<< isWorking rid raindeers
writeChan outChan $ show rid ++ " liefert Geschenke."
randomDelay 2
writeChan outChan $ show rid ++ " ist fertig mit ausliefern."
atomically $ unregister rid raindeers
--------------------
-- Hilfsfunktionen
--------------------
randomDelay :: Int -> IO ()
-- Delay for a random time between 1 and n * 500,000 microseconds
randomDelay n = do
let t = n * 500000
waitTime <- getStdRandom (randomR (1, t))
threadDelay waitTime
snoc :: a -> [a] -> [a]
snoc = flip (++) . pure
setWaiting :: (Ord id, NFData id) => id -> GroupState id -> STM ()
setWaiting id st@(GroupState{..}) = unregister id st >> modifyTVar' waiting (snoc id $!!)
setWorking :: (Ord id, NFData id) => id -> GroupState id -> STM ()
setWorking id st@(GroupState{..}) = unregister id st >> modifyTVar' working (Set.insert id $!!)
isWorking :: (Ord id, NFData id) => id -> GroupState id -> STM Bool
isWorking id GroupState{..} = Set.member id <$> readTVar working
unregister :: (Ord id, NFData id) => id -> GroupState id -> STM ()
unregister id GroupState{..} = do
modifyTVar' waiting (filter (/= id) $!!)
modifyTVar' working (Set.delete id $!!)
{- Eventuell nützliche Funktion aus Modul Control.Monad.STM:
check :: Bool -> STM ()
check b = if b then return () else retry
-}
----------------------------------------------------------------
-- WEITERE HINWEISE:
----------------------------------------------------------------
{-
* Beide Quellen zur Aufgabe finden sich problemlos im Internet,
unter anderem auch im Haskell Center auf fpcomplete.com.
Die elegante Lösung von Simon Peyton Jones ist auf einem sehr hohen
Abstraktionsniveau, welches wir vermutlich nicht auf Anhieb in der
Übung erreichen können.
Natürlich ist es schön und vermeidet Fehler, wenn man zum Beispiel
den ähnlichen Code für Rentiere und Elfe mit einer generischen
Funktion abhandeln kann, aber für den Anfang is es okay, spezielleren
Code zu schreiben, so lange dieser korrekt ist.
Gemeinsamkeiten im Code kann man hinterher immer noch Erkennen
und generalisieren.
Unser Lösungsvorschlag im UniworX wird daher auch eine weniger elegante
Version zeigen. Es wird jedoch ausdrücklich empfohlen, hinterher
einmal auch die kürzere Lösung von Simon Peyton Jones durchzudenken.
-}
{-
* Die Grundidee ist wie folgt:
Jedes Rentier/Elf durchläuft folgende Endlosschleife:
1. Eigene Arbeit erledigen (durch Aufruf an "randomDelay" symbolisiert)
2. Bereitschaft an Weihnachtsmann Prozess signalisieren
3. Warten, bis Weihnachtsmann Startzeichen gibt.
4. Arbeit mit Weihnachtsmann erledigen (durch Aufruf an "randomDelay" symbolisiert)
5. Weihnachtsmann das Ende der eigenen Arbeit signalisieren
Der Weihnachtsmann (bzw. dessen PA, da der Weihnachtsmann
selbst ja eigentlich schläft), prüft ständig ob genug
Rentiere oder Elfen seine Aufmerksamkeit verlangen, und
gibt ggf. den entsprechenden Rentieren/Elfen das Startsignal.
Danach wartet er darauf, dass diese noch das Ende der jeweiligen Aufgabe signalisieren.
-}
{-
Signalisieren soll ausschließlich über TVars erfolgen,
warten kann mit retry oder check (siehe Hilfsfunktionen) realisiert werden.
-}
{-
Die Antowrt auf die Frage, wie viele TVars welcher Art gebraucht werden,
kann ganz unterschiedlich beantwortet werden.
Zum Beispiel verwendet unser Lösungsvorschlag mehrere globale TVars,
während die Lösung von Simon Peyton Jones nur 2 in einem
speziellen Datentyp verpackte TVars verwendet, welche auf weitere,
je nach Aufgabe dynamisch angelegte, TVars verweisen.
-}
{-
Beispielausgabe mit vielen Extra-Ausgaben an der Konsole zum Verständnis des Ablaufs:
Elf 21 ist traurig. Wartezimmer vorher: 0
Elf 16 ist traurig. Wartezimmer vorher: 1
Elf 11 ist traurig. Wartezimmer vorher: 2
Ho! Ho! Ho! Besprechung eröffnet [21,16,11] !
Elf 21 hat Besprechung.
Elf 16 hat Besprechung.
Elf 11 hat Besprechung.
Rentier 8 ist zurück. Vorher im Stall: 0
Elf 20 ist traurig. Wartezimmer vorher: 0
Elf 13 ist traurig. Wartezimmer vorher: 1
Rentier 7 ist zurück. Vorher im Stall: 1
Ho! Ho! Ho! Besprechung vorbei!
Rentier 6 ist zurück. Vorher im Stall: 2
Elf 14 ist traurig. Wartezimmer vorher: 2
Elf 11 ist traurig. Wartezimmer vorher: 3
Elf 17 ist traurig. Wartezimmer vorher: 4
Elf 15 ist traurig. Wartezimmer vorher: 5
Ho! Ho! Ho! Besprechung eröffnet [20,13,14] !
Elf 20 hat Besprechung.
Elf 13 hat Besprechung.
Elf 14 hat Besprechung.
Rentier 2 ist zurück. Vorher im Stall: 3
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [11,17,15] !
Elf 11 hat Besprechung.
Elf 17 hat Besprechung.
Elf 15 hat Besprechung.
Elf 14 ist traurig. Wartezimmer vorher: 0
Elf 13 ist traurig. Wartezimmer vorher: 1
Elf 17 ist traurig. Wartezimmer vorher: 2
Elf 19 ist traurig. Wartezimmer vorher: 3
Elf 16 ist traurig. Wartezimmer vorher: 4
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [14,13,17] !
Elf 14 hat Besprechung.
Elf 13 hat Besprechung.
Elf 17 hat Besprechung.
Elf 18 ist traurig. Wartezimmer vorher: 2
Elf 21 ist traurig. Wartezimmer vorher: 3
Elf 12 ist traurig. Wartezimmer vorher: 4
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [19,16,18] !
Elf 19 hat Besprechung.
Elf 16 hat Besprechung.
Elf 18 hat Besprechung.
Rentier 9 ist zurück. Vorher im Stall: 4
Rentier 3 ist zurück. Vorher im Stall: 5
Elf 20 ist traurig. Wartezimmer vorher: 2
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [21,12,20] !
Elf 21 hat Besprechung.
Elf 12 hat Besprechung.
Elf 20 hat Besprechung.
Rentier 5 ist zurück. Vorher im Stall: 6
Elf 15 ist traurig. Wartezimmer vorher: 0
Rentier 4 ist zurück. Vorher im Stall: 7
Ho! Ho! Ho! Besprechung vorbei!
Rentier 1 ist zurück. Vorher im Stall: 8
Elf 12 ist traurig. Wartezimmer vorher: 1
Elf 20 ist traurig. Wartezimmer vorher: 2
Ho! Ho! Ho! Hüja Rentiere [1,4,5,3,9,2,6,7,8] !
Rentier 8 liefert Geschenke.
Rentier 7 liefert Geschenke.
Rentier 6 liefert Geschenke.
Rentier 2 liefert Geschenke.
Rentier 9 liefert Geschenke.
Rentier 3 liefert Geschenke.
Rentier 5 liefert Geschenke.
Rentier 4 liefert Geschenke.
Rentier 1 liefert Geschenke.
Elf 17 ist traurig. Wartezimmer vorher: 3
Elf 21 ist traurig. Wartezimmer vorher: 4
Elf 11 ist traurig. Wartezimmer vorher: 5
Elf 13 ist traurig. Wartezimmer vorher: 6
Ho! Ho! Ho! Was für ein Fest!
Ho! Ho! Ho! Besprechung eröffnet [15,12,20] !
Elf 15 hat Besprechung.
Elf 12 hat Besprechung.
Elf 20 hat Besprechung.
Rentier 6 ist zurück. Vorher im Stall: 0
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [17,21,11] !
Elf 17 hat Besprechung.
Elf 21 hat Besprechung.
Elf 11 hat Besprechung.
Elf 14 ist traurig. Wartezimmer vorher: 1
Ho! Ho! Ho! Besprechung vorbei!
Elf 19 ist traurig. Wartezimmer vorher: 2
Elf 16 ist traurig. Wartezimmer vorher: 3
Rentier 9 ist zurück. Vorher im Stall: 1
Elf 18 ist traurig. Wartezimmer vorher: 4
Ho! Ho! Ho! Besprechung eröffnet [13,14,19] !
Elf 13 hat Besprechung.
Elf 14 hat Besprechung.
Elf 19 hat Besprechung.
Elf 17 ist traurig. Wartezimmer vorher: 2
Elf 12 ist traurig. Wartezimmer vorher: 3
Rentier 3 ist zurück. Vorher im Stall: 2
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [16,18,17] !
Elf 16 hat Besprechung.
Elf 18 hat Besprechung.
Elf 17 hat Besprechung.
Elf 11 ist traurig. Wartezimmer vorher: 1
Rentier 5 ist zurück. Vorher im Stall: 3
Elf 14 ist traurig. Wartezimmer vorher: 2
Elf 18 ist traurig. Wartezimmer vorher: 3
Rentier 1 ist zurück. Vorher im Stall: 4
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [12,11,14] !
Elf 12 hat Besprechung.
Elf 11 hat Besprechung.
Elf 14 hat Besprechung.
Elf 15 ist traurig. Wartezimmer vorher: 1
Elf 19 ist traurig. Wartezimmer vorher: 2
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [18,15,19] !
Elf 18 hat Besprechung.
Elf 15 hat Besprechung.
Elf 19 hat Besprechung.
Elf 21 ist traurig. Wartezimmer vorher: 0
Rentier 8 ist zurück. Vorher im Stall: 5
Rentier 2 ist zurück. Vorher im Stall: 6
Elf 17 ist traurig. Wartezimmer vorher: 1
Rentier 7 ist zurück. Vorher im Stall: 7
Elf 13 ist traurig. Wartezimmer vorher: 2
Elf 20 ist traurig. Wartezimmer vorher: 3
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [21,17,13] !
Elf 21 hat Besprechung.
Elf 17 hat Besprechung.
Elf 13 hat Besprechung.
Rentier 4 ist zurück. Vorher im Stall: 8
Elf 16 ist traurig. Wartezimmer vorher: 1
Elf 12 ist traurig. Wartezimmer vorher: 2
Elf 19 ist traurig. Wartezimmer vorher: 3
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Hüja Rentiere [4,7,2,8,1,5,3,9,6] !
Rentier 6 liefert Geschenke.
Rentier 9 liefert Geschenke.
Rentier 3 liefert Geschenke.
Rentier 5 liefert Geschenke.
Rentier 1 liefert Geschenke.
Rentier 8 liefert Geschenke.
Rentier 2 liefert Geschenke.
Rentier 7 liefert Geschenke.
Rentier 4 liefert Geschenke.
Elf 17 ist traurig. Wartezimmer vorher: 4
Elf 13 ist traurig. Wartezimmer vorher: 5
Ho! Ho! Ho! Was für ein Fest!
Ho! Ho! Ho! Besprechung eröffnet [20,16,12] !
Elf 20 hat Besprechung.
Elf 16 hat Besprechung.
Elf 12 hat Besprechung.
Rentier 3 ist zurück. Vorher im Stall: 0
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [19,17,13] !
Elf 19 hat Besprechung.
Elf 17 hat Besprechung.
Elf 13 hat Besprechung.
Rentier 5 ist zurück. Vorher im Stall: 1
Elf 11 ist traurig. Wartezimmer vorher: 0
Elf 16 ist traurig. Wartezimmer vorher: 1
Rentier 4 ist zurück. Vorher im Stall: 2
Elf 15 ist traurig. Wartezimmer vorher: 2
Elf 14 ist traurig. Wartezimmer vorher: 3
Elf 18 ist traurig. Wartezimmer vorher: 4
Rentier 6 ist zurück. Vorher im Stall: 3
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [11,16,15] !
Elf 11 hat Besprechung.
Elf 16 hat Besprechung.
Elf 15 hat Besprechung.
Elf 21 ist traurig. Wartezimmer vorher: 2
Elf 12 ist traurig. Wartezimmer vorher: 3
Ho! Ho! Ho! Besprechung vorbei!
Ho! Ho! Ho! Besprechung eröffnet [14,18,21] !
Elf 14 hat Besprechung.
Elf 18 hat Besprechung.
Elf 21 hat Besprechung.
Elf 14 ist traurig. Wartezimmer vorher: 1
Rentier 2 ist zurück. Vorher im Stall: 4
Ho! Ho! Ho! Besprechung vorbei!
q
-}
|
