[Haskell-cafe] example of monad fromhttp://learnyouahaskell.com not working

Damien Mattei damien.mattei at gmail.com
Wed Feb 27 23:10:49 UTC 2019


i mean if y had:
a <- coin
    b <- coin
    c <- loadedCoin

but only compute return (all (==Tails) [a]
what i really does ot understand is how the probability is normalised , yes
monad again keeps an air of mystery for me....

On Thu, Feb 28, 2019 at 12:05 AM Damien Mattei <damien.mattei at gmail.com>
wrote:

> thanks for your code, pretty example, i understand well flatten and all
> the function but at last i cannot figure out how the result come....
> in the example:
> flipThree :: Prob Bool
> flipThree = do
>     a <- coin
>     b <- coin
>     c <- loadedCoin
>     return (all (==Tails) [a,b,c])
>
> the strange thing is if i add more
> variables as :
> d <- coin
> it oes not change the probability but the output yes!
> example:
> Prob {getProb = [(True,1 % 80),(True,1 % 80),(True,9 % 80),(True,9 %
> 80),(True,1 % 80),(True,1 % 80),(True,9 % 80),(True,9 % 80),(True,1 %
> 80),(True,1 % 80),(True,9 % 80),(True,9 % 80),(True,1 % 80),(True,1 %
> 80),(True,9 % 80),(True,9 % 80)]}
>
> On Wed, Feb 27, 2019 at 12:01 PM Jos Kusiek <jos.kusiek at tu-dortmund.de>
> wrote:
>
>> That is most likely, because ap is not in Prelude. You need to import
>> Control.Monad.
>>
>>
>>
>> *Von: *Damien Mattei <damien.mattei at gmail.com>
>> *Gesendet: *Mittwoch, 27. Februar 2019 11:54
>> *An: *Yuji Yamamoto <whosekiteneverfly at gmail.com>
>> *Cc: *haskell-cafe <haskell-cafe at haskell.org>
>> *Betreff: *Re: [Haskell-cafe] example of monad fromhttp://
>> learnyouahaskell.com not working
>>
>>
>>
>> can you give me a complete solution please?
>>
>> i suppose i can set pure = return
>>
>> but have some diffculties with <*> , ap does not works
>>
>>
>>
>> On Wed, Feb 27, 2019 at 11:10 AM Yuji Yamamoto <
>> whosekiteneverfly at gmail.com> wrote:
>>
>> It's the one of the biggest changes of Haskell since LYHG was released.
>>
>> As you guess, now any instance of Monad must be an instance of
>> Applicative.
>>
>>
>>
>> So you have to declare Prob as an instance of Applicative:
>>
>>
>>
>> instance Applicative Prob where
>>
>>    pure = ...
>>
>>    f <*> x = ...
>>
>>
>>
>>
>>
>> 2019年2月27日(水) 18:56 Damien Mattei <damien.mattei at gmail.com>:
>>
>> i'm trying this example (see code below) from :
>>
>> http://learnyouahaskell.com/for-a-few-monads-more#making-monads
>>
>>
>>
>> when trying to compile this:
>>
>>
>>
>> import Data.Ratio
>>
>> newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving Show
>>
>>
>> instance Functor Prob where
>>     fmap f (Prob xs) = Prob $ map (\(x,p) -> (f x,p)) xs
>>
>>
>> thisSituation :: Prob (Prob Char)
>> thisSituation = Prob
>>     [( Prob [('a',1%2),('b',1%2)] , 1%4 )
>>     ,( Prob [('c',1%2),('d',1%2)] , 3%4)
>>     ]
>>
>> flatten :: Prob (Prob a) -> Prob a
>> flatten (Prob xs) = Prob $ concat $ map multAll xs
>>     where multAll (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
>>
>>
>> instance Monad Prob where
>>   return x = Prob [(x,1%1)]
>>   m >>= f = flatten (fmap f m)
>>   fail _ = Prob []
>>
>>
>>
>> l1 = Prob [('a',2%3),('b',1%3)]
>>
>> multAllExt :: (Prob a, Rational) -> [(a, Rational)]
>> multAllExt (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
>>
>> --Main> :type multAllExt
>> --multAllExt :: (Prob a, Rational) -> [(a, Rational)]
>>
>>
>> --Main> multAllExt (l1,1 % 4)
>> --[('a',1 % 6),('b',1 % 12)]
>>
>>
>>
>>
>>
>> i get this error:
>>
>>
>>
>> GHCi, version 8.4.3: http://www.haskell.org/ghc/  :? for help
>> Prelude> :load monade.hs
>> [1 of 1] Compiling Main             ( monade.hs, interpreted )
>>
>> monade.hs:21:10: error:
>>     • No instance for (Applicative Prob)
>>         arising from the superclasses of an instance declaration
>>     • In the instance declaration for ‘Monad Prob’
>>    |
>> 21 | instance Monad Prob where
>>    |          ^^^^^^^^^^
>> Failed, no modules loaded.
>>
>>
>>
>> it fails when i add the last part of the example:
>>
>>
>>
>> instance Monad Prob where
>>   return x = Prob [(x,1%1)]
>>   m >>= f = flatten (fmap f m)
>>   fail _ = Prob []
>>
>>
>>
>>
>>
>> seems the Monad needs an instance of the Applicative to be instanciated...
>>
>>
>>
>> what is wrong?
>>
>>
>>
>> regards,
>>
>> Damien
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> To (un)subscribe, modify options or view archives go to:
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> Only members subscribed via the mailman list are allowed to post.
>>
>>
>>
>> --
>>
>> 山本悠滋
>> twitter: https://twitter.com/igrep
>> GitHub: https://github.com/igrep
>>
>> GitLab: https://gitlab.com/igrep
>> Facebook: http://www.facebook.com/igrep
>>
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190228/81971863/attachment.html>


More information about the Haskell-Cafe mailing list