commit e74be4aaff5fd8376358ceb90e47de3f07bfd97b Author: Stefan Dresselhaus Date: Wed Jul 12 11:38:06 2017 +0200 initial exercise diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0383d89 --- /dev/null +++ b/.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 +*~ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..5ccfeba --- /dev/null +++ b/.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 + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6a042c2 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..375ed4a --- /dev/null +++ b/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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/MainBanking1.hs b/app/MainBanking1.hs new file mode 100644 index 0000000..9ccb9b0 --- /dev/null +++ b/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 () + diff --git a/app/MainBanking2.hs b/app/MainBanking2.hs new file mode 100644 index 0000000..a15f10c --- /dev/null +++ b/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 () diff --git a/app/MainParallel1.hs b/app/MainParallel1.hs new file mode 100644 index 0000000..f3282fa --- /dev/null +++ b/app/MainParallel1.hs @@ -0,0 +1,6 @@ +module Main where + +import Parallel + +main :: IO () +main = putStr strategy1 diff --git a/app/MainParallel2.hs b/app/MainParallel2.hs new file mode 100644 index 0000000..f070858 --- /dev/null +++ b/app/MainParallel2.hs @@ -0,0 +1,6 @@ +module Main where + +import Parallel + +main :: IO () +main = putStr strategy2 diff --git a/app/MainParallel3.hs b/app/MainParallel3.hs new file mode 100644 index 0000000..dc1b265 --- /dev/null +++ b/app/MainParallel3.hs @@ -0,0 +1,6 @@ +module Main where + +import Parallel + +main :: IO () +main = putStr strategy3 diff --git a/app/MainSTMBanking1.hs b/app/MainSTMBanking1.hs new file mode 100644 index 0000000..6fde90b --- /dev/null +++ b/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 () diff --git a/app/MainSTMBanking2.hs b/app/MainSTMBanking2.hs new file mode 100644 index 0000000..cd36557 --- /dev/null +++ b/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 () diff --git a/src/Banking.hs b/src/Banking.hs new file mode 100644 index 0000000..8c40858 --- /dev/null +++ b/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] diff --git a/src/KomplizierteFunktion.hs b/src/KomplizierteFunktion.hs new file mode 100644 index 0000000..75818f4 --- /dev/null +++ b/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)) diff --git a/src/Parallel.hs b/src/Parallel.hs new file mode 100644 index 0000000..6d9cafa --- /dev/null +++ b/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 + diff --git a/src/STMBanking.hs b/src/STMBanking.hs new file mode 100644 index 0000000..55f67d4 --- /dev/null +++ b/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] diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..09b1012 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,6 @@ +flags: {} +extra-package-dbs: [] +packages: +- '.' +extra-deps: [] +resolver: lts-8.12 diff --git a/zettel10.cabal b/zettel10.cabal new file mode 100644 index 0000000..b70a818 --- /dev/null +++ b/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