Lösungsvorschlag Functional Programming Midterm 2007

Aus VISki
Wechseln zu: Navigation, Suche
Question.png

Dem Autor des Lösungsvorschlags stellt sich eine Unklarheit betreffend der Prüfungsfrage oder deren Lösung:
Angaben ohne Gewähr, Änderungsvorschläge willkommen :) --Bo 10:18, 10. Apr 2008 (CEST)
Hilf mit, die Qualität dieser Seite zu verbessern, indem du eine eindeutige Lösung einfügst oder auf der Diskussionsseite dieses Themas deine Meinung äusserst.


Assignment 1

  • a)
(a -> a) -> a -> Bool -> a
  • b)
a -> [c] -> (c -> ( a -> b )) -> b

Achtung, Hugs sagt:

a -> [b] -> (b -> c) -> c

Obwohl man beim "Nachrechnen" auf a -> [c] -> (c -> a -> b ) -> b kommt

  • c)
a -> a

(Wird einfacher durch Einsetzen).

  • d)

Das erste x ist eine einzelne Funktion, aber map nimmt eine Liste als zweites Argument.

  • e)

"foo" hat Typ [Char], das heisst seine Elemente haben Typ Char, aber fst nimmt ein Argument vom Typ (a,b).

Assignment 2

Claim

l : [a]. mfold l mop fop e l = fold l fop e (map mop l)

Induction hypothesis

P(l) = mfoldl mop fop e l = foldl fop e (map mop l)

Base case P([])

mfoldl mop fop e[]

= mfoldl _ _ e []
= e
= foldl fop e []
= foldl fop e (map mop [])
= foldl fop e (map mop l)

Step case P(l) -> P(c:l)

mfoldl mop fop e (c:l)

= mfoldl mop fop (fop e (mop c)) l
= foldl fop (fop e (mop c)) (map mop l)
= foldl fop e (mop c: (map mop l)
= foldl fop e (map mop (c:l))

Assignment 3

Klammern-Überprüfungs-Tool von Adrian Kousz

Falls noch weitere Klammern geprüft werden sollen, können diese einfach der Liste ganz am Ende angehängt werden: Es ist einfach ein Paar – zuerst mit der öffnenden, dann mit der schliessenden Klammer. Da der Code nicht gerade offensichtlich ist, beschreibe ich unten meine Ideen, die mich zur Implementation gebracht haben.

Idee:

'foldr' ist das Kernstück, welches einen String erwartet und den Stack zurück gibt. Das Neutralelement ist hier ein Sentinel (ein beliebiger 'Char', so fällt eine Überprüfung gegen 'null' weg). Falls die Klammerung korrekt ist, gibt die gesamte Funktion das Sentinel aus. Es sei dem Leser überlassen, eine Implementation mit einem beliebigen Sentinel zu schreiben. ;-)

Die Funktion für 'foldr' überprüft die Klammerung. BEACHTE: Ich habe 'foldr' im Glauben gewählt, es sei für Haskell effizienter auszuführen – deshalb wird der ganze String rückwärts überprüft: Die Funktionen 'fst' und 'snd' müssen somit umgekehrt angewendet werden.

Um noch weitere Klammern hinzufügen zu können, werden alle mit 'brackets' in 'watchBrackets' übergeben. 'actualChar' und die Stack-Variablen werden von dann 'foldr' belegt.

Das erste If überprüft, ob der 'actualChar' eine beginnende Klammer ist. Falls ja, hängt es deren Gegenstück an den Stack. Falls es eine schliessende Klammer ist, muss überprüft werden, ob sie überhaupt geöffnet wurde. Falls ja, wird sie vom Stack entfernt (nur 'stackTail' wird zurück gegeben), ansonsten wird ein Fehlerzeichen angehängt (bedeutet: Es wurde eine Klammer geschlossen, ohne eine geöffnet zu haben). Falls es keine Klammer ist, wird nichts am Stack geändert.

