[Haskell-cafe] show in monad
Jos Kusiek
jos.kusiek at tu-dortmund.de
Thu Feb 28 15:58:37 UTC 2019
You do not need to change the Show instance. The one generated by
deriving Show is fine. As I said, you need to change the type of flatten
and add the constraint.
flatten :: Show a => Prob (Prob a) -> Prob a
On 28.02.19 15:30, Damien Mattei wrote:
> even with a definition of show i can not use it in flatten:
> import Control.Monad
>
> import Data.Ratio
> import Data.List (all)
> import Debug.Trace
>
> newtype Prob a = Prob { getProb :: [(a,Rational)] }-- deriving Show
>
>
>
> instance Show a => Show (Prob a) where
> show (Prob [(x,r)]) = ((show x) ++ " _ " ++ (show r))
>
>
> instance Functor Prob where
> fmap f (Prob xs) = trace " Functor Prob "
> Prob $ map (\(x,p) -> (f x,p)) xs
>
>
>
>
> flatten :: Prob (Prob a) -> Prob a
> flatten (Prob xs) = trace (" flatten " ++ (show xs))
> Prob $ concat $ map multAll xs
> where multAll (Prob innerxs,p) = trace (" multAll p= " ++ (show p)
> ++ " ")
> map (\(x,r) -> (x,p*r)) innerxs
>
> monade.hs:23:44: error:
> • No instance for (Show a) arising from a use of ‘show’
> Possible fix:
> add (Show a) to the context of
> the type signature for:
> flatten :: forall a. Prob (Prob a) -> Prob a
> • In the second argument of ‘(++)’, namely ‘(show xs)’
> In the first argument of ‘trace’, namely
> ‘(" flatten " ++ (show xs))’
> In the expression: trace (" flatten " ++ (show xs)) Prob
> |
> 23 | flatten (Prob xs) = trace (" flatten " ++ (show xs))
> | ^^^^^^^
> Failed, no modules loaded.
>
> it seems show i defined is not in the context of flatten???
>
> damien
>
>
>
> On Thu, Feb 28, 2019 at 12:57 PM Jos Kusiek <jos.kusiek at tu-dortmund.de
> <mailto:jos.kusiek at tu-dortmund.de>> wrote:
>
> You simply cannot do that. To be more precise, you cannot use show
> inside the bind operator on Prob (but you could use it in
> flatten). Deriving Show creates a Show instance which looks
> something like that:
>
> instance Show a => Show (Prob a) where ...
>
> This instance needs "a" to instanciate Show, so you can only use
> show with Prob types, where "a" is an instance of Show itself, e.
> g. Prob Int. Your flatten function does not guarantee that "a" is
> an instance of Show. The type says, any type for "a" will do it.
> You can easily restrict that with a class constraint:
>
> flatten :: Show a => Prob (Prob a) -> Prob a
>
> But now you have a problem with the bind operator. You can no
> longer use flatten here. The bind operator for Prob has the
> following type:
>
> (>>=) :: Prob a -> (a -> Prob b) -> Prob b
>
> There are no constraints here and you cannot add any constraints.
> The type is predefined by the Monad class. So it is not
> guaranteed, that this Prob type has a show function and you cannot
> guarantee it in any way. So you cannot use show on your first
> parameter type (Prob a) or your result type (Prob b) inside the
> bind or any function that is called by bind.
>
> On 28.02.19 11:00, Damien Mattei wrote:
>> just for tracing the monad i have this :
>>
>> import Control.Monad
>>
>> import Data.Ratio
>> import Data.List (all)
>> import Debug.Trace
>>
>> newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving Show
>>
>> instance Functor Prob where
>> fmap f (Prob xs) = trace " Functor Prob "
>> Prob $ map (\(x,p) -> (f x,p)) xs
>>
>>
>> t
>>
>>
>> flatten :: Prob (Prob a) -> Prob a
>> flatten (Prob xs) = trace (" flatten " ++ show xs)
>> Prob $ concat $ map multAll xs
>> where multAll (Prob innerxs,p) = trace " multAll "
>> map (\(x,r) -> (x,p*r)) innerxs
>>
>>
>> instance Applicative Prob where
>> pure = trace " Applicative Prob return " return
>> (<*>) = trace " Applicative Prob ap " ap
>>
>> instance Monad Prob where
>> return x = trace " Monad Prob return "
>> Prob [(x,1%1)]
>> m >>= f = trace " Monad Prob >>= "
>> flatten (fmap f m)
>> fail _ = trace " Monad Prob fail "
>> Prob []
>>
>>
>> {-
>> instance Applicative Prob where
>>
>> pure a = Prob [(a,1%1)]
>>
>> Prob fs <*> Prob as = Prob [(f a,x*y) | (f,x) <- fs, (a,y) <- as]
>>
>>
>> instance Monad Prob where
>>
>> Prob as >>= f = Prob [(b,x*y) | (a,x) <- as, let Prob bs = f a,
>> (b,y) <- bs]
>>
>> -}
>>
>>
>>
>> in this :
>>
>> flatten :: Prob (Prob a) -> Prob a
>> flatten (Prob xs) = trace (" flatten " ++ show xs)
>> Prob $ concat $ map multAll xs
>> where multAll (Prob innerxs,p) = trace " multAll "
>> map (\(x,r) -> (x,p*r)) innerxs
>>
>>
>> i have this error:
>>
>> [1 of 1] Compiling Main ( monade.hs, interpreted )
>>
>> monade.hs:22:43: error:
>> • No instance for (Show a) arising from a use of ‘show’
>> Possible fix:
>> add (Show a) to the context of
>> the type signature for:
>> flatten :: forall a. Prob (Prob a) -> Prob a
>> • In the second argument of ‘(++)’, namely ‘show xs’
>> In the first argument of ‘trace’, namely ‘(" flatten " ++
>> show xs)’
>> In the expression: trace (" flatten " ++ show xs) Prob
>> |
>> 22 | flatten (Prob xs) = trace (" flatten " ++ show xs)
>> | ^^^^^^^
>> Failed, no modules loaded.
>>
>> how can i implement a show for xs ?
>> 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.
>
> --
> Dipl.-Inf. Jos Kusiek
>
> Technische Universität Dortmund
> Fakultät 4 - Informatik / Lehrstuhl 1 - Logik in der Informatik
> Otto-Hahn-Straße 12, Raum 3.020
> 44227 Dortmund
>
> Tel.: +49 231-755 7523
>
--
Dipl.-Inf. Jos Kusiek
Technische Universität Dortmund
Fakultät 4 - Informatik / Lehrstuhl 1 - Logik in der Informatik
Otto-Hahn-Straße 12, Raum 3.020
44227 Dortmund
Tel.: +49 231-755 7523
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190228/e9190a68/attachment.html>
More information about the Haskell-Cafe
mailing list