Έχουν δημοσιευτεί Κυριακή, 17 Ιανουαρίου 2010 8:17 μμ από το μέλος PALLADIN

Abstracting over 'M' (generic functions)

(Haskell ideas => F# (OOP + FP))

Στην Haskell, επειδή έχουμε higher kind polymorphism, μπορούμε να ορίσουμε κάποιες πολύ χρήσιμες και αρκετά γενικές συναρτήσεις για Monads.
Σκέφτηκα να προσπαθήσω να κάνω κάτι αντίστοιχο σε F# (υλοποιώντας ένα Generic List Monad) και να ορίσω τις κλασσικές sequence, mapM, filterM.

Ως παράδειγμα της δύναμης που μας προσφέρει η αφαίρεση, μπορούμε να ορίσουμε την συνάρτηση του powerset ως εξής:
let powerSet xs = listM.FilterM ((fun _ -> listM.OfList [false; true]), listM.OfList xs) // it's magic

Χρησιμοποιώντας subtype polymorphism και μερικά περιορισμένα downcasts, καταφέραμε να φέρουμε λίγο από το άρωμα και την αίγλη της Haskell στον κόσμο της F#.

Happy hacking...

module MonadModule = 
    //Generic Monad Definition
    [<AbstractClass>]
    type MonadDef<'M when 'M :> MonadDef<'M>>() as this = 
         let (>>=) m f = this.Bind(m, f)
         let unit v = this.Return v
         static let listDef = ListDef()

         abstract member Return<'T> : 'T -> IMonad<'T,'M> 
         abstract member Bind<'T, 'S> : IMonad<'T,'M> * ('T -> IMonad<'S,'M>) -> IMonad<'S,'M> 
         abstract member Zero<'T> : unit -> IMonad<'T,'M>
         
         member this.Delay(f) = unit () >>= fun () -> f()
         member this.Combine<'T>(first : IMonad<unit, 'M>, second : IMonad<'T, 'M>) : IMonad<'T, 'M>  = 
            this.Then (first, second)

         member this.Then<'T, 'S>(firstM : IMonad<'T, 'M>, secondM : IMonad<'S, 'M>) : IMonad<'S, 'M> =
            firstM >>= fun _ -> secondM

         member this.Map<'T, 'S>(f : 'T -> 'S, m : IMonad<'T, 'M>) : IMonad<'S, 'M> =
            m >>= fun v -> unit (f v)

         member this.Apply<'T, 'S>(mf : IMonad<'T -> 'S, 'M>, m : IMonad<'T, 'M>) : IMonad<'S, 'M> =
            mf >>= fun f -> m >>= fun v -> unit (f v)   

         member this.Join<'T>(m : IMonad<IMonad<'T, 'M>, 'M>) : IMonad<'T, 'M> =
            m >>= id

         member this.Sequence<'T>(lm : IMonad<IMonad<'T, 'M>, ListDef>) : IMonad<IMonad<'T, ListDef>, 'M> =
            match lm :?> _ with
            | Nil -> unit (Nil :> _)
            | Cons (m, ms) -> m >>= fun v -> this.Sequence ms >>= fun vs -> unit (listDef.ConsM v vs)
        
         member this.MapM<'T, 'S>(f : 'T -> IMonad<'S, 'M>, l : IMonad<'T, ListDef>) : IMonad<IMonad<'S, ListDef>, 'M> =  
            this.Sequence (listDef.Map ((fun v -> f v), l))

         member this.FilterM<'T>(p : 'T -> IMonad<bool, 'M>, l : IMonad<'T, ListDef>) : IMonad<IMonad<'T, ListDef>, 'M> =
            match l :?> _ with
            | Nil -> unit (Nil :> _)
            | Cons (x, xs) -> p x >>= fun b -> this.FilterM (p, xs) >>= fun ys -> if b then unit (listDef.ConsM x ys) else unit ys   

    and IMonad<'T,'M when 'M :> MonadDef<'M>> = interface end 

    // List Monad
    and List<'T> = 
        | Nil
        | Cons of ('T * List<'T>)
        interface IMonad<'T, ListDef>
    and
        ListDef() = 
            inherit MonadDef<ListDef>() with
                member this.OfList<'T>(xs : list<'T>) : IMonad<'T, ListDef> =
                    List.foldBack (fun v acc -> this.ConsM v acc) xs <| this.Zero() 

                member this.ConsM (x : 'T) (acc : IMonad<'T, ListDef>) : IMonad<'T, ListDef> = Cons (x, acc :?> _) :> _
                 
                member this.Foldr<'T, 'S>(f : 'T -> 'S -> 'S, seed : 'S, list : IMonad<'T, ListDef>) : 'S =
                    match list :?> _ with
                    | Nil -> seed
                    | Cons (x, xs) -> f x (this.Foldr (f, seed, xs) )

                member this.Concat<'T>(first : IMonad<'T, ListDef>, second : IMonad<'T, ListDef>) : IMonad<'T, ListDef> =
                    this.Foldr(this.ConsM, second, first)

                override this.Return<'T>(v : 'T) : IMonad<'T, ListDef> = 
                    Cons (v, Nil) :> _ 
          
                override this.Bind<'T,'S>(m : IMonad<'T, ListDef>, f : 'T -> IMonad<'S, ListDef>) : IMonad<'S, ListDef> =  
                    this.Foldr ((fun x acc -> this.Concat (f x, acc)), Nil :> _, m)

                override this.Zero<'T>() : IMonad<'T, ListDef> = 
                    Nil :> _ 
 
    let listM = ListDef()

open MonadModule

// Maybe Monad
module MaybeModule =

    type Maybe<'T> = 
        | Nothing 
        | Just of 'T 
        interface IMonad<'T, MaybeDef> 
    and 
        
        MaybeDef() = 
            inherit MonadDef<MaybeDef>() with
                override this.Return<'T>(v : 'T) : IMonad<'T, MaybeDef> = 
                    Just v :> _ 
      
                override this.Bind<'T,'S>(m : IMonad<'T, MaybeDef>, f : 'T -> IMonad<'S, MaybeDef>) : IMonad<'S, MaybeDef> = 
                    match m :?> _ with 
                    | Nothing -> Nothing :> _ 
                    | Just x  -> f x

                override this.Zero<'T>() : IMonad<'T, MaybeDef> = 
                    Nothing :> _
                
                member this.Just<'T>(value : 'T) : IMonad<'T, MaybeDef> =
                    Just value :> _
                member this.Nothing<'T>() : IMonad<'T, MaybeDef> =
                    Nothing :> _
    
    let maybeM = new MaybeDef()     
 

