path: root/ws2015/ffp/blaetter/08/FFP_U08_Parallel.hs

-- Fortgeschrittene Funktionale Programmierung,
--   LMU, TCS, Wintersemester 2015/16
--   Steffen Jost, Alexander Isenko
--
-- Übungsblatt 07. 9.12.2015
--
-- Thema: Paralleles Rechnen
--
-- Hinweis:
--   Falls Ihr Rechner nur 1--2 echte Prozessorkerne besitzt,
--   dann loggen Sie sich für diese Übungen in einem Rechner am
--   CIP-Pool der Informatik ein.
--   Informationen zum Remote-Login am CIP-Pool finden Sie auf:
--      http://www.rz.ifi.lmu.de/FAQ/index.html
--   Abschnitt "Von zu Hause/remote aus ..."
--   Prüfen Sie auch, dass der gewählte Rechner über freie Kapazitäten verfügt,
--   z.B. mit dem Tool "htop". Falls der Rechner beschäftigt ist,
--   dann loggen Sie sich von dem Remote-Rechner weiter zu einem
--   der anderen intern erreichbaren CIP-Arbeitsplatzrechner ein, siehe:
--      http://www.rz.ifi.lmu.de/FAQ/Rechnerliste.faq.html
--
--   Es ist für diese Übung zwingend notwendig, einen Rechner
--   mit mehreren Prozessorkernen einzusetzen. Schließlich dreht es
--   sich darum, eine Berechnung durch die gleichzeitge Verwendung
--   mehrerer Kerne zu beschleunigen.
--
--   Für die nächste Übung 8 zum Thema Nebenläufigkeit reicht
--   dann auch wieder ein einzelner Prozessorkern.
--
--
-- Anweisungen:
--   Es empfiehlt sich heute, die Übungen in einer zur Vorlesung
--   umgekehrten Reihenfolge zu bearbeiten, da die Par-Monade
--   vermutlich das am einfachsten einzusetzende Konzept ist.
--   Für die Vorlesung wurde eine andere Reihenfolge gewählt,
--   um die einzelnen Konzepte besser zu motivieren.
--
--   Gehen Sie diese Datei durch und bearbeiten Sie
--   alle Vorkommen von undefined bzw. die mit -- !!! TODO !!!
--   markierten Stellen. Testen Sie Ihre Lösungen mit GHC!
--
--   Die Verwendung mehrerer Kerne läßt sich mit dem Interpreter
--   (ghci) nur schlecht messen. Kompilieren Sie Ihre Lösung daher
--   mit ghc, ggf. jede Aufgabe in eine eigene Datei auslagern:
--       > ghc MyProgA71.hs -O2 -threaded -rtsopts
--
--   und dann mit gewünschter Anzahl echter Threads ausführen:
--       > time ./MyProgA71 +RTS -N4 -s
--       > time ./MyProgA71 +RTS -N3 -s
--       > time ./MyProgA71 +RTS -N2 -s
--       > time ./MyProgA71 +RTS -N1 -s
--   die Angabe unter "Total -> elapsed" ist dann ein brauchbares Maß.
--

--      _________________________________________________
--     |                                                 |
--     |  * Par-Monade kennenlernen                      |
--     |  * Parallel Strategies kennenlernen             |
--     |  * seq / deepseq kennenlernen                   |
--     |_________________________________________________|
--   λ/
--  /|
--  / \

import Data.List
import Control.Monad
import Control.Monad.Par  -- ggf. cabal oder "stack install monad-par" ausführen
import Control.Parallel
import Control.Parallel.Strategies
import Control.DeepSeq

import System.Environment (getArgs)

-- !!! TODO !!! Je nach bearbeiteter Aufgabe auskommentieren:
main = main' [ ("1", main_A7_1)
             , ("2", main_A7_2)
             , ("3", main_A7_3)
             ]

main' calls = do
  args <- getArgs
  mapM_ (\(s, x) -> when (s `elem` args) x) calls

-- A7-1 Par-Monade
--
-- Beschleunigen Sie die Ausführung des folgenden Programmes
-- durch den Einsatz einer Par-Monade zur Berechnung.
--
-- Hinweis: Sie sollen nur innerhalb der main-Funktion arbeiten.
--   Die Funktion hanoi dient nur als Last, also diese selbst nicht beschleunigen.

main_A7_1 :: IO ()
main_A7_1 = main' [ ("seq", main_A7_1seq)
                  , ("par", main_A7_1par)
                  ]
            
main_A7_1seq :: IO ()
main_A7_1seq = do
  let difficulty  = 25 -- ändern, falls Laufzeit zu lang oder zu kurz ist      
      t1 = length $ hanoi difficulty 1 2
      t2 = length $ hanoi difficulty 1 3
      t3 = length $ hanoi difficulty 2 3
      t4 = length $ hanoi difficulty 3 1
  t1 `par` t2 `par` t3 `par` t4 `pseq` putStrLn "Wusstest Du schon:"      
  putStrLn $ "Man braucht " ++ (show t1) ++ " Schritte um einen Hanoi-Turm der Größe " 
    ++ (show difficulty) ++ " von Platz 1 auf Platz 2 zu versetzen."
  putStrLn $ "Man braucht " ++ (show t2) ++ " Schritte um einen Hanoi-Turm der Größe " 
    ++ (show difficulty) ++ " von Platz 1 auf Platz 3 zu versetzen."
  putStrLn $ "Man braucht " ++ (show t3) ++ " Schritte um einen Hanoi-Turm der Größe " 
    ++ (show difficulty) ++ " von Platz 2 auf Platz 3 zu versetzen."
  putStrLn $ "Man braucht " ++ (show t4) ++ " Schritte um einen Hanoi-Turm der Größe " 
    ++ (show difficulty) ++ " von Platz 3 auf Platz 1 zu versetzen."
  putStrLn "Gut zu wissen, oder?"  

  
