
This is a fairly complex problem and I don't expect anyone to follow it all, but I thought I would just post it and see if anyone can immediately identify unidiomatic Haskell. The problem is this: I'm writing a program that does backtrack search to determine musical counterpoint. I begin by laying out a series of "cells" which are notes of *as yet undetermined* pitch but do have determined begin time and duration (and also the instrument playing them is known). The algorithm will find pitches for each cell in order to maximize a fitness function. Cells can overlap in time. The search algorithm is allowed to make some cells silent if that improves the final result. So each cell has a status which is one of the following "undecided," "determined a specific pitch," and "determined to be silent". data CellStatus = CellUndecided -- Undecided whether this cell will be a -- pitch or silent | CellSilent -- It has been decided that this cell will be -- silent | CellPitch Pitch -- This cell will be a specific pitch deriving(Show) The following code deals with only one aspect of the fitness function. When there are patterns in the music called "octave relations," it makes the solution a bad one that should be avoided. An octave relation is when some note, say a C, appears as a following C in a different octave and fclose in time. It's okay to repeat the same C, just not in a different octave. In some atonal styles of music octave relations need to be specially handled or avoided altogether. So this is an algorithm that determines if any octave relations are present. There are two kinds of octave relations between a cell A and a cell B (containing an octave relation). One happens when A and B overlap in time. Clearly that represent a very close juxtaposition of A and B and it's illegal. The next kind of octave relation happens when B follows A some time later, but there are very few intervening notes of other pitches. The idea is that if *a lot of notes* intervene, it distracts the ear and the octave relation is not audible. But if only a few intervene between A and B, the octave relation will really stand out. Another bit of trickery. Consider the cells that intervene between A and B; that is, notes that start *after the end of A* and *before the beginning of B*. Some of those might have a status of CellUndecided. Those notes count as helping to distract the ear because we know we are eventually going to fill them in. But cells with a status of CellSilent don't count. And of course, notes of CellPitch status count as distracting the ear (unless they represent an octave relation). Here's the code. If anyone actually wants to run this, I can email you some test data. import Data.Maybe import Data.Map(Map) import qualified Data.Map as M import qualified Data.List as L type Time = Int type Pitch = Int data Cell = Cell { endTime :: Time , cellStatus :: CellStatus } deriving(Show) data CellStatus = CellUndecided -- Undecided whether this cell will be a -- pitch or silent | CellSilent -- It has been decided that this cell will be -- silent | CellPitch Pitch -- This cell will be a specific pitch deriving(Show) -- maps a given Time to a list of Cells that *begin* at that time type TimeMap = Map Time [Cell] -- checkOctaveRelations -- -- Int :: all octave relations must be have at least this many -- intervening notes -- TimeMap :: map of Time to list of Cells at that time -- -- Result True if satisfies the condition that all octave relations -- have at least proper number of intervening notes (or there are no -- octave relations), False otherwise. -- checkOctaveRelations :: Int -> TimeMap -> Bool checkOctaveRelations condition timeMap = all checkOneTime . M.keys $ timeMap where -- check all notes at one begin time to verify they satisfy the condition. -- note that we assume this function is called with 'beginTime' in ascending -- time order, so we only check notes at or following 'beginTime' checkOneTime :: Int -> Bool checkOneTime beginTime | checkBunch cellsAtBeginTime = False -- this is the case that among -- all cells at 'beginTime', there -- are octave relations within -- them | otherwise = all checkOneCell cellsAtBeginTime where cellsAtBeginTime = fromJust . M.lookup beginTime $ timeMap checkOneCell :: Cell -> Bool checkOneCell cell -- the line below checks the case that any overlapping cells have -- octave relations | any (any (isOctRel cell)) overlappingCells = False -- otherwise count the number of intervening cells until the -- next octave relation | otherwise = case countFollowingNonOctRel cell followingCells of Nothing -> True -- no octave relatios were found following -- 'cell' - so condition is met Just count -> count >= condition where (Cell endTime _) = cell followingCells = M.elems . snd . M.split (endTime-1) $ timeMap overlappingCells = M.elems . M.filterWithKey (\k _ -> k > beginTime && k < endTime) $ timeMap -- countFollowingNonOctRel -- -- count the number N of cells that do not have an octave relation -- with input 'c' before encountering an octave relation. Result is Just N. -- if no octave relations are found at all, result is Nothing. countFollowingNonOctRel :: Cell -> [[Cell]] -> Maybe Int countFollowingNonOctRel c cellGroups = case L.findIndex (\cells -> any (isOctRel c) cells) cellGroups of Nothing -> Nothing Just idx -> Just . sum . map countCells . take idx $ cellGroups where countCells :: [Cell] -> Int countCells cells = sum . map countFn $ cells countFn (Cell _ CellSilent) = 0 -- silent cells are not distracting; don't count as any countFn _ = 1 -- other cells count as distracting -- checkBunch -- -- Check a group of cells that all occur at the same time for any octave -- relations in any pair of cells checkBunch :: [Cell] -> Bool checkBunch [] = False checkBunch (c:cs) = (any (\c' -> isOctRel c c') cs) || checkBunch cs isOctRel :: Cell -> Cell -> Bool isOctRel cell1 cell2 | isCellPitch cell1 && isCellPitch cell2 = isOctRel' cell1 cell2 | otherwise = False where isOctRel' (Cell _ (CellPitch p1)) (Cell _ (CellPitch p2)) = p1 /= p2 && p1 `mod` 12 == p2 `mod` 12 isCellPitch (Cell _ (CellPitch _)) = True isCellPitch _ = False isCellSilent (Cell _ CellSilent) = True isCellSilent _ = False