Patterns again

Back to patterns in Haskell, an unruly puzzle that’s run through the last few years of my life, trying to work out how I want to represent my music.  Here’s the current state of my types:

  data Pattern a = Sequence {arc :: Range -> [Event a]}
                 | Signal {at :: Rational -> [a]}

  type Event a = (Range, a)
  type Range = (Rational, Rational)

A Range is a time range, with a start (onset) and duration.  An Event is of some type a, that occurs over a Range.  A Pattern can be instantiated either as a Sequence or Signal.  These are directly equivalent to the distinction between digital and analogue, or discrete and continuous.  A Sequence is a set of discrete events (with start and duration) occurring within a given range, and a Signal is a set of values for a given position in time.  In other words, both are represented as functions from time to values, but Sequence is for representing a set of events which have beginnings and ends, and Range is for a continuously varying set of values.

This is a major improvement on my previous version, simply because the types are significantly simpler, which makes the code significantly easier to work with.  This simplicity is due to the structure of patterns being represented entirely with functional composition, so is closer to my (loose) understanding of functional reactive programming..

The Functor definition is straightforward enough:

  mapSnd f (x,y) = (x,f y)

  instance Functor Pattern where
    fmap f (Sequence a) = Sequence $ fmap (fmap (mapSnd f)) a
    fmap f (Signal a) = Signal $ fmap (fmap f) a

The Applicative definition allows signals and patterns to be combined in in a fairly reasonable manner too, although I imagine this could be tidied up a fair bit:

  instance Applicative Pattern where
    pure x = Signal $ const [x]
    (Sequence fs) <*> (Sequence xs) = 
      Sequence $ \r -> concatMap
                       (\((o,d),x) -> map
                                      (\(r', f) -> (r', f x))
                                      (
                                        filter
                                        (\((o',d'),_) -> (o' >= o) && (o' < (o+d)))
                                        (fs r)
                                      )
                       )
                       (xs r)

  (Signal fs) <*> (Signal xs) = Signal $ \t -> (fs t) <*> (xs t)
  (Signal fs) <*> px@(Sequence _) = 
    Signal $ \t -> concatMap (\(_, x) -> map (\f -> f x) (fs t)) (at' px t)
  (Sequence fs) <*> (Signal xs) = 
    Sequence $ \r -> concatMap (\((o,d), f) -> 
                                map (\x -> ((o,d), f x)) (xs o)) (fs r)

In the Pattern datatype, time values are represented using Rational numbers, where each whole number represents the start of a metrical cycle, i.e. something like a bar.  Therefore, concatenating patterns involves ‘playing’ one cycle from each pattern within every cycle:

  cat :: [Pattern a] -> Pattern a
  cat ps = combine $ map (squash l) (zip [0..] ps)
    where l = length ps

  squash :: Int -> (Int, Pattern a) -> Pattern a
  squash n (i, p) = Sequence $ \r -> concatMap doBit (bits r)
    where o' = (fromIntegral i)%(fromIntegral n)
          d' = 1%(fromIntegral n)
          cycle o = (fromIntegral $ floor o)
          subR o = ((cycle o) + o', d')
          doBit (o,d) = mapFsts scaleOut $ maybe [] ((arc p) . scaleIn) (subRange (o,d) (subR o))
          scaleIn (o,d) = (o-o',d* (fromIntegral n))
          scaleOut (o,d) = ((cycle o)+o'+ ((o-(cycle o))/(fromIntegral n)), d/ (fromIntegral n))

  subRange :: Range -> Range -> Maybe Range
  subRange (o,d) (o',d') | d'' > 0 = Just (o'', d'')
                       | otherwise = Nothing
    where o'' = max o (o')
          d'' = (min (o+d) (o'+d')) - o''

  -- chop range into ranges of unit cycles
  bits :: Range -> [Range]
  bits (_, 0) = []
  bits (o, d) = (o,d'):bits (o+d',d-d')
    where d' = min ((fromIntegral $ (floor o) + 1) - o) d

Well this code could definitely be improved..

If anyone is interested the code is on github, but is not really ready for public consumption yet.  Now I can get back to making music with it though, more on that elsewhere, soon, maybe under a new pseudonym..