Dienstag, 18. Mai 2010

CountDownProblem

Nachdem ich nun alle 13 Folgen von Erik Meijers Webcast Serie: http://channel9.msdn.com/shows/Going+Deep/Lecture-Series-Erik-Meijer-Functional-Programming-Fundamentals-Chapter-1/ angeguckt habe, fühlte ich mich gewappnet, das Bsp. aus Folge 11 der Serie, von Haskell nach F# zu portieren.

Hier hab ich recht viel über F# gelernt, es hat viel Spaß gemacht und,… es funktioniert.

Hier ist es also, das Countdown Problem http://www.cs.nott.ac.uk/~gmh/countdown.hs.

Graham Hutton, der die Folge 11 der Serie über funktionale Programmierung gehalten hat, hat hier seine Implementation in Haskell.

Jedem, der mit Linq arbeitet oder irgendetwas über funktionale Programmierung lernen möchte, kann ich diese Webcast Serie vom „großen“ Erik Meijer nur ans Herz legen.

 

#light

type Op = ADD | SUB | MUL | DIV

type Expr = Val of int | App of Op * Expr * Expr

 


let valid o x y =

    match o, x, y with

    | ADD, _, _ -> true

    | SUB, x, y when x > y = true -> true

    | MUL, _, _ ->true

    | DIV, x, y when x % y =0 ->true

    | _ -> false

 

let apply o x y =

    match o, x, y with

    | ADD, x, y -> x+y

    | MUL, x, y -> x*y

    | SUB, x, y -> x-y

    | DIV, x, y -> x / y

 

let rec values e =

    match e with

    | (Val n)           -> [n]

    | (App (_ ,l  , r)) -> values l @ values r

 

let rec eval e =

    match e with

    | Val(n) when n>0   -> [n]

    | App (o, l, r)     -> [for x in eval l do

                                for y in eval r do yield apply o x y]

    | _ -> []

 

let rec interleave x xs =

    match x, xs with 

    |x, [] -> [[x]]

    |x, h::xs -> [[x] @ [h] @ xs] @ List.map(fun l -> [h] @ l) (interleave x xs)

 

let rec perms xs =

    match xs with

    |[]     -> [[]]

    |h::xs  -> List.concat (List.map(interleave h) (perms xs))

 

let rec subs xs =

    match xs with

    |[]     -> [[]]

    |h::xs  ->

        let ys = subs xs

        ys @ List.map(fun l-> [h] @l) ys

 

let subbags xs =

   [for ys in subs xs do

        for zs in perms ys do  yield zs]

 

let elem n xs =

    List.exists(fun x-> n=x) xs

   

let solution e ns n=

    elem (values e) (subbags ns) && eval e = [n]

 

let rec split xs =

    match xs with

    |[]     -> [([], [])]

    |x::xs  -> [[] , [x]] @ [for (ls, rs) in  split xs do yield x::ls, rs]

 

 

let ne ((xs, ys))=

     not (List.isEmpty xs || List.isEmpty ys)

 

let nesplit xs =

    List.filter ne (split xs)

 

let ops = [ADD; SUB; MUL; DIV]

 

let combine l r =

    [for o in ops do yield App(o, l, r)]

 

let rec exprs ns =

    match ns with

    | []    -> []

    | [n]   -> [Val(n)]

    | ns    -> [for ls, rs in nesplit ns do

                    for l in exprs ls do

                    for r in exprs rs do

                    for e in combine l r -> e]

 

let solutions ns n=

    [for ns' in subbags ns do

        for e in exprs ns' do

            if eval e = [n] then yield e]

 

solutions [1;2;3;7;10;20] 250