[Haskell-beginners] my ugly code and the Maybe monad
Simon Parry
sparry04 at googlemail.com
Wed Aug 19 18:57:47 EDT 2009
Thanks Jan, very helpful and you're right I am just trying to combine 2
lists; one with 'wrapped' values, one without.
> You can write your own version of `liftM2` (from
> `Control.Monad`) like this:
>
> liftM2snd f a mb = do { b <- mb; return (f a b) }
>
so the b <- mb bit is 'unwrapping' the Maybe b to use it with the pure
function f? I guess I didn't realise this as I've only seen it in the
IO monad, but naturally it would work with all monads.
> You can verify that
>
> liftM2snd == (fmap .)
if I look at this in GHCi the liftM2snd acts over monads and the (fmap .) acts over functors.
Now I'm still trying to get comfortable with simple monad manipulations so maybe I should just
read this as functors are equivalent to monads and not worry too much about it yet?
With that in mind fmap acts to map some pure function over a 'wrapped' value?
Thanks also for the other suggestions, its always helpful to see a progression rather than
jumping in at say pvs5.
> Anyway, note that all the `pvs` functions (including the your one) return
> `Nothing` when `(df yield)` returns `Nothing` for at least one related
> member of `times`. Is that what you want?
I did want it to only perform the calc if the yield was sensible.
thanks again
Simon
On Wed, 2009-08-19 at 12:53 +0100, Jan Jakubuv wrote:
> Hi Simon,
>
> On Tue, Aug 18, 2009 at 10:41:45PM +0100, Simon Parry wrote:
> > It seems to work ok (I haven't properly tested it yet) but I feel the
> > pvs function is just ugly. However it seems like its a fairly common
> > requirement for maths modelling ie using Maybe or Error or such to
> > represent conditions on the input variables and then later having to
> > combine those 'wrapped' values with other things.
> >
>
> I don't quite understand what is function `pvs` supposed to do ?? Anyway,
> I try to guess. It seems that it just applies `(df yield)` to `times` and
> then multiply the resulting values one by one with `cashflow`. So it seems
> that you need to lift multiplication `(*)` to the Maybe monad in the second
> argument only. You can write your own version of `liftM2` (from
> `Control.Monad`) like this:
>
> liftM2snd f a mb = do { b <- mb; return (f a b) }
>
> You can verify that
>
> liftM2snd == (fmap .)
>
> Thus you can rewrite `pvs` as:
>
> pvs2 df yield cashflow = multiply cashflow discounts
> where multiply = zipWithM (fmap . (*))
> discounts = map (df yield) times
>
> You could alternatively use the library version of `liftM2` but then you
> need to “lift” the `cashflow` list using `return`. Like this:
>
> pvs3 df yield cashflow = multiply (map return cashflow) discounts
> where multiply = zipWithM (liftM2 (*))
> discounts = map (df yield) times
>
> When you take the advantage of commutativity of `*` you can write:
>
> pvs4 df yield = multiply discounts . map return
> where multiply = zipWithM (liftM2 (*))
> discounts = map (df yield) times
>
> or maybe even better:
>
> pvs5 df yield = multiply discounts
> where multiply = zipWithM (flip $ fmap . (*))
> discounts = map (df yield) times
>
> Anyway, note that all the `pvs` functions (including the your one) return
> `Nothing` when `(df yield)` returns `Nothing` for at least one related
> member of `times`. Is that what you want?
>
> > Basically it seems inelegant and I feel like I'm confusing the monadic
> > and non-monadic parts?
> >
>
> You are using this function:
>
> fce = \c -> (>>= \d -> return $ c*d)
>
> which is pretty ugly and not very intuitive. Note that this is simply
> `liftM2snd (*)` from above, that is, `fmap . (*)`.
>
> > help/criticism welcome,
>
> You might want to look at the `liftM` functions from `Control.Monad`.
>
> Note that I have inlined the only use of `discount`. In my opinion it
> improves readability. But it's up to you to judge.
>
> I hope this helps a little. I don't know any financial stuff so maybe I
> didn't understand well what is going on.
>
> Sincerely,
> Jan.
>
> >
> > thanks
> >
> > Simon
> >
> >
> > module TimeValueMoney1 where
> >
> > --taken from Financial Numerical Recipes in C++ by B A Odegaard (2006):
> > --Chapter 3
> >
> > import Control.Monad
> >
> > --time periods - assumes now is time 0--
> > times :: [Int]
> > times = [0..]
> >
> > minusOne :: Double
> > minusOne = -1.0
> >
> > --can have eg discrete or continuous compounding
> > type Compounding = Double -> Int -> Maybe Double
> >
> > --discounting and present value--
> > discreteCompounding :: Compounding
> > discreteCompounding yield elapsed
> > | yield > minusOne = Just ( 1.0/ (1.0 + yield)^elapsed )
> > | otherwise = Nothing
> >
> > continuousCompounding :: Compounding
> > continuousCompounding yield elapsed
> > | yield > minusOne = Just (exp( minusOne * yield * fromIntegral
> > elapsed ) )
> > | otherwise = Nothing
> >
> > pvs :: Compounding -> Double -> [Double] -> Maybe [Double]
> > pvs df yield cashflow = zipWithM ( \c -> (>>= \d -> return $ c*d ) )
> > cashflow discounts
> > where discounts = map discount times
> > discount = df yield
> >
> > _______________________________________________
> > Beginners mailing list
> > Beginners at haskell.org
> > http://www.haskell.org/mailman/listinfo/beginners
>
>
More information about the Beginners
mailing list