[Haskell-cafe] Applicative of Applicative
martin
martin.drautzburg at web.de
Thu Mar 26 18:24:53 UTC 2015
Am 03/24/2015 um 04:13 AM schrieb Chris Wong:
> Hi Martin,
>
> On Tue, Mar 24, 2015 at 10:02 AM, martin <martin.drautzburg at web.de> wrote:
>> Hello all,
>>
>> I've been playing with temporal values, i.e. values which change over time at discrete points in time. I thought it
>> would be good to make it an instance of Applicative and I was pleased with the results. I may be re-inventing some of
>> frp here, but hey.
>
> Have you considered making Temporal a Monad? All monads by definition
> provide a `join :: m (m a) -> m a` which flattens their nested
> structure.
I just tried that, but I started with join and I wanted to get >>= for free.
data Change a = Chg {
ct :: Time, -- "change time"
cv :: a -- "change value"
}
data Temporal a = Temporal {
td :: a, -- "temporal default"
tc :: [Change a] -- "temporal changes"
} deriving (Show)
-- apply a function to the value of a change
cvf :: (a->b) -> Change a -> Change b
cvf f e = Chg (ct e) (f $ cv e)
instance Functor Temporal where
fmap f (Temporal xd xs) = Temporal (f xd) (map (cvf f) xs)
I beleive join is a bit too long to post here. But is seems to work with these examples
exNat :: Temporal Int
exNat = Temporal 0 (map (\x -> Chg (2*x) (fromIntegral x)) [1..100000])
ext2 :: Temporal Int
ext2 = Temporal 10 [Chg 5 0]
exNested2 = Temporal exNat [Chg 7 ext2]
*Main> tJoin exNested2
Temporal {td = 0, tc = [(2,1),(4,2),(6,3),(7,10)]}
It starts with exNat but only up to the Time=10 where ext2 is scheduled and adds the default at Time=10. Since ext2 has
no further changes after Time=10, this is it.
Then I defined Modad as
instance Monad Temporal where
return x = Temporal x []
ma >>= f = tJoin $ fmap f ma
And Applicative
instance Applicative Temporal where
pure x = Temporal x []
(<*>) = ap
But here is what I get
*Main> (*) <$> exNat <*> ext2
Temporal {td = 0, tc = [(2,10),(4,20),(6,30),(8,40),(10,50) ...
This is NOT what I expected. Before I had a hand-crafted <*> function, and this gave me
*Main> (*) <$> exNat <*> ext2
Temporal {td = 0, tc = [(2,10),(4,20),(5,0),(6,0),(8,0) ...
You see the values all drop to zero beyond Time=5, because ext2 drops to zero there and I am multiplying.
Where do you think things went awry? Do you think its my tJoin function, or is there something wrong in the way I
defined those typeclasses with respect to each other? Or did I voilate one of the laws? How could I find out?
More information about the Haskell-Cafe
mailing list