[Haskell-beginners] Re: making translation from imperative code

[Michael Mossey]

Heinrich Apfelmus wrote:
> Michael Mossey wrote:
>> Heinrich Apfelmus wrote:
>>> Can you elaborate on what exactly the algorithm is doing? Does it just
>>> emit notes/chords/symbols at given positions or does it also try to
>>> arrange them nicely? And most importantly, "where" does it emit them to,
>>> i.e. what's the resulting data structure?
>>>
>>> So far, the problem looks like a basic fold to me.
>> Here is some Haskell code that explains the problem in
>> more detail.
>> [...]
> 
> Thanks for the elaboration.
> 
> I think the code doesn't separate concerns very well; mixing information
> about widths and times, page size and the recursion itself into one big
> gnarl.
> 
> Also, there is one important issue, namely returning a special value
> like -1 as error code in
> 
>>          tryAgain state =
>>            case scoreNextTime score (time state) of
>>             -1 -> indicateNoMoreChunks state
>>              t -> layoutSystem' (setTime state t)
> 
> Don't do this, use  Maybe  instead
> 
>     tryAgain state = case scoreNextTime score (time state) of
>         Nothing -> indicateNoMoreChunks state
>         Just t  -> layoutSystem' (state { time = t })
> 
> where  Nothing  indicates failure and  Just  success.

Okay, tried to give some more detail. thanks for the interesting code. I will 
study it some more. But here's the original task.

{-

A composition consists of several voices or instruments, each indicated
by its own *staff*. Visually, a staff is a layout of items such as
notes, clef signs, and accidentals arranged horizontally from left to
right in increasing time.


A *system* is a set of staves stacked vertically that represent
instruments playing at the same time.

Here is a simple representation of a system, in which the pipe character
represents items. Note that some of the items are aligned vertically
meaning they will play at the same time. At other times, only one
staff contains a sounding item.

staff 1:   |    |  | |
staff 2:     |  |    | |

Next we elaborate this model to show that items have visual width. Here
they are represented by clusters of x's with a pipe in the middle. The pipe
represents the part of the item that needs to be aligned with items on
other staves. For example, in the visual representation of a chord,
the part of the chord called the notehead needs to be aligned with
noteheads on other staves. (A chord includes other symbols, like accidentals
and flags, which get drawn to the right or left of the notehead and don't
need to be aligned vertically with anything else.)


staff 1:  x|x xx|xx        x|x

staff 2:       x|x x|x xxxxx|xxxxx

            a    b   c       d

Here you can see that there is an additional constraint on layout,
which is that items need to have horizontal space around them so they
don't collide. For instance, the very wide item at 'd' (on staff 2) means
that the item on staff 1 at 'd' has to be positioned far to the right
of its previous item.

Note that data exists in two domains: there is data that describes notes;
that is, pitches and timbres and volumes and times and duration. We'll
call this the 'score'. It's the fundamental data. Then there is the
visual *representation* of the score. Here we are concerned only with
creating a visual representation. However, we need to refer to
data in the score.

-}

-- LayoutItem is a visual representation of a note. The center of the note
-- or chord (specifically the part that needs to be aligned vertically)
-- goes at position 'pos', the other variables describe how much the
-- note sticks out to the left, right, top, and bottom. We omit other
-- details about the note.
data LayoutItem = LayoutItem
   { pos :: ( Int, Int ),
     leftWidth, rightWidth, topHeight, bottomHeight :: Int,
     staffId :: String  }
-- ChunkData is 'score' domain data. It represents all notes that start
-- sounding at the same time. It is an association list of staff
-- names to notes. Note that a complete score is essentially a list of
-- chunks in time order.
data ChunkData = ChunkData [ ( String, [ Note ] ) ]
-- We'll just say a note is an int giving its pitch.
type Note = Int
-- A system layout is a set of *staves*. Here, staves are
-- lists of LayoutItem, put into an association list by staff name.
-- There is also a need to make a memo of chunks for future reference.
data SystemLayout = SystemLayout
   { staves :: [ ( String, [ LayoutItem ] ) ],
     chunkMemo :: [ ChunkData ] }
-- This is the loop state. During the loop, 'time' keeps advancing to
-- the time of the next chunk, and 'nextX' keeps advancing to the next
-- vetical alignment location.
data LoopState = LoopState {
     time     :: Double,
     nextX    :: Int }
--- Details of score omitted, but assume it has two key functions.
data Score = Score ...
scoreGetChunkData :: Score -> Time -> ChunkData
scoreNextTime :: Score -> Time -> Maybe Time

-- layoutSystem works as follows: it takes a time to start the layout
-- at, a score, and a maximum paper width, and returns a tuple with the
-- LoopState and SystemLayout at termination.
--
-- The looping happens in the helper function layoutSystem' which
-- has a simple signature: basically all relevant state goes in,
-- and all relevant state comes out. (See signtaure below.)
--
-- incororateChunkData does the main work of looking at all notes
-- in the next chunk and either finguring out how to add them to
-- the staves, or indicating they can't be added without going off
-- the right edge of the paper. It returns
-- a tuple ( Bool, LoopState, SystemLayout ) where the Bool indicates
-- success or failure.
layoutSystem Time -> Score -> Int -> ( LoopState, SystemLayout )
layoutSystem firstTime score maxWidth =
    layoutSystem' initialState initialSystemLayout
    where
      initialState = LoopState { time = firstTime, nextX = 0 }
      initialSystemLayout SystemLayout { staves = [], chunkMem = [] } )

      layoutSystem' :: LoopState -> SystemLayout ->( LoopState, SystemLayout )
      layoutSystem' state slayout =
        let chunkData = scoreGetChunkData score (time state)
        in case incorporateChunkData chunkData state slayout maxWidth of
          ( True,  state', slayout' ) -> layoutSystem' state' slayout'
          ( False, state', slayout') ->
            case scoreNextTime score (time state) of
              Just t -> layoutSystem' state' { time = t } slayout'
              Nothing -> ( state', slayout' )


-- incorporateChunkData is a function that does the work  of looking at
-- all notes
-- in the next chunk and either figuring out how to add them to
-- the staves, or indicating they can't be added without going off
-- the right edge of the paper. It returns
-- a tuple ( Bool, LoopState, SystemLayout ) where the Bool indicates
-- success or failure.

incorporateChunkData :: LoopState -> SystemLayout -> Int ->
                         ( Bool, LoopState, SystemLayout )
incorporateChunkData chunkData state slayout maxWidth =
   let items = makeLayoutItems chunkData
       -- Find new x alignment value, which done by finding how far right
       -- each item needs to go to avoid collision with previous items
       -- For each staff staffId and each item i that needs to be added to
       -- the staff, the question is: how far right does the staff extend,
       -- and how far left does the new item stick out from its central
       -- position? That tells you where the new item needs to go.
       -- (the function rightExtent finds how far right a staff extends),
       -- This process needs to be repeated for all staves, noting the
       -- needed alignment point for each---and then the final determination
       -- is the maximum of all those alignment points.
       alignX = max (map (\i -> let r = rightExtent slayout (staffId i)
                                in r + leftWidth i)
                         items)
       -- Now see if we've run off the right edge of the paper.
       -- Then check how far to the right each item will extend and
       -- compare to maxWidth
       farRight = max ( map (\i -> alignX + rightWidth i) items)
       if farRight < maxWidth
       then let slayout' = addItems slayout items alignX
                state' = state { nextX = alignX + 1 }
            in ( True, state', slayout' )
       else ( False, state, slayout )