Normalizing Frequencies of Chords, Parameter Passing

So, in the following code, I am generating a wav file from notes and composed chords. I've got it working for single notes and chords of two notes, but for combinations of more than 2 notes, I run into problems because I am not normalizing the frequencies. I know what I need to do (divide the frequencies at each frame by the number of notes composing it) but not necessarily how to do it in an elegant manner (or, in any manner at all). What has to happen is, I need to somehow get the length of the list returned by notes'' up to buildChord, and then work out how to map a division by that number across the input to buildChord.

I'm really at a loss, here, so any input would be greatly appreciated.

import Data.WAVE

import Control.Applicative
import Data.Char (isDigit)
import Data.Function (on)
import Data.Int (Int32)
import Data.List (transpose, groupBy)
import D开发者_如何学运维ata.List.Split (splitOn, split, oneOf)
import System.IO (hGetContents, Handle, openFile, IOMode(..))

a4 :: Double
a4 = 440.0

frameRate :: Int 
frameRate = 32000

noteLength :: Double
noteLength = 1

volume :: Int32
volume = maxBound `div` 2

buildChord :: [[Double]] -> WAVESamples
buildChord freqs = map ((:[]) . round . sum) $ transpose freqs

generateSoundWave :: Int          -- | Samples Per Second
                  -> Double       -- | Length of Sound in Seconds
                  -> Int32        -- | Volume
                  -> Double       -- | Frequency
                  -> [Double]
generateSoundWave sPS len vol freq =
    take (round $ len * fromIntegral sPS) $
    map ((* fromIntegral vol) . sin) 
    [0.0, (freq * 2 * pi / fromIntegral sPS)..]

generateSoundWaves :: Int          -- | Samples Per Second
                   -> Double       -- | Length of Sound in Seconds
                   -> Int32        -- | Volume
                   -> [Double]     -- | Frequency
                   -> [[Double]]
generateSoundWaves sPS len vol =
    map (generateSoundWave sPS len vol)

noteToSine :: String -> WAVESamples
noteToSine chord =
    buildChord $ generateSoundWaves frameRate noteLength volume freqs
    where freqs = getFreqs $ notes chord

notes'' :: String -> [String]
notes'' = splitOn "/" 

notes' :: [String] -> [[String]]
notes' = map (split (oneOf "1234567890"))

notes :: String -> [(String, Int)]
notes chord = concatMap pair $ notes' $ notes'' chord
    where pair (x:y:ys) = (x, read y :: Int) : pair ys
          pair _           = []

notesToSines :: String -> WAVESamples
notesToSines = concatMap noteToSine . splitOn " "

getFreq :: (String, Int) -> Double
getFreq (note, octave) =
    if octave >= -1 && octave < 10 && n /= 12.0
    then a4 * 2 ** ((o - 4.0) + ((n - 9.0) / 12.0))
    else undefined
    where o = fromIntegral octave :: Double
          n = case note of
                "B#" -> 0.0
                "C"  -> 0.0
                "C#" -> 1.0
                "Db" -> 1.0
                "D"  -> 2.0
                "D#" -> 3.0
                "Eb" -> 3.0
                "E"  -> 4.0
                "Fb" -> 4.0
                "E#" -> 5.0
                "F"  -> 5.0
                "F#" -> 6.0
                "Gb" -> 6.0
                "G"  -> 7.0
                "G#" -> 8.0
                "Ab" -> 8.0
                "A"  -> 9.0
                "A#" -> 10.0
                "Bb" -> 10.0
                "B"  -> 11.0
                "Cb" -> 11.0
                _    -> 12.0

getFreqs :: [(String, Int)] -> [Double]
getFreqs = map getFreq

header :: WAVEHeader
header = WAVEHeader 1 frameRate 32 Nothing 

getFileName :: IO FilePath
getFileName = putStr "Enter the name of the file: " >> getLine

