initial exercise

.gitignore

@@ -0,0 +1,20 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+*~

.travis.yml

@@ -0,0 +1,41 @@
+# This is the simple Travis configuration, which is intended for use
+# on applications which do not require cross-platform and
+# multiple-GHC-version support. For more information and other
+# options, see:
+#
+# https://docs.haskellstack.org/en/stable/travis_ci/
+#
+# Copy these contents into the root directory of your Github project in a file
+# named .travis.yml
+
+# Use new container infrastructure to enable caching
+sudo: false
+
+# Do not choose a language; we provide our own build tools.
+language: generic
+
+# Caching so the next build will be fast too.
+cache:
+  directories:
+  - $HOME/.stack
+
+# Ensure necessary system libraries are present
+addons:
+  apt:
+    packages:
+      - libgmp-dev
+
+before_install:
+# Download and unpack the stack executable
+- mkdir -p ~/.local/bin
+- export PATH=$HOME/.local/bin:$PATH
+- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+
+install:
+# Build dependencies
+- stack --no-terminal --install-ghc test --only-dependencies
+
+script:
+# Build the package, its tests, and its docs and run the tests
+- stack --no-terminal test --haddock --no-haddock-deps
+

LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,83 @@
+Übungszettel 10
+==============
+
+Parallelismus & Nebenläufigkeit
+
+Issue 1
+-------
+
+Im Modul `Parallel` finden Sie eine Funktion, die Sie noch von Zettel 3 kennen.
+Zur Erinnerung: Die Funktion `nBesteEingaben` gibt Ihnen mit beliebiger numerischer Genauigkeit
+diejenigen Eingaben (4-Tupel, jeweils mit Werten aus [-10,10]) zurück, für die eine
+`komlizierteFunktion` maximal wird. Hierfür wird der komplizierten Funktion mithilfe von
+List-Applicative (kartesisches Produkt) eine lange, beliebig dichte Liste möglicher Eingabewerte
+zwischen `(-10,-10,-10,-10)` und `(10,10,10,10)` übergeben. Bei einem Abstand von 0.5 ergeben sich
+damit 41^4 = 2 825 761 Berechnungen. Diese lohnt es sich zu parallelisieren.
+
+Parallelisieren Sie die Funktion `nBesteEingaben`, mit mindestens drei verschiedenen Strategien für Listen aus
+[`Control.Parallel.Strategies`](https://hackage.haskell.org/package/parallel-3.2.1.1/docs/Control-Parallel-Strategies.html#v:evalList).
+
+Um ihre Parallelisierung zu testen, verwenden Sie die folgenden Terminalbefehle:
+
+```bash
+stack exec -- MainParallel1 +RTS -N1 -s
+stack exec -- MainParallel1 +RTS -N2 -s
+stack exec -- MainParallel1 +RTS -N4 -s
+stack exec -- MainParallel1 +RTS -N8 -s
+```
+`-Nx` steht hierbei für die Verwendung von x Kernen.
+
+Eine sinnvolle Parallelisierung erkennen Sie daran, dass die Berechnung schneller wird,
+je mehr echte Kerne Sie für zur Verfügung stellen.
+
+Notieren sie die Laufzeiten ihrer Versuche in einer Tabelle und geben sie den Speedup (`-N1`-Zeit/`-Nx`Zeit) an.
+
+Issue 2
+-------
+
+Sie werden bemerkt haben, dass der Speedup sich nicht linear mit der Anzahl der Kerne steigern lässt.
+Nach [Amdahls Gesetz](https://de.wikipedia.org/wiki/Amdahlsches_Gesetz) ist bei vielen Kernen der nicht-parallelisierte Part
+(in unserem Fall das sortieren) für die schlechte Performance verantwortlich.
+
+Da wir uns nur für die Top `n` eingaben interessieren, schreiben sie eine Funktion
+
+```haskell
+topn :: Int -> [a] -> [a]
+```
+
+welche nach `n` Einsortierungsversuchen das zu sortierende Element verwirft (z.B. als Liste oder Array) und somit die Sortierung
+frühestmöglich abbricht.
+
+Füllen sie die Speedup-Tabelle erneut aus. Was ändert sich?
+
+Issue 3
+-------
+
+Sie besitzen eine Bank und sollen Überweisungen programmieren. Sie finden in `Banking.hs` alles fertig. Nur noch die `debit`-Funktion muss geschrieben werden,
+die von dem ersten auf das Zweite Konto überweist.
+
+Im Szenario der Main-Funktionen hat die Bank 10 verschiedene Server, die gleichzeitig dieselbe Transaktion auf der Datenbank ausführen wollen
+(also haben sie mehrere "Banken" in der Main, die auch alle etwas ausgeben, aber alle zeigen denselben Kontostand, da die Konten selbst nur 1x existieren).
+
+Führen sie anschließend MainBanking1 und MainBanking2 aus. Was können sie beobachten? Wie kommt es zu den Ergebnissen?
+
+Hint (optional!): Mittels `stack exec -- MainBanking1 +RTS -ls` können sie ein eventlog ausgeben lassen, welches sie mittels `threadscope` (`stack install threadscope`) ansehen können.
+
+Was passiert, wenn sie dies mit `-N1` ausführen? Wieso?
+
+Issue 4
+-------
+
+Da sie in Aufgabe 3 in Probleme gelaufen sind (sind sie doch, oder? ;) ), benutzen sie hier statt `MVar`s die STM-eigenen `TMVar`s.
+
+In `STMBanking.hs` finden sie die gleiche Situation vor - nur müssen sie hier mit `STM` statt mit `MVar` arbeiten.
+
+Führen sie anschließend MainSTMBanking1 und MainSTMBanking2 aus. Was können sie beobachten? Inwiefern unterscheiden sich die Ergebnisse zu den `MVar`s?
+
+Hint (optional!): Mittels `stack exec -- MainBanking1 +RTS -ls` können sie ein eventlog ausgeben lassen, welches sie mittels `threadscope` (`stack install threadscope`) ansehen können.
+
+Was passiert, wenn sie dies mit `-N1` ausführen? Wieso?
+
+Wo sind die Unterschiede zu `MVar`s (Performance, Einfachheit der Programmierung, Resistenz gegen Programmierfehler, ..)? Beschreiben sie kurz wie sich ihre Probleme mit
+der jeweiligen Implementation anfühlten und wieso sie welche Lösung selbst bevorzugen würden.
+

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/MainBanking1.hs

@@ -0,0 +1,24 @@
+module Main where
+
+import qualified Control.Concurrent.Thread as Thread ( forkIO, result )
+import Control.Concurrent.MVar
+import Control.Monad
+import Data.Time.Clock
+
+import Banking
+
+main :: IO ()
+main = do
+        start <- getCurrentTime
+        bank <- setup
+        -- start 10 threads doing 10000 treansactions each
+        threads <- sequence $ Thread.forkIO <$> replicate 10 (foldr1 (>=>) (replicate 10000 testTransaction1) bank)
+        banks <- sequence $ (\(_,w) -> w >>= Thread.result) <$> threads
+        stop <- getCurrentTime
+        printBanks banks
+        print $ "Time taken: " ++ (show $ diffUTCTime stop start)
+printBanks :: [Bank] -> IO ()
+printBanks (a:as) = do
+        sequence_ $ (readMVar >=> print) <$> a
+printBanks [] = return ()
+

app/MainBanking2.hs

@@ -0,0 +1,26 @@
+module Main where
+
+import qualified Control.Concurrent.Thread as Thread ( forkIO, result )
+import Control.Concurrent.MVar
+import Control.Monad
+import Data.Time.Clock
+
+import Banking
+
+main :: IO ()
+main = do
+        start <- getCurrentTime
+        bank <- setup
+        bank' <- newMVar bank
+        -- start 10 threads doing 10000 treansactions each
+        threads <- sequence $ Thread.forkIO <$> replicate 10 (foldr1 (>=>) (replicate 10000 testTransaction2) bank')
+        banks <- sequence $ (\(_,w) -> w >>= Thread.result) <$> threads
+        stop <- getCurrentTime
+        printMBanks banks
+        print $ "Time taken: " ++ (show $ diffUTCTime stop start)
+
+printMBanks :: [MVar Bank] -> IO ()
+printMBanks (a:as) = do
+        a' <- readMVar a
+        sequence_ $ (readMVar >=> print) <$> a'
+printMBanks [] = return ()

app/MainParallel1.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Parallel
+
+main :: IO ()
+main = putStr strategy1

app/MainParallel2.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Parallel
+
+main :: IO ()
+main = putStr strategy2

app/MainParallel3.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Parallel
+
+main :: IO ()
+main = putStr strategy3

app/MainSTMBanking1.hs

@@ -0,0 +1,24 @@
+module Main where
+
+import qualified Control.Concurrent.Thread as Thread ( forkIO, result )
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Time.Clock
+
+import STMBanking
+
+main :: IO ()
+main = do
+        start <- getCurrentTime
+        bank <- setup
+        -- start 10 threads doing 10000 treansactions each
+        threads <- sequence $ Thread.forkIO <$> replicate 10 (foldr1 (>=>) (replicate 10000 testTransaction1) bank)
+        banks <- sequence $ (\(_,w) -> w >>= Thread.result) <$> threads
+        stop <- getCurrentTime
+        printBanks banks
+        print $ "Time taken: " ++ (show $ diffUTCTime stop start)
+
+printBanks :: [Bank] -> IO ()
+printBanks (a:as) = do
+        sequence_ $ ((atomically . readTMVar) >=> print) <$> a
+printBanks [] = return ()

app/MainSTMBanking2.hs

@@ -0,0 +1,28 @@
+module Main where
+
+import qualified Control.Concurrent.Thread as Thread ( forkIO, result )
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Time.Clock
+
+import STMBanking
+
+main :: IO ()
+main = do
+        start <- getCurrentTime
+        bank <- setup
+        bank' <- newTMVarIO bank
+        -- start 10 threads doing 10000 treansactions each
+        threads <- sequence $ Thread.forkIO <$> replicate 10 (foldr1 (>=>) (replicate 10000 testTransaction2) bank')
+        banks <- sequence $ (\(_,w) -> w >>= Thread.result) <$> threads
+        stop <- getCurrentTime
+        printMBanks banks
+        print $ "Time taken: " ++ (show $ diffUTCTime stop start)
+
+printMBanks :: [TMVar Bank] -> IO ()
+printMBanks (a:as) = do
+        vals <- atomically $ do
+                a' <- readTMVar a
+                sequence $ readTMVar <$> a'
+        sequence_ $ print <$> vals
+printMBanks [] = return ()

src/Banking.hs

@@ -0,0 +1,44 @@
+module Banking where
+
+import Control.Concurrent.MVar
+
+data Konto = Konto
+  { cents  :: Integer
+  , nummer :: Integer
+  }
+  deriving (Show, Eq)
+
+type Bank = [MVar Konto]
+
+kontoA :: Konto
+kontoA = Konto 1000 1
+kontoB :: Konto
+kontoB = Konto 0    2
+kontoC :: Konto
+kontoC = Konto 2000 3
+
+-- IMPLEMENTIEREN
+debit :: Bank -> MVar Konto -> MVar Konto -> Integer -> IO Bank
+debit b _ _ _ = return b
+
+-- diese Transaktion überweist 1000 cent einmal reihum.
+-- Danach hat jeder dasselbe Geld wie vorher - theoretisch!
+testTransaction1 :: Bank -> IO Bank
+testTransaction1 bank = do
+        bank <- debit bank (bank!!0) (bank!!1) 1000
+        bank <- debit bank (bank!!1) (bank!!2) 1000
+        debit bank (bank!!2) (bank!!0) 1000
+
+-- Dieselbe Transaktion. Diesmal mit gelockter Bank.
+testTransaction2 :: MVar Bank -> IO (MVar Bank)
+testTransaction2 mb = do
+        bank <- takeMVar mb
+        bank <- debit bank (bank!!0) (bank!!1) 1000
+        bank <- debit bank (bank!!1) (bank!!2) 1000
+        bank <- debit bank (bank!!2) (bank!!0) 1000
+        putMVar mb bank
+        return mb
+
+
+setup :: IO Bank
+setup = sequence $ newMVar <$> [kontoA, kontoB, kontoC]

src/KomplizierteFunktion.hs

@@ -0,0 +1,7 @@
+module KomplizierteFunktion
+        ( komplizierteFunktion
+        ) where
+
+{-# INLINE komplizierteFunktion #-}
+
+komplizierteFunktion x y z w = 1/exp (abs (x- 2.3))^2 * sin( (y- 2.9))^2+cos( (0.4*z- 2.6))^5 *(2*z)^2-(2*z- 2.6)^2+ (25-log(abs (w- 0.6)+1))

src/Parallel.hs

@@ -0,0 +1,44 @@
+module Parallel where
+
+import Data.List
+import Data.Array
+import Data.Ord
+import Control.Parallel.Strategies
+import Control.DeepSeq
+import KomplizierteFunktion
+
+-- Sie sollen Minima einer komplizierten Funktion finden. Die Funktion erlaubt keine analytische Berechnung 
+-- der Maxima. Daher sollen Sie im Intervall [-10,10] für alle Parameter x y z w approximativ Maxima suchen. 
+
+-- komplizierteFunktion :: Double -> Double -> Double -> Double -> Double
+
+berechnungMitEingabe :: Double -> Double -> Double -> Double -> ((Double,Double,Double,Double),Double)
+berechnungMitEingabe x y z w = ((x,y,z,w),komplizierteFunktion x y z w)
+
+nBesteEingaben :: Int -> Double -> [((Double,Double,Double,Double),Double)]
+nBesteEingaben n d = take n $ sortOn (negate.snd) $ berechnungMitEingabe <$> range <*> range <*> range <*> range 
+  where range = [(-10),(-(10-d))..10]
+
+-- 3 x dieselbe implementation -> versuchen sie 3 verschiedene Strategien der Parallelisierung
+nBesteEingabenPar1 :: Int -> Double -> [((Double,Double,Double,Double),Double)]
+nBesteEingabenPar1 n d = take n $ sortOn (negate.snd) berechnungen
+  where
+    berechnungen = berechnungMitEingabe <$> range <*> range <*> range <*> range
+    range = [(-10),(-(10-d))..10]
+
+nBesteEingabenPar2 :: Int -> Double -> [((Double,Double,Double,Double),Double)]
+nBesteEingabenPar2 n d = take n $ sortOn (negate.snd) berechnungen
+  where
+    berechnungen = berechnungMitEingabe <$> range <*> range <*> range <*> range
+    range = [(-10),(-(10-d))..10]
+
+nBesteEingabenPar3 :: Int -> Double -> [((Double,Double,Double,Double),Double)]
+nBesteEingabenPar3 n d = take n $ sortOn (negate.snd) berechnungen
+  where
+    berechnungen = berechnungMitEingabe <$> range <*> range <*> range <*> range
+    range = [(-10),(-(10-d))..10]
+
+strategy1 = show $ nBesteEingabenPar1 10 0.5
+strategy2 = show $ nBesteEingabenPar2 10 0.5
+strategy3 = show $ nBesteEingabenPar3 10 0.5
+

src/STMBanking.hs

@@ -0,0 +1,44 @@
+module STMBanking where
+
+import Control.Concurrent.STM
+
+data Konto = Konto
+  { cents  :: Integer
+  , nummer :: Integer
+  }
+  deriving (Show, Eq)
+
+type Bank = [TMVar Konto]
+
+kontoA :: Konto
+kontoA = Konto 1000 1
+kontoB :: Konto
+kontoB = Konto 0    2
+kontoC :: Konto
+kontoC = Konto 2000 3
+
+-- IMPLEMENTIEREN
+debit :: Bank -> TMVar Konto -> TMVar Konto -> Integer -> STM Bank
+debit b _ _ _ = return b
+
+-- diese Transaktion überweist 1000 cent einmal reihum.
+-- Danach hat jeder dasselbe Geld wie vorher - theoretisch!
+testTransaction1 :: Bank -> IO Bank
+testTransaction1 bank = atomically $ do
+        bank <- debit bank (bank!!0) (bank!!1) 1000
+        bank <- debit bank (bank!!1) (bank!!2) 1000
+        debit bank (bank!!2) (bank!!0) 1000
+
+-- Dieselbe Transaktion. Diesmal mit gelockter Bank.
+testTransaction2 :: TMVar Bank -> IO (TMVar Bank)
+testTransaction2 mb = atomically $ do
+        bank <- takeTMVar mb
+        bank <- debit bank (bank!!0) (bank!!1) 1000
+        bank <- debit bank (bank!!1) (bank!!2) 1000
+        bank <- debit bank (bank!!2) (bank!!0) 1000
+        putTMVar mb bank
+        return mb
+
+
+setup :: IO Bank
+setup = sequence $ newTMVarIO <$> [kontoA, kontoB, kontoC]

stack.yaml

@@ -0,0 +1,6 @@
+flags: {}
+extra-package-dbs: []
+packages:
+- '.'
+extra-deps: []
+resolver: lts-8.12

zettel10.cabal

@@ -0,0 +1,100 @@
+name:                zettel10
+version:             0.1.0.0
+synopsis:            First Assignment of FFPiHaskell 2017
+-- description:
+homepage:            https://github.com/FFPiHaskell/zettel10#readme
+license:             BSD3
+license-file:        LICENSE
+author:              FFPiHaskell Tutors
+maintainer:          sdressel@techfak.uni-bielefeld.de
+copyright:           2017 FFPiHaskell Tutors
+category:            cli
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+
+-- library for all things common in all exercises/not neccessary for students
+-- to solve assignments
+library
+  hs-source-dirs:      src
+  exposed-modules:     Parallel
+                     , KomplizierteFunktion
+                     , Banking
+                     , STMBanking
+  build-depends:       base >= 4.7 && < 5
+                     , parallel
+                     , array
+                     , deepseq
+                     , stm
+  default-language:    Haskell2010
+
+executable MainParallel1
+  hs-source-dirs:      app
+  main-is:             MainParallel1.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+  default-language:    Haskell2010
+
+executable MainParallel2
+  hs-source-dirs:      app
+  main-is:             MainParallel2.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+  default-language:    Haskell2010
+
+executable MainParallel3
+  hs-source-dirs:      app
+  main-is:             MainParallel3.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+  default-language:    Haskell2010
+
+executable MainBanking1
+  hs-source-dirs:      app
+  main-is:             MainBanking1.hs
+  ghc-options:         -threaded -eventlog -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+                     , threads
+                     , time
+  default-language:    Haskell2010
+
+executable MainBanking2
+  hs-source-dirs:      app
+  main-is:             MainBanking2.hs
+  ghc-options:         -threaded -eventlog -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+                     , threads
+                     , time
+  default-language:    Haskell2010
+
+executable MainSTMBanking1
+  hs-source-dirs:      app
+  main-is:             MainSTMBanking1.hs
+  ghc-options:         -threaded -eventlog -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+                     , threads
+                     , time
+                     , stm
+  default-language:    Haskell2010
+
+executable MainSTMBanking2
+  hs-source-dirs:      app
+  main-is:             MainSTMBanking2.hs
+  ghc-options:         -threaded -eventlog -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , zettel10
+                     , threads
+                     , time
+                     , stm
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/FFPiHaskell/zettel10