[Haskell-beginners] Re: I have created an ugly Haskell program..
Heinrich Apfelmus
apfelmus at quantentunnel.de
Wed Nov 4 12:21:17 EST 2009
Brent Yorgey wrote:
> Ask yourself: What Would Conal Do (WWCD)? Conal Elliott is always
> trying to get people to think about the semantic essence of their
> problems, so let's try it.
>
> What are we REALLY trying to do here? What are those lists of tuples,
> REALLY? Well, it seems to me that the lists of tuples are really just
> representing *functions* on some totally ordered domain.
> [...]
>
> So, let's try converting these lists of pairs to actual functions:
>
>
> asFunc :: (Ord a) => [(a,b)] -> (a -> Maybe b)
> asFunc is a = fmap snd . listToMaybe . reverse . takeWhile ((<=a) . fst) $ is
>
> [...]
>
> Now, you might object that this is much more inefficient than the
> other solutions put forth. That is very true. [...]
>
> However, I still find it very helpful to think about the essence
> of the problem like this: elegant yet inefficient code is a much
> better starting place than the other way around! [...]
>
> You can also try to optimize, taking advantage of the fact that we
> always call the functions built by asFunc with a sequence of strictly
> increasing inputs.
I am with Brent and Conal here. Now, to continue, ask yourself: What
Would Conal Do Next (WWCDN)?
What are we really trying to do here? What is this function, really,
considering that we are only evaluating it at a strictly increasing
sequence of inputs? Well, it seems to me that it is some special kind of
function, best captured as an *abstract data type*.
In particular, the function is something which I will call a "time
series". In other words, the input is to be thought of as time.
data Time t = Moment t | Infinity
deriving (Eq,Ord,Show)
The inclusion of infinity will turn out to be very convenient.
Now, the time series is a function that has a value x1 in the distant
past, until a time t1 where it begins to have the value x2 , again
until a time t2 where it switches to x3 and so on, until a value xn
that is kept until infinity. In Haskell, this looks like this
function t
| -Infinity <= t && t < t1 = x1
| t1 <= t && t < t2 = x2
| t2 <= t && t < t3 = x3
| ...
| t1 <= t && t < Infinity = xn
and pictorially, something like this:
____ xn _____
____ x2 ____ |
| |____ x3 ____ ... |
_____ x1 ____|
-Inf t1 t2 ... tn Inf
Of course, we can implement this abstract data type with a list of pairs
(tk,xk)
newtype TimeSeries t a = TS { unTS :: [(a,Time t)] }
deriving (Show)
and our goal is to equip this data type with a few natural operations
that can be used to implement Philip's zip-like function.
The first two operations are
progenitor :: TimeSeries t a -> a
progenitor = fst . head . unTS
which returns the value from the distant past and
beginning :: TimeSeries t a -> Time t
beginning = snd . head . unTS
which returns the first point in time when the function changes its
value. These correspond to the operation head on lists.
The next operation is called `forgetTo` t and will throw away all
values and changes before and including a given time t .
forgetTo :: Ord t => TimeSeries t a -> Time t -> TimeSeries t a
forgetTo (TS xs) Infinity = TS [last xs]
forgetTo (TS xs) t = TS $ dropWhile ((<= t) . snd) xs
This roughly corresponds to tail , but takes advantage of the time
being continuous.
Last but not least, we need a way to create a time series
forever :: a -> TimeSeries t a
forever x = TS [(x,Infinity)]
and we need to add values to a time series, which can be done with an
operation called prepend that adds a new beginning and replaces the
progenitor .
-- We assume that t < beginning xs
prepend :: a -> Time t -> TimeSeries t a -> TimeSeries t a
prepend x Infinity _ = TS [(x,Infinity)]
prepend x t (TS xs) = TS $ (x,t) : xs
These operations correspond to [] and (:) for lists.
The key about these operations is that they have a description /
intuition that is *independent* of the implementation of times series.
At no point do we need to know how exactly TimeSeries is implemented
to understand what these five operations do.
Now, Philip's desired zip-like function is straightforward to implement:
zipSeries :: Ord t => TimeSeries t a -> TimeSeries t b
-> TimeSeries t (a,b)
zipSeries xs ys = prepend (progenitor xs, progenitor ys) t $
zipSeries (xs `forgetTo` t) (ys `forgetTo` t)
where t = min (beginning xs) (beginning ys)
and you may want to convince yourself of its correctness by appealing to
the intuition behind time series.
Regards,
apfelmus
--
http://apfelmus.nfshost.com
More information about the Beginners
mailing list