main_A7_1par :: IO ()    -- parallele Version
main_A7_1par = do
  rets <- runParIO $ mapM (\(a, b) -> spawnP $ length $ hanoi difficulty a b) args >>= mapM get
  putStrLn $ unlines $ zipWith (\a r -> show a ++ ": " ++ show r) args rets 
  where
    difficulty = 25
    args = [ (1, 2)
           , (1, 3)
           , (2, 3)
           , (3, 1)
           ]

  

-- Hilfsfunktionen, zur Erzeugung von Rechnenlast, bitte nicht verändern:
hanoi :: Int -> Int -> Int -> [(Int,Int)]
hanoi 1 i j = [(i,j)]
hanoi n i j = hanoi n' i otherTower
           ++ [(i,j)]
           ++ hanoi n' otherTower j
  where
    n'         = n-1
    otherTower = 1+2+3-i-j


 
-- A7-2 Parallel.Strategies
--
-- In der Vorlesung wurden parallele Strategien vorgestellt.
-- Implementieren Sie ein parallel-beschleunigtes Quicksort unter Verwendung von
-- Strategien aus Control.Parallel.Strategies!
--
-- Testen und vergleichen Sie verschiedene Auswerte-Strategien!
-- Welche ist die Beste und warum?
--
-- Hinweis:
--   Die Laufzeit mit einem Kern sollte im CIP-Pool ca. 1 Minuten dauern.

quicksortS :: [Integer] -> [Integer]
quicksortS []       = []
quicksortS  (x:xs)  = result
  where
    result = losort ++ (x:hisort) 
    losort = quicksortS [y | y <- xs, y < x]
    hisort = quicksortS [y | y <- xs, y >= x]

quicksortP :: [Integer] -> [Integer]
quicksortP [] = []
quicksortP (x:xs) = runEval $ do
  lows <- strat $ quicksortP [y | y <- xs, y < x]
  highs <- strat $ quicksortP [y | y <- xs, y >= x]
  return $ lows ++ (x : highs)
    where
      strat = rparWith rdeepseq -- rpar, rseq
      -- rparWith rdeepseq < rpar ~~ rseq
      -- rpar macht nur minimale arbeit innerhalb des sparks (nur WHNF), der rest der arbeit wird am ende (bei return) in einem thread gemacht
            

main_A7_2 = do
  args <- getArgs
  let qs
       | "seq" `elem` args = quicksortS
       | otherwise = quicksortP
  putStrLn "Berechnung von Quicksort gestartet."
  let list1  = [1,7..30000] ++ (reverse [1..45678]) ++ [2,4..30000]
  let qlist1 = qs list1
  let len1   = deepseq qlist1 (length list1)
  let list2  = concat $ permutations $ [1..7]
  let qlist2 = qs list2
  let len2   = deepseq qlist2 (length list2)
  putStrLn $ "Berechnung von Quicksort mit Liste der Länge " ++ (show len1) ++ ":"
  --   putStrLn $ show $ take 33 $ drop 22222 $ quicksortS list1
  putStrLn $ "Berechnung von Quicksort mit Liste der Länge " ++ (show len2) ++ ":"
  --   putStrLn $ show $ take 33 $ drop 22222 $ quicksortS list2
  putStrLn $ "Done."
  
  
  
-- A7-3 par und pseq
--
-- Betrachten Sie die Funktionen pay und payL, welche für einen gegebenen Betrag
-- und einer gegebenen Menge Münzen [(Münzgröße,Anzahl)] alle Möglichkeiten
-- ausgibt, diesen Betrag mit den Münzen zu bezahlen:
--   pay 10 [(3,3),(5,2),(1,2)] = [[(5,2)],[(1,2),(3,1),(5,1)],[(1,1),(3,3)]]
--
-- Beschleunigen Sie die Ausführung der Funktion pay bzw. payL
-- durch den Einsatz von par und pseq
--
type Münzgröße = Integer
type Anzahl    = Integer
type Betrag    = Integer

main_A7_3 = do
  let value = 2345
  let coins = [(23,25),(11,25),(33,50),(5,25),(3,25),(1,25)]
  putStrLn $  "Berechne die Möglichkeiten den Wert " ++ (show value) ++ " mit den Münzen & Scheinen " ++ (show coins) ++ " darzustellen:"
  let poss  = pay value coins
  -- mapM_ print $ poss
  putStrLn $ "Es gibt " ++ (show $ length poss) ++ " Möglichkeiten den Wert " ++ (show value) ++ " mit den Münzen & Scheinen " ++ (show coins) ++ " darzustellen!"

pay :: Betrag -> [(Münzgröße, Anzahl)] -> [[(Münzgröße, Anzahl)]]
pay val coins = map count $ payL [] val (sortBy (\(a,_) (c,_) -> invert $ compare a c) coins)

payL :: [Integer] -> Betrag -> [(Münzgröße,Anzahl)] -> [[Integer]]
payL acc 0   coins = [acc]
payL acc _   []    = []
payL acc val ((c,qty):coins) 
  | c > val   = payL acc val coins 
  | otherwise = let -- speedup by ~100% compared to (left ++ right)
      l = right `par` left
      r = right
      in l ++ r
  where
    left  = payL (c:acc) (val - c) coins'
    right = payL    acc   val      coins
    coins' | qty == 1    = coins
           | otherwise   = (c,qty-1) : coins

count :: [Integer] -> [(Integer,Integer)]
count xs = [(head ks, genericLength ks) | ks <- group $ sort xs]

invert :: Ordering -> Ordering
invert EQ = EQ
invert LT = GT
invert GT = LT