Case Study: TimeSeries by Stateful Functions

11 March 2004

home1 home2
 Bib
 Algorithms
 Bioinfo
 FP
 Logic
 MML
 Prog.Lang
and the
 Book

FP
 II
  Ver'1.1
   States
    #abs'
    #abs2

All of the example TimeSeries models in the [200309] version of the Haskell code are based on functions (->) from the context of previous values to a Model for the next value; this suits low-order Markov models, for example, quite well. As was noted, it is obvious that in some situations another natural way to define a TimeSeries model is by a function manipulating a state, and this is developed below.

It is easy to create a suitable data type to allow TimeSeries to be defined in the new way, and to give the data type the appropriate instance definitions (note that a good choice of names is important and yet somewhat arbitrary, both, and that names might well change from those in this experimental code in some future version):

data StateSeriesType dataSpace =
  SST MessageLength
      ([dataSpace] -> [ModelType dataSpace])
      (() -> String)

instance SuperModel (StateSeriesType dataSpace) where
  msg1 (SST m1 _ _) = m1
  mixture mx = ...

instance TimeSeries StateSeriesType where
  predictors (SST _ p _) ds = p ds

instance Show (StateSeriesType dataSpace) where
  show (SST _ _ desc) = desc()

(Although SST's parameters have the same types as those of TSM, [200309], note that a TSM is given a past context in reverse order but an SST is given a whole data-series in forward order. See below on possibilities for abstracting the state.)

There is a good candidate (parameterless) TimeSeries model for series of Enumerated Bounded data, adaptive, which can be created in the new way: adaptive assumes that the data series is homogeneous but makes no other claim about it. The name comes from the use of adaptive codes in file compression. It operates by keeping (a state) counts of the number of times that each value has been seen prior to the current element and bases the Model for that element on the values of the counts. So that all probabilities are greater than zero, every count is initialised to one. The appropriate count is incremented when the element is passed over.

adaptive =
 let predictors ds =
      let
        incr 0 (c:cs) = (c+1) : cs           -- i.e.
        incr n (c:cs) = c : (incr (n-1) cs)  -- increment the n-th count
        egValue = ds!!0
        mn = fromEnum (minBound `asTypeOf` egValue)
        mx = fromEnum (maxBound `asTypeOf` egValue)
        size = mx - mn + 1
        initial = (size, replicate size 1)   -- initial total and counts
        scan       _        []     = []
        scan (total,counts) (d:ds) =
          let tc = (total+1, incr (fromEnum d - mn) counts)
          in tc : scan tc ds  -- progressive counts from start of data series
      in
        map (\(total,counts) ->
              ((modelInt2model egValue) . probs2model     -- make Model
                . (map (/ (fromIntegral total)))) counts) -- normalise
            (initial : scan initial ds)
 in
   SST 0 predictors (\()->"SST_adaptive")
11/3/2004

At each position, the counts are normalized (it is redundant but convenient to have the total to help), and turned into a Model (of Int) by probs2model, and thence into a Model of the data element type by modelInt2model, i.e. the TimeSeries's prediction for the next element. (Note that all TimeSeries models make one more prediction than there are elements in the given data series.)

main =
 print(predictors adaptive [H,T,H,H])  -- a trivial test

-- [mState[0.5,0.5], mState[0.66,0.33], ... etc.

Notes

adaptive is parameterless and has zero part-one message length (complexity), although this is not true of all TimeSeries.

adaptive assumes that a given data series is homogeneous, but not that ds1++ds2 is, say. It should be the case that, e.g.  msg (timeSeries2model adaptive) ds = msg (timeSeries2model adaptive) (reverse ds)  to within numerical accuracy.

Tuples of Enumerated Bounded types have previously been made Enumerated Bounded so adaptive can automatically apply to them.

The state for adaptive consists of (total,counts) and it slowly changes as the data series is scanned. As the code stands, there is nothing to prevent a careless or unscrupulous implementor of adaptive, or a similar TimeSeries, from cheating by looking at the current element before making a prediction. It is natural to ask if the state, the state-transformation and the state-to-prediction mapping can be abstracted, and if the scanning process can be moved into the TimeSeries-instance definition of the new type [11/3/2004].

The original TimeSeriesType and TSM, [200209], perhaps form a special case of the new stateful TimeSeries with state=context, initial state=[], and state transition function ((:)d) [23/3/2004].

Abstracting the State

A first attempt at abstracting the state might be:
data StateSeriesType2 state dataSpace =
  SST2 MessageLength
       state                           -- initial state
       (state -> dataSpace -> state)   -- transition
       (state -> ModelType dataSpace)  -- predict/model
       (() -> String)                  -- description

However, this means that a mixture of two or more StateSeriesType2 models can only be formed if they all have the same type, including the state.

A better solution is to make the state an existential type (i.e. forall(!), requiring type extensions) SST3b:

data StateSeriesType3 dataSpace =
  SST3a MessageLength
        ([dataSpace] -> [ModelType dataSpace])
        (() -> String)
  |
  forall state. SST3b MessageLength
                      state
                      (state -> dataSpace -> state)
                      (state -> ModelType dataSpace)
                      (() -> String)

Other code should not care what type the state is, provided that the type is consistent with the initial state, the state transformation function and the function mapping states to predictions.

[*] "Externally" every component's state has type ~ (Forall t.t); might think the mixture's state could also be existential? But we must not get "Quantified type variable <state> escapes."  Cannot have a heterogeneous list of states. BUT can ["change" the state] in a t-s-m (by making a new t-s-m) keeping the state hidden but still usable. [5/10/2004]

If we only had the one constructor SST3b, mixtures could still not be formed from stateful TimeSeries because the result must be of the same type so it would be necessary to build some sort of state. An obvious candidate would be a product of the components' states, but the details have just been hidden![*] And even if it could be built its type differs from those of the components. Introducing the constructor SST3a allows mixtures without considering states.

instance SuperModel (StateSeriesType3 dataSpace) where
 ...
 mixture mx =
  let prs ds = ((map (\mdls->mixture (Mix (mixer mx) mdls)))
             . transpose
             . (map (\tsm->predictors tsm ds))) (components mx)
  in SST3a (msg1 mx) prs (\()->show mx)

instance TimeSeries StateSeriesType3 where
 predictors (SST3a _ p _)      ds = p ds
 predictors (SST3b _ s0 t p _) ds =
  let states = s0 : (map  (uncurry t) (zip states ds))  -- !
  in map p states

There remains a more general difficulty: It should be possible to form a mixture of any collection of suitable TimeSeries, stateful or non-stateful, including those already defined in [200309]; only the dataSpaces should have to match. This is possible if SST3a and SST3b (or equivalents with better names) are added beside TSM in the existing TimeSeriesType rather than being declared in their own new type.

Here is an updated version of adaptive:

adaptive' =
 let
  incr ... as before ...
  mn = minBound
  size = (fromEnum(maxBound `asTypeOf` mn)) - (fromEnum mn) + 1
  state0 = (size, replicate size 1)
  t (total, counts) datum =
    (total+1,
     incr(fromEnum datum-fromEnum(mn `asTypeOf` datum)) counts)
  p (total, counts) =
    ((modelInt2model mn) . probs2model
    . (map (/ (fromIntegral total)))) counts
 in SST3b 0 state0 t p (\()->"adaptive\'")
25/3/2004

The remaining drawbacks are modest: (i) SST3a would be better hidden (if Haskell had such a mechanism) because its only(?) legitimate purpose is to form mixtures but it does also allow "cheating" TimeSeries to be written. (ii) Any new sort of TimeSeries must be added as an alternative to TimeSeriesType if it is to be mixed with existing sorts. A mixture of TimeSeries need only be a TimeSeries; we do not really care of what type. (The latter reservation also applies to Models and to FunctionModels.)

On mixtures

SST3a proved unnecessary, at least for mixtures. The state can be "changed" in the time-series model, i.e. make a new state 0. Externally all values ::StateSeriesType3 ds have the same type, the "heterogeneous" states are hidden which allows list membership, but each stays associated with its operators, and the compiler does not complain about "escape".

data StateSeriesType3 dataSpace =  -- NB. dropped SST3a
  forall state. SST3b MessageLength
    state                           -- initial state
    (state -> dataSpace -> state)   -- transition
    (state -> ModelType dataSpace)  -- predict/model
    (() -> String)

step    (SST3b m s0 t p s) x = SST3b m (t s0 x) t p s
stepAll tsms               x = map ((flip step) x) tsms
predict (SST3b m s0 t p s)   = p s0

instance SuperModel (StateSeriesType3 dataSpace) where
  mixture mx =
    SST3b (msg1 mx)
    (components mx)              -- state of mixture
    stepAll                      -- trans fn of mixture
    (\ss -> mixture (Mix (mixer mx) (map predict ss)) )
    (\()->show mx)

instance TimeSeries StateSeriesType3 where
  predictors (SST3b _ s0 t p _) ds = ...as before...
13/10/2004

A useful little function turns a context-based time-series model into a state-based one where state=context::[dataSpace]:

old2new (TSM m f s) = SST3b m [] (flip (:)) f s
Coding Ockham's Razor, L. Allison, Springer

A Practical Introduction to Denotational Semantics, L. Allison, CUP

Linux
 Ubuntu
free op. sys.
OpenOffice
free office suite
The GIMP
~ free photoshop
Firefox
web browser

© L. Allison   http://www.allisons.org/ll/   (or as otherwise indicated),
Faculty of Information Technology (Clayton), Monash University, Australia 3800 (6/'05 was School of Computer Science and Software Engineering, Fac. Info. Tech., Monash University,
was Department of Computer Science, Fac. Comp. & Info. Tech., '89 was Department of Computer Science, Fac. Sci., '68-'71 was Department of Information Science, Fac. Sci.)
Created with "vi (Linux + Solaris)",  charset=iso-8859-1,  fetched Friday, 29-Mar-2024 13:30:51 AEDT.