Patterns in Haskell revisited

A while back I came up with this way of representing musical patterns as pure functions in Haskell:

data Pattern a = Pattern {at :: Int -> [a], period :: Int}

data Pattern a = Atom {event :: a}
                 | Arc {pattern :: Pattern a,
                        onset :: Double,
                        duration :: Maybe Double
                       }
                 | Cycle {patterns :: [Pattern a]}
                 | Signal {at :: Double -> Pattern a}

I’ve got rid of periods, now patterns always have a relative period of 1. However they can be scaled down by being enclosed in an Arc pattern, and given a floating point duration and time phase offset (which in music parlance is called an onset), which should be less than 1.  A Cycle pattern consists of a number of Arcs, which may overlap in time.

The end result is a nice representation of cyclic patterns within patterns, with floating point time so that events don’t have to occur within the fixed time grids of the acid techno I’ve been making.

It is also still possible to represent a pattern as a function, which is what a Signal is in the above.

The Functor definition is straightforward:

instance Functor Pattern where
    fmap f p@(Atom {event = a}) = p {event = f a}
    fmap f p@(Arc {pattern = p'}) = p {pattern = fmap f p'}
    fmap f p@(Cycle {patterns = ps}) = p {patterns = fmap (fmap f) ps}
    fmap f p@(Signal _) = p {at = (fmap f) . (at p)}

The Applicative functor definition isn’t so bad either:

instance Applicative Pattern where
    pure = Atom

    Atom f <*> xs = f <$> xs
    fs <*> (Atom x) = fmap (\f -> f x) fs

    (Cycle fs) <*> xs = Cycle $ map (<*> xs) fs
    fs <*> (Cycle xs) = Cycle $ map (fs <*>) xs

    fs@(Arc {onset = o}) <*> s@(Signal {}) = fs <*> (at s o)
    fs@(Arc {}) <*> xs@(Arc {}) | isIn fs xs = fs {pattern = (pattern fs) <*> (pattern xs)}
                                | otherwise = Cycle []

    fs@(Signal {}) <*> xs = Signal $ (<*> xs) . (at fs)
    fs <*> xs@(Signal {}) = Signal $ (fs <*>) . (at xs)

Here’s how to turn a list into a pattern:

class Patternable p where
    toPattern :: p a -> Pattern a

instance Patternable [] where
    toPattern xs = Cycle ps
      where
        ps = map (\x -> Arc {pattern = Atom $ xs !! x,
                             onset = (fromIntegral x) / (fromIntegral $ length xs),
                             duration = Nothing
                            }
                 ) [0 .. (length xs) - 1]

And here’s how to make a Signal pattern of a sinewave:

-- sinewave from -1 to 1
sinewave :: Pattern Double
sinewave = Signal {at = f}

    where f x = Arc {pattern = Atom $ (sin . (pi * 2 *)) x,
                     onset = mod' x 1,
                     duration = Nothing
                    }

-- sinewave from 0 to 1
sinewave1 :: Pattern Double
sinewave1 = fmap ((/ 2) . (+ 1)) sinewave

Finally, here’s how to multiply a Cycle of discrete events by a Signal, thanks to our Applicative definition:

(*) <$> toPattern [1 .. 16] <*> sinewave

Well this may all be rather trivial, but somehow I find this really exciting, that continuous functions can be multipled by (potentially) complex discrete, hierarchical patterns with such tersity.  Furthermore that time can be manipulated outside of fixed grids.  I’ve been putting off making sounds from this, to try not to prejudice possibilities, but am really looking forward to experimenting with it live in performance.

It’s probably not of much use to anyone else at the moment, but the code is over here.