module Sol_Exercise_12 where import Data.List (find, isInfixOf, isSuffixOf, nub) import Test.QuickCheck {- Library -- nicht veraendern -} {- G12.1 -} {- Ausdruck: 1 + (2 * 3) - 2 * 3 [Innermost + Outermost] - - "+" als primitive Operation kann nur auf vollständig ausgewerteten - Argumenten reduziert werden. - - - Ausdruck: (1 + 2) * (2 + 3) - 1 + 2 [Innermost + Outermost] - 2 + 3 [Innermost + Outermost] - - - Ausdruck: fst (1 + 2, 2 + 3) - 1 + 2 [Innermost] - 2 + 3 [Innermost] - fst (1 + 2, 2 + 3) [Outermost] - - - Ausdruck: fst (snd (1, 2 + 3), 4) - 2 + 3 [Innermost] - snd (1, 2 + 3) [weder noch] - fst (snd (1, 2 + 3), 4) [outermost] - - - Ausdruck: (\x. 1 + x) (2 * 3) - 2 * 3 [Innermost] - (\x. 1 + x) (2 * 3) [Outermost] - - Hinweis: Generell kann unter Lambda-Ausdrücken nicht reduziert werden, - so hat z.B. der Ausdruck - - (\x. (1 + 2) + x) 3 - - nur einen einzigen Redex. -} {- G12.2 -} {- Aufruf: - f (inf (1+0)) (inf (1+1)) (inf (1+2)) - Argumente - inf (1+0) ~~> 1 : 1: inf 1 - inf (1+1) ~~> 2 : inf 2 - inf (1+2) ~~> (1+2) : inf (1+2) - Warum? - Zur Auswertung von f wird zunächst Pattern Matching gemacht gegen die erste - Regel gemacht. Haskell muss also feststellen, ob das erste und zweite - Argument die Form _:_ (statt []) hat. Das dritte Argument ist nur eine - Variable, hier muss also noch nichts ausgewertet werden. - inf (1+0) ~> (1+0) : inf (1+0) - inf (1+1) ~> (1+1) : inf (1+1) - inf (1+2) ~> inf(1+2) - Jetzt wird (unter anderem) x = 1+0 und y = 1+1 gebunden. - In einem zweiten Schritt muss "x > y" getestet werden, dazu müssen x und y - ausgewertet werden: - (1+0) : inf (1+0) ~> 1 : inf 1 - (1+1) : inf (1+1) ~> 2 : inf 2 - inf (1+2) ~> inf(1+2) - Warum wurden jetzt beide 1+0 zu 1 (bzw. beide 1+1 zu 2 ausgewertet)? Weil es - jeweils der selbe (nicht nur der gleiche Ausdruck war). - - "x > y" ist False, deswegen muss jetzt noch die zweite Regel getestet werden. - Dafür ist es notwendig, das erste Argument zu der Form _:_:_ und das dritte - Argument zu der Form _:_ auszuwerten: - 1 : inf 1 ~> 1 : 1 : inf 1 - 2 : inf 2 ~> 2 : inf 2 - inf (1+2) ~> (1+2) : inf (1+2) - Der Rückgabewert ist jetzt 1, was schon vollständig ausgewertet ist und daher - für die Anzeige nicht weiter ausgewertet werden muss. -} {- Aufruf: - f (inf(1+2)) (inf(1+1)) (inf(1+0)) - Argumente: - inf (1+2) ~> 3 : inf 3 - inf (1+2) ~> 2 : inf 2 - inf (1+0) ~> inf (1+0) - Ähnlich wie oben, nur schlägt hier der Test "x > y" nicht fehl, daher wird das - dritte Argument nie ausgewertet. -} {- Aufruf - f (inf (1+0)) [] (inf 0) - Argumente: - inf (1+0) ~~> 1 : 1 : inf 1 - inf 0 ~~> 0 : inf 0 - Warum? - Pattern Matching auf erste Regel: - inf (1+0) ~> 1 + 0 : inf (1 + 0) - inf 0 ~> inf 0 - Hier wird der Test "x > y" nie erreicht (denn das zweite Argument hat die Form []). - - Pattern Matching auf zweite Regel: - 1 + 0 : inf (1+0) ~> 1 + 0 : 1 + 0 : inf (1 + 0) - inf 0 ~> 0 : inf 0 - - Um jetzt 1+0 ausgeben zu können, muss der Ausdruck noch ausgewertet werden: - 1+0 : 1+0 : inf (1+0) ~> 1 : 1 : inf 1 - 0 : inf 0 ~> 0 : inf 0 -} {- G12.3 -} fib1 = 0 : 1 : zipWith (+) fib1 (tail fib1) {- Auswertung der ersten 5 Elemente von fib1: - - fib1 - ~> 0 : 1 : zipWith (+) fib1 (tail fib1) - ~> 0 : 1 : zipWith (+) (0 : 1 : zipWith ...) (1 : zipWith ...) - ~> 0 : 1 : 1 : zipWith (+) (1 : 1 : zipWith ...) (1 : zipWith ...) - ~> 0 : 1 : 1 : 2 : zipWith (+) (1 : 2 : zipWith ...) (2 : zipWith ...) - ~> 0 : 1 : 1 : 2 : 3 : zipWith (+) (2 : 3 : zipWith ...) (3 : zipWith ...) -} fib2 x y = x : fib2 y (x + y) {- fib2 0 1 ~> 0 : fib2 1 (0+1) ~> 0 : 1 : fib2 (0+1) ((0+1)+1) ~> 0 : 1 : (0+1) : fib2 ((0+1)+1) (((0+1)+1)+(0+1)) ~> 0 : 1 : 1 : fib2 (1+1) ((1+1)+1) ~> 0 : 1 : 1 : 1+1 : fib2 ((1+1)+1) (((1+1)+1)+(1+1)) ~> 0 : 1 : 1 : 2 : fib2 (2+1) ((2+1)+2) -} {- Um fib n auszuwerten, muss fib (n-1) 2-mal, fib (n - 2) 4-mal, fib (n-3) - 8-mal, ... ausgewertet werden. Zur Auswertung von fib1 !! n müssen nur die - ersten (n+1) Elemente von fib1 jeweils 1-mal ausgewertet werden. - Die Laufzeit ist also linear statt exponentiell. -} {- G12.4 -} productOf :: [Integer] -> Integer -> Bool productOf xs y = go xs y where go _ 1 = True go [] y = False go (z:zs) y = if y `mod` z == 0 then go xs (y `div` z) else go zs y hamming :: [Integer] hamming = filter (productOf [2,3,5]) [1 ..] -- Schnelle und konstruktive Loesung zum Nachdenken: hamming' :: [Integer] hamming' = 1 : merge x (merge y z) where x = map (*2) hamming' y = map (*3) hamming' z = map (*5) hamming' merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys) | x > y = y : merge (x:xs) ys | x == y = x : merge xs ys -- Alternative (und deutlich langsamere) Loesung: factors :: Integer -> [Integer] factors x = [y | y <- [1..x], x `mod` y == 0] hamming'' :: [Integer] hamming'' = filter (all (\x -> x `elem` [1,2,3,5] || not (factors x == [1,x])) . factors) [1 ..] {- H12.1 -} wordsOfLength :: [a] -> Integer -> [[a]] wordsOfLength alphabet 0 = [[]] wordsOfLength alphabet n = [[a] ++ s | a <- alphabet, s <- wordsOfLength alphabet (n - 1)] wordsOf :: [a] -> [[a]] wordsOf alphabet = concatMap (wordsOfLength alphabet) [0 ..] wordsOf' :: [a] -> [[a]] wordsOf' alphabet = [] : [ys ++ [y] | ys <- wordsOf' alphabet, y <- alphabet] {- H12.2 -} sumOfPrefixes :: Num a => [a] -> [a] sumOfPrefixes [] = [0] sumOfPrefixes xs = 0 : map (\x -> head xs + x) (sumOfPrefixes (tail xs)) sumOfPrefixes' :: Num a => [a] -> [a] sumOfPrefixes' = scanl (+) 0 sumOfPrefixes'' :: Num a => [a] -> [a] sumOfPrefixes'' xs = 0 : zipWith (+) (sumOfPrefixes xs) xs {- H12.3 -} findByFilter :: (a -> Bool) -> [a] -> Maybe a findByFilter p xs = case filter p xs of [] -> Nothing x : _ -> Just x {- Beispiele: -} v = find even [1 .. 10000000] v' = findByFilter even [1 .. 10000000] {- Unsere Funktion scheint genauso effizient zu sein wie die offizielle - "find"-Funktion. Der Grund dafuer, ist dass "filter" lazy ist: Die - Auswertung hoert auf sobald ein "True"-Element gefunden ist, da - "findByFilter" sich nur das erste Element anschaut. -} prop_findByFilter :: [Integer] -> Bool prop_findByFilter xs = find even xs == findByFilter even xs {- H12.4 -} {-WETT-} censoredWordsOf :: Eq a => [a] -> [[a]] -> [[a]] censoredWordsOf alphabet fwords = [] : concatMap (\w -> filter (\w -> not (any (`isSuffixOf` w) fwords)) (map (snoc w) alphabet)) (censoredWordsOf alphabet fwords) snoc :: [a] -> a -> [a] snoc w a = w ++ [a] {- Langsamere Loesung: -} censoredWordsOf_slow :: Eq a => [a] -> [[a]] -> [[a]] censoredWordsOf_slow alphabet fwords = filter (\w -> not (any (`isInfixOf` w) fwords)) (allWords alphabet) allWords :: Eq a => [a] -> [[a]] allWords alphabet = [] : concatMap (\w -> map (snoc w) alphabet) (allWords alphabet) {- Schnellere Loesung: -} censoredWordsOf_fast_helper :: Eq a => [a] -> [[a]] -> [[a]] censoredWordsOf_fast_helper alphabet fwords = [] : concatMapStop (\w -> filter (\w -> not (any (`isSuffixOf` w) fwords)) (map (snoc w) alphabet)) (censoredWordsOf_fast_helper alphabet fwords) concatMapStop :: (a -> [b]) -> [a] -> [b] concatMapStop f [] = [] concatMapStop f (x : xs) = case f x of [] -> [] ys -> ys ++ concatMapStop f xs censoredWordsOf_fast :: Eq a => [a] -> [[a]] -> [[a]] censoredWordsOf_fast [] _ = [[]] censoredWordsOf_fast alphabet fwords = censoredWordsOf_fast_helper alphabet fwords'' where fwords' = nub $ filter (\f -> all (`elem` alphabet) f) $ fwords fwords'' = filter (\f -> not (any (`isStrictInfixOf` f) fwords')) fwords' isStrictInfixOf :: Eq a => [a] -> [a] -> Bool isStrictInfixOf xs ys = isInfixOf xs ys && xs /= ys {-TTEW-}