[Haskell-beginners] Re: [Haskell-cafe] music-related problem

[Dean Herington]

At 11:53 AM -0700 7/4/10, Michael Mossey wrote:
>Wondering if I could get some suggestions for coding this problem.
>
>A musical document (or "score") consists primarily of a list of 
>measures. A measure consists primarily of lists of "items". We'll 
>consider only one kind of item: a note. Items have a location within 
>the measure. A note's
>location indicates both where it goes on the page (i.e. a visual 
>representation of the score) and what moment in time it begins 
>sounding (i.e. rendering the score in sound). My concern here is 
>sound.
>
>data Doc = [Measure]
>
>data Loc = ... (represents a location within the musical
>                 document including measure number)
>
>
>data Measure = Measure [(Loc,Item)]
>   -- In the Meausre, we can assume (Loc,Item) are in
>   --  ascending order
>
>
>Notes also have an end, when indicates when in time they stop
>sounding. See the 'end' field below. Also note the 'soundedEnd'
>  'tieStart' and 'tieStop' fields which I will explain.
>
>data Item = Note
>             { pitch :: Pitch
>             , end :: Loc
>             , soundedEnd :: Maybe Loc
>             , tieNext :: Bool
>             , tiePrior :: Bool
>             }
>
>There is a concept of "tied notes". When two notes are tied
>together, their durations are summed and they are sounded
>continuously as if one note. Ties have several uses, but one
>important one is to make a sound that begins in one measure and
>ends in a later measure, by tying notes across measures.
>
>The 'tieNext' field indicates if a note is tied to the following
>note (that is, the next note of the same pitch). 'tiePrior'
>indicates if tied to immediately prior note of same pitch.
>
>A chain of notes can be tied. Notes in the middle with have
>both tieNext and tiePrior set.
>
>In the event a note is within a chain of ties, its 'soundedEnd'
>field needs to be computed as Just e where e is the end of the
>last note in the chain. This information is useful when rendering
>the document as sound.
>
>My problem is:
>
>   - given a Doc in which all fields have been set EXCEPT soundedEnd
>     (all soundedEnd's are given a default value of Nothing)
>   - update those notes in the Doc which need to have soundedEnd set.
>     This involves chasing down the chain of ties.
>
>I can solve a simpler problem which is
>
>-- Given a note with tieNext set, and a list of notes, find
>-- the end Loc of the last note in the chain. Only notes
>-- with the same pitch as 'firstNote' are considered when looking
>-- for the chain of notes.
>computeSoundedEnd :: Item -> [Item] -> Loc
>computeSoundedEnd firstNote notes = compSndEnd (pitch firstNote) notes
>
>compSndEnd :: Pitch -> [Item] -> Loc
>compSndEnd _ [] = error "tie chain doesn't come to completion"
>compSndEnd p (n:ns) = if pitch n == p
>                         then if tieNext n
>                           then if tiePrior n
>                             then compSndEnd p ns
>                             else error "illegal tie chain"
>                           else if tiePrior n
>                             then end n
>                             else error "illegal tie chain"
>                         else compSndEnd p ns
>
>The thing that is hard for me to understand is how, in a functional
>paradigm, to update the entire Doc by chasing down every tie and making
>all necessary updates.
>
>Thanks,
>Mike


[Sorry to be coming so late to this thread.  I'm catching up on old 
Haskell e-mail.]

I agree with some of the earlier posters that your representation is 
probably more complicated than needed.  (BTW, a graph especially 
seems like overkill.)

Nevertheless, given your representation, `soundedEnd` can be computed 
idiomatically and efficiently in Haskell.  As you showed, computing 
`soundedEnd` for one item depends only on the item and those that 
follow it.  In an imperative language, we would compute the 
`soundedEnd` values from the end to the beginning, storing the 
results as we go.  In Haskell, we can simply use a "foldr" pattern 
and let lazy evaluation take care of the rest.  (Unfortunately, in 
this case the "foldr" is not quite so simple, due to the two levels 
of lists--measures and items.)

I simplify the computation of `soundedEnd` by letting it be defined 
always:  For a note whose `tieNext` is `False`, the `soundedEnd` 
value equals the `end` value.  With this approach, `soundedEnd` has 
type `Loc`.  (In fact, its value could be computed (i.e., the thunk 
to evaluate it could be installed) when the item is originally 
created, thanks again to lazy evaluation.)  Also, I eliminate 
`tiePrior` because it's not needed for this demonstration.

Dean


import Ratio

type Duration = Rational  -- Whole note has duration 1.

type Loc = (Int, Duration)

type Pitch = Char  -- for simplicity

data Item = Note
         { pitch :: Pitch
         , end :: Loc
         , soundedEnd :: Loc
         , tieNext :: Bool
         }
   deriving (Show, Read)

data Measure = Measure [(Loc, Item)]
   deriving (Show, Read)

type Doc = [Measure]


computeSoundedEnd :: Doc -> Doc
computeSoundedEnd measures = foldr eachMeasure [] measures
   where eachMeasure (Measure litems) remainingMeasures = Measure 
(foldr eachLItem [] litems) : remainingMeasures
           where eachLItem (loc, item) remainingLItems = (loc, item') 
: remainingLItems
                   where item' = item{ soundedEnd = soundedEndFor 
item' remainingLItems remainingMeasures }

soundedEndFor :: Item -> [(Loc, Item)] -> [Measure] -> Loc
soundedEndFor item litems measures
     | tieNext item = case filter ((pitch item ==) . pitch . snd) 
(litems ++ concatMap unMeasure measures) of
                        [] -> error "illegal tie chain"
                        (_, item') : _ -> soundedEnd item'
     | otherwise = end item

unMeasure :: Measure -> [(Loc, Item)]
unMeasure (Measure litems) = litems



measureLength = 4%4  -- for simplicity

plus :: Loc -> Duration -> Loc
(m, o) `plus` d = let o' = (o + d) / measureLength
                       md = floor o'
                       od = o' - fromIntegral md
                   in (m + md, od)

li tied start pitch dur = (start, Note pitch (start `plus` dur) 
(error "undefined soundedEnd") tied)
ni start pitch dur = li False start pitch dur
ti start pitch dur = li True  start pitch dur

[a,b,c,d,e,f,g] = ['a'..'g']

-- In the following graphical representation:
--  * Each character position represents an eighth note.
--  * A capitalized note is tied to its successor.
--  * Note that the "B" line is musically dubious.
-- |        |        |      g.|
-- |        |        |   Ff.  |
-- |      E.|E.......|E.e     |
-- |  D.d.  |        |        |
-- |c.  c.  |        |        |
-- |      B.|        |b.......|
-- |        |A.A.A.a.|        |
doc1 = [Measure [ni (0,0%4) c (1%4), ti (0,1%4) d (1%4), ni (0,2%4) c 
(1%4), ni (0,2%4) d (1%4), ti (0,3%4) b (1%4), ti (0,3%4) e (1%4)],
         Measure [ti (1,0%4) a (1%4), ti (1,0%4) e (1%1), ti (1,1%4) a 
(1%4), ti (1,2%4) a (1%4), ni (1,3%4) a (1%4)],
         Measure [ti (2,0%4) e (1%4), ni (2,0%4) b (1%1), ni (2,1%4) e 
(1%8), ti (2,3%8) f (1%8), ni (2,2%4) f (1%4), ni (2,3%4) g (1%4)]]

main = print (computeSoundedEnd doc1)