match s = foldr ((\watchBrackets actualChar stack@(stackHead:stackTail) ->
    if (not.null) (searchFor actualChar snd) then
        (fst.head) (searchFor actualChar snd) : stack
    else
        if (not.null) (searchFor actualChar fst) then
            if actualChar == stackHead then
                stackTail
            else 'X' : stack
        else stack)
    brackets ) ['X'] s
    where
    searchFor = (\x z -> filter (flip ((==).z) x) brackets)
    brackets = [('(',')'),('{','}')]


Alternativ:

match :: String -> Bool
match "" = True
match s = match' s [] where
  match' "" xs = null xs
  match' ('(':ss) xs     = match' ss (')':xs)
  match' ('{':ss) xs     = match' ss ('}':xs)
  match' (')':ss) (x:xs) = if x == ')' then match' ss xs
                           else False
  match' ('}':ss) (x:xs) = if x == '}' then match' ss xs
                           else False
  match' (s:ss) xs       = match' ss xs

Alternativ 2:

match :: String -> Bool
match s = length (analyze s []) == 0
          where analyze [] []            = []
                analyze [] st            = st
                analyze ('(':s) st       = analyze s (['X'] ++ st)
                analyze ('{':s) st       = analyze s (['Y'] ++ st)
                analyze (')':s) ('X':st) = analyze s st
                analyze ('}':s) ('Y':st) = analyze s st
                analyze (')':_) _        = "BREAK"
                analyze ('}':_) _        = "BREAK"
                analyze (_:s)   st       = analyze s st

Assignment 4

  • a)
get :: Tree a -> Path -> Maybe a
get Leaf _ = Nothing
get (Node a _ _) End = Just a
get (Node _ tl _) (Left p) = get tl p
get (Node _ _ tr) (Right p) = get tr p

Und um das ganze auszugeben braucht es noch:

instance Show a => Show (Maybe a) where
  show Nothing = "nothing"
  show (Just a) = show a

Zudem müssen evtl. Maybe, Nothing, End, Just, Left und Right umbenannt werden (Namenskonflikte)

  • b)
pos :: Eq a => Tree a -> a -> [Path]
pos Leaf _ = []
pos (Node a t1 t2) x = if a == x then [End] ++ rest
                       else rest where
  rest = (map (\x -> Left x)(pos t1 x)) ++
         (map (\x -> Right x)(pos t2 x))

Um das nun auszugeben braucht es:

instance Show Path where
  show End = "End"
  show (Left p) = "Left->" ++ show p
  show (Right p) = "Right->" ++ show p

Assignment 5

  • a)
series :: Num a => [a] -> [a]
series [] = []
series (x:xs) = [x] ++ (map (\y -> y + x) (series xs))

Alternative:

series :: Num a => [a] -> [a]
series [] = []
series xs = reverse (calc (reverse (xs)))
            where calc [] = []
                  calc xs = [head xs + sum (tail xs)] ++ (calc (tail (xs)))

Andere Alternative:

series3 :: Num a => [a] -> [a]
series3 [] = []
series3 s = reverse (calc (length s))
            where calc 0 = []
                  calc i = [sum (take i s)] ++ calc (i-1)

Kürzer:

series4 :: Num a => [a] -> [a]
series4 s = [sum x | x <- [take y s | y <- [1 .. length(s)]]]
  • b)
seqMult :: Num a => Int -> [a] -> [a] -> [a]
seqMult n a b = series (take n [seqMult' a b x | x <- [0..]]) where
  seqMult' _ _ (-1) = 0
  seqMult' (a:as) bs i = a * (bs!!i) + (seqMult' as bs (i-1))

Ein anderer Ansatz für seqMult:

seqMult2 n a b = series (reverse (multiply (n-1) (take n a) (take n b)))
 where
   multiply _ [] [] = []
   multiply n a b = (sum (zipWith (*) a (reverse b))) : multiply (n-1) (take n a) (take n b)