open MaybeModule


//Examples

let test = listM.OfList [ maybeM.Just 1; maybeM.Just 2 ]
maybeM.Sequence test |> printfn "%A"


let powerSet xs = listM.FilterM ((fun _ -> listM.OfList [false; true]), listM.OfList xs)
powerSet [1..3] |> printfn "%A"
Share


Ενημέρωση για Σχόλια

Αν θα θέλατε να λαμβάνετε ένα e-mail όταν γίνονται ανανεώσεις στο περιεχόμενο αυτής της δημοσίευσης, παρακαλούμε γίνετε συνδρομητής εδώ

Παραμείνετε ενήμεροι στα τελευταία σχόλια με την χρήση του αγαπημένου σας RSS Aggregator και συνδρομή στη Τροφοδοσία RSS με σχόλια

Σχόλια:

 

Thoughts and Code έγραψε:

Έχοντας αναπτύξει όλο το απαραίτητο machinery ( 1 , 2 ), μπορούμε να συνεχίσουμε με την ίδια αφαιρετική

Φεβρουαρίου 7, 2010 11:47 μμ

Ποιά είναι η άποψή σας για την παραπάνω δημοσίευση;

(απαιτούμενο)
απαιτούμενο
προαιρετικό
απαιτούμενο
ÅéóÜãåôå ôïí êùäéêü:
CAPTCHA Image