getChordsAndOctaves :: IO String
getChordsAndOctaves = getFileName >>= \n ->
                      openFile n ReadMode >>=
                      hGetContents 

main :: IO ()
main = getChordsAndOctaves >>= \co ->
       putWAVEFile "out.wav" (WAVE header $ notesToSines co)

---

The key problem was with the function:

buildChord :: [[Double]] -> WAVESamples
buildChord freqs = map ((:[]) . round . sum) $ transpose freqs

The result of transpose freqs was a list of sound volumes for a particular point in time for each note being played (eg [45.2, 20, -10]). The function (:[] . round . sum) firstly added them together (eg 55.2), rounds it (eg to 55), and wraps it in a list (eg [55]). map (:[] . round . sum) just did that for all the instances of time.

The problem is if you have many note playing at once, the sum results in a note that is too loud. What would be better is to take the average of the notes, rather than the sum. That means 10 notes playing at the same time wont be too loud. Surprisingly, there is no average function in the prelude. So we can either write our own average function, or just embed it in the function passed to map. I did the latter as it was less code:

buildChord :: [[Double]] -> WAVESamples
buildChord freqs = map (\chord -> [round $ sum chord / genericLength chord]) $ transpose freqs

---

I'm guessing from your questions that you are writing a music making program as a way to learn haskell. I have a few ideas that may make your code easier to debug, and more "haskell like".

Code in haskell is often written as a sequence of transformations from input to output. That buildChord function is a good example - firstly the input was transposed, then mapped over with a function that combined the multiple sound amplitudes. However, you could also structure your whole program in this style.

The purpose of the program seems to be: "read notes from a file in some format, then create a wav file from those notes read". The way I would solve that problem would be firstly to break that up into different pure transformations (ie using no input or output), and do the reading and writing as the final step.

I would firstly start by writing a sound wave to WAVE transformation. I would use the type:

data Sound = Sound { soundFreqs :: [Double]
                   , soundVolume :: Double
                   , soundLength :: Double
                   }

Then write the function:

soundsToWAVE :: Int -> [Sound] -> WAVE
soundsToWAVE samplesPerSec sounds = undefined -- TODO

Then I could write the functions writeSoundsToWavFile and testPlaySounds:

writeSoundsToWavFile :: String -> Int -> [Sound] -> IO ()
writeSoundsToWavFile fileN samplesPerSec sounds = putWAVEFile $ soundsToWAVE fileN samplesPerSec sounds

testPlaySounds :: [Sound] -> IO ()
testPlaySounds sounds = do
  writeSoundsToWavFile "test.wav" 32000 sounds
  system("afplay test.wav") -- use aplay on linux, don't know for windows
  return ()

Once that is done, all the WAVE code is done - the rest of the code doesn't need to touch it. It may be a good idea to put that in its own module.

After that, I would write a transformation between music notes and Sounds. I would use the following types for notes:

data Note = A | B | C | D | E | F | G
data NoteAugment = None | Sharp | Flat

data MusicNote = MusicNote { note :: Note, noteAugment :: NoteAugment, noteOctave :: Int }

data Chord = Chord { notes :: [MusicNote], chordVolume :: Double }

Then write the function:

chordToSound :: Chord -> Sound
chordToSound = undefined -- TODO

You could then easily write the function musicNotesToWAVFile:

chordsToWAVFile fileName samplesPerSec notes = writeSoundsToWavFile 32000 fileName samplesPerSec (map chordToSound notes)

(the function testPlayChords can be done in the same way). You could also put this in a new module.

Finally I would write the transformation note string -> [Chord]. This would just need the function:

parseNoteFileText :: String -> [Chord]
parseNoteFileText noteText = undefined

The final program could then be wired up:

main = do
  putStrLn "Enter the name of the file: " 
  fileN <- getLine
  noteText <- readFile fileN
  chordsToWAVFile (parseNoteFileText noteText)