myTestlll (empty) → 1.0.0
raw patch · 82 files changed
+29676/−0 lines, 82 filesdep +CCAdep +Cabaldep +Euterpeabuild-type:Customsetup-changed
Dependencies added: CCA, Cabal, Euterpea, HCodecs, PortMidi, QuickCheck, UISF, ansi-terminal, array, arrows, base, bytestring, containers, deepseq, ghc-prim, heap, markov-chain, monadIO, mtl, pure-fft, random, stm, syb, template-haskell
Files
- ArrowWrap.hs +95/−0
- Control/CCA/ArrowP.lhs +59/−0
- Control/SF/SF.lhs +126/−0
- Euterpea.lhs +34/−0
- Euterpea/Examples/Additive.hs +200/−0
- Euterpea/Examples/EnableGUI.hs +20/−0
- Euterpea/Examples/EuterpeaExamples.lhs +218/−0
- Euterpea/Examples/Instruments.hs +89/−0
- Euterpea/Examples/Interlude.hs +59/−0
- Euterpea/Examples/IntervalTrainer.lhs +200/−0
- Euterpea/Examples/LSystems.hs +125/−0
- Euterpea/Examples/MUI.hs +151/−0
- Euterpea/Examples/MUIExamples.lhs +177/−0
- Euterpea/Examples/MusicToSignal.lhs +116/−0
- Euterpea/Examples/NewResolutions.lhs +226/−0
- Euterpea/Examples/RandomMusic.hs +100/−0
- Euterpea/Examples/SSF.lhs +33/−0
- Euterpea/Examples/SelfSimilar.hs +66/−0
- Euterpea/Examples/SigFuns.hs +65/−0
- Euterpea/Examples/SoundCheck.hs +50/−0
- Euterpea/Experimental.lhs +40/−0
- Euterpea/ExperimentalPlay.lhs +310/−0
- Euterpea/IO/Audio.hs +14/−0
- Euterpea/IO/Audio/BasicSigFuns.lhs +1270/−0
- Euterpea/IO/Audio/Basics.hs +76/−0
- Euterpea/IO/Audio/CSound.lhs +102/−0
- Euterpea/IO/Audio/IO.hs +178/−0
- Euterpea/IO/Audio/Render.hs +127/−0
- Euterpea/IO/Audio/Types.hs +94/−0
- Euterpea/IO/MIDI.hs +27/−0
- Euterpea/IO/MIDI/ExportMidiFile.lhs +282/−0
- Euterpea/IO/MIDI/FromMidi.lhs +270/−0
- Euterpea/IO/MIDI/GeneralMidi.hs +278/−0
- Euterpea/IO/MIDI/MidiIO.lhs +665/−0
- Euterpea/IO/MIDI/ToMidi.hs +155/−0
- Euterpea/IO/MUI.hs +64/−0
- Euterpea/IO/MUI/FFT.hs +59/−0
- Euterpea/IO/MUI/Guitar.hs +181/−0
- Euterpea/IO/MUI/InstrumentBase.hs +203/−0
- Euterpea/IO/MUI/InstrumentWidgets.hs +11/−0
- Euterpea/IO/MUI/MidiWidgets.lhs +306/−0
- Euterpea/IO/MUI/Piano.hs +201/−0
- Euterpea/IO/MUI/UISFCompat.lhs +31/−0
- Euterpea/Music/Note/MoreMusic.hs +262/−0
- Euterpea/Music/Note/Music.hs +206/−0
- Euterpea/Music/Note/Performance.hs +201/−0
- Euterpea/Music/Signal/SpectrumAnalysis.hs +57/−0
- HSoM/Additive.lhs +963/−0
- HSoM/Algebra.lhs +583/−0
- HSoM/Bitans.lhs +112/−0
- HSoM/Class-tour.lhs +602/−0
- HSoM/HSoM.bib +637/−0
- HSoM/HSoM.lhs +298/−0
- HSoM/IO.lhs +283/−0
- HSoM/Induction.lhs +1110/−0
- HSoM/Interlude.lhs +451/−0
- HSoM/Intro.lhs +1508/−0
- HSoM/LSystems.lhs +485/−0
- HSoM/List-tour.lhs +521/−0
- HSoM/MUI.lhs +1629/−0
- HSoM/Monads.lhs +863/−0
- HSoM/MoreMusic.lhs +1260/−0
- HSoM/Music.lhs +958/−0
- HSoM/Patterns.lhs +197/−0
- HSoM/Performance.lhs +905/−0
- HSoM/Poly.lhs +1187/−0
- HSoM/Preface.lhs +217/−0
- HSoM/QualifiedTypes.lhs +1069/−0
- HSoM/RandomMusic.lhs +601/−0
- HSoM/SelfSimilar.lhs +398/−0
- HSoM/SigFuns.lhs +1086/−0
- HSoM/Signals.lhs +804/−0
- HSoM/SpectrumAnalysis.lhs +986/−0
- HSoM/Syntax.lhs +579/−0
- HSoM/ToMidi.lhs +685/−0
- HSoM/myFormat.fmt +214/−0
- License +20/−0
- ReadMe.txt +187/−0
- Setup.hs +51/−0
- System/Random/Distributions.hs +135/−0
- Tests/RunAllTests.hs +92/−0
- myTestlll.cabal +121/−0
+ ArrowWrap.hs view
@@ -0,0 +1,95 @@+module ArrowWrap where++import qualified Data.Generics as G++import Language.Haskell.Exts+import Data.List+import Data.Maybe+import System.Environment+import System.Process++import Distribution.Simple.Program (findProgramLocation)+import Distribution.Verbosity (silent)+++isTyVar (TyVar _) = True+isTyVar _ = False++insertForall t@(TyForall Nothing ctx ty) = + TyForall (Just frAlls) ctx ty+ where frAlls = map mkTyVarBind vars+ vars = nub (G.listify isTyVar t)+insertForall x = x++mkTyVarBind (TyVar x) = UnkindedVar x++parseMode fn = ParseMode + { parseFilename = fn,+ baseLanguage = Haskell2010,+ extensions = fmap EnableExtension [ + MultiParamTypeClasses,+ FlexibleContexts,+ TemplateHaskell,+ ExistentialQuantification,+ BangPatterns,+ FunctionalDependencies,+ Rank2Types ] ,+ ignoreLanguagePragmas = False,+ ignoreLinePragmas = False,+ fixities = Just preludeFixities }++-- fixme: the line pragmas are actually based on the output of arrowp+ppMode = defaultMode { linePragmas = False }++++parseArrowPOutput filename str = + let pm = parseMode filename + parseResult = parseFileContentsWithMode pm str+ in case parseResult of+ ParseOk m -> G.everywhere (G.mkT insertForall) m+ ParseFailed loc err -> error $ + "Parse error: " ++ show loc ++ ": " ++ show err++mkPragma exts = "{-# LANGUAGE " ++ + intercalate ", " (map (show . enabled) exts) +++ " #-}"+ where enabled (EnableExtension ext) = ext++{-+Run arrowp, parse result (since haskell-src-exts doesn't handle +arrow syntax as of July 2009). +Insert "forall" into type signatures; prettyprint result+-}++runArrowP arrowp inFile outFile = do+ result <- readProcess arrowp [inFile] []+ orig <- readFile inFile+ let (_, exts) = fromJust (readExtensions orig)+ parse = parseArrowPOutput inFile result+ pragma = mkPragma exts+ writeFile outFile $ pragma ++ "\n" ++ prettyPrintWithMode ppMode parse+++-- The list of files to be processed, given as a pair of input name and output name.+-- This is used when using main, but not when using the cabal preprocessor.+fileList = [("Euterpea/IO/Audio/Basics.as", "Euterpea/IO/Audio/Basics.hs")]++-- The main function that, when this is not being used as a preprocessor +-- with cabal, should be run to do the processing.+main = do+ arrowp <- findArrowP silent+ mapM_ (f arrowp) fileList+ where+ f arrowp (inFile, outFile) = do+ runArrowP arrowp inFile outFile+ putStrLn $ inFile ++ " has been preprocessed to " ++ outFile++-- Copied from Setup.hs so it can be used in the main method here.+findArrowP verbosity = do+ a <- findProgramLocation verbosity "ccap"+ case a of + Nothing -> error "Preprocessor ccap not found. Please make sure the \+ \CCA library is already installed, and ccap is in \+ \your PATH environment."+ Just p -> return p
+ Control/CCA/ArrowP.lhs view
@@ -0,0 +1,59 @@+> {-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}++> module Control.CCA.ArrowP where++> import Control.Arrow +> import Control.CCA.Types+> import Control.CCA.CCNF+> import Language.Haskell.TH+> import Prelude hiding (init, (.), id)++#if __GLASGOW_HASKELL__ >= 610++> import Control.Category+> instance Category a => Category (ArrowP a p) where+> id = ArrowP id+> ArrowP g . ArrowP f = ArrowP (g . f)++> instance Arrow a => Arrow (ArrowP a p) where+> arr f = ArrowP (arr f)+> first (ArrowP f) = ArrowP (first f)++#else+++> instance Arrow a => Arrow (ArrowP a p) where+> arr f = ArrowP (arr f)+> first (ArrowP f) = ArrowP (first f)+> ArrowP f >>> ArrowP g = ArrowP (f >>> g)++#endif+++> newtype ArrowP a p b c = ArrowP (a b c)++> class (ArrowInit (ArrowP a p), ArrowInit a) => ArrowInitP a p where+> strip :: ArrowP a p b c -> a b c+> strip (ArrowP f) = f++> instance ArrowLoop a => ArrowLoop (ArrowP a p) where+> loop (ArrowP f) = ArrowP (loop f)++> instance ArrowInit a => ArrowInit (ArrowP a p) where+> init i = ArrowP (init i) -- error "use init' instead"+> arr' f f' = ArrowP (arr' f f')+> init' i i' = ArrowP (init' i i')++> instance ArrowChoice a => ArrowChoice (ArrowP a p) where+> left (ArrowP f) = ArrowP (left f)+> ArrowP f ||| ArrowP g = ArrowP (f ||| g)++> instance ArrowInitP ASyn p++> normP :: ArrowP ASyn p b c -> ExpQ+> normP (ArrowP x) = norm x++> normOptP :: ArrowP ASyn p b c -> ExpQ+> normOptP x = normOpt (strip x)++
+ Control/SF/SF.lhs view
@@ -0,0 +1,126 @@+> {-# LANGUAGE CPP, TemplateHaskell, BangPatterns, FlexibleInstances, MultiParamTypeClasses #-}++> module Control.SF.SF where++#if __GLASGOW_HASKELL__ >= 610+> import Control.Category+> import Prelude hiding ((.), init, exp)+#else+> import Prelude hiding (init, exp)+#endif++> import Control.Arrow+> import Control.CCA.Types+> import Control.CCA.ArrowP+> import Control.Arrow.Operations+++> newtype SF a b = SF { runSF :: (a -> (b, SF a b)) }++> instance ArrowInitP SF p++#if __GLASGOW_HASKELL__ >= 610+> instance Category SF where+> id = SF h where h x = (x, SF h)+> g . f = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f x+> (z, g') = runSF g y+> in f' `seq` g' `seq` (z, SF (h f' g'))++> instance Arrow SF where+> arr f = g+> where g = SF (\x -> (f x, g))+> first f = SF (g f)+> where+> g f (x, z) = f' `seq` ((y, z), SF (g f'))+> where (y, f') = runSF f x+> f &&& g = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f x+> (z, g') = runSF g x +> in ((y, z), SF (h f' g'))+> f *** g = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f (fst x)+> (z, g') = runSF g (snd x) +> in ((y, z), SF (h f' g'))+#else+> instance Arrow SF where+> arr f = g+> where g = SF (\x -> (f x, g))+> f >>> g = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f x+> (z, g') = runSF g y+> in (z, SF (h f' g'))+> first f = SF (g f)+> where+> g f (x, z) = ((y, z), SF (g f'))+> where (y, f') = runSF f x+> f &&& g = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f x+> (z, g') = runSF g x +> in ((y, z), SF (h f' g'))+> f *** g = SF (h f g)+> where+> h f g x =+> let (y, f') = runSF f (fst x)+> (z, g') = runSF g (snd x) +> in ((y, z), SF (h f' g'))+#endif++> instance ArrowLoop SF where+> loop sf = SF (g sf)+> where+> g f x = f' `seq` (y, SF (g f'))+> where ((y, z), f') = runSF f (x, z)++> instance ArrowChoice SF where+> left sf = SF (g sf)+> where +> g f x = case x of+> Left a -> let (y, f') = runSF f a in f' `seq` (Left y, SF (g f'))+> Right b -> (Right b, SF (g f))+> +> instance ArrowInit SF where+> init i = SF (f i)+> where f i x = (i, SF (f x))+> loopD i g = SF (f i)+> where+> f i x = +> let (y, i') = g (x, i)+> in (y, SF (f i'))++> instance ArrowCircuit SF where+> delay = init++> run :: SF a b -> [a] -> [b]+> run _ [] = []+> run (SF f) (x:xs) =+> let (y, f') = f x +> in y `seq` f' `seq` (y : run f' xs)+> +> unfold :: SF () a -> [a]+> unfold = flip run inp+> where inp = () : inp+>+> +> nth :: Int -> SF () a -> a+> nth n (SF f) = x `seq` if n == 0 then x else nth (n - 1) f'+> where (x, f') = f ()+> +> nth' :: Int -> (b, ((), b) -> (a, b)) -> a+> nth' !n (i, f) = n `seq` i `seq` f `seq` aux n i+> where+> aux !n !i = x `seq` i' `seq` if n == 0 then x else aux (n-1) i'+> where (x, i') = f ((), i)+> ++
+ Euterpea.lhs view
@@ -0,0 +1,34 @@+> {-# OPTIONS -XFlexibleInstances #-}+> {-# OPTIONS -XTypeSynonymInstances #-}++> module Euterpea (+> module Euterpea.Music.Note.Music,+> module Euterpea.Music.Note.MoreMusic,+> module Euterpea.Music.Note.Performance,+> module Euterpea.IO.Audio,+> module Euterpea.IO.MIDI,+> module Euterpea.IO.MUI,+> module Control.Arrow,+> -- These 4 lines are from FRP.UISF.AuxFunctions+> SEvent, edge, accum, constA, constSF, foldA, foldSF, (~++),+> unique, hold, now, mergeE,+> delay, vdelay, fdelay,+> timer, genEvents, Time, DeltaT,+> -- This next line is from Codec.Midi+> exportFile, importFile+> ) where+>+> import Euterpea.Music.Note.Music hiding (t251)+> import Euterpea.Music.Note.MoreMusic+> import Euterpea.Music.Note.Performance+> import Euterpea.IO.Audio+> import Euterpea.IO.MIDI+> import Euterpea.IO.MUI++> import Control.Arrow+> import FRP.UISF.AuxFunctions++> import Codec.Midi(exportFile, importFile)+++
+ Euterpea/Examples/Additive.hs view
@@ -0,0 +1,200 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Additive.lhs. (See HSoM/MakeCode.bat.)++{-# LANGUAGE Arrows #-}++module Euterpea.Examples.Additive where+import Euterpea+-- TBD+-- TBD+bell1 :: Instr (Mono AudRate)+ -- |Dur -> AbsPitch -> Volume -> AudSF () Double|+bell1 dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ d = fromRational dur+ sfs = map (\p-> constA (f*p) >>> osc tab1 0) + [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56]+ in proc () -> do+ aenv <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< ()+ a1 <- foldSF (+) 0 sfs -< ()+ outA -< a1*aenv*v/9++tab1 = tableSinesN 4096 [1]++bellTest1 = outFile "bell1.wav" 6 (bell1 6 (absPitch (C,5)) 100 []) +bell'1 :: Instr (Mono AudRate)+bell'1 dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ d = fromRational dur+ in proc () -> do+ aenv <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< ()+ a1 <- osc tab1' 0 -< f+ outA -< a1*aenv*v++tab1' = tableSines3N 4096 [(4.07,1,0), (3.76,1,0), (3,1,0),+ (2.74,1,0), (2,1,0), (1.71,1,0), (1.19,1,0), (0.92,1,0), (0.56,1,0)]++bellTest1' = outFile "bell'1.wav" 6 (bell'1 6 (absPitch (C,5)) 100 [])+bell2 :: Instr (Mono AudRate)+ -- |Dur -> AbsPitch -> Volume -> AudSF () Double|+bell2 dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ d = fromRational dur+ sfs = map (mySF f d)+ [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56]+ in proc () -> do+ a1 <- foldSF (+) 0 sfs -< ()+ outA -< a1*v/9++mySF f d p = proc () -> do+ s <- osc tab1 0 <<< constA (f*p) -< ()+ aenv <- envExponSeg [0,1,0.001] [0.003,d/p-0.003] -< ()+ outA -< s*aenv++bellTest2 = outFile "bell2.wav" 6 (bell2 6 (absPitch (C,5)) 100 []) +sineTable :: Table+sineTable = tableSinesN 4096 [1]++env1 :: AudSF () Double+env1 = envExpon 20 10 10000+good = outFile "good.wav" 10 + (osc sineTable 0 <<< envExpon 20 10 10000 :: AudSF () Double)++bad = outFile "bad.wav" 10 + (osc sineTable 0 <<< envLine 20 10 10000 :: AudSF () Double)+sfTest1 :: AudSF (Double,Double) Double -> Instr (Mono AudRate)+ -- |AudSF (Double,Double) Double -> |+ -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double|+sfTest1 sf dur ap vol [] =+ let f = apToHz ap+ v = fromIntegral vol / 100+ in proc () -> do+ a1 <- osc sineTable 0 <<< env1 -< () + a2 <- sf -< (a1,f)+ outA -< a2*v+tLow = outFile "low.wav" 10 $+ sfTest1 filterLowPass 10 (absPitch (C,5)) 80 []++tHi = outFile "hi.wav" 10 $+ sfTest1 filterHighPass 10 (absPitch (C,5)) 80 []++tLowBW = outFile "lowBW.wav" 10 $+ sfTest1 filterLowPassBW 10 (absPitch (C,5)) 80 []++tHiBW = outFile "hiBW.wav" 10 $+ sfTest1 filterHighPassBW 10 (absPitch (C,5)) 80 []+addBandWidth :: AudSF (Double,Double,Double) Double ->+ AudSF (Double,Double) Double+addBandWidth filter =+ proc (a,f) -> do filter -< (a,f,200)++tBP = outFile "bp.wav" 10 $+ sfTest1 (addBandWidth (filterBandPass 1)) 10 (absPitch (C,6)) 80 []++tBS = outFile "bs.wav" 10 $+ sfTest1 (addBandWidth (filterBandStop 1)) 10 (absPitch (C,6)) 80 []++tBPBW = outFile "bpBW.wav" 10 $+ sfTest1 (addBandWidth filterBandPassBW) 10 (absPitch (C,6)) 80 []++tBSBW = outFile "bsBW.wav" 10 $+ sfTest1 (addBandWidth filterBandStopBW) 10 (absPitch (C,6)) 80 []+noise1 :: Instr (Mono AudRate)+ -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double|+noise1 dur ap vol [] = + let v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseWhite 42 -< ()+ outA -< a1*v+test1 = outFile "noise1.wav" 6 (noise1 6 (absPitch (C,5)) 100 []) +env2 :: AudSF () Double+env2 = envExpon 1 10 2000++sfTest2 :: AudSF (Double,Double,Double) Double -> Instr (Mono AudRate)+ -- |AudSF (Double,Double,Double) Double -> |+ -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double|+sfTest2 sf dur ap vol [] =+ let f = apToHz ap+ v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseWhite 42 -< ()+ bw <- env2 -< ()+ a2 <- sf -< (a1,f,bw)+ outA -< a2++tBP' = outFile "bp'.wav" 10 $+ sfTest2 (filterBandPass 1) 10 (absPitch (C,5)) 80 []++tBS' = outFile "bs'.wav" 10 $+ sfTest2 (filterBandStop 1) 10 (absPitch (C,5)) 80 []++tBPBW' = outFile "bpBW'.wav" 10 $+ sfTest2 filterBandPassBW 10 (absPitch (C,5)) 80 []++tBSBW' = outFile "bsBW'.wav" 10 $+ sfTest2 filterBandStopBW 10 (absPitch (C,5)) 80 []+noise2 :: Instr (Mono AudRate)+noise2 dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseBLI 42 -< f+ outA -< a1*v+test2 = outFile "noise2.wav" 6 (noise2 6 (absPitch (C,5)) 100 []) +ss1 :: Instr (Mono AudRate)+ss1 dur ap vol [] = + let v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseWhite 42 -< ()+ a2 <- filterBandPass 2 -< (a1, 1000, 200)+ outA -< a2*v/5+test3 = outFile "ss1.wav" 6 (ss1 6 (absPitch (C,5)) 100 []) +wind :: Instr (Mono AudRate)+wind dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseWhite 42 -< ()+ lfo1 <- osc sineTable 0 -< 0.9+ lfo2 <- osc sineTable 0 -< 1.3+ a2 <- filterBandPass 2 -< (a1, f + 100*(lfo1+lfo2), 200)+ outA -< a2*v/5+test4 = outFile "wind.wav" 6 (wind 6 (absPitch (C,7)) 100 []) +buzzy :: Instr (Mono AudRate)+buzzy dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ in proc () -> do+ a1 <- oscPartials sineTable 0 -< (f,20)+ outA -< a1*v+test5 = outFile "buzzy.wav" 6 (buzzy 6 (absPitch (C,5)) 100 []) +buzzy2 :: Instr (Mono AudRate)+buzzy2 dur ap vol [] = + let f = apToHz ap+ v = fromIntegral vol / 100+ d = fromRational dur+ in proc () -> do+ a1 <- oscPartials sineTable 0 -< (f,20)+ env <- envExponSeg [0, 1, 0.001] [0.003, d - 0.003] -< ()+ a2 <- filterLowPass -< (a1,20000*env)+ outA -< a2*v*env+test6 = outFile "buzzy2.wav" 6 (buzzy2 6 (absPitch (C,5)) 100 []) +scifi1 :: Instr (Mono AudRate)+scifi1 dur ap vol [] = + let v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseBLH 42 -< 8+ a2 <- osc sineTable 0 -< 600 + 200*a1+ outA -< a2*v+test7 = outFile "scifi1.wav" 10 (scifi1 10 (absPitch (C,5)) 100 []) +scifi2 :: Instr (Mono AudRate)+scifi2 dur ap vol [] = + let v = fromIntegral vol / 100+ in proc () -> do+ a1 <- noiseBLI 44 -< 8+ a2 <- osc sineTable 0 -< 600 + 200*a1+ outA -< a2*v+test8 = outFile "scifi2.wav" 10 (scifi2 10 (absPitch (C,5)) 100 [])
+ Euterpea/Examples/EnableGUI.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module EnableGUI(enableGUI) where++import Data.Int+import Foreign++type ProcessSerialNumber = Int64++foreign import ccall "GetCurrentProcess" getCurrentProcess :: Ptr ProcessSerialNumber -> IO Int16+foreign import ccall "_CGSDefaultConnection" cgsDefaultConnection :: IO ()+foreign import ccall "CPSEnableForegroundOperation" cpsEnableForegroundOperation :: Ptr ProcessSerialNumber -> IO ()+foreign import ccall "CPSSignalAppReady" cpsSignalAppReady :: Ptr ProcessSerialNumber -> IO ()+foreign import ccall "CPSSetFrontProcess" cpsSetFrontProcess :: Ptr ProcessSerialNumber -> IO ()++enableGUI = alloca $ \psn -> do+ getCurrentProcess psn+ cgsDefaultConnection+ cpsEnableForegroundOperation psn+ cpsSignalAppReady psn+ cpsSetFrontProcess psn
+ Euterpea/Examples/EuterpeaExamples.lhs view
@@ -0,0 +1,218 @@+> module Euterpea.Examples.EuterpeaExamples where+>+> import Euterpea+> import Euterpea.Examples.Interlude+> import Euterpea.Examples.SelfSimilar+> import Euterpea.Examples.SSF++Simple examples of Euterpea in action. Note that this module also+imports modules Interlude and SelfSimilar.++-----------------------------------------------------------------------------++From the tutorial, try things such as pr12, cMajArp, cMajChd, etc. and+try applying inversions, retrogrades, etc. on the same examples. Also+try "childSong6" imported from module Interlude. For example:++> t0 = play childSong6++-----------------------------------------------------------------------------++C Major scale for use in examples below:++> cMajScale = Modify (Tempo 2)+> (line [c 4 en, d 4 en, e 4 en, f 4 en, +> g 4 en, a 4 en, b 4 en, c 5 en])+>+> cms' = line [c 4 en, d 4 en, e 4 en, f 4 en, +> g 4 en, a 4 en, b 4 en, c 5 en]+>+> cms = cMajScale++Test of various articulations and dynamics:++> t1 = play (Modify (Instrument Percussion)+> (Modify (Phrase [Art (Staccato (1/10))]) cms :+:+> cms :+:+> Modify (Phrase [Art (Legato (11/10))]) cms ))+>+> temp = Modify (Instrument AcousticGrandPiano) +> (Modify (Phrase [Dyn (Crescendo 4)]) (c 4 en))+>+> mu2 = Modify (Instrument Vibraphone)+> (Modify (Phrase [Dyn (Diminuendo (3/4))]) cms :+:+> (Modify (Phrase [Dyn (Crescendo 4), Dyn (Loudness 25)]) cms))+> t2 = play mu2+>+> t3 = play (Modify (Instrument Flute) +> (Modify (Phrase [Tmp (Accelerando 0.3)]) cms :+:+> Modify (Phrase [Tmp (Ritardando 0.6)]) cms ))++-----------------------------------------------------------------------------++A function to recursively apply transformations f (to elements in a+sequence) and g (to accumulated phrases):++> {-+> rep :: (Music a -> Music a) -> (Music a -> Music a) -> Int -> +> Music a -> Music a+> rep f g 0 m = Prim (Rest 0)+> rep f g n m = m :=: g (rep f g (n-1) (f m))++An example using "rep" three times, recursively, to create a "cascade"+of sounds.++> run = rep (Modify (Transpose 5)) (delayM tn) 8 (c 4 tn)+> cascade = rep (Modify (Transpose 4)) (delayM en) 8 run+> cascades = rep id (delayM sn) 2 cascade+> -}++> t4' x = play (Modify (Instrument AcousticGrandPiano) x)+> t4 = play (Modify (Instrument AcousticGrandPiano) +> (cascades :+: revM cascades))++What happens if we simply reverse the f and g arguments?++> {-+> run' = rep (delayM tn) (Modify (Transpose 5)) 4 (c 4 tn)+> cascade' = rep (delayM en) (Modify (Transpose 4)) 6 run'+> cascades' = rep (delayM sn) id 2 cascade'+> -}++> t5 = play (Modify (Instrument AcousticGrandPiano) cascades')++-----------------------------------------------------------------------------++Example from the SelfSimilar module.++> t10s = play (rep (delayM (dur ttm0)) (Modify (Transpose 4)) 2 ttm0)++-----------------------------------------------------------------------------++Example from the Interlude module.++> cs6 = play childSong6++-----------------------------------------------------------------------------++Example from the Ssf (Stars and Stripes Forever) module.++> ssf0 = play ssf++-----------------------------------------------------------------------------++Midi percussion test. Plays all "notes" in a range. (Requires adding+an instrument for percussion to the UserPatchMap.)++> drums a b = Modify (Instrument Percussion)+> (line (map (\p-> Prim $ Note sn (pitch p)) [a..b]))+> t11 a b = play (drums a b)++-----------------------------------------------------------------------------++Test of cut and shorten.++> t12 = play (cut 4 childSong6)+> t12a = play (cms /=: childSong6)++-----------------------------------------------------------------------------++Tests of the trill functions.++> t13note = Prim (Note qn (C,5))+> t13 = play (trill 1 sn t13note)+> t13a = play (trill' 2 dqn t13note)+> t13b = play (trilln 1 5 t13note)+> t13c = play (trilln' 3 7 t13note)+> t13d = play (roll tn t13note)+> t13e = play (Modify (Tempo (2/3)) +> (Modify (Transpose 2) +> (Modify (Instrument AcousticGrandPiano) +> (trilln' 2 7 t13note))))++-----------------------------------------------------------------------------++Tests of drum.++> t14 = play (Modify (Instrument Percussion) (perc AcousticSnare qn))++> -- a "funk groove"+> t14b = let p1 = perc LowTom qn+> p2 = perc AcousticSnare en+> in play (Modify (Tempo 3) (Modify (Instrument Percussion) (cut 8 (repeatM+> ((p1 :+: qnr :+: p2 :+: qnr :+: p2 :+:+> p1 :+: p1 :+: qnr :+: p2 :+: enr)+> :=: roll en (perc ClosedHiHat 2))))))++> -- a "jazz groove"+> t14c = let p1 = perc CrashCymbal2 qn+> p2 = perc AcousticSnare en+> p3 = perc LowTom qn+> in play (Modify (Tempo 3) (Modify (Instrument Percussion) (cut 4 (repeatM+> ((p1 :+: (Modify (Tempo (3/2)) (p2 :+: enr :+: p2))+> :=: (p3 :+: qnr)) )))))++> t14d = let p1 = perc LowTom en+> p2 = perc AcousticSnare hn+> in play (Modify (Instrument Percussion)+> ( roll tn p1+> :+: p1+> :+: p1+> :+: Prim (Rest en)+> :+: roll tn p1+> :+: p1+> :+: p1+> :+: Prim (Rest qn)+> :+: roll tn p2+> :+: p1+> :+: p1 ))++-----------------------------------------------------------------------------++Tests of the MIDI interface.++> loadMidiFile fn = do+> r <- importFile fn +> case r of+> Left err -> error err+> Right m -> return m++Music into a MIDI file.++> tab m = do+> exportFile "test.mid" $ makeMidi (m, defCon, defUpm)++Music to a MidiFile datatype and back to Music.++> tad m = fromMidi (testMidi m)++A MIDI file to a MidiFile datatype and back to a MIDI file.++> tcb file = do+> x <- loadMidiFile file+> exportFile "test.mid" x++MIDI file to MidiFile datatype.++> tc file = do+> x <- loadMidiFile file+> print x++MIDI file to Music, a UserPatchMap, and a Context.++> tcd file = do+> x <- loadMidiFile file+> print $ fst3 $ fromMidi x+> print $ snd3 $ fromMidi x+> print $ thd3 $ fromMidi x++A MIDI file to Music and back to a MIDI file.++> tcdab file = do+> x <- loadMidiFile file+> exportFile "test.mid" $ makeMidi $ fromMidi x++> fst3 (a,b,c) = a+> snd3 (a,b,c) = b+> thd3 (a,b,c) = c+
+ Euterpea/Examples/Instruments.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE Arrows #-}+module Euterpea.Examples.Instruments where+import Euterpea+import Euterpea.Experimental+import FRP.UISF.AuxFunctions ((~++))++-- Here is a demonstration of the guitar and piano widgets available in Euterpea.++instrumentDemo :: IO ()+instrumentDemo = runMUI (defaultMUIParams {uiSize=(1038,706), uiTitle="Instrument Demo"}) $ proc _ -> do+ devId <- selectOutput -< ()+ -- The song player is a standard component that plays back a music value. The string is used+ -- as a display name.+ song <- songPlayer [("Sonata In C", tempo 2 sonataInC), ("Frere Jaques", tempo (2/3) fjfj)] -< ()+ -- The InstrumentData structure holds the settings for each instrument.+ -- If you want to be able to change these settings at runtime, a structure like this is necessary+ -- addNotation presents a checkbox that allows the user to toggle the display of pitch classes+ -- on the instruements. In this example, a single settings variable is used.+ rec settings' <- addNotation -< settings+ settings <- hold defaultInstrumentData -< Just settings'+ -- The guitar UISF takes in a keymap (sixString is the only one available at the moment) and+ -- a midi channel. Any midi messages passed into the guitar will be coerced to that channel.+ guitar1 <- guitar sixString 1 -< (settings, Nothing)+ -- Select instrument takes in a channel and an initial midi instrument, 0 is Grand Piano, 25 is steel guitar.+ -- As the slider is changed, it prepends midi messages to its input to change the instrument on the given+ -- channel.+ outG <- selectInstrument 1 25 -< guitar1+ piano1 <- piano defaultMap0 0 -< (settings, song)+ outP <- selectInstrument 0 0 -< piano1+ -- ~++ attempts to concatenate Maybe Lists, using Nothing as though it were []+ midiOut -< (devId, outG ~++ outP)++-- The exposition of Mozart's Sonata in C, the "Easy Sonata"++sonataInC :: Music Pitch+sonataInC = line [c 5 wn, e 5 hn, g 5 hn, b 4 dhn, c 5 en, d 5 en, c 5 hn, rest hn,+ a 5 wn, g 5 hn, c 6 hn, g 5 hn, f 5 en, g 5 en, e 5 en, f 5 en, e 5 hn, rest hn, + a 4 qn, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en, g 5 en, a 5 en,+ g 5 en, f 5 en, e 5 en, d 5 en, c 5 en, b 4 en, a 4 en,+ g 4 qn, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en, g 5 en,+ f 5 en, e 5 en, d 5 en, c 5 en, b 4 en, a 4 en, g 4 en,+ f 4 qn, g 4 en, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en,+ e 5 en, d 5 en, c 5 en, b 4 en, a 4 en, g 4 en, f 4 en,+ e 4 qn, f 4 en, g 4 en, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, + d 5 en, c 5 en, b 4 en, a 4 en, g 4 en, f 4 en, e 4 en,+ d 4 qn, e 4 en, f 4 en, g 4 en, a 4 en, b 4 en, cs 5 en,+ d 5 en, a 4 en, b 4 en, cs 5 en, d 5 en, e 5 en, f 5 en, g 5 en,+ a 5 en, b 5 en, c 6 en, b 5 en, a 5 en, g 5 en, f 5 en, e 5 en,+ f 5 en, g 5 en, a 5 en, g 5 en, f 5 en, e 5 en, d 5 en, c 5 en,+ b 4 qn, g 5 qn, e 5 qn, c 5 qn, d 5 qn, g 5 qn, e 5 qn, c 5 qn,+ d 5 hn, g 5 hn, g 4 hn, rest hn,+ fs 4 en, g 4 en, fs 4 en, g 4 en, fs 4 en, g 4 en, fs 4 en, g 4 en,+ f 4 en, g 4 en, f 4 en, g 4 en, f 4 en, g 4 en, f 4 en, g 4 en,+ g 5 qn, e 5 qn, c 5 dhn, d 5 en, e 5 en, d 5 qn, c 5 qn,+ c 5 dqn, b 4 en, b 4 hn, rest wn, g 5 qn, e 5 qn, c 5 dhn,+ d 5 en, e 5 en, d 5 qn, c 5 qn, c 5 dqn, b 4 en, b 4 hn, rest wn,+ g 5 en, e 3 en,g 3 en, c 4 en, e 4 en, g 5 en, e 5 en, c 5 en,+ a 4 en, f 3 en, a 3 en, c 4 en, f 4 en, a 4 en, c 5 en, a 4 en,+ f 5 en, d 3 en, f 3 en, b 3 en, d 4 en, f 5 en, d 5 en, b 4 en,+ g 4 en, e 3 en, g 3 en, b 3 en, e 4 en, g 4 en, b 4 en, g 4 en,+ e 5 en, c 4 en, e 4 en, a 4 en, c 5 en, e 5 en, c 5 en, a 4 en,+ f 4 en, d 4 en, f 4 en, a 4 en, d 5 en, f 4 en, a 4 en, f 4 en,+ d 6 en, b 3 en, d 4 en, g 4 en, b 4 en, d 6 en, b 5 en, g 5 en,+ e 5 en, c 4 en, e 4 en, g 4 en, c 5 en, c 6 en, g 5 en, e 5 en,+ d 5 wn, d 5 hn, d 5 hn, a 5 wn, a 5 hn, a 5 hn, g 5 qn, a 5 en,+ b 5 en, c 6 en, d 6 en, e 6 en, d 6 en, c 6 en, b 5 en, a 5 en,+ g 5 en, f 5 en, e 5 en, d 5 en, c 5 en, e 5 en, d 5 en, e 5 en,+ d 5 en, e 5 en, d 5 en, e 5 en, d 5 en, e 5 en, d 5 en, e 5 en,+ d 5 en, e 5 en, d 5 en, c 5 en, d 5 en, c 5 hn, c 5 en, g 4 en,+ c 5 en, e 5 en, g 5 en, e 5 en, c 5 en, e 5 en, f 5 en, d 5 en,+ b 4 en, d 5 en, c 5 hn, c 4 en, g 3 en, c 4 en, e 4 en, g 4 en,+ e 4 en, c 4 en, e 4 en, f 4 en, d 4 en, b 3 en, d 4 en, c 4 hn,+ c 5 hn, c 4 hn]++-- Frere-Jaques using some more Euterpea features++fj0, fj1, fj2, fj3, fj4 :: Music Pitch+fj0 = c 4 qn :+: c 4 qn :+: c 4 qn+fj1 = c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn+fj2 = e 4 qn :+: f 4 qn :+: g 4 hn+fj3 = g 4 en :+: a 4 en :+: g 4 en :+: f 4 en :+: e 4 qn :+: c 4 qn+fj4 = c 4 qn :+: g 3 qn :+: c 4 hn++fj :: Music Pitch+fj = two fj1 :+: two fj2 :+: two fj3 :+: two fj4+ where two m = m :+: m++fjfj :: Music Pitch+fjfj = Modify (Tempo 4) (Modify (Instrument AcousticGrandPiano) fj)
+ Euterpea/Examples/Interlude.hs view
@@ -0,0 +1,59 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Interlude.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Examples.Interlude + ( childSong6, -- :: Music Pitch, + prefix -- :: [Music a] -> Music a) + ) where +import Euterpea + +addDur :: Dur -> [Dur -> Music a] -> Music a +addDur d ns = let f n = n d + in line (map f ns) +graceNote :: Int -> Music Pitch -> Music Pitch +graceNote n (Prim (Note d p)) = + note (d/8) (trans n p) :+: note (7*d/8) p +graceNote n _ = + error "Can only add a grace note to a note." + +b1 = addDur dqn [b 3, fs 4, g 4, fs 4] +b2 = addDur dqn [b 3, es 4, fs 4, es 4] +b3 = addDur dqn [as 3, fs 4, g 4, fs 4] +bassLine = timesM 3 b1 :+: timesM 2 b2 :+: + timesM 4 b3 :+: timesM 5 b1 +mainVoice = timesM 3 v1 :+: v2 +v1 = v1a :+: graceNote (-1) (d 5 qn) :+: v1b -- bars 1-2 +v1a = addDur en [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4] +v1b = addDur en [cs 5, b 4] +v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g +v2a = line [ cs 5 (dhn+dhn), d 5 dhn, + f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en] -- bars 7-11 +v2b = addDur en [ fs 5, e 5, cs 5, as 4] :+: a 4 dqn :+: + addDur en [ as 4, cs 5, fs 5, e 5, fs 5] -- bars 12-13 +v2c = line [ g 5 en, as 5 en, cs 6 (hn+en), d 6 en, cs 6 en] :+: + e 5 en :+: enr :+: + line [ as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en] + -- bars 14-16 +v2d = addDur en [ fs 5, cs 5, e 5, cs 5, + a 4, as 4, d 5, e 5, fs 5] -- bars 17-18.5 +v2e = line [ graceNote 2 (e 5 qn), d 5 en, graceNote 2 (d 5 qn), cs 5 en, + graceNote 1 (cs 5 qn), b 4 (en+hn), cs 5 en, b 4 en ] + -- bars 18.5-20 +v2f = line [ fs 5 en, a 5 en, b 5 (hn+qn), a 5 en, fs 5 en, e 5 qn, + d 5 en, fs 5 en, e 5 hn, d 5 hn, fs 5 qn] -- bars 21-23 +v2g = tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: + b 4 (3*dhn+hn) -- bars 24-28childSong6 :: Music Pitch +childSong6 = let t = (dhn/qn)*(69/120) + in instrument RhodesPiano + (tempo t (bassLine :=: mainVoice)) +prefixes :: [a] -> [[a]] +prefixes [] = [] +prefixes (x:xs) = let f pf = x:pf + in [x] : map f (prefixes xs) +prefix :: [Music a] -> Music a +prefix mel = let m1 = line (concat (prefixes mel)) + m2 = transpose 12 (line (concat (prefixes (reverse mel)))) + m = instrument Flute m1 :=: instrument VoiceOohs m2 + in m :+: transpose 5 m :+: m +mel1 = [c 5 en, e 5 sn, g 5 en, b 5 sn, a 5 en, f 5 sn, d 5 en, b 4 sn, c 5 en] +mel2 = [c 5 sn, e 5 sn, g 5 sn, b 5 sn, a 5 sn, f 5 sn, d 5 sn, b 4 sn, c 5 sn]
+ Euterpea/Examples/IntervalTrainer.lhs view
@@ -0,0 +1,200 @@+> {-# LANGUAGE Arrows #-}++> module Euterpea.Examples.IntervalTrainer where++> import Euterpea+> import Euterpea.Experimental (liftAIO)+> import System.Random (randomRIO)+> import Codec.Midi (Message(ProgramChange))++> import FRP.UISF.AuxFunctions (concatA, evMap)+++> main = runMUI (defaultMUIParams {uiSize=(600,700), uiTitle="Interval Trainer"}) intervalTrainer++> -- music theory name for intervals:+> intNameList :: [String]+> intNameList =+> ["uni","min2","Maj2","min3","Maj3","4th","aug4",+> "5th","min6","Maj6","min7","Maj7","oct"]++States of the MUI's internal Finite State Machine:++> data State = Start | Base | Guessed+> deriving (Eq,Ord,Show)++State transition table:++ | Next | Repeat | Giveup | Guess | Reset |+-----------------------------------------------------------+Start | Base | Start | Start | Start | Start | +Base | Base | Base | Guessed | Guessed | Start |+Guessed | Base | Guessed | Guessed | Guessed | Start |++State variables:++total: number ofintervals generated+correct: number guessed correctly+repeats: number of repeat requests prior to making a guess+answer: a pair, the random root note and the random interval+state: the durrect FSA state (see above)++State variable updates:++Variable | Event : action+------------------------------------------------------------------------+total | Next (Base) : incr, Guess (Base) : incr, Giveup (Base) : incr+correct | Guess (Base) /\ match : incr+repeats | Repeat (Base) : incr+answer | Next : generate and save new random root and interval+state | see State Transition Table++Also, Reset forces total, correct, and repeats to 0, and answer to (0,0).++The main UI:++> intervalTrainer :: UISF () ()+> intervalTrainer = proc _ -> do+> -- MIDI output select:+> mo <- setSize (600,90) $ selectOutput -< ()+> -- Play note:+> pns <- setSize (600,60) . title "Play notes" . leftRight $+> radio ["Together","Low then high","High then low"] 0 -< ()+> -- Note length:+> dur <- setSize (600,60) . title "Note length" . leftRight $ +> radio ["Whole","Half","Quarter","Eighth"] 2 -< ()+> -- Max interval+> maxInt <- (| (setSize (600,60) . title "Maximum interval" . leftRight) (do+> max <- shiSlider 1 (1,12) 12 -< ()+> sDisplay -< intNameList !! max+> returnA -< max )|)+> -- Range:+> range <- (| (setSize (600,60) . title "Range in octaves" . leftRight) (do+> range <- shiSlider 1 (2,10) 4 -< ()+> sDisplay -< take 3 $ show $ fromIntegral range / 2+> returnA -< range )|)+> -- Lowest octave:+> lowOct <- (| (setSize (600,60) . title "Lowest octave" . leftRight) (do+> low <- shiSlider 1 (1,8) 4 -< ()+> sDisplay -< show low+> returnA -< low )|)+> -- Instrument:+> instr <- setSize (600,60) . title "Instrument" . leftRight $ +> radio ["Acous Piano","Elec Piano","Violin","Saxophone","Flute"] 0 -< ()+> -- Control:+> (nextE,repeatE,giveUpE,resetE) <- (| (setSize (600,60) . title "Control" . leftRight) (do+> next <- edge <<< button "Next" -< ()+> repeat <- edge <<< button "Repeat" -< ()+> giveUp <- edge <<< button "Give Up" -< ()+> reset <- edge <<< button "Reset" -< ()+> returnA -< (next,repeat,giveUp,reset) )|)+> -- User Input:+> guesses <- (| (setSize (600,90) . title "Guess the interval") (do+> g1 <- leftRight $+> concatA $ map (\s -> edge <<< button s) +> ["uni","min2","Maj2","min3","Maj3","4th","aug4"] -< repeat ()+> g2 <- leftRight $+> concatA $ map (\s -> edge <<< button s)+> ["5th","min6","Maj6","min7","Maj7","oct"] -< repeat ()+> returnA -< g1++g2) |)+> -- edge-detect pushbuttons:+> let guessesE = foldl1 (.|.) $ zipWith (->>) guesses intNameList+> rec -- the state+> state <- accum Start -< updates+> -- event filter based on MUI state+> let whileIn' :: SEvent a -> State -> SEvent a+> e `whileIn'` s = if s == state then e else Nothing+> updates = (giveUpE `whileIn'` Base ->> const Guessed) .|.+> (nextE ->> const Base) .|. (resetE ->> const Start) .|.+> (guessesE `whileIn'` Base ->> const Guessed)+> let whileIn :: SEvent a -> State -> SEvent a+> e `whileIn` s = if s == state then e else Nothing+> +> -- Random intervals:+> randIntE <- evMap (liftAIO mkRandInt) -< snapshot_ nextE (maxInt, lowOct, range)+> interval <- hold (0,0) -< randIntE+> let trigger = snapshot randIntE (dur, instr) .|.+> snapshot_ repeatE (interval, (dur, instr))+> -- state variables:+> let matchE = snapshot (guessesE `whileIn` Base) interval =>> +> \(g,(r,i)) -> if g==intNameList!!i then succ else id+> total <- accum 0 -< ((guessesE `whileIn` Base ->> succ) .|.+> (nextE `whileIn` Base ->> succ) .|.+> (giveUpE `whileIn` Base ->> succ) .|.+> (resetE ->> const 0) )+> correct <- accum 0 -< (matchE .|. (resetE ->> const 0))+> repeats <- accum 0 -< ((repeatE `whileIn` Base ->> succ) .|.+> (resetE ->> const 0) )+> -- Note delays+> let f n pn dur = if pn==n then 1 / fromIntegral (2 ^ dur) else 0+> del0 = f 2 pns dur -- lo note delay only when "hi then lo"+> del1 = f 1 pns dur -- hi note delay only when "lo then hi"+> -- Random interval & Midi signals:+> note0 <- vdelay -< (del0, (trigger =>> mkNote 0))+> note1 <- vdelay -< (del1, (trigger =>> mkNote 1))+> nowE <- now -< ()+> let progChan = nowE ->> (map Std $+> zipWith ProgramChange [0,1,2,3,4] [0,4,40,66,73])+> midiMsgs = progChan .|. mergeE (++) note0 note1+> -- Display results:+> (| leftRight (do+> title "Score:" $ setSize (120,50) $ +> display -< showScore correct total+> title "Repeats:" $ setSize (120,50) $ display -< show repeats+> title "Answer:" $ setSize (120,50) $ display -< +> if state==Guessed then intNameList!!(snd interval) else ""+> returnA -< () )|)+> -- Midi output+> midiOut -< (mo, midiMsgs)+> returnA -< ()+++Auxilliary Functions:++> sDisplay = setSize (50,25) display+> shiSlider inc ran pre = setSize (300,25) $ hiSlider inc ran pre+> sButton str = setSize (75,25) $ button str++> showScore :: Int -> Int -> String+> showScore c 0 = "0"+> showScore c t = show c ++ "/" ++ show t ++ " = " ++ +> take 5 (show (100 * fromIntegral c / fromIntegral t)) ++ "%"++> mkRandInt :: (Int,Int,Int) -> IO (Int,Int)+> mkRandInt (maxInt,lowOct,range) = +> do+> let low = lowOct*12+> int <- randomRIO (0,maxInt) :: IO Int+> root <- randomRIO (low, low + range*6 - int) :: IO Int+> return (root,int)++> mkNote :: Int -> ((Int,Int),(Int,Int)) -> [MidiMessage]+> mkNote n ((root,int),(dur,instr)) =+> let durT = 1 / fromIntegral (2 ^ dur)+> in if n==0 then [ANote instr root 100 durT]+> else [ANote instr (root+int) 100 durT]++0 whole 1 sec 1/2^0+1 half 1/2 sec 1/2^1+2 quarter 1/4 sec 1/2^2+3 eighth 1/8 sec 1/2^3++at 60 BPM a whole note is 1 sec++ANote :: Channel -> Key -> Velocity -> Time -> MidiMessage++--------------------------------------+-- Yampa-style utilities+--------------------------------------++> (=>>) :: SEvent a -> (a -> b) -> SEvent b+> (=>>) = flip fmap+> (->>) :: SEvent a -> b -> SEvent b+> (->>) = flip $ fmap . const+> (.|.) :: SEvent a -> SEvent a -> SEvent a+> (.|.) = flip $ flip maybe Just+> +> snapshot :: SEvent a -> b -> SEvent (a,b)+> snapshot = flip $ fmap . flip (,)+> snapshot_ :: SEvent a -> b -> SEvent b+> snapshot_ = flip $ fmap . const -- same as ->>
+ Euterpea/Examples/LSystems.hs view
@@ -0,0 +1,125 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/LSystems.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Examples.LSystems where + +import Euterpea +import Data.List hiding (transpose) +import System.Random + +data DetGrammar a = DetGrammar a -- start symbol + [(a,[a])] -- productions + deriving Show +detGenerate :: Eq a => DetGrammar a -> [[a]] +detGenerate (DetGrammar st ps) = iterate (concatMap f) [st] + where f a = maybe [a] id (lookup a ps) +redAlgae = DetGrammar 'a' + [ ('a',"b|c"), ('b',"b"), ('c',"b|d"), + ('d',"e\\d"), ('e',"f"), ('f',"g"), + ('g',"h(a)"), ('h',"h"), ('|',"|"), + ('(',"("), (')',")"), ('/',"\\"), + ('\\',"/") + ] +t n g = sequence_ (map putStrLn (take n (detGenerate g))) +data Grammar a = Grammar a -- start sentence + (Rules a) -- production rules + deriving Show +data Rules a = Uni [Rule a] + | Sto [(Rule a, Prob)] + deriving (Eq, Ord, Show) + +data Rule a = Rule { lhs :: a, rhs :: a } + deriving (Eq, Ord, Show) + +type Prob = Double +type ReplFun a = [[(Rule a, Prob)]] -> (a, [Rand]) -> (a, [Rand]) +type Rand = Double +gen :: Ord a => ReplFun a -> Grammar a -> Int -> [a] +gen f (Grammar s rules) seed = + let Sto newRules = toStoRules rules + rands = randomRs (0.0,1.0) (mkStdGen seed) + in if checkProbs newRules + then generate f newRules (s,rands) + else (error "Stochastic rule-set is malformed.") +toStoRules :: (Ord a, Eq a) => Rules a -> Rules a +toStoRules (Sto rs) = Sto rs +toStoRules (Uni rs) = + let rs' = groupBy (\r1 r2 -> lhs r1 == lhs r2) (sort rs) + in Sto (concatMap insertProb rs') + +insertProb :: [a] -> [(a, Prob)] +insertProb rules = let prb = 1.0 / fromIntegral (length rules) + in zip rules (repeat prb) +checkProbs :: (Ord a, Eq a) => [(Rule a, Prob)] -> Bool +checkProbs rs = and (map checkSum (groupBy sameLHS (sort rs))) + +eps = 0.001 + +checkSum :: [(Rule a, Prob)] -> Bool +checkSum rules = let mySum = sum (map snd rules) + in abs (1.0 - mySum) <= eps + +sameLHS :: Eq a => (Rule a, Prob) -> (Rule a, Prob) -> Bool +sameLHS (r1,f1) (r2,f2) = lhs r1 == lhs r2 +generate :: Eq a => + ReplFun a -> [(Rule a, Prob)] -> (a,[Rand]) -> [a] +generate f rules xs = + let newRules = map probDist (groupBy sameLHS rules) + probDist rrs = let (rs,ps) = unzip rrs + in zip rs (tail (scanl (+) 0 ps)) + in map fst (iterate (f newRules) xs) +data LSys a = N a + | LSys a :+ LSys a + | LSys a :. LSys a + | Id + deriving (Eq, Ord, Show) +replFun :: Eq a => ReplFun (LSys a) +replFun rules (s, rands) = + case s of + a :+ b -> let (a',rands') = replFun rules (a, rands ) + (b',rands'') = replFun rules (b, rands') + in (a' :+ b', rands'') + a :. b -> let (a',rands') = replFun rules (a, rands ) + (b',rands'') = replFun rules (b, rands') + in (a' :. b', rands'') + Id -> (Id, rands) + N x -> (getNewRHS rules (N x) (head rands), tail rands) +getNewRHS :: Eq a => [[(Rule a, Prob)]] -> a -> Rand -> a +getNewRHS rrs ls rand = + let loop ((r,p):rs) = if rand <= p then rhs r else loop rs + loop [] = error "getNewRHS anomaly" + in case (find (\ ((r,p):_) -> lhs r == ls) rrs) of + Just rs -> loop rs + Nothing -> error "No rule match" +type IR a b = [(a, Music b -> Music b)] -- ``interpetation rules'' + +interpret :: (Eq a) => LSys a -> IR a b -> Music b -> Music b +interpret (a :. b) r m = interpret a r (interpret b r m) +interpret (a :+ b) r m = interpret a r m :+: interpret b r m +interpret Id r m = m +interpret (N x) r m = case (lookup x r) of + Just f -> f m + Nothing -> error "No interpetation rule" +data LFun = Inc | Dec | Same + deriving (Eq, Ord, Show) + +ir :: IR LFun Pitch +ir = [ (Inc, transpose 1), + (Dec, transpose (-1)), + (Same, id)] + +inc, dec, same :: LSys LFun +inc = N Inc +dec = N Dec +same = N Same +sc = inc :+ dec +r1a = Rule inc (sc :. sc) +r1b = Rule inc sc +r2a = Rule dec (sc :. sc) +r2b = Rule dec sc +r3a = Rule same inc +r3b = Rule same dec +r3c = Rule same same +g1 = Grammar same (Uni [r1b, r1a, r2b, r2a, r3a, r3b]) +t1 n = instrument Vibraphone $ + interpret (gen replFun g1 42 !! n) ir (c 5 tn)
+ Euterpea/Examples/MUI.hs view
@@ -0,0 +1,151 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.)++{-# LANGUAGE Arrows #-}++module Euterpea.Examples.MUI where+import Euterpea+import Control.Arrow+import Data.Maybe (mapMaybe)++ui0 :: UISF () ()+ui0 = proc _ -> do+ ap <- hiSlider 1 (0,100) 0 -< ()+ display -< pitch ap++--mui0 = runMUI' "Simple MUI" ui0++ui1 :: UISF () ()+ui1 = setLayout (makeLayout (Fixed 150) (Fixed 150)) $ + proc _ -> do+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap++--mui1 = runMUI' "Simple MUI (sized and titled)" ui1+ui2 :: UISF () ()+ui2 = leftRight $+ proc _ -> do+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap++--mui2 = runMUI' "Simple MUI (left-to-right layout)" ui2+--ui3 :: UISF () ()+--ui3 = proc _ -> do+-- ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+-- title "Pitch" display -< pitch ap+-- uap <- unique -< ap+-- midiOut -< (0, fmap (\k-> [ANote 0 k 100 0.1]) uap)++--mui3 = runMUI' "Pitch Player" ui3++ui4 :: UISF () ()+ui4 = proc _ -> do+ devid <- selectOutput -< ()+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap+ uap <- unique -< ap+ midiOut -< (devid, fmap (\k-> [ANote 0 k 100 0.1]) uap)++--mui4 = runMUI' "Pitch Player with MIDI Device Select" ui4++ui5 :: UISF () ()+ui5 = proc _ -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ m <- midiIn -< mi+ midiOut -< (mo, m)++--mui5 = runMUI' "MIDI Input / Output UI" ui5++getDeviceIDs = topDown $+ proc () -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ outA -< (mi,mo)+ui6 :: UISF () ()+ui6 = proc _ -> do+ devid <- selectOutput -< ()+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap+ f <- title "Tempo" (hSlider (1,10) 1) -< ()+ tick <- timer -< 1/f+ midiOut -< (devid, fmap (const [ANote 0 ap 100 0.1]) tick)++--mui6 = runMUI' "Pitch Player with Timer" ui6++chordIntervals :: [ (String, [Int]) ]+chordIntervals = [ ("Maj", [4,3,5]), ("Maj7", [4,3,4,1]),+ ("Maj9", [4,3,4,3]), ("Maj6", [4,3,2,3]),+ ("min", [3,4,5]), ("min7", [3,4,3,2]),+ ("min9", [3,4,3,4]), ("min7b5", [3,3,4,2]),+ ("mMaj7", [3,4,4,1]), ("dim", [3,3,3]),+ ("dim7", [3,3,3,3]), ("Dom7", [4,3,3,2]),+ ("Dom9", [4,3,3,4]), ("Dom7b9", [4,3,3,3]) ]++toChord :: Int -> [MidiMessage] -> [MidiMessage]+toChord i ms@(m:_) = + case m of + Std (NoteOn c k v) -> f NoteOn c k v+ Std (NoteOff c k v) -> f NoteOff c k v+ _ -> ms+ where f g c k v = map (\k' -> Std (g c k' v)) + (scanl (+) k (snd (chordIntervals !! i)))++buildChord :: UISF () ()+buildChord = leftRight $ + proc _ -> do+ (mi, mo) <- getDeviceIDs -< ()+ m <- midiIn -< mi+ i <- topDown $ title "Chord Type" $ + radio (fst (unzip chordIntervals)) 0 -< ()+ midiOut -< (mo, fmap (toChord i) m)++--chordBuilder = runMUI (600,400) "Chord Builder" buildChord+grow :: Double -> Double -> Double+grow r x = r * x * (1-x)++popToNote :: Double -> [MidiMessage]+popToNote x = [ANote 0 n 64 0.05] + where n = truncate (x * 127)++bifurcateUI :: UISF () ()+bifurcateUI = proc _ -> do+ mo <- selectOutput -< ()+ f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()+ tick <- timer -< 1/f+ r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()+ pop <- accum 0.1 -< fmap (const (grow r)) tick+ _ <- title "Population" $ display -< pop+ midiOut -< (mo, fmap (const (popToNote pop)) tick)++--bifurcate = runMUI (300,500) "Bifurcate!" $ bifurcateUI++echoUI :: UISF () ()+echoUI = proc _ -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ m <- midiIn -< mi+ r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< ()+ f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< ()++ rec let m' = removeNull $ mergeE (++) m s+ s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m')++ midiOut -< (mo, m')++--echo = runMUI (500,500) "Echo" echoUI++removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]+removeNull (Just []) = Nothing+removeNull mm = mm++decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage+decay dur r m = + let f c k v d = if v > 0 + then let v' = truncate (fromIntegral v * r)+ in Just (ANote c k v' d)+ else Nothing+ in case m of+ ANote c k v d -> f c k v d+ Std (NoteOn c k v) -> f c k v dur+ _ -> Nothing
+ Euterpea/Examples/MUIExamples.lhs view
@@ -0,0 +1,177 @@+> {-# LANGUAGE Arrows #-}++> module Euterpea.Examples.MUIExamples where++> import Euterpea+> import Data.Maybe (mapMaybe)+++=============+Chord builder++Here is a simple program that plays the selected chord when a root+note is entered using a Midi input device.++We define a mapping between chord extensions and their intervals with+respect to the root note.++> chordIntervals = [("Maj", [4,3,5]),+> ("Maj7", [4,3,4,1]),+> ("Maj9", [2,2,3,4,1]),+> ("6", [4,3,2,3]),+> ("m", [3,4,5]),+> ("m7", [3,4,3,2]),+> ("m9", [2,1,4,3,2]),+> ("m7b5", [3,3,4,2]),+> ("mMaj7", [3,4,4,1]),+> ("dim", [3,3,3]),+> ("7", [4,3,3,2]),+> ("9", [2,2,3,3,2]),+> ("7b9", [1,3,3,3,2])]++We display the list of extensions on the screen as radio buttons for+the user to click on.++The toChord function takes in the index of the selected chord extension +and an input message as the root note, and outputs the notes of+the selected chord based on the root note. For simplicity, we only+process the head of the message list and ignore everything else.++> toChord :: Int -> [MidiMessage] -> [MidiMessage]+> toChord i (ms@(m:_)) = +> case m of +> Std (NoteOn c k v) -> f NoteOn c k v+> Std (NoteOff c k v) -> f NoteOff c k v+> _ -> ms+> where f g c k v = map (\k -> Std (g c k v)) +> (scanl (+) k (snd (chordIntervals !! i)))++The UI is arranged in the following way. On the left side, the list+of input and output devices are displayed top-down. On the right is+the list of chord extensions. We take the name of each extension from+the chordIntervals list to create the radio buttons. ++When a Midi input event occurs, the input message and the currently+selected index to the list of chords is sent to the toChord function,+and the resulting chord is sent to the output device.++> buildChord = runMUI (defaultMUIParams {uiSize=(500,500), uiTitle="Chord Builder"}) $ leftRight $ proc _ -> do+> (mi,mo) <- topDown (selectInput &&& selectOutput) -< ()+> m <- midiIn -< mi+> i <- topDown $ title "Extension" $ radio (fst (unzip chordIntervals)) 0 -< ()+> midiOut -< (mo, fmap (toChord i) m)+++=================+Bifurcate example++Here is an example with some ideas borrowed from Gary Lee Nelson's+composition "Bifurcate me, Baby!"++The basic idea is to evaluate the logistic growth function at+different points and convert the value to a musical note. The growth+function is given by++ x_(n+1) = r x_n (1 - x_n)++We start with an initial population x_0 and iteratively apply the+growth function to it, where r is the growth rate. For certain values+of r, the population stablizes to a certain value, but as r increases,+the period doubles, quadruples, and eventually leads to chaos. It is+one of the classic examples in chaos theory.++First we define the growth function which, given a rate r and+current population x, generates the next population.++> grow :: Double -> Double -> Double+> grow r x = r * x * (1-x)++Then we define a signal 'tick' that pulsates at a given frequency+specified by slider f. This is the signal that will drive the+simulation. The timer function takes in a frequency.++The next thing we need is a time-varying population. This is where +the delay function and the rec keyword come in handy. We initialize +the 'pop' signal with the value 0.1, and then on every tick, we +grow it with the instantaneous value of the growth rate signal.++We can now write a simple function that maps a population value to a+musical note:++> popToNote :: Double -> [MidiMessage]+> popToNote x = [ANote 0 n 64 0.05] where n = truncate (x * 127)++Finally, to play the note, we simply send the current population to +popToNote, and send the result to the selected Midi output device. ++> bifurcate = runMUI (defaultMUIParams {uiSize=(300,500), uiTitle="Bifurcate!"}) $ proc _ -> do+> mo <- selectOutput -< ()+> f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()+> r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()+> +> tick <- timer -< 1.0 / f+> rec pop <- delay 0.1 -< maybe pop (const $ grow r pop) tick+> +> _ <- title "Population" $ display -< pop+> midiOut -< (mo, fmap (const (popToNote pop)) tick)+++============+Echo example++Here we present a program that takes in a Midi event stream and, in+addition to playing each note received from the input device, it also+echoes the note at a given rate, while playing each successive note+more softly until the velocity reduces to 0.++The key component we need for this problem is a delay function that+can delay a given event signal for a certain amount of time. vdelay+takes in the amount of time to delay and an input signal+and outputs the delayed signal.++There are two signals we want to attenuate. One is the signal coming+from the input device, and the other is the delayed and decayed signal+containing the echoes. In the code shown below, they are denoted as m+and s, respectively. We merge the two event streams into one and then +remove events with empty Midi messages by replacing them with Nothing. +The resulting signal, m', is then sent to the Midi output device.++The echo signal s is created recursively from m' as follows. We examine +the signal m' and decay any events that we find there, using the decay +rate indicated by the instantaneous value from the slider r. This +decayed signal is fed into the vdelay signal function along with +the amount of time to delay (the inverse of the echo frequency, +which is given by the other slider f).++> echo = runMUI (defaultMUIParams {uiSize=(500,500), uiTitle="Echo"}) $ proc _ -> do+> mi <- selectInput -< ()+> mo <- selectOutput -< ()+> m <- midiIn -< mi+> r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< ()+> f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< ()+> +> rec let m' = removeNull $ mergeS m s+> s <- vdelay -< (1.0 / f, fmap (mapMaybe (decay 0.1 r)) m')+> +> midiOut -< (mo, m')++> mergeS :: Maybe [MidiMessage] -> Maybe [MidiMessage] -> Maybe [MidiMessage]+> mergeS (Just ns1) (Just ns2) = Just (ns1 ++ ns2)+> mergeS n1 Nothing = n1+> mergeS Nothing n2 = n2++> removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]+> removeNull Nothing = Nothing+> removeNull (Just []) = Nothing+> removeNull (Just xs) = Just xs++> decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage+> decay dur r m = +> let f c k v d = if v > 0 +> then Just (ANote c k (truncate (fromIntegral v * r)) d)+> else Nothing+> in case m of+> ANote c k v d -> f c k v d+> Std (NoteOn c k v) -> f c k v dur+> _ -> Nothing+
+ Euterpea/Examples/MusicToSignal.lhs view
@@ -0,0 +1,116 @@+> {-# LANGUAGE Arrows #-}++This file demonstrates how to turn a Music value into an audio signal +using the Render module.++> module Euterpea.Examples.MusicToSignal where++> import Euterpea++First, define some instruments.++> reedyWav = tableSinesN 1024 [0.4, 0.3, 0.35, 0.5, 0.1, 0.2, 0.15, +> 0.0, 0.02, 0.05, 0.03]++> reed :: Instr (Stereo AudRate)+> reed dur pch vol params = +> let reedy = osc reedyWav 0+> freq = apToHz pch+> vel = fromIntegral vol / 127 / 3+> env = envLineSeg [0, 1, 0.8, 0.6, 0.7, 0.6, 0] +> (replicate 6 (fromRational dur/6))+> in proc _ -> do+> amp <- env -< ()+> r1 <- reedy -< freq+> r2 <- reedy -< freq + (0.023 * freq)+> r3 <- reedy -< freq + (0.019 * freq)+> let [a1, a2, a3] = map (* (amp * vel)) [r1, r2, r3]+> let rleft = a1 * 0.5 + a2 * 0.44 * 0.35 + a3 * 0.26 * 0.65+> rright = a1 * 0.5 + a2 * 0.44 * 0.65 + a3 * 0.26 * 0.35+> outA -< (rleft, rright)++> saw = tableSinesN 4096 [1, 0.5, 0.333, 0.25, 0.2, 0.166, 0.142, 0.125, +> 0.111, 0.1, 0.09, 0.083, 0.076, 0.071, 0.066, 0.062]++> plk :: Instr (Stereo AudRate)+> plk dur pch vol params = +> let vel = fromIntegral vol / 127 / 3+> freq = apToHz pch+> sf = pluck saw freq SimpleAveraging+> in proc _ -> do+> a <- sf -< freq+> outA -< (a * vel * 0.4, a * vel * 0.6)++Define some instruments:++> myBass, myReed :: InstrumentName+> myBass = Custom "pluck-like"+> myReed = Custom "reed-like"++Construct a custom instrument map. An instrument map is just +an association list containing mappings from InstrumentName to Instr.++> myMap :: InstrMap (Stereo AudRate)+> myMap = [(myBass, plk), (myReed, reed)]++> bass = mMap (\p-> (p, 40 :: Volume)) $ instrument myBass bassLine+> melody = mMap (\p-> (p,100 :: Volume)) $ instrument myReed mainVoice++> childSong6 :: Music (Pitch, Volume)+> childSong6 = tempo 1.5 (bass :=: melody)++All instruments used in the same performance must output the same number +of channels, but renderSF supports both mono or stereo instruments +(and any instrument that produces samples in the AudioSample type class).+The outFile function will produce a monaural or stereo file accordingly.++> recordSong = uncurry (outFile "song.wav") (renderSF childSong6 myMap)++> main = recordSong++This stuff is taken from Euterpea.Examples.Interlude:++> bassLine = timesM 3 b1 :+: timesM 2 b2 :+: +> timesM 4 b3 :+: timesM 5 b1++> mainVoice = timesM 3 v1 :+: v2++> v1 = v1a :+: graceNote (-1) (d 5 qn) :+: v1b -- bars 1-2+> v1a = addDur en [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4]+> v1b = addDur en [cs 5, b 4]++> v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g+> v2a = line [ cs 5 (dhn+dhn), d 5 dhn, +> f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en]+> v2b = addDur en [ fs 5, e 5, cs 5, as 4] :+: a 4 dqn :+:+> addDur en [ as 4, cs 5, fs 5, e 5, fs 5]+> v2c = line [ g 5 en, as 5 en, cs 6 (hn+en), d 6 en, cs 6 en] :+:+> e 5 en :+: enr :+: +> line [ as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en] +> v2d = addDur en [ fs 5, cs 5, e 5, cs 5, +> a 4, as 4, d 5, e 5, fs 5]+> v2e = line [ graceNote 2 (e 5 qn), d 5 en, graceNote 2 (d 5 qn), cs 5 en,+> graceNote 1 (cs 5 qn), b 4 (en+hn), cs 5 en, b 4 en ] +> v2f = line [ fs 5 en, a 5 en, b 5 (hn+qn), a 5 en, fs 5 en, e 5 qn,+> d 5 en, fs 5 en, e 5 hn, d 5 hn, fs 5 qn]+> v2g = tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: +> b 4 (3*dhn+hn)++> b1 = addDur dqn [b 3, fs 4, g 4, fs 4]+> b2 = addDur dqn [b 3, es 4, fs 4, es 4]+> b3 = addDur dqn [as 3, fs 4, g 4, fs 4]++> addDur :: Dur -> [Dur -> Music a] -> Music a+> addDur d ns = let f n = n d+> in line (map f ns)++> graceNote :: Int -> Music Pitch -> Music Pitch+> graceNote n (Prim (Note d p)) =+> note (d/8) (trans n p) :+: note (7*d/8) p+> graceNote n _ = +> error "Can only add a grace note to a note."++childSong6 :: Music Pitch+childSong6 = let t = (dhn/qn)*(69/120)+ in instrument RhodesPiano + (tempo t (bassLine :=: mainVoice))
+ Euterpea/Examples/NewResolutions.lhs view
@@ -0,0 +1,226 @@+New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin + +> module Euterpea.Examples.NewResolutions where +> import Euterpea + +> nrContext = Context {cTime = 0, +> cPlayer = fancyPlayer, +> cInst = Marimba, +> cDur = 1.0, +> cPch = 0, +> cKey = (C,Major), +> cVol = 100} +> +> tNewRes m = makeMidi (m, nrContext, defUpm) + +> root, minThird, fifth, octave :: Pitch -> Dur -> Music Pitch +> root p dur = Prim $ Note dur p +> minThird p dur = Prim $ Note dur (trans 3 p) +> majThird p dur = Prim $ Note dur (trans 4 p) +> fifth p dur = Prim $ Note dur (trans 7 p) +> majSixth p dur = Prim $ Note dur (trans 9 p) +> minSeventh p dur = Prim $ Note dur (trans 10 p) +> octave p dur = Prim $ Note dur (trans 12 p) +> oMinThird p dur = Prim $ Note dur (trans 15 p) +> oFifth p dur = Prim $ Note dur (trans 19 p) + +> minArpegUp, minArpegDown :: Pitch -> Dur -> Music Pitch +> minArpegUp p d = root p d +> :+: minThird p d +> :+: fifth p d +> :+: octave p d +> minArpegDown p d = octave p d +> :+: fifth p d +> :+: minThird p d +> :+: root p d +> majArpegDown p d = octave p d +> :+: fifth p d +> :+: majThird p d +> :+: root p d +> six3ArpegDown p d = octave p d +> :+: majSixth p d +> :+: majThird p d +> :+: root p d + +> pattern = minArpegUp (D,5) sn +> :+: minArpegDown (C,5) sn +> :+: minArpegUp (A,4) sn +> :+: minArpegDown (G,4) sn +> :+: minArpegUp (F,4) sn +> :+: d 5 sn :+: a 4 sn :+: f 4 sn :+: a 4 sn + +> melPattern = d 6 en :+: c 6 en :+: d 6 en +> :+: snr +> :+: a 5 en :+: g 5 en :+: a 5 en + +> melody1 = melPattern :+: enr :+: d 5 sn +> :+: f 5 sn :+: g 5 en :+: f 5 sn :+: d 5 en :+: c 5 en +> :+: d 5 en :+: melPattern :+: d 5 sn +> :+: f 5 sn :+: f 5 sn :+: g 5 sn :+: f 5 sn +> :+: d 5 sn :+: c 5 en :+: d 5 den +> :+: melPattern :+: d 5 sn +> :+: f 5 sn :+: g 5 sn :+: f 5 sn :+: d 5 en +> :+: c 5 sn :+: d 5 en +> :+: d 6 en :+: c 6 en :+: d 6 den :+: c 6 en +> :+: a 5 en :+: c 6 en :+: a 5 sn :+: g 5 en +> :+: f 5 en :+: af 5 en +> :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: c 5 sn +> -- last note removed to make fit with pattern + +> bellPart = d 7 en :+: f 7 en :+: c 7 en :+: d 7 en +> :+: a 6 en :+: c 7 en :+: g 6 en :+: a 6 en +> :+: f 6 en :+: g 6 en +> :+: d 6 sn :+: f 6 sn :+: a 6 sn :+: c 7 sn + +> vibesLine = d 5 qn :+: c 5 qn :+: a 4 qn +> :+: g 4 qn :+: f 4 qn :+: d 4 qn +> vibesPart = vibesLine :=: Modify (Transpose 12) vibesLine + +> cMajorScale = [(C,0), (D,0), (E,0), (F,0), (G,0), (A,0), (B,0)] +> gMajorScale = [(G,0), (A,0), (B,0), (C,1), (D,1), (E,1), (Fs,1)] +> dPentMinScale = [(D,0), (F,0), (G,0), (A,0), (C,1)] + +> prevNote [] _ = error ("Scale empty") +> prevNote [x] _ = error ("Note not found in scale") +> prevNote ((y,n):ys) (p,oct) | y == p = let (x,m) = last ys +> in (x, oct + m - n - 1) +> prevNote ((x,m):(y,n):xys) (p,oct) | y == p = (x, oct + m - n) +> | otherwise = prevNote ((y,n):xys) (p,oct) + +> nextNote scale note = nextNote' (head scale) scale note +> nextNote' _ [] _ = error ("Scale empty") +> nextNote' (fstP,fstO) [(x,m)] (p,oct) +> | x == p = (fstP, oct - m + fstO + 1) +> | otherwise = error ("Note not found in scale") +> nextNote' fst ((x,m):(y,n):xys) (p,oct) +> | x == p = (y, oct - m + n) +> | otherwise = nextNote' fst ((y,n):xys) (p,oct) + +> back2Note s = prevNote s . prevNote s + +> nextNR = nextNote dPentMinScale +> prevNR = prevNote dPentMinScale +> back2NR = back2Note dPentMinScale + +> diddle p = snr :+: Prim (Note sn p) +> :+: Prim (Note sn (prevNR p)) :+: Prim (Note sn p) + +> melody2 = d 6 sn :+: d 6 en :+: c 6 en :+: d 6 sn :+: c 6 en +> :+: a 5 en :+: g 5 sn :+: f 5 sn +> :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: f 5 sn +> :+: diddle (D,5) :+: diddle (C,5) +> :+: diddle (D,6) :+: diddle (C,6) :+: diddle (A,5) +> :+: diddle (G,5) :+: diddle (F,5) :+: diddle (D,5) +> :+: snr :+: d 6 en :+: c 6 en :+: d 6 den +> :+: c 6 en :+: a 5 en :+: g 5 den +> :+: f 5 en :+: g 5 en :+: f 5 sn +> :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: c 5 sn +> :+: d 5 den :+: d 6 en :+: c 6 den :+: a 5 en :+: g 5 den +> :+: f 5 en :+: d 5 den :+: c 5 en :+: d 5 qn + +> part1 = Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) pattern) +> :+: +> Modify (Instrument Xylophone) (Modify (Phrase [Dyn (Loudness 120)]) melody1) +> :=: Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) (timesM 4 pattern)) +> bridge = Modify (Instrument Xylophone) (d 5 hn) -- (d 5 hn [Volume 120]) +> :=: (timesM 2 $ +> Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 60)]) (Modify (Transpose (-12)) bellPart)) +> :=: Modify (Instrument Vibraphone) (Modify (Phrase [Dyn (Loudness 40)]) vibesPart) +> :=: Modify (Instrument Glockenspiel) (Modify (Phrase [Dyn (Loudness 80)]) bellPart)) +> part2 = Modify (Instrument Xylophone) (Modify (Phrase [Dyn (Loudness 120)]) melody2) +> :=: Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) (timesM 3 pattern +> :+: minArpegUp (D,5) sn +> :+: minArpegDown (C,5) sn +> :+: minArpegUp (A,4) sn +> :+: minArpegDown (G,4) sn +> :+: minArpegUp (F,4) sn +> :+: d 5 sn)) +> :=: timesM 4 (Modify (Instrument Vibraphone) (Modify (Phrase [Dyn (Loudness 40)]) vibesPart)) + +> run1 p d = root p d :+: minThird p d :+: fifth p d +> :+: minSeventh p d :+: octave p d :+: oMinThird p d +> :+: oFifth p d :+: oMinThird p d :+: octave p d +> :+: minSeventh p d :+: fifth p d :+: minThird p d + +> part3Pattern el = el (D,4) sn :+: el (C,4) sn :+: el (D,4) sn :+: el (F,4) sn + +> run2 p d = timesM 2 $ +> fifth p d :+: minSeventh p d :+: octave p d +> :+: oMinThird p d :+: octave p d :+: minSeventh p d + +> run3 p d = timesM 3 $ +> oMinThird p d :+: octave p d :+: minSeventh p d :+: fifth p d + +> vibeLine3 = let el = \p -> octave p den :+: fifth p den +> :+: minSeventh p den :+: octave p den +> in el (D,4) :+: el (C,4) :+: el (D,4) +> :+: f 5 den :+: c 5 den +> :+: ef 5 en :+: f 5 en :+: af 5 en +> vibePart3 = vibeLine3 :=: Modify (Transpose 12) vibeLine3 + +> melody3 = a 5 (11/16) :+: f 6 sn +> :+: ef 6 en :+: d 6 en :+: c 6 en :+: g 5 dqn +> :+: timesM 3 (a 5 sn :+: f 6 en) :+: a 5 en +> :+: f 6 en :+: af 5 en :+: f 6 en :+: af 5 en +> :+: minArpegDown (F,5) sn :+: snr +> :+: majArpegDown (F,5) sn :+: snr +> :+: six3ArpegDown (F,5) sn :+: snr :+: f 6 sn :+: d 6 sn +> :+: ef 6 sn :+: d 6 sn :+: c 6 sn :+: g 5 sn :+: snr +> :+: majArpegDown (Ef,5) sn :+: snr :+: ef 6 sn :+: c 6 sn +> :+: majArpegDown (F,5) sn :+: snr +> :+: six3ArpegDown (F,5) sn :+: snr :+: f 6 sn :+: d 6 sn +> :+: minArpegDown (F,5) sn :+: snr +> :+: minArpegDown (F,5) sn :+: af 5 sn :+: c 6 sn :+: f 6 sn +> :+: line (map (timesM 2) [f 6 sn, d 6 sn, c 6 sn, +> a 5 sn, g 5 sn, f 5 sn]) +> :+: ef 5 sn :+: f 5 sn :+: g 5 sn :+: bf 5 sn +> :+: c 6 sn :+: d 6 sn :+: ef 6 sn :+: d 6 sn +> :+: c 6 sn :+: bf 5 sn :+: a 5 sn :+: g 5 sn +> :+: timesM 4 (a 5 sn :+: a 5 sn :+: g 5 sn) +> :+: timesM 2 (af 5 sn :+: af 5 sn :+: g 5 sn) +> :+: timesM 2 (af 5 sn :+: g 5 sn :+: f 5 sn) +> :+: a 5 dqn +> :+: f 6 sn :+: d 6 sn :+: c 6 sn +> :+: a 5 sn :+: g 5 sn :+: f 5 sn +> :+: g 5 sn :+: bf 5 sn :+: ef 6 dqn +> :+: bf 6 den :+: bf 6 sn +> :+: a 6 en :+: a 6 sn :+: g 6 en :+: g 6 sn +> :+: f 6 den :+: a 5 sn :+: c 6 sn :+: d 6 sn +> :+: f 6 den :+: f 6 sn :+: d 6 sn :+: c 6 sn +> :+: af 5 sn :+: af 5 sn :+: g 5 sn +> :+: f 5 sn :+: d 5 sn :+: c 5 sn + +> harmony3 = Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1 +> :=: part3Pattern run2 +> :=: Modify (Transpose 12) (part3Pattern run3)) +> :=: Modify (Phrase [Dyn (Loudness 50)]) (Modify (Instrument Vibraphone) vibePart3) + +> part3 = Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1) +> :+: (Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1) +> :=: Modify (Phrase [Dyn (Loudness 90)]) (part3Pattern run2)) +> :+: (Modify (Phrase [Dyn (Loudness 60)]) ((part3Pattern run1) +> :=: (part3Pattern run2)) +> :=: Modify (Phrase [Dyn (Loudness 100)]) (Modify (Transpose 12) (part3Pattern run3))) +> :+: Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1 +> :=: part3Pattern run2 +> :=: Modify (Transpose 12) (part3Pattern run3)) +> :=: Modify (Phrase [Dyn (Loudness 70)]) (Modify (Instrument Vibraphone) vibePart3) +> :+: (timesM 4 harmony3 :=: Modify (Phrase [Dyn (Loudness 100)]) (Modify (Instrument Xylophone) melody3) +> :=: (Modify (Instrument Marimba) melody3)) + +> all3Insts m = Modify (Instrument Marimba) m +> :=: Modify (Instrument Xylophone) m +> :=: Modify (Instrument Vibraphone) m + +> endEl n = Prim (Note sn n) :+: Prim (Note sn (back2NR n)) +> :+: Prim (Note sn (prevNR n)) :+: Prim (Note sn n) + +> endRun = line $ map endEl $ take 10 $ iterate nextNR (D,5) + +> ending = all3Insts $ +> Prim (Note qn (D,5)) +> :+: Modify (Phrase [Dyn (Loudness 120)]) (endRun :+: d 7 sn) + +> newResolutions = part1 :+: bridge :+: part2 :+: part3 :+: ending + +> nr = play newResolutions
+ Euterpea/Examples/RandomMusic.hs view
@@ -0,0 +1,100 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/RandomMusic.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Examples.RandomMusic where + +import Euterpea + +import System.Random +import System.Random.Distributions +import qualified Data.MarkovChain as M +sGen :: StdGen +sGen = mkStdGen 42 +randInts :: StdGen -> [Int] +randInts g = let (x,g') = next g + in x : randInts g' +randFloats :: [Float] +randFloats = randomRs (-1,1) sGen + +randIntegers :: [Integer] +randIntegers = randomRs (0,100) sGen + +randString :: String +randString = randomRs ('a','z') sGen +randIO :: IO Float +randIO = randomRIO (0,1) +randIO' :: IO () +randIO' = do r1 <- randomRIO (0,1) :: IO Float + r2 <- randomRIO (0,1) :: IO Float + print (r1 == r2) +toAbsP1 :: Float -> AbsPitch +toAbsP1 x = round (40*x + 30) +mkNote1 :: AbsPitch -> Music Pitch +mkNote1 = note tn . pitch + +mkLine1 :: [AbsPitch] -> Music Pitch +mkLine1 rands = line (take 32 (map mkNote1 rands)) +-- uniform distribution +m1 :: Music Pitch +m1 = mkLine1 (randomRs (30,70) sGen) + +-- linear distribution +m2 :: Music Pitch +m2 = let rs1 = rands linear sGen + in mkLine1 (map toAbsP1 rs1) + +-- exponential distribution +m3 :: Float -> Music Pitch +m3 lam = let rs1 = rands (exponential lam) sGen + in mkLine1 (map toAbsP1 rs1) + +-- Gaussian distribution +m4 :: Float -> Float -> Music Pitch +m4 sig mu = let rs1 = rands (gaussian sig mu) sGen + in mkLine1 (map toAbsP1 rs1) +-- Gaussian distribution with mean set to 0 +m5 :: Float -> Music Pitch +m5 sig = let rs1 = rands (gaussian sig 0) sGen + in mkLine2 50 (map toAbsP2 rs1) + +-- exponential distribution with mean adjusted to 0 +m6 :: Float -> Music Pitch +m6 lam = let rs1 = rands (exponential lam) sGen + in mkLine2 50 (map (toAbsP2 . subtract (1/lam)) rs1) + +toAbsP2 :: Float -> AbsPitch +toAbsP2 x = round (5*x) + +mkLine2 :: AbsPitch -> [AbsPitch] -> Music Pitch +mkLine2 start rands = + line (take 64 (map mkNote1 (scanl (+) start rands))) +m2' = let rs1 = rands linear sGen + in sum (take 1000 rs1) / 1000 :: Float + +m5' sig = let rs1 = rands (gaussian sig 0) sGen + in sum (take 1000 rs1) + +m6' lam = let rs1 = rands (exponential lam) sGen + rs2 = map (subtract (1/lam)) rs1 + in sum (take 1000 rs2) +-- some sample training sequences +ps0,ps1,ps2 :: [Pitch] +ps0 = [(C,4), (D,4), (E,4)] +ps1 = [(C,4), (D,4), (E,4), (F,4), (G,4), (A,4), (B,4)] +ps2 = [ (C,4), (E,4), (G,4), (E,4), (F,4), (A,4), (G,4), (E,4), + (C,4), (E,4), (G,4), (E,4), (F,4), (D,4), (C,4)] + +-- functions to package up |run| and |runMulti| +mc ps n = mkLine3 (M.run n ps 0 (mkStdGen 42)) +mcm pss n = mkLine3 (concat (M.runMulti n pss 0 + (mkStdGen 42))) + +-- music-making functions +mkNote3 :: Pitch -> Music Pitch +mkNote3 = note tn + +mkLine3 :: [Pitch] -> Music Pitch +mkLine3 ps = line (take 64 (map mkNote3 ps)) +-- testing the Markov output directly +lc ps n = take 1000 (M.run n ps 0 (mkStdGen 42)) +lcl pss n m = take 1000 (M.runMulti n pss 0 (mkStdGen 42) !! m)
+ Euterpea/Examples/SSF.lhs view
@@ -0,0 +1,33 @@+The first phrase of the flute part of "Stars and Stripes Forever."++> module Euterpea.Examples.SSF where+> import Euterpea+>+> legato = Legato (11/10)+> staccato = Staccato (5/10)+>+> ssfMelody = line (m1 ++ m2 ++ m3 ++ m4)+> m1 = [ trilln 2 5 (bf 6 en),+> Modify (Phrase [Art staccato]) (line [ef 7 en,+> ef 6 en,+> ef 7 en])]+>+> m2 = [Modify (Phrase [Art legato]) (line [bf 6 sn,+> c 7 sn,+> bf 6 sn,+> g 6 sn]),+> Modify (Phrase [Art staccato]) (line [ef 6 en,+> bf 5 en])]+>+> m3 = [Modify (Phrase [Art legato]) (line [ef 6 sn,+> f 6 sn,+> g 6 sn,+> af 6 sn]),+> Modify (Phrase [Art staccato]) (line [bf 6 en,+> ef 7 en])]+>+> m4 = [ trill 2 tn (bf 6 qn),+> bf 6 sn,+> denr]+>+> ssf = Modify (Instrument Flute) ssfMelody
+ Euterpea/Examples/SelfSimilar.hs view
@@ -0,0 +1,66 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SelfSimilar.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Examples.SelfSimilar where +import Euterpea + +data Cluster = Cluster SNote [Cluster] +type SNote = (Dur,AbsPitch) +selfSim :: [SNote] -> Cluster +selfSim pat = Cluster (0,0) (map mkCluster pat) + where mkCluster note = + Cluster note (map (mkCluster . addMult note) pat) + +addMult :: SNote -> SNote -> SNote +addMult (d0,p0) (d1,p1) = (d0*d1,p0+p1) +fringe :: Int -> Cluster -> [SNote] +fringe 0 (Cluster note cls) = [note] +fringe n (Cluster note cls) = concatMap (fringe (n-1)) cls +simToMusic :: [SNote] -> Music Pitch +simToMusic = line . map mkNote + +mkNote :: (Dur,AbsPitch) -> Music Pitch +mkNote (d,ap) = note d (pitch ap) +ss pat n tr te = + transpose tr $ tempo te $ simToMusic $ fringe n $ selfSim pat +m0 :: [SNote] +m0 = [(1,2),(1,0),(1,5),(1,7)] + +tm0 = instrument Vibraphone (ss m0 4 50 20) +ttm0 = tm0 :=: transpose (12) (revM tm0) +m1 :: [SNote] +m1 = [(1,0),(0.5,0),(0.5,0)] + +tm1 = instrument Percussion (ss m1 4 43 2) +m2 :: [SNote] +m2 = [(dqn,0),(qn,4)] + +tm2 = ss m2 6 50 (1/50) +m3 :: [SNote] +m3 = [(hn,3),(qn,4),(qn,0),(hn,6)] + +tm3 = ss m3 4 50 (1/4) + +ttm3 = let l1 = instrument Flute tm3 + l2 = instrument AcousticBass $ + transpose (-9) (revM tm3) + in l1 :=: l2 + +m4 :: [SNote] +m4 = [ (hn,3),(hn,8),(hn,22),(qn,4),(qn,7),(qn,21), + (qn,0),(qn,5),(qn,15),(wn,6),(wn,9),(wn,19) ] + +tm4 = ss m4 3 50 8 +fringe' :: Int -> Cluster -> [[SNote]] +fringe' 0 (Cluster note cls) = [[note]] +fringe' n (Cluster note cls) = map (fringe (n-1)) cls +simToMusic' :: [[SNote]] -> Music Pitch +simToMusic' = chord . map (line . map mkNote) +ss' pat n tr te = + transpose tr $ tempo te $ simToMusic' $ fringe' n $ selfSim pat +ss1 = ss' m2 4 50 (1/8) +ss2 = ss' m3 4 50 (1/2) +ss3 = ss' m4 3 50 2 +m5 = [(en,4),(sn,7),(en,0)] +ss5 = ss m5 4 45 (1/500) +ss6 = ss' m5 4 45 (1/1000)
+ Euterpea/Examples/SigFuns.hs view
@@ -0,0 +1,65 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SigFuns.lhs. (See HSoM/MakeCode.bat.)++{-# LANGUAGE Arrows #-}++module Euterpea.Examples.SigFuns where++import Euterpea+import Control.Arrow ((>>>),(<<<),arr)+s1 :: Clock c => SigFun c () Double+s1 = proc () -> do+ s <- oscFixed 440 -< ()+ outA -< s+tab1 :: Table+tab1 = tableSinesN 4096 [1]+s2 :: Clock c => SigFun c () Double+s2 = proc () -> do+ osc tab1 0 -< 440+tab2 = tableSinesN 4096 [1.0,0.5,0.33]+s3 :: Clock c => SigFun c () Double+s3 = proc () -> do+ osc tab2 0 -< 440+s4 :: Clock c => SigFun c () Double+s4 = proc () -> do+ f0 <- oscFixed 440 -< ()+ f1 <- oscFixed 880 -< ()+ f2 <- oscFixed 1320 -< ()+ outA -< (f0 + 0.5*f1 + 0.33*f2) / 1.83+vibrato :: Clock c =>+ Double -> Double -> SigFun c Double Double+vibrato vfrq dep = proc afrq -> do+ vib <- osc tab1 0 -< vfrq+ aud <- osc tab2 0 -< afrq + vib * dep+ outA -< aud+s5 :: AudSF () Double+s5 = constA 1000 >>> vibrato 5 20+simpleClip :: Clock c => SigFun c Double Double+simpleClip = arr f where+ f x = if abs x <= 1.0 then x else signum x+time :: Clock c => SigFun c () Double+time = integral <<< constA 1+simpleInstr :: InstrumentName+simpleInstr = Custom "Simple Instrument"+myInstr :: Instr (AudSF () Double)+ -- |Dur -> AbsPitch -> Volume -> [Double] -> (AudSF () Double)|+myInstr dur ap vol [vfrq,dep] =+ proc () -> do+ vib <- osc tab1 0 -< vfrq+ aud <- osc tab2 0 -< apToHz ap + vib * dep+ outA -< aud+myInstrMap :: InstrMap (AudSF () Double)+myInstrMap = [(simpleInstr, myInstr)]+(dr, sf) = renderSF mel myInstrMap+main = outFile "simple.wav" dr sf+mel :: Music1+mel = + let m = Euterpea.line [ na1 (c 4 en), na1 (ef 4 en), na1 (f 4 en), + na2 (af 4 qn), na1 (f 4 en), na1 (af 4 en), + na2 (bf 4 qn), na1 (af 4 en), na1 (bf 4 en),+ na1 (c 5 en), na1 (ef 5 en), na1 (f 5 en),+ na3 (af 5 wn) ]+ na1 (Prim (Note d p)) = Prim (Note d (p,[Params [0, 0]]))+ na2 (Prim (Note d p)) = Prim (Note d (p,[Params [5,10]]))+ na3 (Prim (Note d p)) = Prim (Note d (p,[Params [5,20]]))+ in instrument simpleInstr m
+ Euterpea/Examples/SoundCheck.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE Arrows #-}++module Euterpea.Examples.SoundCheck where++import Euterpea++sineTable = tableSinesN 16384 [1]+sawtoothTable = tableSinesN 16384 + [1, 0.5, 0.3, 0.25, 0.2, 0.167, 0.14, 0.125, 0.111]++oscSine = osc sineTable 0++sine :: AudSF () Double+sine = + proc _ -> do+ oscSine -< 440++sine_am :: AudSF () Double+sine_am = + proc _ -> do+ amp <- oscSine -< 5+ s <- oscSine -< 440+ outA -< amp * s++sine_fm :: AudSF () Double+sine_fm = + proc _ -> do+ frq <- oscSine -< 3+ oscSine -< 330 + frq * 110 -- oscillates between 220 and 440 at 3 Hz++sine_fm2 :: AudSF () Double+sine_fm2 = + proc _ -> do+ modfrq <- oscSine -< 0.1+ frq <- oscSine -< 3 + modfrq * 100+ oscSine -< 330 + frq * 110 -- oscillates between 220 and 440 at 3 Hz++sawtooth :: AudSF () Double+sawtooth = + proc _ -> do+ osc sawtoothTable 0 -< 440++squareWave :: AudSF () Double+squareWave =+ proc _ -> do+ frq <- oscSine -< 1000+ outA -< if frq > 0 then 0.99 else -0.99++test :: AudSF () Double -> IO ()+test = outFile "test.wav" 3.0
+ Euterpea/Experimental.lhs view
@@ -0,0 +1,40 @@+++The experimental module for Euterpea includes several features that we believe +are not yet mature enough for prime time in Euterpea but that we would like +to include in the project as a whole. One should not rely on the features +found here as they may be removed or changed without thought to backwards +compatability.++> module Euterpea.Experimental (+> module Euterpea.IO.MUI.InstrumentWidgets+> -- The InstrumentWidgets module provides support for the piano and guitar+> -- MUI widgets.+> , asyncUISFV, asyncUISFE, clockedSFToUISF+> , runMidi, runMidiM, runMidiMFlood, runMidiMB, runMidiMBFlood+> -- These conversion functions are for lifting SFs into UISFs.+> , Automaton(..), toAutomaton+> -- The async function allows a signal function to run asynchronously. +> -- This can be especially useful for a hard computation that needs to be +> -- performed sporadically in the MUI.+> , quantize, presentFFT, fftA+> -- These functions are used for applying and using the result of a Fast +> -- Fourier Transform.+> , liftAIO -- :: (b -> IO c) -> a b c+> , initialAIO -- :: IO d -> (d -> a b c) -> a b c+> -- These two functions allow one to lift generic IO actions to a +> -- UISF. They should be used with care.+> , uisfSource, uisfSink, uisfPipe+> , uisfSourceE, uisfSinkE, uisfPipeE+> ) where++> import Euterpea.IO.MUI.UISFCompat+> import Euterpea.IO.MUI.InstrumentWidgets+> import Euterpea.IO.MUI.MidiWidgets+> import Euterpea.IO.MUI.FFT+> import FRP.UISF.AuxFunctions+> import FRP.UISF.UISF++++
+ Euterpea/ExperimentalPlay.lhs view
@@ -0,0 +1,310 @@+Special playback functions+Created by Donya Quick+Last modified: 27-Oct-2014++Experimental playback implementation.++> module Euterpea.ExperimentalPlay (+> play' -- new implementation of play+> ,playC -- custom playback implementation to replace playA, playS, playDev, etc.+> ,devices -- function that prints available MIDI device information+> ,musicToMsgs' -- music to MIDI message conversion+> ,linearCP -- linear channel assignment policy+> ,dynamicCP -- dynamic channel assignment policy+> ,predefinedCP -- user-specified channel map (for MUIs)+> ,defParams+> ,PlayParams(..)+> ) where+> import Codec.Midi hiding (Tempo)+> import Control.DeepSeq+> import Control.Monad+> import Control.Concurrent+> import Control.Exception+> import Data.List+> import Euterpea.IO.MIDI.MidiIO+> import Euterpea.IO.MIDI.ToMidi+> import Euterpea.Music.Note.Music+> import Euterpea.Music.Note.Performance+> import Sound.PortMidi++--------------------------+ | User-Level Functions |+--------------------------++Playback parameter data type.++> data PlayParams = PlayParams{+> pmap :: PMap Note1, -- player map+> ctxt :: Context Note1, -- context+> strict :: Bool, -- strict timing (False for infinite values)+> chanPolicy :: ChannelMapFun, -- channel assignment policy+> devID :: Maybe OutputDeviceID, -- output device (Nothing means to use the OS default)+> closeDelay :: Time -- delay in seconds to avoid truncated notes+> }++Default parameters are the default pmap+context, allowing for infinite playback, +using a linear channel assignment policy for 16 channels with percussion on +channel 9 (which is channel 10 when indexing from 1), using the default MIDI +device as set by the operating system, and using a closing delay of 1.0sec.++> defParams = PlayParams defPMap defCon False (linearCP 16 9) Nothing 1.0++New implementation of play using default parameters:++> play' :: (Performable a, NFData a) => Music a -> IO ()+> play' = playC defParams++"Custom play" interface:++> playC :: (Performable a, NFData a) => PlayParams -> Music a -> IO ()+> playC p = if strict p then playStrict p else playInf p++Getting a list of all MIDI input and output devices, showing both +their device IDs and names. ++> devices = do+> (devsIn, devsOut) <- getAllDevices+> let f (devid, devname) = " "++show devid ++ "\t" ++ name devname ++ "\n"+> strIn = concatMap f devsIn+> strOut = concatMap f devsOut+> putStrLn "\nInput devices: " >> putStrLn strIn +> putStrLn "Output devices: " >> putStrLn strOut+++------------------------------------+ | Supporting functions for playC |+------------------------------------++Strict playback: timing will be as close to perfect as possible, but the+Music value must be finite. Timing will be correct starting from the first +note, even if there is a long computation delay prior to any sound. ++> playStrict :: (Performable a, NFData a) => PlayParams -> Music a -> IO ()+> playStrict p m = m `deepseq`+> let x = toMidi (fst $ perfDur (pmap p) (ctxt p) m) defUpm +> in x `deepseq` playM' (devID p) x++> playM' :: Maybe OutputDeviceID -> Midi -> IO ()+> playM' devID midi = handleCtrlC $ do +> initialize+> (maybe (defaultOutput playMidi) playMidi devID) midi+> terminate+> return () where+> handleCtrlC :: IO a -> IO a+> handleCtrlC op = onException op terminate+++Infinite playback: arbitrarily long music values can be played, although +with the compromise that timing may be imperfect due to lazy evaluation of+the Music value. Delays may happen if a section of the Music value is time-+consuming to compute. Infinite parallelism is not supported.++> playInf :: Performable a => PlayParams -> Music a -> IO ()+> playInf p m = handleCtrlC $ do+> initializeMidi+> (maybe (defaultOutput playRec) playRec (devID p)) $ musicToMsgs' p m+> threadDelay $ round (closeDelay p * 1000000)+> terminateMidi+> return () where+> handleCtrlC :: IO a -> IO a+> handleCtrlC op = onException op terminateMidi++> playRec dev [] = return ()+> playRec dev (x@(t,m):ms) = +> if t > 0 then threadDelay (toMicroSec t) >> playRec dev ((0,m):ms) else +> let mNow = x : takeWhile ((<=0).fst) ms+> mLater = drop (length mNow - 1) ms+> in doMidiOut dev (Just $ mNow) >> playRec dev mLater where+> doMidiOut dev Nothing = outputMidi dev+> doMidiOut dev (Just ms) = do+> outputMidi dev+> mapM_ (\(t,m) -> deliverMidiEvent dev (0, m)) ms+> toMicroSec x = round (x * 1000000)+++---------------------------------+ | Music to Message conversion |+---------------------------------++Music to message conversion will take place differently depending+on the channel assignment method. Using linearCP will assign the first +n instruments to channels 0 through n-1 (or 1 through n). Using +dynamicCP will fill up n channels and then replace the last-used +instrument's channel with the new instrument.++Some synthesizers only recognize 10 unique channels, others use the+full 16 allowed by general MIDI. Drums are usually on channel 9 +(channel 10 when indexing from 1), but not always. Sometimes drums+can be assigned to a custom channel.++A ChannelMap stores which instrument is assigned to which channel.+This table is built automatically when playing a Music value; the+user does not need to worry about constructing it.++> type ChannelMap = [(InstrumentName, Channel)]++Given an InstrumentName and a ChannelMap, a ChannelMapFun picks a new+channel to assign to the instrument and retruns both that and the +updated ChannelMap. This is done each time a new InstrumentName is+encountered (in other words, it is not in the current ChannelMap).++> type ChannelMapFun = InstrumentName -> ChannelMap -> (Channel, ChannelMap)++The function below first converts to ANote values and then to Std On/Off +pairs. This is needed to avoid timing issues associated with using ANote+and trying to call terminateMIDI, since if there is an ANote at the end+it will sometimes have its NoteOff lost, which can cause errors.++> musicToMsgs' :: (Performable a) => PlayParams -> Music a -> [(Time, MidiMessage)]+> musicToMsgs' p m = +> let (perf,dt) = perfDur (pmap p) (ctxt p) m -- obtain the performance +> evsA = channelMap (chanPolicy p) [] perf -- time-stamped ANote values+> evs = stdMerge evsA -- merged On/Off events sorted by absolute time+> times = map fst evs -- absolute times in seconds+> newTimes = zipWith subtract (head times : times) times -- relative times+> in zip newTimes (map snd evs) where+> -- stdMerge: converts ANotes into a sorted list of On/Off events+> stdMerge :: [(Time, MidiMessage)] -> [(Time, MidiMessage)]+> stdMerge [] = []+> stdMerge ((t,ANote c k v d):es) = +> (t, Std $ NoteOn c k v) : +> stdMerge (insertBy (\(a,b) (x,y) -> compare a x) (t+d, Std $ NoteOff c k v) es) +> stdMerge (e1:es) = e1 : stdMerge es +> -- channelMap: performs instrument assignment for a list of Events+> channelMap :: ChannelMapFun -> ChannelMap -> [Event] -> [(Time, MidiMessage)]+> channelMap cf cMap [] = []+> channelMap cf cMap (e:es) = +> let i = eInst e+> ((chan, cMap'), newI) = case lookup i cMap of Nothing -> (cf i cMap, True)+> Just x -> ((x, cMap), False)+> e' = (fromRational (eTime e), +> ANote chan (ePitch e) (eVol e) (fromRational $ eDur e)) +> es' = channelMap cf cMap' es+> iNum = if i==Percussion then 0 else fromEnum i+> in if newI then (fst e', Std $ ProgramChange chan iNum) : e' : es' +> else e' : es' ++The linearCP channel map just fills up channels left to right until it hits +the maximum number and then throws an error. Percussion is handled as a +special case.++> type NumChannels = Int -- maximum number of channels (i.e. 0-15 is 16 channels)+> type PercChan = Int -- percussion channel, using indexing from zero++> linearCP :: NumChannels -> PercChan -> ChannelMapFun +> linearCP cLim pChan i cMap = if i==Percussion then (pChan, (i,pChan):cMap) else +> let n = length $ filter ((/=Percussion). fst) cMap+> newChan = if n>=pChan then n+1 else n -- step over the percussion channel +> in if newChan < cLim then (newChan, (i, newChan) : cMap) else+> error ("Cannot use more than "++show cLim++" instruments.") ++For the dynamicCP channel map, new assignements are added in the left side +of the channel map/list. This means that the item farthest to the right +is the oldest and should be replaced when the table is full. Percussion+is handled separately.++> dynamicCP :: NumChannels -> PercChan -> ChannelMapFun +> dynamicCP cLim pChan i cMap = +> if i==Percussion then (pChan, (i, pChan):cMap) else+> let cMapNoP = filter ((/=Percussion). fst) cMap+> extra = if length cMapNoP == length cMap then [] else [(Percussion, pChan)]+> newChan = snd $ last cMapNoP +> in if length cMapNoP < cLim - 1 then linearCP cLim pChan i cMap+> else (newChan, (i, newChan) : (take (length cMapNoP - 1) cMapNoP)++extra)+++A predefined policy will send instruments to user-defined channels. If new+instruments are found that are not accounted for, an error is thrown.++> predefinedCP :: ChannelMap -> ChannelMapFun+> predefinedCP cMapFixed i _ = case lookup i cMapFixed of +> Nothing -> error (show i ++ " is not included in the channel map.")+> Just c -> (c, cMapFixed)++-------------------------------+ | NFData instances for Midi |+-------------------------------++> instance NFData FileType where+> rnf x = ()++> instance NFData TimeDiv where+> rnf (TicksPerBeat i) = rnf i+> rnf (TicksPerSecond i j) = rnf j `seq` rnf i++> instance NFData Midi where+> rnf (Midi ft td ts) = rnf ft `seq` rnf td `seq` rnf ts++> instance NFData Message where+> rnf (NoteOff c k v) = rnf c `seq` rnf k `seq` rnf v+> rnf (NoteOn c k v) = rnf c `seq` rnf k `seq` rnf v+> rnf (KeyPressure c k v) = rnf c `seq` rnf k `seq` rnf v+> rnf (ProgramChange c v) = rnf c `seq` rnf v+> rnf (ChannelPressure c v) = rnf c `seq` rnf v+> rnf (PitchWheel c v) = rnf c `seq` rnf v+> rnf (TempoChange t) = rnf t+> rnf x = () -- no other message types are currently used by Euterpea++> instance NFData MidiMessage where +> rnf (Std m) = rnf m+> rnf (ANote c k v d) = rnf c `seq` rnf k `seq` rnf v `seq` rnf d+++--------------------------------+ | NFData instances for Music |+--------------------------------++> instance NFData a => NFData (Music a) where+> rnf (a :+: b) = rnf a `seq` rnf b+> rnf (a :=: b) = rnf a `seq` rnf b+> rnf (Prim p) = rnf p+> rnf (Modify c m) = rnf c `seq` rnf m++> instance NFData a => NFData (Primitive a) where+> rnf (Note d a) = rnf d `seq` rnf a+> rnf (Rest d) = rnf d++> instance NFData Control where+> rnf (Tempo t) = rnf t+> rnf (Transpose t) = rnf t+> rnf (Instrument i) = rnf i+> rnf (Phrase xs) = rnf xs+> rnf (Player p) = rnf p+> rnf (KeySig r m) = rnf r `seq` rnf m++> instance NFData PitchClass where+> rnf p = ()++> instance NFData Mode where+> rnf x = ()++> instance NFData PhraseAttribute where+> rnf (Dyn d) = rnf d+> rnf (Tmp t) = rnf t+> rnf (Art a) = rnf a+> rnf (Orn o) = rnf o++> instance NFData Dynamic where+> rnf (Accent r) = rnf r+> rnf (Crescendo r) = rnf r+> rnf (Diminuendo r) = rnf r+> rnf (StdLoudness x) = rnf x+> rnf (Loudness r) = rnf r++> instance NFData StdLoudness where+> rnf x = ()++> instance NFData Articulation where+> rnf (Staccato r) = rnf r+> rnf (Legato r) = rnf r+> rnf x = ()++> instance NFData Ornament where+> rnf x = ()++> instance NFData Tempo where+> rnf (Ritardando r) = rnf r+> rnf (Accelerando r) = rnf r++> instance NFData InstrumentName where+> rnf x = ()
+ Euterpea/IO/Audio.hs view
@@ -0,0 +1,14 @@+module Euterpea.IO.Audio+ ( module Euterpea.IO.Audio.BasicSigFuns,+ module Euterpea.IO.Audio.Basics,+ module Euterpea.IO.Audio.Types,+ module Euterpea.IO.Audio.IO,+ module Euterpea.IO.Audio.Render+ ) where++import Euterpea.IO.Audio.BasicSigFuns+import Euterpea.IO.Audio.Basics+import Euterpea.IO.Audio.Types+import Euterpea.IO.Audio.IO+import Euterpea.IO.Audio.Render+
+ Euterpea/IO/Audio/BasicSigFuns.lhs view
@@ -0,0 +1,1270 @@+> {-# LANGUAGE Arrows, TemplateHaskell, BangPatterns, +> ExistentialQuantification, FlexibleContexts, +> FunctionalDependencies, ScopedTypeVariables,+> NoMonomorphismRestriction #-}++Euterpea adaptation of some unit generators from csound+-------------------------------------------------------++Conventions: ++(1) Optional arguments in some csound unit generators sometimes carry+different semantics depending on the way the generator is called.+Here they are encoded as algebraic datatypes instead (see 'pluck' for+example). A single optional argument is normally encoded using+Haskell's Maybe type.++(2) csound's i-type is updated only once on every note's+initialization pass. They are represented as unlifted arguments here+(i.e. non-signal).++(3) Many unit generators in csound take a signal 'amp' as input, which+scales its result by 'amp'. Since this feature induces computational+overhead when scaling is not needed, and is easily expressed using+arrow syntax when needed, we omit that functionality from Eutperpea's+versions of the unit generators.++> module Euterpea.IO.Audio.BasicSigFuns (+> Table,+> pluck,+> PluckDecayMethod(..),+> balance,+> tableExponN,+> tableExpon,+> tableLinearN,+> tableLinear,+> tableSines3N,+> tableSines3,+> tableSinesN,+> tableSines,+> tableBesselN,+> tableBessel,+> filterLowPass,+> filterHighPass,+> filterBandPass,+> filterBandStop,+> filterLowPassBW,+> filterHighPassBW,+> filterBandPassBW,+> filterBandStopBW,+> filterComb,+> osc,+> oscI,+> oscFixed,+> oscDur,+> oscDurI,+> oscPartials,+> envLine,+> envExpon,+> envLineSeg,+> envExponSeg,+> envASR,+> envCSEnvlpx,+> noiseWhite, noiseBLI, noiseBLH,+> delayLine, delayLine1, delayLineT,+> samples, milliseconds, seconds, countTime+> ) where++> -- oscil, oscili, oscils, oscil1, oscil1i,+> -- table, tablei, tableIx, tableiIx,+> -- buzz,+> -- delayt, +> -- delay, vdelay,+> -- comb,+> -- reson, areson,+> -- tone, atone,+> -- rand, randi, randh,+> -- line, +> -- expon, linseg, expseg, linen, +> -- envlpx,+> -- integral,+> -- gen05, gen05', exponential1,+> -- gen07, gen07', lineSeg1,+> -- gen09, gen09', compSine2,+> -- gen10, gen10', compSine1,+> -- gen12, gen12',+> -- butterlp, butterhp, butterbp, butterbr,++> import Prelude hiding (init)++> import Euterpea.IO.Audio.Basics+> import Euterpea.IO.Audio.Types+> import Control.Arrow+> import Control.CCA.ArrowP+> import Control.CCA.Types+> import FRP.UISF.AuxFunctions (SEvent, constA)+> import Data.Array.Base (unsafeAt)+> import Data.Array.Unboxed++> import Language.Haskell.TH+> import Language.Haskell.TH.Syntax++> import Foreign.Marshal+> import Foreign.Ptr+> import Foreign.Storable++> import GHC.IO+> import System.Random++Helper Functions+----------------++> wrap :: (Ord n, Num n) => n -> n -> n+> wrap val bound = if val > bound then wrap val (val-bound) else val++> clip :: Ord n => n -> n -> n -> n+> clip val lower upper +> | val <= lower = lower+> | val >= upper = upper+> | otherwise = val++Raises 'a' to the power 'b' using logarithms.++> pow :: Floating a => a -> a -> a+> pow a b = exp (log a * b)++Returns the fractional part of 'x'.++> frac :: RealFrac r => r -> r+> frac = snd . properFraction++Table Creation and Access+-------------------------++A Table is essentially a UArray.++> data Table = Table +> !Int -- size+> !(UArray Int Double) -- table implementation+> ExpQ -- TH expression to construct +> -- the table at compile time+> !Bool -- Whether the table is normalized++> instance Show Table where+> show (Table sz a _ n) = "Table with " ++ show sz ++ " entries: " ++ +> show a++> instance Language.Haskell.TH.Syntax.Lift Table where+> lift (Table sz uarr fexp norm) =+> [| funToTable ($(fexp)) fexp norm sz |]++> funToTable :: (Double->Double) -> ExpQ -> Bool -> Int -> Table+> funToTable f f' normalize size = +> let delta = 1 / fromIntegral size+> ys = take size (map f [0, delta.. ]) ++ [head ys]+> -- make table one size larger as an extended guard point+> zs = if normalize then map (/ maxabs ys) ys else ys+> maxabs = maximum . map abs+> in Table size (listArray (0, size) zs) f' normalize++> readFromTable :: Table -> Double -> Double+> readFromTable (Table sz array _ _) pos = +> let idx = truncate (fromIntegral sz * pos) -- range must be [0,size]+> in array `unsafeAt` idx+> {-# INLINE [0] readFromTable #-}++> readFromTableA :: ArrowInit a => Table -> a Double Double+> readFromTableA t = arr' [| readFromTable t |] (readFromTable t)++> readFromTableRaw :: Table -> Int -> Double+> readFromTableRaw (Table _ a _ _) idx = a `unsafeAt` idx++Like readFromTable, but with linear interpolation.++> readFromTablei :: Table -> Double -> Double+> readFromTablei (Table sz array _ _) pos = +> let idx = fromIntegral sz * pos -- fractional "index" in table ([0,sz])+> idx0 = (truncate idx) `mod` sz :: Int+> idx1 = idx0 + 1 :: Int+> val0 = array `unsafeAt` idx0+> val1 = array `unsafeAt` idx1+> in val0 + (val1 - val0) * (idx - fromIntegral idx0)+> {-# INLINE [0] readFromTablei #-}++> readFromTableiA :: ArrowInit a => Table -> a Double Double+> readFromTableiA t = arr' [| readFromTablei t |] (readFromTablei t)++Accesses table values by direct indexing with linear interpolation.+The index 'pos' is expected to be normalized (between 0 and 1). Values+out of bounds are either clipped or wrapped.++> tablei :: (Clock p, ArrowInit a) => +> Table -- Table to read from.+> -> Bool -- Whether to wrap around index; +> -- if not, index is clipped within bounds+> -> ArrowP a p Double Double+> tablei tab True =+> proc pos -> do +> outA -< readFromTablei tab (wrap pos 1)+> tablei tab False =+> proc pos -> do+> outA -< readFromTablei tab (clip pos 0 1)++Accesses table values by direct indexing; the index is normalized+(between 0 and 1).++> table :: (Clock p, ArrowInit a) => Table -> Bool -> ArrowP a p Double Double+> table tab True =+> proc pos -> do +> outA -< readFromTable tab (wrap pos 1)+> table tab False =+> proc pos -> do+> outA -< readFromTable tab (clip pos 0 1)++Like tablei, but the index is interpreted as a raw value (between 0+and (size of table - 1), inclusive).++> tableiIx :: (Clock p, ArrowInit a) => +> Table -> Bool -> ArrowP a p Double Double+> tableiIx tab@(Table sz array _ _) True =+> proc idx -> do+> let idx0 = (truncate idx) `mod` sz+> val0 = readFromTableRaw tab idx0+> val1 = readFromTableRaw tab (idx0 + 1)+> outA -< val0 + (val1 - val0) * (idx - fromIntegral idx0)+> tableiIx tab@(Table sz _ _ _) False =+> proc idx -> do+> let pos = idx / fromIntegral (sz-1)+> outA -< readFromTablei tab (clip pos 0 1)++Like table, but index interpreted as raw value.++> tableIx :: (Clock p, ArrowInit a) => Table -> Bool -> ArrowP a p Double Double+> tableIx tab@(Table sz array _ _) True =+> proc idx -> do+> outA -< readFromTableRaw tab (truncate idx `mod` (sz-1))+> tableIx tab@(Table sz array _ _) False =+> proc idx -> do+> outA -< readFromTableRaw tab (clip (truncate idx) 0 (sz-1))++Oscillators+-----------++'osc' generates periodic signals consisting of the values returned+from sampling a stored function table. The internal phase is+simultaneously advanced in accordance with the input signal 'freq'.++> osc :: (Clock p, ArrowInit a) =>+> Table +> -> Double -- Initial phase of sampling, expressed as a+> -- fraction of a cycle (0 to 1).+> -> ArrowP a p Double Double+> osc table iphs = osc_ iphs >>> readFromTableA table++'oscI' is like 'osc', but with linear interpolation.++> oscI :: (Clock p, ArrowInit a) => +> Table +> -> Double +> -> ArrowP a p Double Double+> oscI table iphs = osc_ iphs >>> readFromTableiA table++Helper function for osc and oscI.++> osc_ :: forall p a. (Clock p, ArrowInit a) => +> Double -> ArrowP a p Double Double+> osc_ phs = +> let sr = rate (undefined :: p)+> in proc freq -> do+> rec +> let delta = 1 / sr * freq+> phase = if next > 1 then frac next else next+> next <- init phs -< frac (phase + delta)+> outA -< phase++Simple, fast sine oscillator, that uses only one multiply and two add+operations to generate one sample of output, and does not require a+function table.++> oscFixed :: forall p a . (Clock p, ArrowInit a) =>+> Double -> ArrowP a p () Double+> oscFixed freq =+> let omh = 2 * pi * freq / sr+> d = sin omh+> c = 2 * cos omh+> sr = rate (undefined :: p)+> sf = proc () -> do+> rec+> let r = c * d2 - d1+> d1 <- init 0 -< d2+> d2 <- init d -< r+> outA -< r+> in sf++'oscDur' accesses values by sampling once through the function table+at a rate determined by 'dur'. For the first 'del' seconds, the point+of scan will reside at the first location of the table; it will then+begin moving through the table at a constant rate, reaching the end in+another 'dur' seconds; from that time on (i.e. after 'del' + 'dur'+seconds) it will remain pointing at the last location. ++> oscDur :: (Clock p, ArrowChoice a, ArrowInit a) =>+> Table+> -> Double+> -- delay in seconds before 'oscDur' incremental sampling begins+> -> Double+> -- duration in seconds to sample through the table just once.+> -> ArrowP a p () Double+> oscDur = oscDur_ osc++Like 'oscDur', but with linear interpolation.++> oscDurI :: (Clock p, ArrowChoice a, ArrowInit a) => +> Table+> -> Double +> -- delay in seconds before 'oscDur' incremental sampling begins.+> -> Double +> -- duration in seconds to sample through the table just once.+> -> ArrowP a p () Double+> oscDurI = oscDur_ oscI++Helper function for oscDur and oscDurI.++> oscDur_ :: forall p a . (Clock p, ArrowChoice a, ArrowInit a) => +> (Table -> Double -> ArrowP a p Double Double)+> -> Table -> Double -> Double -> ArrowP a p () Double+> oscDur_ osc table@(Table sz _ _ _) del dur =+> let sr = rate (undefined :: p)+> t1 = del * sr+> t2 = t1 + dur * sr+> v0 = readFromTableRaw table 0+> v2 = readFromTableRaw table (sz-1)+> in proc () -> do+> i <- countUp -< ()+> let i' = fromIntegral i+> y <- case (i' < t1, i' < t2) of+> (True, _) -> outA -< v0+> (False, True) -> osc table 0 -< 1 / dur+> (False, False) -> outA -< v2+> outA -< y++These are not implemented.++> foscil, foscili :: (Clock p, ArrowInit a) => +> Table -> ArrowP a p (Double,Double,Double,Double) Double+> foscil table =+> proc (freq,carfreq,modfreq,modindex) -> do+> outA -< 0++> foscili table =+> proc (freq,carfreq,modfreq,modindex) -> do+> outA -< 0++> loscil :: (Clock p, ArrowInit a) => Table -> ArrowP a p Double Double+> loscil table = +> proc freq -> do+> outA -< 0++Output a set of harmonically related sine partials.++> oscPartials :: forall p . Clock p => +> Table -- table containing a sine wave;+> -- a table size of at least 8192 is recommended.+> -> Double -- initial phase of the fundamental frequency,+> -- expressed as a fraction of a cycle (0 to 1).+> -> Signal p (Double,Int) Double +> -- 'freq' is the fundamental frequency in cycles per +> -- second; 'nharms' is the number of harmonics requested.+> oscPartials table initialPhase =+> let sr = rate (undefined :: p)+> in proc (freq, nharms) -> do+> rec+> let delta = 1 / sr * freq+> phase = if next > 1 then frac next else next+> next <- init initialPhase -< frac (phase + delta)+> outA -< sum [ readFromTable table (frac (phase * fromIntegral pn)) | +> pn <- [1..nharms] ]+> / fromIntegral nharms++Pluck+-----++> instance Lift PluckDecayMethod where+> lift SimpleAveraging = [| SimpleAveraging |]+> lift (WeightedAveraging a b) = [| WeightedAveraging a b |]+> lift _ = error "Euterpea.IO.Audio.BasicSigFuns: Lift PluckDecayMethod not yet defined (in TODO)"+> -- TODO: rest of the methods++> data PluckDecayMethod+> = SimpleAveraging+> -- A simple smoothing process.+> | StretchedAveraging Double +> -- Smoothing time stretched by a factor.+> | SimpleDrum Double+> -- The range from pitch to noise is controlled by a 'roughness+> -- factor' (0 to 1). Zero gives the plucked string effect, while+> -- 1 reverses the polarity of every sample (octave down, odd+> -- harmonics). The setting .5 gives an optimum snare drum.+> | StretchedDrum Double Double +> -- Combines both roughness and stretch factors. parm1 is+> -- roughness (0 to 1), and parm2 the stretch factor (=1).+> | WeightedAveraging Double Double +> -- As SimpleAveraging, with parm1 weighting the current sample+> -- (the status quo) and iparm2 weighting the previous adjacent+> -- one. iparm1 + iparm2must be <= 1.+> | RecursiveFilter+> -- 1st order recursive filter, with coefs .5. Unaffected by+> -- parameter values.++> pluck :: forall p . Clock p => +> Table -> Double -> PluckDecayMethod -> Signal p Double Double+> pluck table pitch method = +> let sr = rate (undefined :: p) +> in proc cps -> do+> rec +> z <- delayLineT (max 64 (truncate (sr / pitch))) table -< y+> z' <- init 0 -< z+> let y = case method of +> SimpleAveraging -> 0.5 * (z + z') +> -- or is this "RecursiveFilter?"+> WeightedAveraging a b -> z * a + z' * b+> _ -> error "pluck: method not implemented"+> outA -< y++Grain+-----++Not implemented.++> grain :: Table +> -- Grain waveform. This can be just a sine wave or a sampled sound. +> -> Table+> -- Amplitude envelope used for the grains.+> -> Double+> -- Maximum grain duration in seconds. This is the biggest+> -- value to be assigned to 'gdur'.+> -> Bool+> -- If 'True', all grains will begin reading from the+> -- beginning of the 'gfn' table. If 'False', grains+> -- will start reading from random 'gfn' table positions.+> -> Signal p (Double,Double,Double,Double,Double) Double+> grain gfn wfn mgdur grnd = +> proc (pitch,dens,ampoff,pitchoff,gdur) -> do+> outA -< 0++Delay Lines+-----------++csound's delayr and delayw are not implemented -- instead, one can use+a fixed-time delay with native recursive arrow syntax to achieve+modified feedback loops.++> data Buf = Buf !Int !(Ptr Double)++> instance Lift Buf where+> lift (Buf sz _) = [| mkArr sz |]++> updateBuf :: Buf -> Int -> Double -> IO Double+> updateBuf (Buf _ a) i u = a `seq` i `seq` u `seq` do+> let p = a `advancePtr` i+> x' <- peek p+> poke p u+> return x'++> peekBuf (Buf sz a) i = peek (a `advancePtr` (min (sz-1) i))++TODO: deal with pre-initialized buffers++> mkArr :: Int -> Buf+> mkArr n = n `seq` Buf n (unsafePerformIO $ +> Foreign.Marshal.newArray (replicate n 0))++> mkArrWithTable size t = Buf size (unsafePerformIO $+> Foreign.Marshal.newArray (map (readFromTable t) [0, (1/sz)..((sz-1)/sz)]))+> where sz = fromIntegral size++A fixed-length delay line, initialized using a table.++> delayLineT :: forall p . Clock p => +> Int -> Table -> Signal p Double Double+> delayLineT size table =+> let sr = rate (undefined :: p)+> buf = mkArrWithTable size table+> in proc x -> do+> rec+> let i' = if i == size-1 then 0 else i+1+> i <- init 0 -< i'+> y <- init 0 -< x +> -- TODO: this proc can't be strict on x, but how can we +> -- deal with strictness better without this hack?+> outA -< unsafePerformIO $ updateBuf buf i y++A fixed-length delay line.++> delayLine :: forall p . Clock p => +> Double -> Signal p Double Double+> delayLine maxdel =+> let sr = rate (undefined :: p)+> sz = truncate (sr * maxdel)+> buf = mkArr sz+> in proc x -> do+> rec+> let i' = if i == sz-1 then 0 else i+1+> i <- init 0 -< i'+> y <- init 0 -< x +> outA -< unsafePerformIO $ updateBuf buf i y++delay line with one tap.++> delayLine1 :: forall p . Clock p => Double -> Signal p (Double, Double) Double+> delayLine1 maxdel =+> let sr = rate (undefined :: p)+> sz = truncate (sr * maxdel)+> buf = mkArr sz+> in proc (sig,dlt) -> do+> rec+> let i' = if i == sz-1 then 0 else i+1+> dl = min maxdel dlt+> tap = i - truncate (sr * dl)+> tapidx = if tap < 0 then sz + tap else tap+> i <- init 0 -< i'+> y <- init 0 -< sig+> outA -< unsafePerformIO $ do+> s <- peekBuf buf tapidx+> _ <- updateBuf buf i y+> return s++delay line with two taps.++> delay2 :: Double -> Signal p (Double, Double, Double) Double+> delay2 maxdel = +> proc (sig, dlt1, dlt2) -> do+> outA -< 0++delay line with three taps.++> delay3 :: Double -> Signal p (Double, Double, Double, Double) Double+> delay3 maxdel = +> proc (sig, dlt1, dlt2, dlt3) -> do+> outA -< 0++delay line with four taps.++> delay4 :: Double -> Signal p (Double, Double, Double, Double, Double) Double+> delay4 maxdel = +> proc (sig, dlt1, dlt2, dlt3, dlt4) -> do+> outA -< 0++> instance Language.Haskell.TH.Syntax.Lift StdGen where+> lift g = [| g |]++Noise Generators+----------------++Analogous to rand, randi, and randh in csound.++Generate uniform white noise with an R.M.S value of 1 / sqrt 2, where+'seed' is the random seed.++> noiseWhite :: Int -> Signal p () Double+> noiseWhite seed =+> let gen = mkStdGen seed+> in proc () -> do+> rec+> let (a,g') = random g :: (Double,StdGen)+> g <- init gen -< g'+> outA -< a * 2 - 1++Controlled band-limited noise with interpolation between each new+number, and with an RMS value of 1 / sqrt 2.+'cps' controls how fast the new numbers are generated.+'seed' is the random seed.++> noiseBLI :: forall p . Clock p => Int -> Signal p Double Double+> noiseBLI seed =+> let sr = rate (undefined :: p)+> gen = mkStdGen seed+> (i_n1, i_g1) = random gen :: (Double,StdGen)+> (i_n2, i_g2) = random i_g1 :: (Double,StdGen)+> i_pr = (i_n1, i_n2, i_g2)+> in proc cps -> do+> let bound = sr / cps+> rec+> state <- init (0, i_pr) -< state'+> let (cnt, pr@(n1, n2, g)) = state+> n = n1 + (n2 - n1) * cnt / bound+> state' = if cnt + 1 < bound +> then (cnt + 1, pr)+> else let (n3, g') = random g :: (Double,StdGen)+> in (0, (n2, n3, g'))+> outA -< n * 2 - 1++Controlled band-limited noise without interpolation (holds+previous value instead), and with an RMS value of 1 / sqrt 2.+'cps' controls how fast the new numbers are generated.+'seed' is the random seed.++> noiseBLH :: forall p . Clock p => Int -> Signal p Double Double+> noiseBLH seed =+> let sr = rate (undefined :: p)+> gen = mkStdGen seed+> (i_n1, i_g) = random gen :: (Double,StdGen)+> i_pr = (i_n1, i_g)+> in proc cps -> do+> let bound = sr / cps+> rec+> state <- init (0, i_pr) -< state'+> let (cnt, pr@(n, g)) = state+> state' = if cnt + 1 < bound +> then (cnt + 1, pr)+> else let (n', g') = random g :: (Double,StdGen)+> in (0, (n', g'))+> outA -< n * 2 - 1++Gain Adjustment+---------------++Adjusts RMS amplitude of 'sig' so that it matches RMS amplitude of 'ref'.++> balance :: forall p . Clock p =>+> Int -> Signal p (Double, Double) Double+> balance ihp =+> proc (sig, ref) -> do+> rec+> (sqrsum, refsum) <- init (0, 0) -< (sqrsum', refsum')+> let sqrsum' = c1 * sig * sig + c2 * sqrsum+> refsum' = c1 * ref * ref + c2 * refsum+> ratio = if sqrsum == 0 then sqrt $ refsum+> else sqrt $ refsum / sqrsum+> outA -< sig * ratio+> where sr = rate (undefined :: p)+> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr+> b = 2 - cos (fromIntegral ihp * tpidsr)+> c1 = 1 - c2+> c2 = b - sqrt (b * b - 1)++Filters+-------++> data BandPassData = BandPassData{ +> rsnKcf :: !Double+> , rsnKbw :: !Double+> , rsnCosf :: !Double+> , rsnC1 :: !Double+> , rsnC2 :: !Double+> , rsnC3 :: !Double+> , rsnYt1 :: !Double+> , rsnYt2 :: !Double+> }+> rsnDefault :: BandPassData+> rsnDefault = BandPassData (-1) (-1) 0 0 0 0 0 0++A second-order resonant (band pass) filter.++Analogous to csound's 'reson' routine.++> filterBandPass :: forall p . Clock p =>+> Int -- 'scale': 1 signifies a peak response factor of 1, i.e. all+> -- frequencies other than kcf are attenuated in accordance with+> -- the (normalized) response curve; 2 raises the response+> -- factor so that its overall RMS value equals 1; 0 ignifies+> -- no scaling of the signal, leaving that to some later+> -- adjustment (like balance).+> -> Signal p (Double, Double, Double) Double+> -- 'sig' is the signal to be filtered,+> -- 'kcf' is the center frequency of the filter,+> -- and 'kbw' is the bandwidth of it.+> filterBandPass scale =+> proc (sig, kcf, kbw) -> do+> rec+> rsnData <- init rsnDefault -< rsnData'+> currData <- if kcf == rsnKcf rsnData && kbw == rsnKbw rsnData+> then outA -< rsnData+> else update -< (rsnData, kcf, kbw)+> let BandPassData{ rsnC1 = c1, rsnC2 = c2, rsnC3 = c3,+> rsnYt1 = yt1, rsnYt2 = yt2 } = currData+> a = c1 * sig + c2 * yt1 - c3 * yt2+> rsnData' = currData{ rsnYt1 = a, rsnYt2 = yt1 }+> outA -< a+> where sr = rate (undefined :: p)+> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr+> update = proc (rsnData, kcf, kbw) -> do+> -- kcf or kbw changed, recalc consts+> let cosf = cos $ kcf * tpidsr -- cos (2pi * freq / rate)+> c3 = exp $ - kbw * tpidsr -- exp (-2pi * bwidth / rate)+> -- (note on csound code) mtpdsr = -tpidsr+> -- c1 Gain for input signal.+> -- c2 (Minused) gain for output of delay 1.+> -- c3 Gain for output of delay 2.+> c3p1 = c3 + 1+> c3t4 = c3 * 4+> c2 = c3t4 * cosf / c3p1+> omc3 = 1 - c3+> c2sqr = c2 * c2+> c1 = case scale of+> 1 -> omc3 * sqrt (1 - c2sqr / c3t4)+> 2 -> sqrt $ (c3p1 * c3p1 - c2sqr) * omc3 / c3p1+> _ -> 1.0+> outA -< rsnData{ rsnKcf = kcf, rsnKbw = kbw, rsnCosf = cosf,+> rsnC1 = c1, rsnC2 = c2, rsnC3 = c3 }++A band stop filter whose transfer function is the complement of+filterBandPass.++Analogous to csound's 'areson' routine.++> filterBandStop :: forall p. Clock p =>+> Int -> Signal p (Double, Double, Double) Double+> filterBandStop scale = proc (sig, kcf, kbw) -> do+> r <- filterBandPass scale -< (sig, kcf, kbw)+> outA -< sig - r++> data ButterData = ButterData !Double !Double !Double !Double !Double++> sqrt2 :: Double+> sqrt2 = sqrt 2++> blpset :: Double -> Double -> ButterData+> blpset freq sr = ButterData a1 a2 a3 a4 a5+> where c = 1 / tan (pidsr * freq)+> csq = c * c; pidsr = pi / sr+> a1 = 1 / (1 + sqrt2 * c + csq)+> a2 = 2 * a1+> a3 = a1+> a4 = 2 * (1 - csq) * a1+> a5 = (1 - sqrt2 * c + csq) * a1++> bhpset :: Double -> Double -> ButterData+> bhpset freq sr = ButterData a1 a2 a3 a4 a5+> where c = tan (pidsr * freq)+> csq = c * c; pidsr = pi / sr+> a1 = 1 / (1 + sqrt2 * c + csq)+> a2 = (-2) * a1+> a3 = a1+> a4 = 2 * (csq - 1) * a1+> a5 = (1 - sqrt2 * c + csq) * a1++> bbpset :: Double -> Double -> Double -> ButterData+> bbpset freq band sr = ButterData a1 a2 a3 a4 a5+> where c = 1 / tan (pidsr * band)+> d = 2 * cos (2 * pidsr * freq)+> pidsr = pi / sr+> a1 = 1 / (1 + c)+> a2 = 0+> a3 = negate a1+> a4 = negate (c * d * a1)+> a5 = (c - 1) * a1++> bbrset :: Double -> Double -> Double -> ButterData+> bbrset freq band sr = ButterData a1 a2 a3 a4 a5+> where c = tan (pidsr * band)+> d = 2 * cos (2 * pidsr * freq)+> pidsr = pi / sr+> a1 = 1 / (1 + c)+> a2 = negate d * a1+> a3 = a1+> a4 = a2+> a5 = (1 - c) * a1++A second-order low-pass Butterworth filter, where 'sig' is the input+signal to be filtered, and 'freq' is the cutoff center frequency.++Analogous to csound's 'butterlp' routine.++> filterLowPassBW :: forall p . Clock p => Signal p (Double, Double) Double+> filterLowPassBW = +> let sr = rate (undefined :: p) +> in proc (sig, freq) -> do+> butter -< (sig, blpset freq sr)++A high-pass Butterworth filter.++Analogous to csound's 'butterhp' routine.++> filterHighPassBW :: forall p . Clock p => Signal p (Double, Double) Double+> filterHighPassBW = +> let sr = rate (undefined :: p)+> in proc (sig, freq) -> do+> butter -< (sig, bhpset freq sr)++A band-pass Butterworth filter where 'band' is the bandwidth.+'filterBandPassBW -< (s, 2000, 100)' will pass only 1950 to 2050 Hz in 's'.++Analogous to csound's 'butterbp' routine.++> filterBandPassBW :: forall p . Clock p => +> Signal p (Double, Double, Double) Double+> filterBandPassBW = +> let sr = rate (undefined :: p)+> in proc (sig, freq, band) -> do+> butter -< (sig, bbpset freq band sr)++A band-stop Butterworth filter where 'band' is the bandwidth.+'filterBandStopBW -< (s, 4000, 1000)' will filter 's' such that frequencies +between 3500 to 4500 Hz are rejected.++Analogous to csound's 'butterbr' routine.++> filterBandStopBW :: forall p . Clock p => +> Signal p (Double, Double, Double) Double+> filterBandStopBW = +> let sr = rate (undefined :: p)+> in proc (sig, freq, band) -> do+> butter -< (sig, bbrset freq band sr)++Helper function for various Butterworth filters.++> butter :: Clock p => Signal p (Double,ButterData) Double+> butter = proc (sig, ButterData a1 a2 a3 a4 a5) -> do+> rec let t = sig - a4 * y' - a5 * y''+> y = t * a1 + a2 * y' + a3 * y''+> y' <- init 0 -< t+> y'' <- init 0 -< y'+> outA -< y++This filter reiterates input with an echo density determined by loop+time 'looptime'. The attenuation rate is independent and is+determined by 'rvt', the reverberation time (defined as the time in+seconds for a signal to decay to 1/1000 of, or 60dB down from, its+original amplitude). Output from 'filterComb' will appear only after+'looptime' seconds.++Analogous to csound's 'comb' routine.++> filterComb :: Clock p => +> Double -- loop time in seconds, which determines the "echo+> -- density" of the reverberation. This in turn+> -- characterizes the "color" of the filter whose+> -- frequency response curve will contain 'looptime' *+> -- sr/2 peaks spaced evenly between 0 and sr/2 (the+> -- Nyquist frequency). Loop time can be as large as+> -- available memory will permit.+> -> Signal p (Double, Double) Double+> filterComb looptime = +> let log001 = -6.9078+> del = delayLine looptime+> in proc (sig, rvt) -> do+> let gain = exp (log001 * looptime / rvt)+> rec+> r <- del -< sig + r * gain+> outA -< r++A first-order recursive low-pass filter with variable frequency+response. 'hp' is the response curve's half-power point, in Hertz.+Half power is defined as peak power / sqrt 2.++Analogous to csound's tone routine.++> filterLowPass :: forall p . Clock p => Signal p (Double,Double) Double+> filterLowPass = +> let sr = rate (undefined :: p)+> in proc (sig, hp) -> do+> rec+> let y' = c1 * sig + c2 * y+> b = 2 - cos (2 * pi * hp / sr)+> c2 = b - sqrt (b * b - 1.0)+> c1 = 1 - c2+> y <- init 0 -< y'+> outA -< y++A high-pass filter whose transfer function is the complement of that+of 'filterLowPass'. The transfer function of 'filterHighPass'+represents the "filtered out" aspects of its complement. However,+power scaling is not normalized in 'filterHighPass' but remains the+true complement of filterLowPass. Thus an audio signal, filtered by+parallel matching 'filterLowPass' and 'filterHighPass', would under+addition simply reconstruct the original spectrum.++> filterHighPass :: Clock p => Signal p (Double,Double) Double+> filterHighPass = proc (sig, hp) -> do+> y <- filterLowPass -< (sig, hp)+> outA -< sig - y++Envelopes+---------++'envLine' generates control or audio signals whose values move linearly+from an initial value to a final one. A common error with this signal+function is to assume that the value of 'b' is held after the time+'dur'. 'envLine' does not automatically end or stop at the end of the+duration given. If your note length is longer than 'dur' seconds, the+resulting value will not come to rest at 'b', but will instead+continue to rise or fall with the same rate. If a rise (or fall) and+then hold is required then 'envLineSeg' should be considered instead.++> envLine :: forall p . Clock p => +> Double -- Starting value.+> -> Double -- Duration in seconds.+> -> Double -- Value after 'dur' seconds.+> -> Signal p () Double+> envLine a dur b =+> let sr = rate (undefined :: p)+> in proc () -> do+> rec+> y <- init a -< y + (b-a) * (1 / sr / dur)+> outA -< y++Trace an exponential curve between specified points. ++> envExpon :: forall p . Clock p => +> Double -- Starting value. Zero is illegal for exponentials. +> -> Double -- Duration in seconds. +> -> Double -- Value after 'dur' seconds. For exponentials,+> -- must be non-zero and must agree in sign with 'a'.+> -> Signal p () Double+> envExpon a dur b =+> let sr = rate (undefined :: p)+> in proc () -> do+> rec+> y <- init a -< y * pow (b/a) (1 / sr / dur)+> outA -< y++Unfortunately, envLine and envExpon cannot be abstracted to a common+function because Template Haskell doesn't like higher-order functions.++> data Tab = Tab [Double] !Int !(UArray Int Double)++> instance Language.Haskell.TH.Syntax.Lift Tab where+> lift (Tab xs sz uarr) =+> [| Tab xs sz (listArray (0, sz-1) xs) |]++> aAt :: Tab -> Int -> Double+> aAt (Tab _ sz a) i = unsafeAt a (min (sz-1) i)++Helper function for envLineSeg and envExponSeg.++> seghlp :: forall p . Clock p =>+> [Double] -- List of points to trace through.+> -> [Double] -- List of durations for each line segment.+> -- Needs to be one element fewer than 'iamps'.+> -> Signal p () (Double,Double,Double,Double)+> seghlp iamps idurs =+> let sr = rate (undefined :: p)+> sz = length iamps+> amps = Tab iamps sz (listArray (0, sz-1) iamps)+> durs = Tab idurs (sz-1) (listArray (0, sz-2) (map (*sr) idurs))+> in proc _ -> do+> -- TODO: this is better defined using 'integral', but which is faster?+> rec+> let (t', i') = if t >= durs `aAt` i +> then if i == sz-2 then (t+1, i) else (0, i+1)+> else (t+1, i)+> i <- init 0 -< i'+> t <- init 0 -< t'+> let a1 = aAt amps i+> a2 = aAt amps (i+1)+> d = aAt durs i+> outA -< (a1,a2,t,d)++Trace a series of line segments between specified points.++> envLineSeg :: Clock p => +> [Double] -- List of points to trace through.+> -> [Double] -- List of durations for each line segment.+> -- Needs to be one element fewer than 'amps'.+> -> Signal p () Double+> envLineSeg amps durs = +> let sf = seghlp amps durs+> in proc () -> do+> (a1,a2,t,d) <- sf -< ()+> outA -< a1 + (a2-a1) * (t / d)++Trace a series of exponential segments between specified points.++> envExponSeg :: Clock p => +> [Double] -- List of points to trace through.+> -> [Double] -- List of durations for each line segment.+> -- Needs to be one element fewer than 'amps'.+> -> Signal p () Double+> envExponSeg ampinps durs = +> let amps' = case ampinps of+> (a:amps) -> max 0.001 a : amps+> [] -> []+> sf = seghlp amps' durs+> in proc () -> do+> (a1,a2,t,d) <- sf -< ()+> outA -< a1 * pow (a2/a1) (t / d)++Creates a straight-line rise and decay envelope. Rise modifications+are applied for the first 'rise' seconds, and decay from time 'dur' -+'dec'. If these periods are separated in time there will be a steady+state during which the output will remain constant. If the overall+duration idur is exceeded in performance, the final decay will+continue on in the same direction, going negative.++> envASR :: (Clock p) =>+> Double -- rise time in seconds.+> -> Double -- overall duration in seconds.+> -> Double -- decay time in seconds.+> -> Signal p () Double+> envASR rise dur dec = +> let sf = envLineSeg [0,1,1,0] [rise, dur-rise-dec, dec]+> in proc () -> do+> env <- sf -< ()+> outA -< env++Apply an envelope consisting of 3 segments:+ 1. stored function rise shape+ 2. modified exponential pseudo steady state+ 3. exponential decay++Rise modifications are applied for the first 'rise' seconds, and decay+from time 'dur' - 'dec'. If these periods are separated in time the+output will be modified by the first exponential pattern. If rise and+decay periods overlap then both modifications will be in effect for+that time. If the overall duration 'dur' is exceeded in performance,+the final decay will continue on in the same direction, tending+asymptotically to zero.++> envCSEnvlpx :: forall p . Clock p =>+> Double -- rise time in seconds.+> -> Double -- overall duration in seconds.+> -> Double -- decay time in seconds.+> -> Table -- table of stored rise shape.+> -> Double +> -- attenuation factor, by which the last value of the+> -- 'envCSEnvlpx' rise is modified during the note's pseudo+> -- steady state. A factor greater than 1 causes an+> -- exponential growth and a factor less than 1 creates an+> -- exponential decay. A factor of 1 will maintain a true+> -- steady state at the last rise value. Note that this+> -- attenuation is not by fixed rate (as in a piano), but+> -- is sensitive to a note's duration. However, if 'atss'+> -- is negative (or if steady state < 4 k-periods) a fixed+> -- attenuation rate of 'abs' 'atss' per second will be+> -- used. 0 is illegal.+> -> Double +> -- attenuation factor by which the closing steady state+> -- value is reduced exponentially over the decay+> -- period. This value must be positive and is normally of+> -- the order of .01. A large or excessively small value is+> -- apt to produce a cutoff which is audible. A zero or+> -- negative value is illegal.+> -> Signal p () Double+> envCSEnvlpx rise dur dec tab atss atdec = +> let sr = rate (undefined :: p)+> cnt1 = (dur - rise - dec) * sr + 0.5 +> -- num of samples in steady state+> mlt1 = pow atss (1 / cnt1)+> mlt2 = pow atdec (1 / sr / dec)+> in proc () -> do+> rec +> i <- countUp -< ()+> let i' = fromIntegral i+> y <- init (readFromTableRaw tab 0) -< y'+> y' <- case (i' < rise * sr, i' < (dur-dec) * sr) of +> (True, _) -> table tab False -< i' / (rise*sr+0.5)+> (False, True) -> outA -< y * mlt1+> (False, False) -> outA -< y * mlt2+> outA -< y'++GEN routines+------------++All the GEN routines in Csound are normalized by default. In+Euterpea, the names of normalized table generators end in "N"; those+without an "N" are unnormalized++> type TableSize = Int+> type PartialNum = Double+> type PartialStrength = Double+> type PhaseOffset = Double+> type StartPt = Double+> type SegLength = Double+> type EndPt = Double++> type DoubleSegFun = +> (Double, StartPt) -> [(SegLength, EndPt)] -> Double -> Double++Analgous to csound's gen05 routine.++> tableExponN :: TableSize+> -- The size of the table to be produced. +> -> StartPt+> -- The y-coordinate for the start point, (0,y). +> -> [(SegLength, EndPt)]+> -- Pairs of segment lengths and y-coordinates. The segment+> -- lengths are the projection along the x-axis. The first+> -- pair will define the line from (0, startPt) to (segLength,+> -- endPt).+> -> Table+> tableExponN size sp segs = tableExp_ sp segs True size+> tableExpon :: Int -> StartPt -> [(SegLength, EndPt)] -> Table+> tableExpon size sp segs = tableExp_ sp segs False size+> tableExp_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table+> tableExp_ sp segs = funToTable (interpLine sp segs interpExpLine) +> [| interpLine sp segs interpExpLine |]++Analogous to csound's gen07 routine.++> tableLinearN :: TableSize+> -- The size of the table to be produced. +> -> StartPt+> -- The y-coordinate for the start point, (0,y). +> -> [(SegLength, EndPt)]+> -- Pairs of segment lengths and y-coordinates. The segment+> -- lengths are the projection along the x-axis. The first+> -- pair will define the line from (0, startPt) to (segLength,+> -- endPt).+> -> Table+> tableLinearN size sp segs = tableLin_ sp segs True size+> tableLinear :: Int -> StartPt -> [(SegLength, EndPt)] -> Table+> tableLinear size sp segs = tableLin_ sp segs False size+> tableLin_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table+> tableLin_ sp segs = funToTable (interpLine sp segs interpStraightLine) +> [| interpLine sp segs interpStraightLine |]++Make a table from a collection of sine waves at different offsets and+strengths.++Analogous to csound's gen09 routine.++> tableSines3N :: TableSize+> -- The size of the table to be produced.+> -> [(PartialNum, PartialStrength, PhaseOffset)]+> -- List of triples of the partial (0,1,...), partial+> -- strength on [0,1], and phase offset on [0,360].+> -> Table+> tableSines3N size ps = tableSines3_ ps True size+> tableSines3 :: Int -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table+> tableSines3 size ps = tableSines3_ ps False size+> tableSines3_ :: [(PartialNum, PartialStrength, PhaseOffset)] -> Bool -> Int -> Table+> tableSines3_ ps = funToTable (makeCompositeSineFun ps) +> [| makeCompositeSineFun ps |]++> tableSinesF :: (Floating a, Enum a) => [a] -> a -> a+> tableSinesF pss x = let phase = 2 * pi * x +> in sum (zipWith (*) [ sin (phase * pn) | pn <- [1..] ] pss)++Analogous to csound's gen10 routine.++> tableSinesN :: TableSize -> [PartialStrength] -> Table+> tableSinesN size pss = tableSinesN_ pss True size+> tableSines :: Int -> [Double] -> Table+> tableSines size pss = tableSinesN_ pss False size+> tableSinesN_ :: [Double] -> Bool -> Int -> Table+> tableSinesN_ pss = funToTable (tableSinesF pss) [| tableSinesF pss |]++Generates the log of a modified Bessel function of the second kind,+order 0, suitable for use in amplitude-modulated FM.++Analogous to csound's gen12 routine.++> tableBesselN :: TableSize +> -> Double -- specifies the x interval [0 to +xint] over which+> -- the function is defined.+> -> Table+> tableBesselN size xint = tableBess_ xint True size+> tableBessel :: Int -> Double -> Table+> tableBessel size xint = tableBess_ xint False size+> tableBess_ :: Double -> Bool -> Int -> Table+> tableBess_ xint = funToTable (tableBessF xint) [| tableBessF xint |]+> tableBessF :: Floating s => s -> s -> s+> tableBessF xint x =+> log $ 1 ++> let tsquare = x * x * xint * xint / 3.75 / 3.75+> in sum $ zipWith (*) [ 3.5156229, 3.0899424, 1.2067492,+> 0.2659732, 0.0360768, 0.0045813 ]+> $ iterate (*tsquare) tsquare++Utility functions for tableExpon and tableLinear.++> normalizeSegs :: [(SegLength, entPt)] -> [(SegLength, entPt)]+> normalizeSegs segs =+> let s = sum (map fst segs)+> fact = if (s > 1) then (1/s) else 1 -- don't force max<1 up to max=1+> in map (\(x,y) -> (x*fact, y)) segs++> interpLine :: StartPt+> -- The y-coordinate for the start point (0,y).+> -> [(SegLength, EndPt)]+> -- Pairs of segment lengths (projected on the x-axis)+> -- and y-coordinates (end points).+> -> DoubleSegFun+> -- The function to use for interpolation+> -> Double+> -- The x-coordinate for which to find the+> -- corresponding f(x)=y.+> -> Double+> interpLine sp [] d f = 0 -- catchall case+> interpLine sp points f d = f (0,sp) (normalizeSegs points) d ++The exponential interpolation function stretches e^x between two +endpoints for each pair of points.++> interpExpLine :: (Double, StartPt)+> -- The startpoing as (x,y)+> -> [(SegLength, EndPt)]+> -- A list of line segments with (x',y) where x' is+> -- a length projected on the x-axis+> -> Double+> -- The target x-coordinate to find a corresponding+> -- y value for+> -> Double+> interpExpLine (s1, e1) [] d = e1 -- termination case, end of list+> interpExpLine (s1, e1) ((s2, e2):t) d = +> if d > s2 then interpExpLine (s2, e2) t (d-s2) else+> let h = e2 - e1 +> x = if h<0 then s2-d else d+> in if s2<=0 then e2 else -- accomodate discontinuities+> (abs h)*((exp (x/s2))-1)/((exp 1)-1) + (min e1 e2)++> interpStraightLine :: (Double, StartPt)+> -- The startpoing as (x,y)+> -> [(SegLength, EndPt)]+> -- A list of line segments with (x',y) where x' is+> -- a length projected on the x-axis+> -> Double+> -- The target x-coordinate to find a corresponding+> -- y value for+> -> Double+> interpStraightLine (s1, e1) [] d = e1 -- termination case, end of list+> interpStraightLine (s1, e1) ((s2, e2):t) d = +> if d > s2 then interpStraightLine (s2, e2) t (d-s2) else+> let h = e2 - e1 -- height of triangle+> s = h/s2 -- slope of triangle+> in if s2<=0 then e2 else +> e1 + (s*d) -- start point plus slope times distance++Function to find a particular point at a particular strength++> makeSineFun :: (PartialNum, PartialStrength, PhaseOffset)+> -- Triple of the partial (0,1,...), partial strength+> -- on [0,1], and phase offset on [0,360].+> -> Double+> -- The x coordinate for which to find f(x)=y+> -> Double+> makeSineFun (pNum, pStrength, pOffset) x = +> let x' = x * 2 * pi -- convert [0,1] to [0,pi] radians+> po = (pOffset/360) * 2 * pi -- convert [0,360] to [0,pi] radians+> in pStrength * sin (x' * pNum + po)++For a particular point, sum all partials.++> makeCompositeSineFun :: [(PartialNum, PartialStrength, PhaseOffset)]+> -- List of triples of the partial (0,1,...),+> -- partial strength on [0,1], and phase offset+> -- on [0,360].+> -> Double+> -- The x coordinate for which to find f(x)=y+> -> Double+> makeCompositeSineFun [] x = 0+> makeCompositeSineFun (p:ps) x = makeSineFun p x + makeCompositeSineFun ps x+++--------------------------------------+-- Time events+--------------------------------------++> samples :: forall p . Clock p => Signal p () (SEvent ())+> samples = constA (Just ())++> timeBuilder :: forall p . Clock p => Double -> Signal p () (SEvent ())+> timeBuilder d =+> let r = (rate (undefined :: p))*d+> in proc _ -> do+> rec i <- init 0 -< if i >= r then i-r else i+1+> outA -< if i < 1 then Just () else Nothing++> milliseconds :: Clock p => Signal p () (SEvent ())+> milliseconds = timeBuilder (1/1000)++> seconds :: Clock p => Signal p () (SEvent ())+> seconds = timeBuilder 1++> countTime :: Clock p => Int -> Signal p () (SEvent ()) -> Signal p () (SEvent ())+> countTime n t = proc _ -> do+> e <- t -< ()+> rec i <- init 0 -< maybe i' (const $ i'+1) e+> let (i',o) = if i == n then (0, Just ()) else (i, Nothing)+> outA -< o
+ Euterpea/IO/Audio/Basics.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, ExistentialQuantification, TemplateHaskell, Arrows #-}+module Euterpea.IO.Audio.Basics+ (outA, integral, countDown, countUp, upsample, pchToHz, apToHz)+ where+import Prelude hiding (init)+import Euterpea.Music.Note.Music+import Euterpea.IO.Audio.Types+import Control.Arrow+import Control.CCA.ArrowP+import Control.CCA.Types+ +outA :: forall a b . (ArrowInit a) => a b b+outA = arr' [| id |] id+ +integral ::+ forall a p . (ArrowInitP a p, Clock p) => ArrowP a p Double Double+integral+ = let dt = 1 / rate (undefined :: p) in+ (loop+ ((arr' [| (\ (x, i) -> let i' = i + x * dt in i') |]+ (\ (x, i) -> let i' = i + x * dt in i')+ >>> init' [| 0 |] 0)+ >>> arr' [| (\ i -> (i, i)) |] (\ i -> (i, i)))+ >>> outA)+ +countDown :: forall a . (ArrowInit a) => Int -> a () Int+countDown x+ = (loop+ (arr' [| (\ (_, i) -> i - 1) |] (\ (_, i) -> i - 1) >>>+ (init' [| x |] x >>> arr' [| (\ i -> (i, i)) |] (\ i -> (i, i))))+ >>> outA)+ +countUp :: forall a . (ArrowInit a) => a () Int+countUp+ = (loop+ (arr' [| (\ (_, i) -> i + 1) |] (\ (_, i) -> i + 1) >>>+ (init' [| 0 |] 0 >>> arr' [| (\ i -> (i, i)) |] (\ i -> (i, i))))+ >>> outA)+ +upsample ::+ forall a p1 p2 b x .+ (ArrowChoice a, ArrowInitP a p1, ArrowInitP a p2, Clock p1,+ Clock p2, AudioSample b) =>+ ArrowP a p1 x b -> ArrowP a p2 x b+upsample f = g+ where g = (loop+ (arr' [| (\ (x, ~(cc, y)) -> (cc, (x, y))) |]+ (\ (x, ~(cc, y)) -> (cc, (x, y)))+ >>>+ (first+ (arr' [| (\ cc -> if cc >= r - 1 then 0 else cc + 1) |]+ (\ cc -> if cc >= r - 1 then 0 else cc + 1)+ >>> init' [| 0 |] 0)+ >>>+ arr' [| (\ (cc, (x, y)) -> ((cc, x, y), cc)) |]+ (\ (cc, (x, y)) -> ((cc, x, y), cc)))+ >>>+ (first+ (arr' [| (\ (cc, x, y) -> if cc == 0 then Left x else Right y) |]+ (\ (cc, x, y) -> if cc == 0 then Left x else Right y)+ >>> (ArrowP (strip f) ||| init' [| zero |] zero))+ >>>+ arr' [| (\ (y, cc) -> (y, (cc, y))) |]+ (\ (y, cc) -> (y, (cc, y)))))+ >>> outA)+ r = if outRate < inRate then+ error "Cannot upsample a signal of higher rate to lower rate" else+ outRate / inRate+ inRate = rate (undefined :: p1)+ outRate = rate (undefined :: p2)+ +apToHz :: forall a . (Floating a) => AbsPitch -> a+apToHz ap = 440 * 2 ** (fromIntegral (ap - absPitch (A, 5)) / 12)+ +pchToHz :: forall a . (Floating a) => Pitch -> a+pchToHz = apToHz . absPitch
+ Euterpea/IO/Audio/CSound.lhs view
@@ -0,0 +1,102 @@+> {-# LANGUAGE Arrows, NoMonomorphismRestriction #-} + +This module is strictly for backward compatibility with Euterpea 0.1.0, +which used many csound names for the basic signal functions. + +> module Euterpea.IO.Audio.CSound where +> import Euterpea.IO.Audio.BasicSigFuns +> import Euterpea.IO.Audio.Basics + +> gen05 = tableExponN +> gen05' = tableExpon +> gen07 = tableLinearN +> gen07' = tableLinear +> gen09 = tableSines3N +> gen09' = tableSines3 +> gen10 = tableSinesN +> gen10' = tableSines +> gen12 = tableBesselN +> gen12' = tableBessel + +> compSine1 = tableSinesN +> compSine2 = tableSines3N +> exponential1 = tableExponN +> lineSeg1 = tableLinearN + +> tone = filterLowPass +> -- :: forall p . Clock p => Signal p (Double, Double) Double +> atone = filterHighPass +> -- :: forall p . Clock p => Signal p (Double, Double) Double +> reson = filterBandPass +> -- :: forall p . Clock p => +> -- Int -> Signal p (Double, Double, Double) Double +> areson = filterBandStop +> -- :: forall p . Clock p => +> -- Int -> Signal p (Double, Double, Double) Double +> butterlp = filterLowPassBW +> butterhp = filterHighPassBW +> butterbp = filterBandPassBW +> butterbr = filterBandStopBW +> comb = filterComb + +> oscil = osc +> oscili = oscI +> oscils f = proc a -> do +> o <- oscFixed f -< () +> outA -< o*a +> oscil1 tab del dur = +> proc a -> do +> o <- oscDur tab del dur -< () +> outA -< o*a +> oscil1i tab del dur = +> proc a -> do +> o <- oscDurI tab del dur -< () +> outA -< o*a + +> buzz = oscPartials + +> -- pluck = pluck +> -- balance = balance + +> line a d b = +> proc s -> do +> o <- envLine a d b -< () +> outA -< o*s + +> expon a d b = +> proc s -> do +> o <- envExpon a d b -< () +> outA -< o*s + +> linseg = envLineSeg +> expseg = envExponSeg + +> linen rise dur dec = +> proc s -> do +> o <- envASR rise dur dec -< () +> outA -< o*s + +> envlpx rise dur dec tab atss atdec = +> proc s -> do +> o <- envCSEnvlpx rise dur dec tab atss atdec -< () +> outA -< o*s + +> rand s = +> proc a -> do +> o <- noiseWhite s -< () +> outA -< o*a + +> randi s = +> proc (a,f) -> do +> o <- noiseBLI s -< f +> outA -< o*a + +> randh s = +> proc (a,f) -> do +> o <- noiseBLH s -< f +> outA -< o*a + +> delay = delayLine +> vdelay = delayLine1 +> delay1 = delayLine1 +> delayT = delayLineT
+ Euterpea/IO/Audio/IO.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification, + ScopedTypeVariables, FlexibleContexts #-}++module Euterpea.IO.Audio.IO (+ outFile, outFileNorm, +-- outFileA, outFileNormA, RecordStatus, + maxSample) where++import Prelude hiding (init)+import Control.CCA.ArrowP+import Control.SF.SF+import Euterpea.IO.Audio.Types hiding (Signal)++import Codec.Wav+import Data.Audio+import Data.Array.Unboxed+import Data.Int++--import Data.IORef+--import Foreign.C+--import Foreign.Marshal.Array+--import Foreign.Marshal.Utils+--import Foreign.Ptr+--import Foreign.Storable+--import Control.CCA.Types+--import Control.Arrow+--import Control.Concurrent.MonadIO+--import Sound.RtAudio++type Signal clk a b = ArrowP SF clk a b++-- | Writes sound to a wave file (.wav)+outFile :: forall a p. (AudioSample a, Clock p) => + String -- ^ Filename to write to.+ -> Double -- ^ Duration of the wav in seconds.+ -> Signal p () a -- ^ Signal representing the sound.+ -> IO ()+outFile = outFileHelp id++normList :: [Double] -> [Double]+normList xs = map (/ mx) xs + where mx = max 1.0 (maximum (map abs xs))++-- | Like outFile, but normalizes the output if the amplitude of +-- the signal goes above 1. If the maximum sample is less than+-- or equal to 1, the output is not normalized.+-- Currently this requires storing the entire output stream in memory+-- before writing to the file.+outFileNorm :: forall a p. (AudioSample a, Clock p) => + String -- ^ Filename to write to.+ -> Double -- ^ Duration of the wav in seconds.+ -> Signal p () a -- ^ Signal representing the sound.+ -> IO ()+outFileNorm = outFileHelp normList++outFileHelp :: forall a p. (AudioSample a, Clock p) => + ([Double] -> [Double]) -- ^ Post-processing function.+ -> String -- ^ Filename to write to.+ -> Double -- ^ Duration of the wav in seconds.+ -> Signal p () a -- ^ Signal representing the sound.+ -> IO ()+outFileHelp f filepath dur sf = + let sr = rate (undefined :: p)+ numChannels = numChans (undefined :: a)+ numSamples = truncate (dur * sr) * numChannels+ dat = map (fromSample . (*0.999)) + (f (toSamples dur sf)) :: [Int32]+ -- multiply by 0.999 to avoid wraparound at 1.0+ array = listArray (0, numSamples-1) dat+ aud = Audio { sampleRate = truncate sr,+ channelNumber = numChannels,+ sampleData = array }+ in exportFile filepath aud+++{-+data RecordStatus = Pause | Record | Clear | Write++outFileA :: forall a. AudioSample a => + String -- ^ Filename to write to.+ -> Double -- ^ Sample rate of the incoming signal.+ -> UISF (a, RecordStatus) ()+outFileA = outFileHelpA id++outFileNormA :: forall a. AudioSample a => + String -- ^ Filename to write to.+ -> Double -- ^ Sample rate of the incoming signal.+ -> UISF (a, RecordStatus) ()+outFileNormA = outFileHelpA normList++outFileHelpA :: forall a. AudioSample a => + ([Double] -> [Double]) -- ^ Post-processing function.+ -> String -- ^ Filename to write to.+ -> Double -- ^ Sample rate of the incoming signal.+ -> UISF (a, RecordStatus) ()+outFileHelpA f filepath sr = + let numChannels = numChans (undefined :: a)+ writeWavSink = sink (writeWav f filepath sr numChannels)+ in proc (a, rs) -> do+ rec dat <- init [] -< dat'+ dat' <- case rs of+ Pause -> returnA -< dat+ Record -> returnA -< a:dat+ Clear -> returnA -< []+ Write -> do writeWavSink -< dat+ returnA -< a:dat+ returnA -< ()+-}+{-+writeWav :: AudioSample a => ([Double] -> [Double]) -> String -> Double -> Int -> [a] -> UI ()+writeWav f filepath sr numChannels adat = + let dat = map (fromSample . (*0.999)) + (f (concatMap collapse adat)) :: [Int32]+ -- multiply by 0.999 to avoid wraparound at 1.0+ array = listArray (0, (length dat)-1) dat+ aud = Audio { sampleRate = truncate sr,+ channelNumber = numChannels,+ sampleData = array }+ in liftIO $ exportFile filepath aud+-}+++ ++toSamples :: forall a p. (AudioSample a, Clock p) =>+ Double -> Signal p () a -> [Double]+toSamples dur sf = + let sr = rate (undefined :: p)+ numChannels = numChans (undefined :: a)+ numSamples = truncate (dur * sr) * numChannels+ in take numSamples $ concatMap collapse $ unfold $ strip sf++-- | Compute the maximum sample of an SF in the first 'dur' seconds.+maxSample :: forall a p. (AudioSample a, Clock p) =>+ Double -> Signal p () a -> Double+maxSample dur sf = maximum (map abs (toSamples dur sf))+++{-+chunk !nFrames !(i, f) ref buf = nFrames `seq` i `seq` f `seq` aux nFrames i + where aux !n !i = x `seq` i `seq` i' `seq`+ if n == 0 then do+ writeIORef ref i+ return ()+ else do+ pokeElemOff buf (fromIntegral nFrames-n) (realToFrac x)+ aux (n-1) i'+ where (x, i') = f ((), i)+{-# INLINE [0] chunk #-}++chunkify !i !f !secs = do+ --userData <- new i+ ref <- newIORef i+ let cb :: RtAudioCallback + cb oBuf iBuf nFrames nSecs status userData = do+ + lastState <- readIORef ref+ -- Fill output buffer with nFrames of samples+ chunk (fromIntegral nFrames) (lastState,f) ref oBuf+ if secs < (realToFrac nSecs) then return 2 else return 0+ + + mkAudioCallback cb ++++playPure :: Show b => Double -> (b, ((), b) -> (Double, b)) -> IO ()+playPure !secs !(i, f) = do+ rtaCloseStream+ rtaInitialize+ dev <- rtaGetDefaultOutputDevice+ callback <- chunkify i f secs+ with (StreamParameters dev 1 0) (\params -> do+ rtaOpenStream params nullPtr float64 44100 4096 callback nullPtr nullPtr)+ rtaStartStream+ return ()+ +-}
+ Euterpea/IO/Audio/Render.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE Arrows, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-}++-- Render a Music object to a audio signal function that can be further+-- manipulated or saved to a file. It is channel-agnostic in that it is+-- able to deal with instruments of arbitrary number of channels.++module Euterpea.IO.Audio.Render (+ Instr, InstrMap, renderSF, +) where++import Control.Arrow+import Control.CCA.Types+import Control.CCA.ArrowP+import Control.SF.SF++import Euterpea.Music.Note.Music+import Euterpea.Music.Note.MoreMusic+import Euterpea.Music.Note.Performance+import Euterpea.IO.Audio.Basics+import Euterpea.IO.Audio.Types++import Data.List hiding (init)+import qualified Data.IntMap as M+import Data.Ord (comparing)++import Prelude hiding (init)++-- Every instrument is a function that takes a duration, absolute+-- pitch, volume, and a list of parameters (Doubles). What the function +-- actually returns is implementation independent.+type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a++type InstrMap a = [(InstrumentName, Instr a)]++lookupInstr :: InstrumentName -> InstrMap a -> Instr a+lookupInstr ins im =+ case lookup ins im of+ Just i -> i+ Nothing -> error $ "Instrument " ++ show ins ++ + " does not have a matching Instr in the supplied InstrMap."++-- Each note in a Performance is tagged with a unique NoteId, which+-- helps us keep track of the signal function associated with a note.+type NoteId = Int++-- In this particular implementation, 'a' is the signal function that+-- plays the given note.+data NoteEvt a = NoteOn NoteId a+ | NoteOff NoteId++type Evt a = (Double, NoteEvt a) -- Timestamp in seconds, and the note event+++-- Turn an Event into a NoteOn and a matching NoteOff with the same NodeId. +eventToEvtPair :: InstrMap a -> Event -> Int -> [Evt a]+eventToEvtPair imap (Event {eTime, eInst, ePitch, eDur, eVol, eParams}) nid =+ let instr = lookupInstr eInst imap+ tOn = fromRational eTime+ tDur = fromRational eDur :: Double+ sf = instr eDur ePitch eVol eParams+ in [(tOn, NoteOn nid sf), (tOn + tDur, NoteOff nid)]++-- Turn a Performance into an SF of NoteOn/NoteOffs. +-- For each note, generate a unique id to tag the NoteOn and NoteOffs.+-- The tag is used as the key to the collection of signal functions+-- for efficient insertion/removal.+toEvtSF :: Clock p => Performance -> InstrMap a -> Signal p () [Evt a]+toEvtSF pf imap = + let evts = sortBy (comparing fst) $ concat $ + zipWith (eventToEvtPair imap) pf [0..]+ -- Sort all NoteOn/NoteOff events by timestamp.+ in proc _ -> do+ rec+ t <- integral -< 1+ es <- init evts -< next+ let (evs, next) = span ((<= t) . fst) es+ -- Trim events that are due off the list and output them,+ -- retaining the rest+ outA -< evs++-- Modify the collection upon receiving NoteEvts. The timestamps +-- are not used here, but they are expected to be the same.++modSF :: M.IntMap a -> [Evt a] -> M.IntMap a+modSF = foldl' mod+ where mod m (_, NoteOn nid sf) = M.insert nid sf m+ mod m (_, NoteOff nid) = M.delete nid m+++-- Simplified version of a parallel switcher. +-- Note that this is tied to the particular implementation of SF, as it+-- needs to use runSF to run all the signal functions in the collection.++pSwitch :: forall p col a. (Clock p, Functor col) =>+ col (Signal p () a) -- Initial SF collection.+ -> Signal p () [Evt (Signal p () a)] -- Input event stream.+ -> (col (Signal p () a) -> [Evt (Signal p () a)] -> col (Signal p () a))+ -- A Modifying function that modifies the collection of SF+ -- based on the event that is occuring.+ -> Signal p () (col a) + -- The resulting collection of output values obtained from+ -- running all SFs in the collection.++pSwitch col esig mod = + proc _ -> do+ evts <- esig -< ()+ rec+ -- perhaps this can be run at a lower rate using upsample+ sfcol <- init col -< mod sfcol' evts + let rs = fmap (\s -> runSF (strip s) ()) sfcol :: col (a, SF () a)+ (as, sfcol' :: col (Signal p () a)) = (fmap fst rs, fmap (ArrowP . snd) rs)+ outA -< as+++renderSF :: (Clock p, Performable a, AudioSample b) => + Music a + -> InstrMap (Signal p () b) + -> (Double, Signal p () b)+ -- ^ Duration of the music in seconds, + -- and a signal function that plays the music.++renderSF m im = + let (pf, d) = perfDur defPMap defCon m+ evtsf = toEvtSF pf im+ allsf = pSwitch M.empty evtsf modSF+ sf = allsf >>> arr (foldl' mix zero . M.elems) -- add up all samples+ in (fromRational d, sf)
+ Euterpea/IO/Audio/Types.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}++module Euterpea.IO.Audio.Types where++import Control.CCA.CCNF+import Control.CCA.ArrowP+import Control.SF.SF+++class Clock p where+ rate :: p -> Double -- sampling rate++data AudRate+data CtrRate++instance Clock AudRate where+ rate _ = 44100++instance Clock CtrRate where+ rate _ = 4410++type AudSF a b = SigFun AudRate a b+type CtrSF a b = SigFun CtrRate a b++type Signal clk a b = ArrowP SF clk a b+type SigFun clk a b = ArrowP SF clk a b+type SignalSyn clk a b = ArrowP ASyn clk a b++-- Arbitrary number of channels (say, 5.1) can be supported by just adding more+-- instances of the AudioSample type class.++class AudioSample a where+ zero :: a+ mix :: a -> a -> a+ collapse :: a -> [Double]+ numChans :: a -> Int + -- allows us to reify the number of channels from the type.++instance AudioSample Double where+ zero = 0+ mix = (+)+ collapse a = [a]+ numChans _ = 1++instance AudioSample (Double,Double) where+ zero = (0,0)+ mix (a,b) (c,d) = (a+c,b+d)+ collapse (a,b) = [a,b]+ numChans _ = 2++-- Some useful type synonyms:+type Mono p = Signal p () Double+type Stereo p = Signal p () (Double,Double)+++{-+-- Experimental stuff+class Unlifted a where+ expose :: a -> b -> b+ expose = seq+ unlifted_dummy :: a+ unlifted_dummy = error "unlifted_dummy"++instance Unlifted Double+instance Unlifted Float+instance Unlifted Int+instance Unlifted ()+instance Unlifted a => Unlifted [a]++instance (Unlifted a, Unlifted b) => Unlifted (a -> b)++data a :!: b = (Unlifted a, Unlifted b) => !a :!: !b+instance Unlifted (a :!: b) where+ expose (a :!: b) s = expose a (expose b s)+ {-# INLINE expose #-}++instance (Unlifted a, Unlifted b) => Unlifted (a,b) where+ expose (a, b) s = expose a (expose b s)+ {-# INLINE expose #-}++instance (Unlifted a, Unlifted b, Unlifted c) => Unlifted (a,b,c) where+ expose (a, b, c) s = expose a (expose b (expose c s))+ {-# INLINE expose #-}++instance (Unlifted a, Unlifted b, Unlifted c, Unlifted d) + => Unlifted (a,b,c,d) where+ expose (a, b, c,d) s = expose a (expose b (expose c (expose d s)))+ {-# INLINE expose #-}++instance (Unlifted a, Unlifted b, Unlifted c, Unlifted d, Unlifted e) + => Unlifted (a,b,c,d,e) where+ expose (a, b, c,d,e) s = expose a (expose b (expose c (expose d (expose e s))))+ {-# INLINE expose #-}+-}
+ Euterpea/IO/MIDI.hs view
@@ -0,0 +1,27 @@+module Euterpea.IO.MIDI + ( + fromMidi -- :: Midi -> (Music1, Context (Pitch, [NoteAttribute]), UserPatchMap)+ , module Euterpea.IO.MIDI.GeneralMidi+-- , fromGM -- :: Int -> InstrumentName+-- , toGM -- :: InstrumentName -> Int+ , defaultOutput -- :: (OutputDeviceID -> a -> IO b) -> a -> IO b+ , defaultInput -- :: (InputDeviceID -> a -> IO b) -> a -> IO b+ , playMidi -- :: OutputDeviceID -> Midi -> IO ()+ , MidiMessage(..) -- data MidiMessage = ANote { .. } | Std Message+ , Message(..) -- data Message (from Codec.Midi)+ , DeviceInfo(..) -- data DeviceInfo (from Sound.PortMidi)+ , OutputDeviceID -- newtype OutputDeviceID+ , InputDeviceID -- newtype InputDeviceID+ --, DeviceID -- type DeviceID = Int (from Sound.PortMidi)+ --, exportMidiFile -- :: FilePath -> Midi -> IO ()+ --, writeMidi -- :: (Performable a) => FilePath -> Music a -> IO ()+ --, writeMidiA -- :: (Performable a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO ()+ , module Euterpea.IO.MIDI.ToMidi+ , module Euterpea.IO.MIDI.ExportMidiFile+ ) where++import Euterpea.IO.MIDI.FromMidi+import Euterpea.IO.MIDI.GeneralMidi+import Euterpea.IO.MIDI.MidiIO+import Euterpea.IO.MIDI.ToMidi+import Euterpea.IO.MIDI.ExportMidiFile
+ Euterpea/IO/MIDI/ExportMidiFile.lhs view
@@ -0,0 +1,282 @@+MIDI File-writing module for use with Euterpea+Donya Quick+Last modified: 19-June-2013++This file fixes some file-writing bugs in Codec.Midi that +prevent some multi-instrument output from showing up correctly. +It defines the function exportMidiFile, which can be used like+Codec.Midi's exportFile function. Additionally, it defines two+functions for writing MIDI files, writeMidi and writeMidiA that+are like test and testA respectively but with an additional file+path argument.++NOTE #1: some of the binary handling should be redone at some +point. Currently, parts of it are using conversion to a String +type, and although it works, it should not be necessary (or at +least a cleaner way should be found).++NOTE #2: many MIDI messages are currently unsupported. The set +of supported messages is limited to those that can be produced by +Euterpea.++> module Euterpea.IO.MIDI.ExportMidiFile+> (exportMidiFile) where+> import Codec.Midi+> import Numeric+> import Data.Char+> import qualified Data.ByteString as Byte ++A standard MIDI file has two main sections: a header and a +series of track chunks. Track chunks each have a track header+section and end with an end-of-track marker. Detailed infomation+on the file format can be found here:++http://faydoc.tripod.com/formats/mid.htm+++> makeFile :: Midi -> Byte.ByteString+> makeFile (Midi ft td trs) = +> let ticksPerQn = +> case td of TicksPerBeat x -> x+> TicksPerSecond x y -> +> error ("(makeFile) Don't know how "+++> "to handle TicksPerSecond yet.")+> header = makeHeader ft (length trs) ticksPerQn+> body = map makeTrack trs+> in Byte.concat (header:body)++============++BUILD FILE HEADER++The standard MIDI file header starts with the following value:+4D 54 68 00 00 00 06 ff ff nn nn dd dd++ff ff is the format of the file: single-track, multi-track, or +multi-track/multi-pattern. Only the first two cases are addressed +here.++nn nn is the number of tracks in the file.++dd dd is the delta-time in ticks for a quarternote or beat.++> midiHeaderConst :: Byte.ByteString+> midiHeaderConst = +> Byte.pack [0x4D, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06] ++> type TrackCount = Int+> type TicksPerQN = Int+++The MIDI file header is built as described above. ++> makeHeader :: FileType -> TrackCount -> TicksPerQN -> Byte.ByteString+> makeHeader ft numTracks ticksPerQn = +> let +> ft' = case ft of SingleTrack -> [0x00, 0x00]+> MultiTrack -> [0x00, 0x01]+> MultiPattern -> error ("(makeHeader) Don't know "+++> "how to handle multi-pattern yet.")+> numTracks' = padByte 2 numTracks+> ticksPerQn' = padByte 2 ticksPerQn+> in if numTracks > 16 then error ("(makeHeader) Don't know how to "+++> "handle >16 tracks!")+> else Byte.concat [midiHeaderConst, Byte.pack ft', numTracks', ticksPerQn']++> padByte :: Integral a => Int -> a -> Byte.ByteString+> padByte byteCount i = +> let b = Byte.pack [fromIntegral i] +> n = Byte.length b+> padding = Byte.pack $ take (byteCount - n) $ repeat 0x00+> in if n < byteCount then Byte.concat [padding, b] else b++================++BUILDING TRACKS++A track consists of a track header, event information, and an +end-of-track marker. The track header has the format:++4D 54 72 6B xx xx xx xx++xx xx xx xx is the total number of BYTES in the track that +follows the header. This includes the end marker! This value+is obtained by generating the track first and then generating+its header.++> makeTrack :: Track Ticks -> Byte.ByteString+> makeTrack t = +> let body = makeTrackBody t+> header = makeTrackHeader body+> in Byte.concat [header, body]++> trackHeaderConst :: Byte.ByteString+> trackHeaderConst = Byte.pack [0x4D, 0x54, 0x72, 0x6B] ++> makeTrackHeader :: Byte.ByteString -> Byte.ByteString+> makeTrackHeader tbody = +> let len = Byte.length tbody+> f = Byte.pack . map (fromIntegral . binStrToNum . reverse) . +> breakBinStrs 8 . pad (8*4) '0' . numToBinStr+> in Byte.concat [trackHeaderConst, f len]++Track events have two components: a variable-length delta-time and+a message. The delta-time is the number of ticks between the last +message and the next one. The format will be: time message time message ...++However, delta-times are tricky things. The fact that they can be +any length requires that they be encoded in a special way. The binary+value of the number is split into 7-bit sections. This splitting +goes from RIGHT TO LEFT (this is not in any documentation I have read,+but was the only way that worked). For n sections, the first start +with a 1 and the last starts with a 0 - thereby indicating the last +byte of the number. The following is an example of the conversion:++192 track ticks = C0 (hex) = 1100 0000 (bin) +==> converts to 8140 (hex)++Split into 7-bit groups: [1] [100 0000]+Apply padding: [000 0001] [100 0000]+Add flags: [1000 0001] [0100 0000]+Result as hex 8 1 4 0++> makeTrackBody :: Track Ticks -> Byte.ByteString +> makeTrackBody [] = endOfTrack -- end marker, very important!+> makeTrackBody ((ticks, msg):rest) = +> let b = msgToBytes msg+> b' = [to7Bits ticks, msgToBytes msg, makeTrackBody rest]+> in if Byte.length b > 0 then Byte.concat b' +> else makeTrackBody rest++The end of track marker is set 96 ticks after the last event in the +track. This offset is arbitrary, but it helps avoid clipping the notes+at the end of a file during playback in a program like Winamp or+Quicktime.++> endOfTrack = Byte.concat [to7Bits 96, Byte.pack [0xFF, 0x2F, 0x00]]++Splitting numbers into 7-bit sections and applying flags is done+by the following process:+- convert to a binary string representation+- pad the number to be full bytes+- split from right to left into groups of 7 and apply flags+- convert each 8-bit chunk back to a byte representation++> to7Bits :: (Integral a, Show a) => a -> Byte.ByteString+> to7Bits = Byte.pack . map (fromIntegral . binStrToNum . reverse) .+> fixBinStrs . map (padTo 7 . reverse). reverse . +> breakBinStrs 7 . reverse . padTo 8 . numToBinStr++Pad a binary string to be a multiple of 8 bits:++> padTo :: Int -> String -> String+> padTo i xs = if length xs `mod` i == 0 then xs else padTo i ('0':xs)++Break a string into chunks of length i:++> breakBinStrs :: Int -> String -> [String]+> breakBinStrs i s = +> if length s <= i then [s] else take i s : breakBinStrs i (drop i s)++Convert a number to a binary string:++> numToBinStr :: (Integral a, Show a) => a -> String+> numToBinStr i = showIntAtBase 2 intToDigit i ""++Convert a binary string to an integer:++> binStrToNum :: String -> Int+> binStrToNum [] = 0+> binStrToNum ('0':xs) = 2* binStrToNum xs+> binStrToNum ('1':xs) = 1 + 2*binStrToNum xs+> binStrToNum _ = error "bad data."++Append flags to a string (note, the string must be BACKWARDS):++> fixBinStrs :: [String] -> [String]+> fixBinStrs xs = +> let n = length xs+> bits = take (n-1) (repeat '1') ++ "0"+> in Prelude.zipWith (:) bits xs++Pad a list from the left until it is a fixed length:++> pad :: Int -> a -> [a] -> [a]+> pad b x xs = if length xs >= b then xs else pad b x (x:xs)++Messages have the following encodings:++8x nn vv Note Off for pitch nn at velocity vv, channel x+9x nn vv Note On for pitch nn at velocity vv, channel x+Ax nn vv Key aftertouch for pitch nn at velocity vv, channel x+Bx cc vv Control Change for controller cc with value vv, channel x+Cx pp Program Change to patch pp for channel x+Dx cc Channel after-touch to cc on channel x+Ex bb tt Pitch wheel to value ttbb, channel x (2000 hex is "normal") + (note: bb are least significant bits, tt are most significant)++Currently, only note on/off, control change, and program change are supported.++There are also META -EVENTS. This are events that have no channel number.+All meta-events have the format++FF xx nn nn dd dd ...++where xx is the command code, and nnnn is the number of bytes in the data (dd).++FF 00 nn ssss Set track sequence number+FF 01 nn tt... Text event+FF 02 nn tt... Copyright info+FF 03 nn tt... Track name+FF 04 nn tt... Track instrument name+FF 05 nn tt... Lyric+FF 06 nn tt... Marker+FF 07 nn tt... Cue point+FF 2F 00 END OF TRACK MARKER+FF 51 03 tttttt Tempo change marker, where tttttt is the microseconds per qn+FF 48 04 nnddccbb Time signature nn/dd with cc ticks per beat and bb 32nds/qn+FF 59 02 sfmi Key signature with sf sharps/flats and mi mode in {0,1}++Of these, only the end of track and tempo marker are implemented.++> msgToBytes :: Message -> Byte.ByteString+> msgToBytes (NoteOn c k v) = +> Byte.concat [Byte.pack [0x90 + fromIntegral c], padByte 1 k, padByte 1 v]+> msgToBytes (NoteOff c k v) = +> Byte.concat [Byte.pack [0x80 + fromIntegral c], padByte 1 k, padByte 1 v]+> msgToBytes (ProgramChange c p) = +> Byte.concat [Byte.pack [0xC0 + fromIntegral c], padByte 1 p]+> msgToBytes (ControlChange c n v) = +> Byte.concat [Byte.pack [0xB0 + fromIntegral c], padByte 1 n, padByte 1 v]+> msgToBytes (TempoChange t) = -- META EVENT, HAS NO CHANNEL NUMBER+> Byte.concat [Byte.pack [0xFF, 0x51, 0x03], fixTempo t]+> msgToBytes x = error ("(msgToBytes) Message type not currently "++ +> "supported: "++show x)++Fix a tempo value to be exactly 3 bytes:++> fixTempo = Byte.pack . map (fromIntegral . binStrToNum . reverse) . +> breakBinStrs 8 . pad (4*6) '0' . numToBinStr++> exportMidiFile :: FilePath -> Midi -> IO ()+> exportMidiFile fn = Byte.writeFile fn . makeFile+++=================++USAGE++The exportMidiFile can now be used as follows in place of Codec.Midi's exportFile:++ writeMidi :: (Performable a) => FilePath -> Music a -> IO ()+ writeMidi fn = exportMidiFile fn . testMidi++ writeMidiA :: (Performable a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO ()+ writeMidiA fn pm con m = exportMidiFile fn $ testMidiA pm con m++ test :: (Performable a) => Music a -> IO ()+ test = exportMidiFile "test.mid" . testMidi+ + testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO ()+ testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m)+
+ Euterpea/IO/MIDI/FromMidi.lhs view
@@ -0,0 +1,270 @@+> module Euterpea.IO.MIDI.FromMidi (fromMidi) where+> import Euterpea.Music.Note.Music+> import Euterpea.Music.Note.MoreMusic+> import Euterpea.Music.Note.Performance+> import Euterpea.IO.MIDI.ToMidi+> import Euterpea.IO.MIDI.GeneralMidi+> import Data.List+> import Codec.Midi+++Donya Quick+Last updated 15-Oct-2013.++Changes since last major version (15-Jan-2013):+- makeUPM: (is !! i, 10) changed to (is !! i, 9) for Percussion.+- Instrument numbers <0 are interpreted as Percussion.+- ProgChange 10 x is now assigned (-1) as an instrument number.++KNOWN ISSUES:+- Tempo changes occuring between matching note on/off events may not be + interpreted optimally. A performance-correct representation rather + than a score-correct representation could be accomplished by looking + for these sorts of between-on-off tempo changes when calculating a + note's duration. + +This code was originally developed for research purposes and then +adapted for CPSC 431/531 to overcome some problems exhibited by the+original implementation of fromMidi. ++This code has functions to read Midi values into an intermediate type,+SimpleMsg, before conversion to Music (Pitch, Volume) to make processing +instrument changes easier. The following features will be retained from +the input file:+- Placement of notes relative to the beat (assumed to be quarternotes).+- The pitch, volume, and instrument of each note.+- Tempo changes indicated by TempoChange MIDI events++Other MIDI controller information is currently not supported. This includes +events such as pitch bends and modulations. For these controllers, there is +no simple way to capture the information in a Music data structure.++The following datatype is for a simplification of MIDI events into simple +On/off events for pitches occurring at different times. There are two +types of events considered: tempo changes and note events. The note events+are represented by tuples of:+- exact onset time, Rational+- absolute pitch, AbsPitch+- volume from 0-127, Volume+- instrument number, Int. The value (-1) is used for Percussion.+- on/off type, NEvent++> data NEvent = On | Off+> deriving (Eq, Show, Ord)++> data SimpleMsg = SE (Rational, AbsPitch, Volume, Int, NEvent) |+> T (Rational, Rational)+> deriving (Eq, Show)+> instance Ord (SimpleMsg) where+> compare (SE(t,p,v,i,e)) (SE(t',p',v',i',e')) = +> if t<t' then LT else if t>t' then GT else EQ+> compare (T(t,x)) (SE(t',p',v',i',e')) = +> if t<t' then LT else if t>t' then GT else EQ+> compare (SE(t,p,v,i,e)) (T(t',x)) = +> if t<t' then LT else if t>t' then GT else EQ+> compare (T(t,x)) (T(t',x')) =+> if t<t' then LT else if t>t' then GT else EQ++The importFile function places track ticks (Ticks) in a format where +each value attached to a message represents the number of ticks that +have passed SINCE THE LAST MESSAGE. The following function will convert +input in that format into a list of pairs where the ticks are absolute. +In otherwords, ticks in the output will represent the exact point in +time of an event. This means that unsupported events (e.g. pitch bend) +can later be filtered out without affecting the timing of support events.++> addTrackTicks :: Int -> [(Ticks, a)] -> [(Ticks, a)]+> addTrackTicks sum [] = []+> addTrackTicks sum ((t,x):ts) = (t+sum,x) : addTrackTicks (t+sum) ts++The following function addresses a ticks to Music duration conversion.++> applyTD :: TimeDiv -> SimpleMsg -> SimpleMsg+> applyTD tdw x = +> case x of T(t,i) -> T(fixT tdw t, i) +> SE(t,p,v,i,e) -> SE(fixT tdw t, p, v, i, e) where++> fixT tdw t = +> case tdw of TicksPerBeat td -> t / (fromIntegral td * 4)+> TicksPerSecond fps tpf -> t / fromIntegral (fps * tpf)+++The midiToEvents function will take a Midi structure (from importFile, +for example) and convert it to a list of lists of SimpleMsgs. Each outer +list represents a track in the original Midi. ++> midiToEvents :: Midi -> [[SimpleMsg]]+> midiToEvents m = +> let ts = map (simplifyTrack 0) $ map (addTrackTicks 0) (tracks m) +> in distributeTempos $ map (map (applyTD $ timeDiv m)) ts where +> simplifyTrack :: Int -> [(Ticks, Message)] -> [SimpleMsg]+> simplifyTrack icur [] = []+> simplifyTrack icur ((t,m):ts) = +> case m of (NoteOn c p v) -> +> SE (fromIntegral t, p, v, icur, On) : simplifyTrack icur ts+> (NoteOff c p v) -> +> SE (fromIntegral t, p, v, icur, Off) : simplifyTrack icur ts+> (ProgramChange c p) -> simplifyTrack (if c==9 then (-1) else p) ts +> (TempoChange x) -> T (fromIntegral t, fromIntegral x) : simplifyTrack icur ts+> _ -> simplifyTrack icur ts +++The first track is the tempo track. It's events need to be distributed+across the other tracks. This function below is called for that purpose+in midiToEvents above.++> distributeTempos :: [[SimpleMsg]] -> [[SimpleMsg]]+> distributeTempos tracks = +> if length tracks > 1 then map (sort . (head tracks ++)) (tail tracks)+> else tracks -- must be a single-track file with embedded tempo changes.+++The eventsToMusic function will convert a list of lists of SimpleMsgs +(output from midiToEvents) to a Music(Pitch,Volume) structure. All +notes will be connected together using the (:=:) constructor. For +example, the first line of "Frere Jaque", which would normally be+written as:++c 5 qn :+: d 5 qn :+: e 5 qn :+: c 5 qn++would actually get represented like this when read in from a MIDI:++ (rest 0 :+: c 5 qn) :=:+ (rest qn :+: d 5 qn) :=:+ (rest hn :+: e 5 qn) :=:+ (rest dhn :+: c 5 qn)++This structure is clearly more complicated than it needs to be.+However, identifying melodic lines and phrases inorder to group the+events in a more musically appropriate manor is non-trivial, since+it requires both phrase and voice identification within an instrument +To see why this is the case, consider a Piano, which may have right +and lef thand lines that might be best separated by :=: at the +outermost level. In a MIDI, however, we are likely to get all of the+events for both hands lumped into the same track. ++The parallelized structure is also required for keeping tempo changes+syced between instruments. While MIDI files allow tempo changes to +occur in the middle of a note, Euterpea's Music values do not.+ +Instruments will be grouped at the outermost level. For example, if +there are 2 instruments with music values m1 and m2 repsectively, the+structure would be:++ (instrument i1 m1) :=: (instrument i2 m1)+ +Tempo changes are processed within each instrument.++> eventsToMusic :: [[SimpleMsg]] -> Music (Pitch, Volume)+> eventsToMusic tracks = +> let tracks' = splitByInstruments tracks -- handle any mid-track program changes+> is = map toInstr $ map getInstrument $ filter (not.null) tracks' -- instruments+> tDef = 500000 -- current tempo, 120bpm as microseconds per qn+> in chord $ zipWith instrument is $ map (seToMusic tDef) tracks' where+> +> toInstr :: Int -> InstrumentName+> toInstr i = if i<0 then Percussion else toEnum i +>+> seToMusic :: Rational -> [SimpleMsg] -> Music (Pitch, Volume)+> seToMusic tCurr [] = rest 0+> seToMusic tCurr (e1@(SE(t,p,v,ins,On)):es) = +> let piMatch (SE(t1,p1,v1,ins1,e1)) = (p1==p && ins1==ins) && e1==Off+> piMatch (T(t1,x)) = False+> is = findIndices piMatch es -- find mactching note-offs+> SE(t1,p1,v1,ins1, e) = es !! (is !! 0) -- pick the first matching note-off+> n = (rest t :+: note (t1-t) (pitch p,v)) -- create a Music note+> in if v > 0 then -- a zero volume note is silence+> if length is > 0 then n :=: seToMusic tCurr es -- found an off+> else seToMusic tCurr ((e1:es)++[correctOff e1 es]) -- missing off case+> else seToMusic tCurr es+> seToMusic tCurr (e1@(T (t,newTempo)):es) = +> let t2 = getTime $ head es -- find time of next event after tempo change+> tfact = tCurr / newTempo -- calculate tempo change factor+> es' = map (changeTime (subtract t)) es -- adjust start times+> m = rest t :+: tempo tfact (seToMusic newTempo es') +> in if null es then rest 0 else m where+> changeTime f (SE (t,p,v,i,e)) = SE (f t,p,v,i,e)+> changeTime f (T (t,x)) = T (f t, x)+> seToMusic tCurr (_:es) = seToMusic tCurr es -- ignore note-offs (already handled)+++Finding the time of an event.++> getTime (SE(t,p,v,i,e)) = t+> getTime (T (t,x)) = t+++Finding the instrument associated with a track. Only the first+instrument label to appear is chosen. If a program change happens+mid-track, it will not be counted.++> getInstrument ((SE(t,p,v,i,e)):xs) = i+> getInstrument ((T x) : xs) = getInstrument xs+> getInstrument [] = -1 -- No instrument assigned+++The following function ensure that only one instrument appears in +each list of SimpleMsgs. This is necessary in order to ensure that +instrument assignments occur at the outermost level of the Music.++> splitByInstruments :: [[SimpleMsg]] -> [[SimpleMsg]] +> splitByInstruments [] = []+> splitByInstruments (t:ts) = +> let i = getInstrument t+> (t',t'') = splitByI i t+> ts' = if or $ map isSE t'' then splitByInstruments (t'':ts) +> else splitByInstruments ts+> in if or $ map isSE t' then t' : ts' else ts'++> isSE :: SimpleMsg -> Bool+> isSE (SE xs) = True+> isSE (T i) = False+++The splitByI function partitions a stream to select a specific instrument's events.++> splitByI :: Int -> [SimpleMsg] -> ([SimpleMsg],[SimpleMsg])+> splitByI i0 [] = ([],[])+> splitByI i0 (x:xs) = +> let (ts,fs) = splitByI i0 xs+> f (SE(_,_,_,i1,_)) = i0 == i1+> f _ = False+> in case x of SE x' -> if f x then (x:ts,fs) else (ts,x:fs)+> T i -> (x:ts, x:fs) -- add tempos to both streams+++This function is an error-handling method for MIDI files which have +mismatched note on/off events. This seems to be common in output from +some software. The solution used here is to assume that the note lasts +until the the time of the last event in the list. ++> correctOff (SE(t,p,v,ins,e)) [] = SE(t,p,v,ins,Off)+> correctOff (SE(t,p,v,ins,e)) es = +> let SE(t1,p1,v1,ins1,e1) = last $ filter isSE es+> in SE(t1,p,v,ins,Off) +++The fromMidi function wraps the combination of midiToEvents and +eventsToMusic and performs the final conversion to Music1.++> fromMidi :: Midi -> (Music1, Context (Pitch, [NoteAttribute]), UserPatchMap)+> fromMidi m = +> let seList = midiToEvents m+> iNums = filter (>0) $ map getInstrument seList+> upm = makeUPM $ map toEnum iNums+> in (mMap (\(p,v) -> (p, [Volume v])) $ eventsToMusic seList,+> defCon, upm)+++This function is to correct for the fact that channel 10 is+traditionally reserved for percussion. If there is no percussion,+then channel 10 must remain empty. Channels are indexed from zero +in this representation, so channel 1 is 0, channel 10 is 9, etc.++> makeUPM :: [InstrumentName] -> UserPatchMap+> makeUPM is = +> case findIndex (==Percussion) is of +> Nothing -> zip is ([0..8]++[10..]) -- no percussion+> Just i -> (is !! i, 9) : +> zip (take i is ++ drop (i+1) is) ([0..8]++[10..])+
+ Euterpea/IO/MIDI/GeneralMidi.hs view
@@ -0,0 +1,278 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/GeneralMidi.lhs. (See HSoM/MakeCode.bat.)+++module Euterpea.IO.MIDI.GeneralMidi where++import Euterpea.Music.Note.Music (InstrumentName(..))++fromGM :: Int -> InstrumentName+fromGM i | i >= 0 && i <= 127 = toEnum i+fromGM i = error $ "fromGMNo: " ++ show i ++ + " is not a valid General Midi Number"+toGM :: InstrumentName -> Int+toGM Percussion = 0+toGM (Custom name) = 0+toGM i = fromEnum i++instance Enum InstrumentName where+ fromEnum AcousticGrandPiano = 0+ fromEnum BrightAcousticPiano = 1+ fromEnum ElectricGrandPiano = 2+ fromEnum HonkyTonkPiano = 3+ fromEnum RhodesPiano = 4+ fromEnum ChorusedPiano = 5+ fromEnum Harpsichord = 6+ fromEnum Clavinet = 7+ fromEnum Celesta = 8+ fromEnum Glockenspiel = 9+ fromEnum MusicBox = 10+ fromEnum Vibraphone = 11+ fromEnum Marimba = 12+ fromEnum Xylophone = 13+ fromEnum TubularBells = 14+ fromEnum Dulcimer = 15+ fromEnum HammondOrgan = 16+ fromEnum PercussiveOrgan = 17+ fromEnum RockOrgan = 18+ fromEnum ChurchOrgan = 19+ fromEnum ReedOrgan = 20+ fromEnum Accordion = 21+ fromEnum Harmonica = 22+ fromEnum TangoAccordion = 23+ fromEnum AcousticGuitarNylon = 24+ fromEnum AcousticGuitarSteel = 25+ fromEnum ElectricGuitarJazz = 26+ fromEnum ElectricGuitarClean = 27+ fromEnum ElectricGuitarMuted = 28+ fromEnum OverdrivenGuitar = 29+ fromEnum DistortionGuitar = 30+ fromEnum GuitarHarmonics = 31+ fromEnum AcousticBass = 32+ fromEnum ElectricBassFingered = 33+ fromEnum ElectricBassPicked = 34+ fromEnum FretlessBass = 35+ fromEnum SlapBass1 = 36+ fromEnum SlapBass2 = 37+ fromEnum SynthBass1 = 38+ fromEnum SynthBass2 = 39+ fromEnum Violin = 40+ fromEnum Viola = 41+ fromEnum Cello = 42+ fromEnum Contrabass = 43+ fromEnum TremoloStrings = 44+ fromEnum PizzicatoStrings = 45+ fromEnum OrchestralHarp = 46+ fromEnum Timpani = 47+ fromEnum StringEnsemble1 = 48+ fromEnum StringEnsemble2 = 49+ fromEnum SynthStrings1 = 50+ fromEnum SynthStrings2 = 51+ fromEnum ChoirAahs = 52+ fromEnum VoiceOohs = 53+ fromEnum SynthVoice = 54+ fromEnum OrchestraHit = 55+ fromEnum Trumpet = 56+ fromEnum Trombone = 57+ fromEnum Tuba = 58+ fromEnum MutedTrumpet = 59+ fromEnum FrenchHorn = 60+ fromEnum BrassSection = 61+ fromEnum SynthBrass1 = 62+ fromEnum SynthBrass2 = 63+ fromEnum SopranoSax = 64+ fromEnum AltoSax = 65+ fromEnum TenorSax = 66+ fromEnum BaritoneSax = 67+ fromEnum Oboe = 68+ fromEnum EnglishHorn = 69+ fromEnum Bassoon = 70+ fromEnum Clarinet = 71+ fromEnum Piccolo = 72+ fromEnum Flute = 73+ fromEnum Recorder = 74+ fromEnum PanFlute = 75+ fromEnum BlownBottle = 76+ fromEnum Shakuhachi = 77+ fromEnum Whistle = 78+ fromEnum Ocarina = 79+ fromEnum Lead1Square = 80+ fromEnum Lead2Sawtooth = 81+ fromEnum Lead3Calliope = 82+ fromEnum Lead4Chiff = 83+ fromEnum Lead5Charang = 84+ fromEnum Lead6Voice = 85+ fromEnum Lead7Fifths = 86+ fromEnum Lead8BassLead = 87+ fromEnum Pad1NewAge = 88+ fromEnum Pad2Warm = 89+ fromEnum Pad3Polysynth = 90+ fromEnum Pad4Choir = 91+ fromEnum Pad5Bowed = 92+ fromEnum Pad6Metallic = 93+ fromEnum Pad7Halo = 94+ fromEnum Pad8Sweep = 95+ fromEnum FX1Train = 96+ fromEnum FX2Soundtrack = 97+ fromEnum FX3Crystal = 98+ fromEnum FX4Atmosphere = 99+ fromEnum FX5Brightness = 100+ fromEnum FX6Goblins = 101+ fromEnum FX7Echoes = 102+ fromEnum FX8SciFi = 103+ fromEnum Sitar = 104+ fromEnum Banjo = 105+ fromEnum Shamisen = 106+ fromEnum Koto = 107+ fromEnum Kalimba = 108+ fromEnum Bagpipe = 109+ fromEnum Fiddle = 110+ fromEnum Shanai = 111+ fromEnum TinkleBell = 112+ fromEnum Agogo = 113+ fromEnum SteelDrums = 114+ fromEnum Woodblock = 115+ fromEnum TaikoDrum = 116+ fromEnum MelodicDrum = 117+ fromEnum SynthDrum = 118+ fromEnum ReverseCymbal = 119+ fromEnum GuitarFretNoise = 120+ fromEnum BreathNoise = 121+ fromEnum Seashore = 122+ fromEnum BirdTweet = 123+ fromEnum TelephoneRing = 124+ fromEnum Helicopter = 125+ fromEnum Applause = 126+ fromEnum Gunshot = 127+ fromEnum i = error $ "fromEnum: " ++ show i ++ " inot implemented"++ toEnum 0 = AcousticGrandPiano + toEnum 1 = BrightAcousticPiano + toEnum 2 = ElectricGrandPiano + toEnum 3 = HonkyTonkPiano + toEnum 4 = RhodesPiano + toEnum 5 = ChorusedPiano + toEnum 6 = Harpsichord + toEnum 7 = Clavinet + toEnum 8 = Celesta + toEnum 9 = Glockenspiel + toEnum 10 = MusicBox + toEnum 11 = Vibraphone + toEnum 12 = Marimba + toEnum 13 = Xylophone + toEnum 14 = TubularBells + toEnum 15 = Dulcimer + toEnum 16 = HammondOrgan + toEnum 17 = PercussiveOrgan + toEnum 18 = RockOrgan + toEnum 19 = ChurchOrgan + toEnum 20 = ReedOrgan + toEnum 21 = Accordion + toEnum 22 = Harmonica + toEnum 23 = TangoAccordion + toEnum 24 = AcousticGuitarNylon + toEnum 25 = AcousticGuitarSteel + toEnum 26 = ElectricGuitarJazz + toEnum 27 = ElectricGuitarClean + toEnum 28 = ElectricGuitarMuted + toEnum 29 = OverdrivenGuitar + toEnum 30 = DistortionGuitar + toEnum 31 = GuitarHarmonics + toEnum 32 = AcousticBass + toEnum 33 = ElectricBassFingered + toEnum 34 = ElectricBassPicked + toEnum 35 = FretlessBass + toEnum 36 = SlapBass1 + toEnum 37 = SlapBass2 + toEnum 38 = SynthBass1 + toEnum 39 = SynthBass2 + toEnum 40 = Violin + toEnum 41 = Viola + toEnum 42 = Cello + toEnum 43 = Contrabass + toEnum 44 = TremoloStrings + toEnum 45 = PizzicatoStrings + toEnum 46 = OrchestralHarp + toEnum 47 = Timpani + toEnum 48 = StringEnsemble1 + toEnum 49 = StringEnsemble2 + toEnum 50 = SynthStrings1 + toEnum 51 = SynthStrings2 + toEnum 52 = ChoirAahs + toEnum 53 = VoiceOohs + toEnum 54 = SynthVoice + toEnum 55 = OrchestraHit + toEnum 56 = Trumpet + toEnum 57 = Trombone + toEnum 58 = Tuba + toEnum 59 = MutedTrumpet + toEnum 60 = FrenchHorn + toEnum 61 = BrassSection + toEnum 62 = SynthBrass1 + toEnum 63 = SynthBrass2 + toEnum 64 = SopranoSax + toEnum 65 = AltoSax + toEnum 66 = TenorSax + toEnum 67 = BaritoneSax + toEnum 68 = Oboe + toEnum 69 = EnglishHorn + toEnum 70 = Bassoon + toEnum 71 = Clarinet + toEnum 72 = Piccolo + toEnum 73 = Flute + toEnum 74 = Recorder + toEnum 75 = PanFlute + toEnum 76 = BlownBottle + toEnum 77 = Shakuhachi + toEnum 78 = Whistle + toEnum 79 = Ocarina + toEnum 80 = Lead1Square + toEnum 81 = Lead2Sawtooth + toEnum 82 = Lead3Calliope + toEnum 83 = Lead4Chiff + toEnum 84 = Lead5Charang + toEnum 85 = Lead6Voice + toEnum 86 = Lead7Fifths + toEnum 87 = Lead8BassLead + toEnum 88 = Pad1NewAge + toEnum 89 = Pad2Warm + toEnum 90 = Pad3Polysynth + toEnum 91 = Pad4Choir + toEnum 92 = Pad5Bowed + toEnum 93 = Pad6Metallic + toEnum 94 = Pad7Halo + toEnum 95 = Pad8Sweep + toEnum 96 = FX1Train + toEnum 97 = FX2Soundtrack + toEnum 98 = FX3Crystal + toEnum 99 = FX4Atmosphere + toEnum 100 = FX5Brightness + toEnum 101 = FX6Goblins + toEnum 102 = FX7Echoes + toEnum 103 = FX8SciFi + toEnum 104 = Sitar + toEnum 105 = Banjo + toEnum 106 = Shamisen + toEnum 107 = Koto + toEnum 108 = Kalimba + toEnum 109 = Bagpipe + toEnum 110 = Fiddle + toEnum 111 = Shanai + toEnum 112 = TinkleBell + toEnum 113 = Agogo + toEnum 114 = SteelDrums + toEnum 115 = Woodblock + toEnum 116 = TaikoDrum + toEnum 117 = MelodicDrum + toEnum 118 = SynthDrum + toEnum 119 = ReverseCymbal + toEnum 120 = GuitarFretNoise + toEnum 121 = BreathNoise + toEnum 122 = Seashore + toEnum 123 = BirdTweet + toEnum 124 = TelephoneRing + toEnum 125 = Helicopter + toEnum 126 = Applause + toEnum 127 = Gunshot + toEnum n = error $ "toEnum: " ++ show n ++ " is not implemented for InstrumentName"+
+ Euterpea/IO/MIDI/MidiIO.lhs view
@@ -0,0 +1,665 @@++> {-# LANGUAGE GeneralizedNewtypeDeriving #-}+> module Euterpea.IO.MIDI.MidiIO (+> getAllDevices, --isValidInputDevice, isValidOutputDevice, -- Used only by Euterpea.IO.MUI.MidiWidgets+> terminateMidi, initializeMidi, -- Used only by Euterpea.IO.MUI+> outputMidi, deliverMidiEvent, -- Used only by Euterpea.IO.MUI.MidiWidgets (particularly by midiOut)+> pollMidi, -- Used only by Euterpea.IO.MUI.MidiWidgets (particularly by midiIn)+> defaultOutput, defaultInput,+> playMidi, +> MidiMessage (ANote, Std), +> getTimeNow,+> DeviceInfo(..), InputDeviceID, OutputDeviceID, Message(..), Time,+> unsafeInputID, unsafeOutputID,+> ) where++> import Codec.Midi (Time, Channel, Key, Velocity, +> Message (..), Midi (..), Track, +> toRealTime, toAbsTime, toSingleTrack, isTrackEnd)+> import Sound.PortMidi (DeviceInfo (..), getDeviceInfo, +> DeviceID, countDevices, time, +> getDefaultOutputDeviceID, getDefaultInputDeviceID, +> openInput, openOutput, readEvents, +> close, writeShort, getErrorText, terminate, initialize, +> PMError (NoError, BufferOverflow), PMStream, +> PMEvent (..), PMMsg (PMMsg))+> import Control.Exception (finally)+> import Control.Concurrent+> import Control.Concurrent.STM.TChan+> import Control.Monad.STM (atomically)+> import Data.IORef++> import Data.Bits (shiftR, shiftL, (.|.), (.&.))+> import Data.List (findIndex)+> import Data.Maybe (mapMaybe)+> import qualified Data.Heap as Heap++> import System.IO (hPutStrLn, stderr)+> import System.IO.Unsafe (unsafePerformIO)+> import Control.DeepSeq (NFData)+++----------------------------+ | Midi Type declarations | +----------------------------++> type MidiEvent = (Time, MidiMessage)++> data MidiMessage = ANote { channel :: !Channel, key :: !Key,+> velocity :: !Velocity, duration :: !Time }+> | Std Message+> deriving Show++> newtype InputDeviceID = InputDeviceID DeviceID+> deriving (Eq, Show, NFData)+> newtype OutputDeviceID = OutputDeviceID DeviceID+> deriving (Eq, Show, NFData)++> unsafeInputID :: Int -> InputDeviceID+> unsafeInputID = InputDeviceID++> unsafeOutputID :: Int -> OutputDeviceID+> unsafeOutputID = OutputDeviceID++----------+ | Time | +----------++Is this the time we want? This comes from PortMidi, but there's also the +function FRP.UISF.SOE.timeGetTime which uses time data from GLFW.++> getTimeNow :: IO Time +> getTimeNow = do+> t <- time+> return (fromIntegral t / 1000)+++----------------------+ | Device Functions | +----------------------++getAllDevices returns a list of all of the DeviceInfos found.+It calls Port.Midi.getDeviceInfo over all device numbers++> getAllDevices :: IO ([(InputDeviceID, DeviceInfo)], [(OutputDeviceID, DeviceInfo)])+> getAllDevices = do+> n <- countDevices+> deviceInfos <- mapM getDeviceInfo [0..n-1]+> let devs = zip [0..n-1] deviceInfos+> return ([ (InputDeviceID d, i) | (d,i) <- devs, input i], +> [ (OutputDeviceID d, i) | (d,i) <- devs, output i])+++isValidInputDevice and isValideOutputDevice check whether the given +devices are respectively valid for input or output.++isValidInputDevice, isValidOutputDevice :: DeviceID -> IO Bool+isValidInputDevice = isValidDevice input+isValidOutputDevice = isValidDevice output+isValidDevice :: (DeviceInfo -> Bool) -> DeviceID -> IO Bool+isValidDevice pred i = do+ n <- countDevices + info <- getAllDevices+ return $ + i >= 0 && i < n && pred (snd $ info !! i)+++---------------------+ | Default devices | +---------------------++Rather than export the deviceIDs directly, these two functions allow +the caller to use the DeviceID without directly controlling it.++They take a function (such as playMidi) and an auxiary argument and +apply them together with the default device. If no default device +exists, an error is thrown.++> defaultOutput :: (OutputDeviceID -> a -> IO b) -> a -> IO b+> defaultOutput f a = do+> i <- getDefaultOutputDeviceID+> case i of+> Nothing -> error "No MIDI output device found"+> Just i -> f (OutputDeviceID i) a+> +> defaultInput :: (InputDeviceID -> a -> IO b) -> a -> IO b+> defaultInput f a = do+> i <- getDefaultInputDeviceID+> case i of+> Nothing -> error "No MIDI input device found"+> Just i -> f (InputDeviceID i) a+++-----------------------+ | Priority Channels | +-----------------------++The priority channel data type and a constructor for it will be used +by devices. We define them here.++> data PrioChannel a b = PrioChannel+> { get :: IO (Heap.MinPrioHeap a b),+> push :: a -> b -> IO (),+> pop :: IO (a,b),+> peek :: IO (Maybe (a,b)) }++> makePriorityChannel :: IO (PrioChannel Time Message)+> makePriorityChannel = do+> heapRef <- newIORef (Heap.empty :: Heap.MinPrioHeap Time Message)+> let get = readIORef heapRef+> push a b = modifyIORef heapRef (Heap.insert (a,b))+> pop = do+> h <- get+> let (a, h') = Heap.extractHead h+> modifyIORef heapRef (\_ -> h')+> return a+> peek = do+> h <- get+> if Heap.isEmpty h +> then return Nothing +> else return $ Just $ Heap.head h+> +> return $ PrioChannel get push pop peek+++------------------------+ | Global Device Data | +------------------------++We keep a mapping from DeviceID to the priority channel for keeping+track of future MIDI messages, an output function to produce sound, +and a stop function. This mapping is stored in the global ref +outDevMap, and it is accessed by getOutDev (which looks up info +and adds associations if necessary) and terminateMidi (which calls +the stop function on all elements and clears the mapping).++outDevMap is the global mapping.++> outDevMap :: IORef [(OutputDeviceID, +> (PrioChannel Time Message, -- priority channel+> (Time, Message) -> IO (), -- sound output function+> IO ()))] -- stop/terminate function+> outDevMap = unsafePerformIO $ newIORef []+++outPort and inPort are global memory refs that contain a mapping of +DeviceID to Port Midi Streams. They are modified with addPort (which +adds a new mapping to the list) and lookupPort (which, given a DeviceID, +returns the Port Midi Stream associated with it).++> outPort :: IORef [(OutputDeviceID, PMStream)]+> inPort :: IORef [(InputDeviceID, PMStream)]+> outPort = unsafePerformIO (newIORef [])+> inPort = unsafePerformIO (newIORef [])++> lookupPort :: (Eq deviceid) => IORef [(deviceid, PMStream)] -> deviceid -> IO (Maybe PMStream)+> lookupPort p i = readIORef p >>= (return . lookup i)++> addPort :: IORef [(deviceid, PMStream)] -> (deviceid, PMStream) -> IO ()+> addPort p is = modifyIORef p (is:)+++--------------------------------------------------+ | Global Device Initialization and Termination | +--------------------------------------------------++initializeMidi just initializes PortMidi++> initializeMidi :: IO ()+> initializeMidi = do+> e <- initialize+> if e == NoError +> then return () +> else reportError "initializeMidi" e++terminateMidi calls the stop function on all elements of outDevMap +and clears the mapping entirely. It also clears outPort and inPort.++> terminateMidi :: IO ()+> terminateMidi = do+> inits <- readIORef outDevMap+> mapM_ (\(_, (_,_out,stop)) -> stop) inits+> terminate+> modifyIORef outDevMap (const [])+> writeIORef outPort []+> writeIORef inPort []+++-------------------+ | Device Lookup | +-------------------++getOutDev looks up info in outDevMap and adds associations if necessary. +It is accessed as a helper function for outputMidi and deliverMidiEvent.++> getOutDev :: OutputDeviceID -> IO (PrioChannel Time Message, (Time, Message) -> IO (), IO ())+> getOutDev devId = do+> inits <- readIORef outDevMap+> case lookup devId inits of+> Just f -> return f+> Nothing -> do+> x <- midiOutRealTime' devId -- Changes made by Donya Quick: this line used to pattern match against Just.+> pChan <- makePriorityChannel+> case x of Just (mout,stop) -> do -- Case statement added.+> modifyIORef outDevMap ((devId,(pChan,mout,stop)):)+> return (pChan,mout,stop)+> Nothing -> return (pChan, const (return ()), return ()) -- Nothing case added+++----------------+ | Midi Input | +----------------++pollMidi take an input device and a callback function and polls the device +for midi events. Any events are sent, along with the current time, to +the callback function.+DWC NOTE: Why is the time even used? All messages get the same time?++> pollMidiCB :: InputDeviceID -> ((Time, [Message]) -> IO ()) -> IO ()+> pollMidiCB idid@(InputDeviceID devId) callback = do+> s <- lookupPort inPort idid +> case s of+> Nothing -> do+> r <- openInput devId +> case r of+> Right e -> reportError "pollMidiCB" e+> Left s -> addPort inPort (idid, s) >> input s+> Just s -> input s +> where+> input :: PMStream -> IO ()+> input s = do+> e <- readEvents s+> case e of+> Right e -> if e == NoError +> then return () +> else reportError "pollMidiCB" e+> Left l -> do+> now <- getTimeNow+> case mapMaybe (msgToMidi . message) l of+> [] -> return ()+> ms -> callback (now, ms)++> pollMidi :: InputDeviceID -> IO (Maybe (Time, [Message]))+> pollMidi idid@(InputDeviceID devId) = do+> s <- lookupPort inPort idid +> case s of+> Nothing -> do+> r <- openInput devId +> case r of+> Right e -> reportError "pollMIDI" e >> return Nothing+> Left s -> addPort inPort (idid, s) >> input s+> Just s -> input s +> where+> input :: PMStream -> IO (Maybe (Time, [Message]))+> input s = do+> e <- readEvents s+> case e of+> Right e -> if e == NoError +> then return Nothing+> else reportError "pollMIDI" e >> return Nothing+> Left l -> do+> now <- getTimeNow+> case mapMaybe (msgToMidi . message) l of+> [] -> return Nothing+> ms -> return $ Just (now, ms)+++---------------------------------------------+ | Midi Output for inidividual Midi events | +---------------------------------------------++The following two functions are for sending and playing individual +Midi events to devices. Typically, usage will be to call outputMidi +to play anything that's ready to play and then send in the latest +messages with deliverMidiEvent. Of course, if no new messages are +ready to be delivered, that step can be omitted. Either way, +outputMidi should be called many times per second to assure that +all Midi messages are played approximately when scheduled.++deliverMidiEvent sends the given MidiEvent to the given device. If +the event is scheduled to happen ``now'', then it is immediately +played. Otherwise, it is queued for later.++> deliverMidiEvent :: OutputDeviceID -> MidiEvent -> IO ()+> deliverMidiEvent devId (t,m) = do+> (pChan, out, _stop) <- getOutDev devId+> now <- getTimeNow+> let deliver t m = do+> if t == 0+> then out (now,m) +> else push pChan (now+t) m+> +> case m of+> Std m -> deliver t m+> ANote c k v d -> do+> deliver t (NoteOn c k v)+> deliver (t+d) (NoteOff c k v)+++outputMidi plays all midi events that are waiting in this device's +priority queue whose time to play has come.++> outputMidi :: OutputDeviceID -> IO ()+> outputMidi devId = do+> (pChan, out, _stop) <- getOutDev devId+> let loop = do+> r <- peek pChan+> case r of+> Nothing -> return ()+> Just (t,m) -> do+> now <- getTimeNow+> if t <= now +> then out (now, m) >> pop pChan >> loop+> else return ()+> loop+> return ()+++-------------------------------------------+ | Midi Output for a complete Midi track | +-------------------------------------------++When an entire Midi track is ready to be played, the playMidi function +may be more appropriate than deliverMidiEvent and outputMidi.++playMidi will queue up the entire Midi track given to it and then close +the output device.++> playMidi :: OutputDeviceID -> Midi -> IO ()+> playMidi device midi@(Midi _ division _) = do+> let track = toRealTime division (toAbsTime (head (tracks (toSingleTrack midi))))+> out <- midiOutRealTime device+> case out of+> Nothing -> return ()+> Just (out, stop) -> do+> t0 <- getTimeNow +> finally (playTrack t0 0 out track) stop+> where+> playTrack t0 t' out [] = out (t0 + t', TrackEnd)+> playTrack t0 t' out (e@(t, m) : s) = do+> out (t0 + t, m) +> if isTrackEnd m +> then return ()+> else playTrack t0 t out s+++---------------------+ | midiOutRealTime | +---------------------++The following two functions are used to open a device for Midi output. +They should only be called when the device hasn't yet been opened, and +they both return a ``play'' function and a ``stop'' function.++Currently, midiOutRealTime' is used for Midi output for inidividual +Midi events, and midiOutRealTime is used for Midi output for a complete +Midi track.++DWC Notes:+I'm not entirely sure how they both work yet. midiOutRealTime' +actually looks pretty straightforward in that it just creates the process +and stop functions and adds this device to the outPort device list. The +process function will look up the device in the outPort device list, and +if it finds it, it writes the message to it. The stop function removes +the device from the outPort list and closes it.++On the other hand, midiOutRealTime spawns a new thread and does some +concurrent stuff. Really, it looks similar, but I don't know when to +use one and when to use the other.++> midiOutRealTime' :: OutputDeviceID -> IO (Maybe ((Time, Message) -> IO (), IO ()))+> midiOutRealTime' odid@(OutputDeviceID devId) = do+> s <- openOutput devId 1 +> case s of+> Right e -> reportError "Unable to open output device in midiOutRealTime'" e >> return Nothing+> Left s -> do+> addPort outPort (odid, s)+> return $ Just (process odid, finalize odid)+> where+> process odid (t, msg) = do+> s <- lookupPort outPort odid+> case s of+> Nothing -> error ("midiOutRealTime': port " ++ show odid ++ " is not open for output")+> Just s -> do+> if isTrackEnd msg +> then return ()+> else case midiEvent msg of+> Just m -> writeMsg s t m+> Nothing -> return ()+> writeMsg s t m = do+> e <- writeShort s (PMEvent m (round (t * 1e3)))+> case e of+> NoError -> return () +> _ -> reportError "midiOutRealTime'" e+> finalize odid = do+> s <- lookupPort outPort odid+> e <- maybe (return NoError) close s+> case e of+> NoError -> return () +> _ -> reportError "midiOutRealTime'" e+++> midiOutRealTime :: OutputDeviceID -> IO (Maybe ((Time, Message) -> IO (), IO ()))+> midiOutRealTime odid@(OutputDeviceID devId) = do+> s <- openOutput devId 1 +> case s of+> Right e -> reportError "outputMidi" e >> return Nothing+> Left s -> do+> ch <- atomically newTChan +> wait <- newEmptyMVar+> fin <- newEmptyMVar+> forkIO (pump s ch wait fin)+> return $ Just (output s ch wait, stop ch fin)+> where+> stop ch fin = atomically (unGetTChan ch Nothing) >> takeMVar fin+> output s ch wait evt@(_, m) = do+> atomically $ writeTChan ch (Just evt)+> if isTrackEnd m then takeMVar wait else return ()+> pump s ch wait fin = loop+> where+> loop = do +> e <- atomically $ readTChan ch+> case e of+> Nothing -> close s >> putMVar fin ()+> Just (t, msg) -> do+> now <- getTimeNow+> if (t > now + 5) +> then atomically (unGetTChan ch e) >> threadDelay 10000 >> loop+> else do +> done <- process t msg+> if done +> then waitUntil (t + 1)+> else loop +> where+> waitUntil t = do+> now <- getTimeNow+> if t > now +> then do+> threadDelay $ min 10000 (round((t - now) * 1E6)) +> empty <- atomically $ isEmptyTChan ch+> if empty +> then waitUntil t+> else do+> e <- atomically $ readTChan ch+> case e of+> Nothing -> finishup +> _ -> waitUntil t+> else finishup+> finishup = putMVar wait () >> close s >> putMVar fin ()+> process t msg = if isTrackEnd msg +> then return True +> else case midiEvent msg of+> Just m -> writeMsg t m+> Nothing -> return False +> writeMsg t m = do+> e <- writeShort s (PMEvent m (round (t * 1e3)))+> case e of+> NoError -> return False +> BufferOverflow -> putStrLn "overflow" >> threadDelay 10000 >> writeMsg t m+> _ -> reportError "outputMidi" e >> return True +++---------------------+ | MIDI Conversion | +---------------------++A conversion function from Codec.Midi Messages to PortMidi PMMsgs.++> midiEvent :: Message -> Maybe PMMsg+> midiEvent (NoteOff c p v) = Just $ PMMsg (128 .|. (fromIntegral c .&. 0xF)) (fromIntegral p) (fromIntegral v)+> midiEvent (NoteOn c p v) = Just $ PMMsg (144 .|. (fromIntegral c .&. 0xF)) (fromIntegral p) (fromIntegral v)+> midiEvent (KeyPressure c p pr) = Just $ PMMsg (160 .|. (fromIntegral c .&. 0xF)) (fromIntegral p) (fromIntegral pr)+> midiEvent (ControlChange c cn cv) = Just $ PMMsg (176 .|. (fromIntegral c .&. 0xF)) (fromIntegral cn) (fromIntegral cv)+> midiEvent (ProgramChange c pn) = Just $ PMMsg (192 .|. (fromIntegral c .&. 0xF)) (fromIntegral pn) 0+> midiEvent (ChannelPressure c pr) = Just $ PMMsg (208 .|. (fromIntegral c .&. 0xF)) (fromIntegral pr) 0+> midiEvent (PitchWheel c pb) = Just $ PMMsg (224 .|. (fromIntegral c .&. 0xF)) (fromIntegral lo) (fromIntegral hi)+> where (hi,lo) = (pb `shiftR` 8, pb .&. 0xFF)+> midiEvent _ = Nothing +++A conversion function from PortMidi PMMsgs to Codec.Midi Messages.++> msgToMidi :: PMMsg -> Maybe Message+> msgToMidi (PMMsg m d1 d2) = +> let k = (m .&. 0xF0) `shiftR` 4+> c = fromIntegral (m .&. 0x0F)+> in case k of+> 0x8 -> Just $ NoteOff c (fromIntegral d1) (fromIntegral d2)+> 0x9 -> Just $ NoteOn c (fromIntegral d1) (fromIntegral d2)+> 0xA -> Just $ KeyPressure c (fromIntegral d1) (fromIntegral d2)+> 0xB -> Just $ ControlChange c (fromIntegral d1) (fromIntegral d2)+> 0xC -> Just $ ProgramChange c (fromIntegral d1)+> 0xD -> Just $ ChannelPressure c (fromIntegral d1)+> 0xE -> Just $ PitchWheel c (fromIntegral (d1 + d2 `shiftL` 8))+> 0xF -> Nothing -- SysEx event not handled+> _ -> Nothing+++---------------------+ | Error Reporting | +---------------------++> reportError :: String -> PMError -> IO ()+> reportError prompt e = do+> err <- getErrorText e +> hPutStrLn stderr $ prompt ++ ": " ++ err++++++----------------------+ | Unused Functions | +----------------------++> -- Prints all DeviceInfo found by getAllDevices.+> printAllDeviceInfo :: IO ()+> printAllDeviceInfo = do+> (indevs, outdevs) <- getAllDevices+> mapM_ (print . snd) indevs+> mapM_ (print . snd) outdevs++-- Given whether the device is an input device and the device name, +-- returns the DeviceID.+getDeviceId :: Bool -> String -> IO (Maybe DeviceID)+getDeviceId isInput n = do+ devs <- getAllDevices+ return $ findIndex (\(_,d) -> name d == n && input d == isInput) devs++> playTrackRealTime :: OutputDeviceID -> [(t, Message)] -> IO ()+> playTrackRealTime device track = do+> out <- midiOutRealTime device+> case out of+> Nothing -> return ()+> Just (out, stop) -> finally (playTrack out track) stop+> where+> playTrack out [] = do+> t <- getTimeNow+> out (t, TrackEnd)+> playTrack out (e@(_, m) : s) = do+> t <- getTimeNow+> out (t, m) +> if isTrackEnd m +> then return ()+> else playTrack out s++> {-+> ticksPerBeat = case division of+> TicksPerBeat n -> n+> TicksPerSecond mode nticks -> (256 - mode - 128) * nticks `div` 2 +> -}++> {-+> runTrack tpb = runTrack' 0 0 120 -- 120 beat/s is the default tempo+> where+> runTrack' t t0 bps ((_, TempoChange tempo) : l) = +> let bps' = 1000000 `div` fromIntegral tempo +> in runTrack' t t0 bps' l+> runTrack' t t0 bps ((t1, m) : l) = +> let t' = t + 1000 * fromIntegral (t1 - t0) `div` (tpb * bps)+> in (t', m) : runTrack' t' t1 bps l+> runTrack' _ _ _ [] = [] +>+> playTrack s ch t0 = playTrack' 0+> where+> playTrack' t [] = putStrLn "done" >> putMVar ch Nothing >> return (round (t * 1.0E3))+> playTrack' _ ((t, e):es) = putMVar ch (Just io) >> playTrack' t es +> where +> io = case midiEvent e of+> Just m -> writeShort s (PMEvent m (t0 + round (t * 1.0E3)))+> Nothing -> return NoError +> -}++> recordMidi :: DeviceID -> (Track Time -> IO ()) -> IO ()+> recordMidi device f = do+> ch <- newChan+> final <- midiInRealTime device (\e -> writeChan ch e >> return False)+> case final of +> Nothing -> return () +> Just fin -> do+> track <- getChanContents ch+> done <- newEmptyMVar +> forkIO (f track >> putMVar done ()) +> putStrLn "Start recording, hit ENTER when you are done."+> getLine+> fin +> takeMVar done+> return ()++> midiInRealTime :: DeviceID -> ((Time, Message) -> IO Bool) -> IO (Maybe (IO ()))+> midiInRealTime device callback = do+> r <- openInput device +> case r of+> Right e -> reportError "midiInRealTime" e >> return Nothing +> Left s -> do+> fin <- newEmptyMVar+> forkIO (loop Nothing s fin)+> return (Just (putMVar fin () >> putMVar fin ()))+> where+> loop start s fin = do+> done <- tryTakeMVar fin+> t <- getTimeNow+> case done of+> Just _ -> close s >> callback (t, TrackEnd) >> takeMVar fin >> return ()+> Nothing -> do+> e <- readEvents s+> case e of+> Right e -> if e == NoError +> then threadDelay 1000 >> loop start s fin+> else do+> reportError "midiInRealTime" e +> callback (t, TrackEnd)+> return ()+> Left l -> do+> t <- getTimeNow+> sendEvts start t l+> where +> sendEvts start now [] = loop start s fin+> sendEvts start now (e@(PMEvent m t):l) = do+> let t0 = maybe t id start+> case msgToMidi m of+> Just m' -> do+> done <- callback (now + fromIntegral (t - t0) / 1E3, m')+> if done then close s >> return () else sendEvts (Just t0) now l+> Nothing -> sendEvts (Just t0) now l+
+ Euterpea/IO/MIDI/ToMidi.hs view
@@ -0,0 +1,155 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/ToMidi.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.IO.MIDI.ToMidi(toMidi, UserPatchMap, defST, + defUpm, testMidi, testMidiA, + test, testA, writeMidi, writeMidiA, + play, playM, playA, + makeMidi, mToMF, gmUpm, gmTest) where + +import Euterpea.Music.Note.Music +import Euterpea.Music.Note.MoreMusic +import Euterpea.Music.Note.Performance +import Euterpea.IO.MIDI.GeneralMidi +import Euterpea.IO.MIDI.MidiIO +import Euterpea.IO.MIDI.ExportMidiFile +import Sound.PortMidi +import Data.List(partition) +import Data.Char(toLower,toUpper) +import Codec.Midi +type ProgNum = Int +type UserPatchMap = [(InstrumentName, Channel)] +makeGMMap :: [InstrumentName] -> UserPatchMap +makeGMMap ins = mkGMMap 0 ins + where mkGMMap _ [] = [] + mkGMMap n _ | n>=15 = + error "MakeGMMap: Too many instruments." + mkGMMap n (Percussion : ins) = + (Percussion, 9) : mkGMMap n ins + mkGMMap n (i : ins) = + (i, chanList !! n) : mkGMMap (n+1) ins + chanList = [0..8] ++ [10..15] -- channel 9 is for percussion +upmLookup :: UserPatchMap -> InstrumentName + -> (Channel, ProgNum) +upmLookup upm iName = (chan, toGM iName) + where chan = maybe (error ( "instrument " ++ show iName ++ + " not in patch map") ) + id (lookup iName upm) +toMidi :: Performance -> UserPatchMap -> Midi +toMidi pf upm = + let split = splitByInst pf + insts = map fst split + rightMap = if (allValid upm insts) then upm + else (makeGMMap insts) + in Midi (if length split == 1 then SingleTrack + else MultiTrack) + (TicksPerBeat division) + (map (fromAbsTime . performToMEvs rightMap) split) + +division = 96 :: Int +allValid :: UserPatchMap -> [InstrumentName] -> Bool +allValid upm = and . map (lookupB upm) + +lookupB :: UserPatchMap -> InstrumentName -> Bool +lookupB upm x = or (map ((== x) . fst) upm) +splitByInst :: Performance -> [(InstrumentName,Performance)] +splitByInst [] = [] +splitByInst pf = (i, pf1) : splitByInst pf2 + where i = eInst (head pf) + (pf1, pf2) = partition (\e -> eInst e == i) pf +type MEvent = (Ticks, Message) + +defST = 500000 + +performToMEvs :: UserPatchMap + -> (InstrumentName, Performance) + -> [MEvent] +performToMEvs upm (inm, pf) = + let (chan,progNum) = upmLookup upm inm + setupInst = (0, ProgramChange chan progNum) + setTempo = (0, TempoChange defST) + loop [] = [] + loop (e:es) = let (mev1,mev2) = mkMEvents chan e + in mev1 : insertMEvent mev2 (loop es) + in setupInst : setTempo : loop pf +mkMEvents :: Channel -> Event -> (MEvent,MEvent) +mkMEvents mChan (Event { eTime = t, ePitch = p, + eDur = d, eVol = v}) + = ( (toDelta t, NoteOn mChan p v'), + (toDelta (t+d), NoteOff mChan p v') ) + where v' = max 0 (min 127 (fromIntegral v)) + +toDelta t = round (t * 2.0 * fromIntegral division) +insertMEvent :: MEvent -> [MEvent] -> [MEvent] +insertMEvent mev1 [] = [mev1] +insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') = + if t1 <= t2 then mev1 : mevs + else mev2 : insertMEvent mev1 mevs' + +defUpm :: UserPatchMap +defUpm = [(AcousticGrandPiano,1), + (Vibraphone,2), + (AcousticBass,3), + (Flute,4), + (TenorSax,5), + (AcousticGuitarSteel,6), + (Viola,7), + (StringEnsemble1,8), + (AcousticGrandPiano,9)] + -- the GM name for drums is unimportant, only channel 9 + +testMidi :: Performable a => Music a -> Midi +testMidi m = toMidi (defToPerf m) defUpm + +testMidiA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Midi +testMidiA pm con m = toMidi (toPerf pm con m) defUpm + +test :: Performable a => Music a -> IO () +test m = exportMidiFile "test.mid" (testMidi m) + +testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO () +testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m) + +writeMidi :: Performable a => FilePath -> Music a -> IO () +writeMidi fn = exportMidiFile fn . testMidi + +writeMidiA :: Performable a => + FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () +writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m) + +play :: Performable a => Music a -> IO () +play = playM . testMidi + +playM :: Midi -> IO () +playM midi = do + initialize + (defaultOutput playMidi) midi + terminate + return () + +playA :: Performable a => PMap Note1 -> Context Note1 + -> Music a -> IO () +playA pm con m = + let pf = fst $ perfDur pm con m + in playM (toMidi pf defUpm) +makeMidi :: (Music1, Context Note1, UserPatchMap) -> Midi +makeMidi (m,c,upm) = toMidi (perform defPMap c m) upm + +mToMF :: PMap a -> Context a -> UserPatchMap -> FilePath -> Music a -> IO () +mToMF pmap c upm fn m = + let pf = perform pmap c m + mf = toMidi pf upm + in exportMidiFile fn mf + +gmUpm :: UserPatchMap +gmUpm = map (\n -> (toEnum n, mod n 16 + 1)) [0..127] + +gmTest :: Int -> IO () +gmTest i = let gMM = take 8 (drop (i*8) [0..127]) + mu = line (map simple gMM) + simple n = Modify (Instrument (toEnum n)) cMajArp + in mToMF defPMap defCon gmUpm "test.mid" mu + +cMaj = [ n 4 qn | n <- [c,e,g] ] -- octave 4, quarter notes +cMajArp = toMusic1 (line cMaj) +
+ Euterpea/IO/MUI.hs view
@@ -0,0 +1,64 @@+module Euterpea.IO.MUI + ( -- UI functions+ UISF + , asyncV -- :: NFData b => Integer -> Int -> SF a b -> UISF a ([b], Bool)+ , Dimension -- type Dimension = (Int, Int)+ , topDown, bottomUp, leftRight, rightLeft -- :: UISF a b -> UISF a b+ , setSize -- :: Dimension -> UISF a b -> UISF a b+ , setLayout -- :: Layout -> UISF a b -> UISF a b+ , pad -- :: (Int, Int, Int, Int) -> UISF a b -> UISF a b+ , defaultMUIParams -- :: UIParams+ , UIParams (..) -- :: UISF () () -> IO ()+ , runMUI -- :: UIParams -> UISF () () -> IO ()+ , runMUI' -- :: UISF () () -> IO ()+ , getTime -- :: UISF () Time+ -- Widgets+ , label -- :: String -> UISF a a+ , displayStr -- :: UISF String ()+ , display -- :: Show a => UISF a ()+ , withDisplay -- :: Show b => UISF a b -> UISF a b+ , textboxE -- :: String -> UISF (SEvent String) String+ , textbox -- :: UISF String String+ , title -- :: String -> UISF a b -> UISF a b+ , button -- :: String -> UISF () Bool+ , stickyButton -- :: String -> UISF () Bool+ , checkbox -- :: String -> Bool -> UISF () Bool+ , checkGroup -- :: [(String, a)] -> UISF () [a]+ , radio -- :: [String] -> Int -> UISF () Int+ , hSlider, vSlider -- :: RealFrac a => (a, a) -> a -> UISF () a+ , hiSlider, viSlider -- :: Integral a => a -> (a, a) -> a -> UISF () a+ , realtimeGraph -- :: RealFrac a => Layout -> Time -> Color -> UISF (Time, [(a,Time)]) ()+ , histogram -- :: RealFrac a => Layout -> UISF (Event [a]) ()+ , listbox -- :: (Eq a, Show a) => UISF ([a], Int) Int+ , midiIn -- :: UISF (Maybe InputDeviceID) (SEvent [MidiMessage])+ , midiOut -- :: UISF (Maybe OutputDeviceID, SEvent [MidiMessage]) ()+ , selectInput -- :: UISF () (Maybe InputDeviceID)+ , selectOutput -- :: UISF () (Maybe OutputDeviceID)+ , canvas -- :: Dimension -> UISF (Event Graphic) ()+ , canvas' -- :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) ()+ -- Widget Utilities+ , makeLayout -- :: LayoutType -> LayoutType -> Layout+ , LayoutType (..) -- data LayoutType = Stretchy { minSize :: Int } | Fixed { fixedSize :: Int }+ , Color (..) -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White+ ) where++import Euterpea.IO.MUI.MidiWidgets+import Euterpea.IO.MIDI.MidiIO (initializeMidi, terminateMidi)+import FRP.UISF++import Control.CCA.Types++instance ArrowInit UISF where+ init = delay++defaultMUIParams :: UIParams+defaultMUIParams = defaultUIParams { uiInitialize = initializeMidi, uiClose = terminateMidi, uiTitle = "MUI" }++runMUI :: UIParams -> UISF () () -> IO ()+runMUI = runUI++runMUI' :: UISF () () -> IO ()+runMUI' = runUI defaultMUIParams+++
+ Euterpea/IO/MUI/FFT.hs view
@@ -0,0 +1,59 @@+-- Filename: fft.hs+-- Created by: Daniel Winograd-Cort+-- Created on: unknown+-- Last Modified by: Daniel Winograd-Cort+-- Last Modified on: 12/12/2013++-- This module requires the array and pure-fft packages.++{-# LANGUAGE Arrows #-}+module Euterpea.IO.MUI.FFT where+import Control.CCA.Types+import Prelude hiding (init)++import FRP.UISF+import Numeric.FFT (fft)+import Data.Complex+import Data.Map (Map)+import qualified Data.Map as Map++++-- | Alternative for working with Math.FFT instead of Numeric.FFT+--import qualified Math.FFT as FFT+--import Data.Array.IArray+--import Data.Array.CArray+--myFFT n lst = elems $ (FFT.dft) (listArray (0, n-1) lst)+++--------------------------------------+-- Fast Fourier Transform+--------------------------------------++-- | Returns n samples of type b from the input stream at a time, +-- updating after k samples. This function is good for chunking +-- data and is a critical component to fftA+quantize :: ArrowInit a => Int -> Int -> a b (SEvent [b])+quantize n k = proc d -> do+ rec (ds,c) <- init ([],0) -< (take n (d:ds), c+1)+ returnA -< if c >= n && c `mod` k == 0 then Just ds else Nothing++-- | Converts the vector result of a dft into a map from frequency to magnitude.+-- One common use is:+-- fftA >>> arr (fmap $ presentFFT clockRate)+presentFFT :: Double -> [Double] -> Map Double Double+presentFFT clockRate a = Map.fromList $ zipWith (curry mkAssoc) [0..] a where + mkAssoc (i,c) = (freq, c) where+ samplesPerPeriod = fromIntegral (length a)+ freq = i * (clockRate / samplesPerPeriod)++-- | Given a quantization frequency (the number of samples between each +-- successive FFT calculation) and a fundamental period, this will decompose+-- the input signal into its constituent frequencies.+-- NOTE: The fundamental period must be a power of two!+fftA :: ArrowInit a => Int -> Int -> a Double (SEvent [Double])+fftA qf fp = proc d -> do+ carray <- quantize fp qf -< d :+ 0+ returnA -< fmap (map magnitude . take (fp `div` 2) . fft) carray++
+ Euterpea/IO/MUI/Guitar.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE Arrows #-}+module Euterpea.IO.MUI.Guitar where+import FRP.UISF+import FRP.UISF.SOE+import FRP.UISF.UITypes (Layout(..), nullLayout)+import FRP.UISF.Widget+import Euterpea.IO.MIDI+import Euterpea.Music.Note.Music hiding (transpose)+import Euterpea.IO.MUI.InstrumentBase+import qualified Codec.Midi as Midi+import Data.Maybe+import qualified Data.Char as Char++--Note, only valid for standard US keyboards:+--Also, this is an ugly hack that can't stay+--it's mostly to test the new key events+toUpper :: Char -> Char+toUpper c = fromMaybe (Char.toUpper c) (lookup c keyMap)+ where keyMap = [('`', '~'), ('1', '!'), ('2', '@'), ('3', '#'), ('4', '$'),+ ('5', '%'), ('6', '^'), ('7', '&'), ('8', '*'), ('9', '('),+ ('0', ')'), ('-', '_'), ('=', '+'), ('[', '{'), (']', '}'),+ ('|', '\\'), ('\'', '\"'), (';', ':'), ('/', '?'), ('.', '>'),+ (',', '<')]++isUpper :: Char -> Bool+isUpper c = toUpper c == c++-- first fret's width and height+fw,fh,tw,th :: Int+(fw, fh) = (90, 45)+(tw, th) = (8, 16)++type KeyType = Int+type GuitarKeyMap = [(String, Pitch, Char)]++-- Draws an individual fret++drawFret [] ((x, y), (w, h)) = nullGraphic+drawFret ((t, b):cs) ((x, y), (w, h)) =+ drawFret cs ((x + 1, y + 1), (w - 2, h )) //+ withColor' t (line (x, y) (x, y + h)) //+ withColor' b (line (x + w - 1, y) (x + w - 1, y + h))++-- Draws the string on top of each fret+ +drawString down ((x, y), (w, h)) =+ withColor Black (if down then arc (x,midY+2) (x+w, midY-2) (-180) 180+ else line (x-1, y+ h `div` 2) (x+w, y+h `div` 2)) //+ if down then withColor Blue (ellipse (midX - d, midY - d) (midX + d, midY + d)) else nullGraphic+ where d = 10+ midX = x + w `div` 2+ midY = y + h `div` 2++-- Draws just the guitar head, not interactive++drawHead :: Int -> UISF () ()+drawHead n = topDown $ constA (repeat ()) >>>+ concatA (map (mkBasicWidget layout . draw) [n,n-1..1]) >>>+ constA ()+ where draw k ((x,y),(w,h)) = withColor Black $ line (x, y + h `div` 2 + 5 * (3 - k)) (x + w, y + h `div` 2)+ layout = Layout 0 0 fw fh fw fh+++--drawHead :: Int -> UISF () ()+--drawHead 0 = proc _ -> returnA -< ()+--drawHead n = topDown $ proc _ -> do+-- ui <- mkBasicWidget layout draw -< ()+-- ui' <- drawHead (n-1) -< ()+-- returnA -< ()+-- where draw ((x,y),(w,h)) = withColor Black $ line (x, y + h `div` 2 + 5 * (3 - n)) (x + w, y + h `div` 2)+-- layout = Layout 0 0 fw fh fw fh++-- Given a character to respond to, and which fret it is, draws and displays a single interactive fret+ +mkKey :: Char -> KeyType -> UISF KeyData KeyState+mkKey c kt = mkWidget iState d process draw where+ iState = (KeyState False False False 127, Nothing)++ d = Layout 0 0 0 minh minw minh+ (minh, minw) = (fh, fw - kt * 3)++ draw box@((x,y),(w,h)) _ (kb, showNote) =+ let isDown = isKeyDown kb+ x' = x + (w - tw) `div` 2 + if isDown then 0 else -1+ y' = y + h `div` 5 + (h - th) `div` 2 + if isDown then 0 else -1+ drawNotation s = withColor Red $ text (x' + (1 - length s) * tw `div` 2, y' - th) s+ in withColor Blue (text (x', y') [c]) + // maybe nullGraphic drawNotation showNote + // drawString isDown box + // drawFret popped box++ process kd (kb,_) box evt = (kb'', (kb'', notation kd), kb /= kb'') where+ kb' = if isJust (pressed kd) then kb { song = fromJust $ pressed kd } else kb+ kb'' = case evt of+ Key c' ms down ->+ if detectKey c' (hasShiftModifier ms)+ then kb' { keypad = down, vel = 127 }+ else kb'+ Button pt True down ->+ case (mouse kb', down, pt `inside` box) of+ (False, True, True) -> kb' { mouse = True, vel = getVel pt box }+ (True, False, True) -> kb' { mouse = False, vel = getVel pt box }+ otherwise -> kb'+ MouseMove pt ->+ if pt `inside` box+ then kb'+ else kb' { mouse = False }+ otherwise -> kb'+ where getVel (u,v) ((x,y),(w,h)) = 127 - round (87 * (abs (fromIntegral u - fromIntegral (2 * x + w) / 2) / (fromIntegral w / 2)))+ detectKey c' s = toUpper c == toUpper c' && isUpper c == s -- This line should be more robust++-- Makes all of the frets on a string, returning the combined list of their outputs+ +mkKeys :: AbsPitch -> [(Char, KeyType, AbsPitch)] -> UISF (Bool, InstrumentData) (SEvent [(AbsPitch, Bool, Midi.Velocity)])+mkKeys _ [] = proc _ -> returnA -< Nothing+mkKeys free ((c,kt,ap):ckas) = proc (pluck, instr) -> do+ msg <- unique <<< mkKey c kt -< getKeyData ap instr+ let on = maybe False isKeyPlay msg+ ret | pluck = if on then [(ap, True, maybe 127 vel msg)] else [(free, True, 127)]+ | otherwise = [(ap, False, maybe 0 vel msg)]+ msgs <- mkKeys free ckas -< (pluck, instr)+ returnA -< fmap (const ret) msg ~++ msgs++-- Creates the whole string, including the response to the strum key+ +mkString :: (String, Pitch, Char) -> UISF InstrumentData (SEvent [(AbsPitch, Bool, Midi.Velocity)])+mkString (frets, freePitch, p) = leftRight $ proc insData -> do+ isPluck <- pluckString p -< ()+ msgs <- mkKeys freeap (zip3 frets [1..] [freeap+1..]) -< (isPluck, insData)+ returnA -< msgs+ where freeap = absPitch freePitch++-- Invisible widget that responds to a single character+-- There should really be built-in behavior for this sort of thing+ +pluckString :: Char -> UISF () Bool+pluckString c = mkWidget False nullLayout process draw where+ draw ((x,y),(w,h)) _ down =+ let x' = x + (w - tw) `div` 2 + if down then 0 else -1+ y' = y + (h - th) `div` 2 + if down then 0 else -1+ in withColor (if down then White else Black) $ block ((0,0),(10,10))++ process _ s _ evt = (s', s', s /= s') where+ s' = case evt of+ Button pt True down -> down+ Key c' _ down ->+ down && c == c'+ _ -> s++-- Assembles the whole guitar according to a given key map and channel+-- Requires a persistent instrument data object to be passed in.+-- Any midi messages passed to the guitar will be played on all applicable frets+-- Outputs its midi messages as generated by its inputs and user interaction+ +guitar :: GuitarKeyMap -> Midi.Channel -> UISF (InstrumentData,EMM) EMM+guitar spcList chn = focusable $ leftRight $ proc (instr, emm) -> do+ let emm' = fmap (setChannel chn) emm+ h <- drawHead (length spcList) -< ()+ frets <- mkStrings spcList -< instr { keyPairs = fmap mmToPair emm' }+ returnA -< fmap (pairToMsg chn) frets ~++ emm'+ where mkStrings [] = proc _ -> returnA -< Nothing+ mkStrings (spc:spcs) = topDown $ proc instrData -> do+ msg <- mkString spc -< instrData+ msgs <- mkStrings spcs -< instrData+ returnA -< msg ~++ msgs++-- The default six string keymap. The first in the tuple determines how many frets+-- will be displayed and what their activator keys are. The second in the tuple+-- is the open pitch (that is, the note that is played when no frets are pressed)+-- and the final entry is the strum key.+ +string1, string2, string3, string4, string5, string6 :: (String, Pitch, Char)+string6 = ("1qaz__________", (E,5), '\b')+string5 = ("2wsx__________", (B,4), '=')+string4 = ("3edc__________", (G,4), '-')+string3 = ("4rfv__________", (D,4), '0')+string2 = ("5tgb__________", (A,3), '9')+string1 = ("6yhn__________", (E,3), '8')++sixString :: GuitarKeyMap+sixString = reverse [string1, string2, string3, string4, string5, string6]
+ Euterpea/IO/MUI/InstrumentBase.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE Arrows #-}+module Euterpea.IO.MUI.InstrumentBase where+import qualified Codec.Midi as Midi+import FRP.UISF+import Data.Maybe+import Control.Monad+import Euterpea.IO.MUI.MidiWidgets (musicToMsgs)+import Euterpea.IO.MIDI+import Euterpea.Music.Note.Music hiding (transpose)+import Euterpea.Music.Note.Performance++type EMM = SEvent [MidiMessage]++-- The KeyData structure is maintained on a per-key basis in each instrument.+-- It is usually initialized by a call to getKeyData below+data KeyData = KeyData {+ pressed :: Maybe Bool,+ notation :: Maybe String,+ offset :: Int+} deriving (Show, Eq)++-- KeyState carries the information about whether the key is being pressed or not,+-- and carries the information regarding the velocity generated by the last event+data KeyState = KeyState {+ keypad:: Bool,+ mouse :: Bool,+ song :: Bool,+ vel :: Midi.Velocity+} deriving (Show, Eq)++-- InstrumentData is a settings structure for the active instrument. It takes in+-- a bool that decides whether to show the pitch classes on the instrument, an+-- AbsPitch to decide by how much to transpose the instrument, a bool that indicates+-- whether a sustain pedal is being held down and a list describing the +data InstrumentData = InstrumentData {+ showNotation::Bool,+ keyPairs :: Maybe [(AbsPitch, Bool)],+ transpose :: AbsPitch,+ pedal :: Bool+} deriving (Show, Eq)++-- A simple predicate to determine whether a given key should be displayed as pressed+isKeyDown :: KeyState -> Bool+isKeyDown (KeyState False False False _) = False+isKeyDown _ = True++-- A simple predicate to determine whether a given key is being pressed by the user+isKeyPlay :: KeyState -> Bool+isKeyPlay (KeyState False False _ _) = False+isKeyPlay _ = True++-- A neutral InstrumentData structure.+defaultInstrumentData :: InstrumentData+defaultInstrumentData = InstrumentData False Nothing 0 False++-----------------------------+-- INSTRUMENT DATA WIDGETS --+-----------------------------++-- Notation Widget+addNotation :: UISF InstrumentData InstrumentData+addNotation = proc inst -> do+ notA <- checkbox "Notation" False -< ()+ returnA -< inst { showNotation = notA }++-- Transpose Widget+addTranspose :: UISF InstrumentData InstrumentData+addTranspose = proc inst -> do+ tp <- withDisplay $ hiSlider 1 (-6,6) 0 -< ()+ returnA -< inst { transpose = tp }++-- Pedal Widget+addPedal :: UISF InstrumentData InstrumentData+addPedal = proc inst -> do+ ped <- checkbox "Pedal" False -< ()+ returnA -< inst { pedal = ped }++-----------------------------+-- ECHO WIDGET --+-----------------------------++-- This is a widget that adds an echo to a MidiMessage signal++addEcho :: UISF EMM EMM+addEcho = title "Echo" $ leftRight $ proc m -> do+ r <- title "Decay Rate" $ withDisplay (hSlider (0,0.9) 0.5) -< ()+ f <- title "Echoing Frequency" $ withDisplay (hSlider (1,10) 10) -< ()+ rec let m' = removeNull $ m ~++ s+ s <- vdelay -< (1.0/f, fmap (mapMaybe (decay 0.1 r)) m')+ returnA -< m'++removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]+removeNull Nothing = Nothing+removeNull (Just []) = Nothing+removeNull mm = mm++decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage+decay dur r m =+ let f c k v d = if v > 0 + then Just (ANote c k (truncate (fromIntegral v * r)) d)+ else Nothing+ in case m of+ ANote c k v d -> f c k v d+ Std (Midi.NoteOn c k v) -> f c k v dur+ _ -> Nothing++-----------------------------+-- INSTRUMENT SELECT --+-----------------------------++-- Sets the midi instrument on a given channel. Takes the channel and a starting instrument as an argument++selectInstrument :: Midi.Channel -> Int -> UISF EMM EMM+selectInstrument chn i = title "Instrument" $ proc msg -> do+ instrNum <- hiSlider 1 (0,127) i -< ()+ display -< (toEnum :: Int -> InstrumentName) instrNum+ instrNum' <- unique -< instrNum+ returnA -< fmap (\x -> [Std $ Midi.ProgramChange chn x]) instrNum' ~++ msg++-----------------------------+-- SONG SELECTION --+-----------------------------++-- Takes an array of tuples of song names and Music values and creates a player for them+-- Emits a midi signal that can be routed through other filters before being passed+-- on to a midiOut sink.++songPlayer :: [(String, Music Pitch)] -> UISF () EMM+songPlayer songList = proc _ -> do+ i <- pickSong songList -< ()+ let song = fmap (\x -> snd $ songList !! x) i+ let msgs = fmap (musicToMsgs False [] . toMusic1) song+ (out, _) <- eventBuffer -< maybe NoBOp MergeInBuffer msgs+ returnA -< out++pickSong :: [(String, Music Pitch)] -> UISF () (SEvent Int)+pickSong [] = title "No Songs Imported" $ proc _ -> returnA -< Nothing+pickSong songList = title "Available Songs" $ leftRight $ proc _ -> do+ i <- topDown $ radio (fst $ unzip songList) 0 -< ()+ playBtn <- edge <<< button "Play" -< ()+ returnA -< fmap (const i) playBtn++-----------------------------+-- OTHER HELPERS --+-----------------------------++-- Converts a set of midi messages to a set of pitch and state pairs to be used+-- in an InstrumentData structure++mmToPair :: [MidiMessage] -> [(AbsPitch, Bool)]+mmToPair [] = []+mmToPair (Std (Midi.NoteOn _ k _) : rest) = (k, True) : mmToPair rest+mmToPair (Std (Midi.NoteOff _ k _) : rest)= (k, False) : mmToPair rest+mmToPair (ANote {} :_) = error "ANote not implemented"+mmToPair (_:rest) = mmToPair rest++-- Given a channel, converts a list of pitches, states and velocities to a string of+-- midi messages, the opposite of mmToPair++pairToMsg :: Midi.Channel -> [(AbsPitch, Bool, Midi.Velocity)] -> [MidiMessage]+pairToMsg ch = map f where+ f (ap, b, vel) | b = Std (Midi.NoteOn ch ap vel)+ | not b = Std (Midi.NoteOff ch ap 0)++-- Given an absolute pitch, looks though the InstrumentData to create the related+-- KeyData structure containing the pressed information, the string to use for+-- pitch notation and the adjusted pitch+ +getKeyData :: AbsPitch -> InstrumentData -> KeyData+getKeyData ap (InstrumentData isShow pairs trans _) =+ KeyData (if isNothing pairs then Nothing+ else Control.Monad.mplus (lookup ap (fromJust pairs)) Nothing)+ (if isShow then Just (show $ fst $ pitch ap) else Nothing)+ (ap + trans)++-- Looks through a string of midi messages and returns the first channel in a+-- command, if it finds one. Counter to setChannel+ +detectChannel :: [MidiMessage] -> Maybe Midi.Channel+detectChannel [] = Nothing+detectChannel (ANote c _ _ _:_) = Just c+detectChannel (Std (NoteOn c _ _):_) = Just c+detectChannel (Std (NoteOff c _ _):_) = Just c+detectChannel (Std (KeyPressure c _ _):_) = Just c+detectChannel (Std (ControlChange c _ _):_) = Just c+detectChannel (Std (ProgramChange c _):_) = Just c+detectChannel (Std (ChannelPressure c _):_) = Just c+detectChannel (Std (PitchWheel c _):_) = Just c+detectChannel (_:as) = detectChannel as++-- Sets all midi messages to a single channel. This will destroy any custom commands.+-- Used inside the guitar and piano, which coerce their streams to their own channel.++setChannel :: Int -> [MidiMessage] -> [MidiMessage]+setChannel c (ANote _ k v d:as) = ANote c k v d : setChannel c as+setChannel c (Std (NoteOn _ k v):as) = Std (NoteOn c k v) : setChannel c as+setChannel c (Std (NoteOff _ k v):as) = Std (NoteOff c k v) : setChannel c as+setChannel c (Std (KeyPressure _ k p):as) = Std (KeyPressure c k p) : setChannel c as+setChannel c (Std (ControlChange _ cn cv):as) = Std (ControlChange c cn cv) : setChannel c as+setChannel c (Std (ProgramChange _ p):as) = Std (ProgramChange c p) : setChannel c as+setChannel c (Std (ChannelPressure _ p):as) = Std (ChannelPressure c p) : setChannel c as+setChannel c (Std (PitchWheel _ p):as) = Std (PitchWheel c p) : setChannel c as+setChannel _ x = x
+ Euterpea/IO/MUI/InstrumentWidgets.hs view
@@ -0,0 +1,11 @@+module Euterpea.IO.MUI.InstrumentWidgets (+ PianoKeyMap, GuitarKeyMap,+ KeyData, KeyState, InstrumentData,+ defaultInstrumentData, defaultKeyLayout, defaultMap0, defaultMap1, defaultMap2,+ addNotation, addTranspose, addPedal, addEcho,+ selectInstrument, songPlayer,+ piano, guitar, sixString+) where+import Euterpea.IO.MUI.InstrumentBase+import Euterpea.IO.MUI.Guitar+import Euterpea.IO.MUI.Piano
+ Euterpea/IO/MUI/MidiWidgets.lhs view
@@ -0,0 +1,306 @@+> {-# LANGUAGE RecursiveDo, Arrows, TupleSections #-}++> module Euterpea.IO.MUI.MidiWidgets (+> midiIn+> , midiOut+> , midiInM+> , midiOutMB+> , runMidi, runMidiM, runMidiMFlood, runMidiMB, runMidiMBFlood+> , musicToMsgs+> , musicToBO+> , selectInput, selectOutput+> , selectInputM, selectOutputM+> , BufferOperation (..) -- Reexported for use with midiOutMB +> ) where++> import FRP.UISF+> import Euterpea.IO.MIDI.MidiIO++> import Control.Monad (liftM)++> -- These four imports are just for musicToMsgs+> import Euterpea.IO.MIDI.GeneralMidi (toGM)+> import Euterpea.Music.Note.Performance (Music1, Event (..), perform, defPMap, defCon)+> import Euterpea.Music.Note.Music (InstrumentName)+> import Data.List (nub, elemIndex, sortBy)++> -- These three imports are for the runMidi functions+> import Euterpea.IO.MUI.UISFCompat+> import Control.SF.SF+> import Control.DeepSeq+++++============================================================+========================= Widgets ==========================+============================================================++-------------------+ | Midi Controls | +-------------------+midiIn is a widget that accepts a MIDI device ID and returns the event +stream of MidiMessages that that device is producing.++midiOut is a widget that accepts a MIDI device ID as well as a stream +of MidiMessages and sends the MidiMessages to the device.++> midiIn :: UISF (Maybe InputDeviceID) (SEvent [MidiMessage])+> midiIn = liftAIO f where+> f Nothing = return Nothing+> f (Just dev) = do+> m <- pollMidi dev+> return $ fmap (\(_t, ms) -> map Std ms) m+ +> midiOut :: UISF (Maybe OutputDeviceID, SEvent [MidiMessage]) ()+> midiOut = liftAIO f where+> f (Nothing, _) = return ()+> f (Just dev, Nothing) = outputMidi dev+> f (Just dev, Just ms) = do+> outputMidi dev >> mapM_ (\m -> deliverMidiEvent dev (0, m)) ms++ +The midiInM widget takes input from multiple devices and combines +it into a single stream. ++> midiInM :: UISF [InputDeviceID] (SEvent [MidiMessage])+> midiInM = foldA (~++) Nothing (arr Just >>> midiIn)++> midiInM' :: UISF [(InputDeviceID, Bool)] (SEvent [MidiMessage])+> midiInM' = arr (map fst . filter snd) >>> midiInM+++A midiOutM widget sends output to multiple MIDI devices by sequencing+the events through a single midiOut. The same messages are sent to +each device. The midiOutM is designed to be hooked up to a stream like+that from a checkGroup.++> midiOutM :: UISF [(OutputDeviceID, SEvent [MidiMessage])] ()+> midiOutM = foldA const () (arr (first Just) >>> midiOut)++> midiOutM' :: UISF ([(OutputDeviceID, Bool)], SEvent [MidiMessage]) ()+> midiOutM' = arr fixData >>> midiOutM where+> fixData (lst, mmsgs) = map ((,mmsgs) . fst) $ filter snd lst+++A midiOutB widget wraps the regular midiOut widget with a buffer. +This allows for a timed series of messages to be prepared and sent+to the widget at one time. With the regular midiOut, there is no+timestamping of the messages and they are assumed to be played "now"+rather than at some point in the future. Just as MIDI files have the+events timed based on ticks since the last event, the events here +are timed based on seconds since the last event. If an event is +to occur 0.0 seconds after the last event, then it is assumed to be+played at the same time as that other event and all simultaneous +events are handed to midiOut at the same timestep. Finally, the +widget returns a flat that is True if the buffer is empty and False+if the buffer is full (meaning that items are still being played).++> midiOutB :: UISF (Maybe OutputDeviceID, BufferOperation MidiMessage) Bool+> midiOutB = proc (devID, bo) -> do+> (out, b) <- eventBuffer -< bo+> midiOut -< (devID, if shouldClear bo then Just clearMsgs ~++ out else out)+> returnA -< b+> where clearMsgs = map (\c -> Std (ControlChange c 123 0)) [0..15]+> shouldClear ClearBuffer = True+> shouldClear (SkipAheadInBuffer _) = True+> shouldClear (SetBufferPlayStatus _ bo) = shouldClear bo+> shouldClear (SetBufferTempo _ bo) = shouldClear bo+> shouldClear _ = False++> midiOutB' :: UISF (Maybe OutputDeviceID, SEvent [(DeltaT, MidiMessage)]) Bool+> midiOutB' = second (arr $ maybe NoBOp AppendToBuffer) >>> midiOutB+++The midiOutMB widget combines the power of midiOutM with midiOutB, allowing +multiple sets of buffer controlled midi messages to be sent to different +devices. The Bool output is True if every buffer is empty (that is, no device +has any pending music to be played) and False otherwise.++> midiOutMB :: UISF [(OutputDeviceID, BufferOperation MidiMessage)] Bool+> midiOutMB = foldA (&&) True (arr (first Just) >>> midiOutB)++> midiOutMB' :: UISF ([(OutputDeviceID, Bool)], SEvent [(DeltaT, MidiMessage)]) Bool+> midiOutMB' = arr fixData >>> midiOutMB where+> fixData (lst, mmsgs) = map ((,maybe NoBOp AppendToBuffer mmsgs) . fst) $ filter snd lst+++-------------+ | runMidi | +-------------+The following functions are experimental functions for doing all Midi +behavior at once in an external thread. There are mutiple versions +corresponding to Multiple input/output (M), Batch (B), and message +flooding (Flood).++> runMidi :: NFData b+> => SF (b, SEvent [MidiMessage]) +> (c, SEvent [MidiMessage])+> -> UISF (b, (Maybe InputDeviceID, Maybe OutputDeviceID)) [c]+> runMidi sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where+> iAction Nothing = return Nothing+> iAction (Just idev) = do+> m <- pollMidi idev+> return $ fmap (\(_t, ms) -> map Std ms) m+> oAction (Nothing, _) = return ()+> oAction (Just odev, ms) = do+> outputMidi odev+> maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms+> sf' = toAutomaton $ arr (\((b,(idev,odev)),mms) -> ((b,mms),odev)) >>> first sf >>>+> arr (\((c,mms),odev) -> (c, (odev, mms)))++> runMidiM :: NFData b+> => SF (b, ([(InputDeviceID, SEvent [MidiMessage])], [OutputDeviceID]))+> (c, [(OutputDeviceID, SEvent [MidiMessage])])+> -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [c]+> runMidiM sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where+> iAction [] = return []+> iAction (idev:devs) = do+> m <- pollMidi idev+> let ret = fmap (\(_t, ms) -> map Std ms) m+> rst <- iAction devs+> return $ (idev, ret):rst+> oAction [] = return ()+> oAction ((odev, ms):rst) = do+> outputMidi odev+> maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms+> oAction rst+> sf' = toAutomaton $ arr (\((b,(idevs,odevs)),mms) -> (b,(mms,odevs))) >>> sf++> runMidiMFlood :: NFData b+> => SF (b, SEvent [MidiMessage])+> (c, SEvent [MidiMessage])+> -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [c]+> runMidiMFlood = runMidiFloodHelper runMidiM++> runMidiMB :: NFData b+> => SF (b, ([(InputDeviceID, SEvent [MidiMessage])], [OutputDeviceID]))+> (c, [(OutputDeviceID, BufferOperation MidiMessage)])+> -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [(c, Bool)] --([c], Bool)+> runMidiMB sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where+> -- >>> arr (\lst -> let (cs, bools) = unzip lst in (cs, and bools)) >>> delay ([],True) where+> iAction idevs = do+> t <- getTimeNow+> mms <- iAction' idevs+> return (mms, t)+> iAction' [] = return []+> iAction' (idev:devs) = do+> m <- pollMidi idev+> let ret = fmap (\(_t, ms) -> map Std ms) m+> rst <- iAction' devs+> return $ (idev, ret):rst+> oAction [] = return ()+> oAction ((odev, ms):rst) = do+> outputMidi odev+> maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms+> oAction rst+> sf' = toAutomaton $ arr (\((b,(idevs,odevs)),(mms, t)) -> ((b,(mms,odevs)), t)) >>> first sf+> >>> arr (\((c, bos), t) -> (c, (map (,t) bos))) >>> second (foldA cons ([], True) buffer)+> >>> arr (\(c, (lst, bool)) -> ((c, bool), lst))+> cons (e, b) (lst, b') = (e:lst, b && b')+> buffer = proc ((dev, bo), t) -> do+> (out, b) <- eventBuffer' -< (bo, t)+> returnA -< ((dev, if shouldClear bo then Just clearMsgs ~++ out else out), b)+> clearMsgs = map (\c -> Std (ControlChange c 123 0)) [0..15]+> shouldClear ClearBuffer = True+> shouldClear (SkipAheadInBuffer _) = True+> shouldClear (SetBufferPlayStatus _ bo) = shouldClear bo+> shouldClear (SetBufferTempo _ bo) = shouldClear bo+> shouldClear _ = False+++> runMidiMBFlood :: NFData b+> => SF (b, SEvent [MidiMessage])+> (c, BufferOperation MidiMessage)+> -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [(c, Bool)] --([c], Bool)+> runMidiMBFlood = runMidiFloodHelper runMidiMB++> runMidiFloodHelper :: Arrow a =>+> (a (b, ([(idev, SEvent [m])], [odev])) (c, [(odev, mms)]) -> t)+> -> a (b, SEvent [m]) (c, mms) -> t+> runMidiFloodHelper runner sf = runner sf' where+> sf' = arr (\(b, (idevs, odevs)) -> ((b, foldl (flip ((~++) . snd)) Nothing idevs), odevs)) >>> first sf >>> +> arr (\((c, mms), odevs) -> (c, map (\d -> (d, mms)) odevs))+++++++The musicToMsgs function bridges the gap between a Music1 value and+the input type of midiOutB. It turns a Music1 value into a series +of MidiMessages that are timestamped using the number of seconds +since the last event. The arguments are as follows:++- True if allowing for an infinite music value, False if the input+ value is known to be finite. ++- InstrumentName overrides for channels for infinite case. When the+ input is finite, an empty list can be supplied since the instruments+ will be pulled from the Music1 value directly (which is obviously + not possible to do in the infinite case).++- The Music1 value to convert to timestamped MIDI messages.++> musicToMsgs :: Bool -> [InstrumentName] -> Music1 -> [(DeltaT, MidiMessage)]+> musicToMsgs inf is m = +> let p = perform defPMap defCon m -- obtain the performance+> instrs = if null is && not inf then nub $ map eInst p else is+> chan e = 1 + case elemIndex (eInst e) instrs of +> Just i -> i+> Nothing -> error ("Instrument "++show (eInst e)+++> "is not assigned to a channel.") +> f e = (eTime e, ANote (chan e) (ePitch e) (eVol e) (fromRational $ eDur e))+> f2 e = [(eTime e, Std (NoteOn (chan e) (ePitch e) (eVol e))), +> (eTime e + eDur e, Std (NoteOff (chan e) (ePitch e) (eVol e)))]+> evs = if inf then map f p else sortBy mOrder $ concatMap f2 p -- convert to MidiMessages+> times = map (fromRational.fst) evs -- absolute times+> newTimes = zipWith subtract (head times : times) times -- relative times+> progChanges = zipWith (\c i -> (0, Std $ ProgramChange c i)) +> [1..16] $ map toGM instrs+> in if length instrs > 16 then error "too many instruments!" +> else progChanges ++ zip newTimes (map snd evs) where+> mOrder (t1,m1) (t2,m2) = compare t1 t2++> musicToBO :: Bool -> [InstrumentName] -> Music1 -> BufferOperation MidiMessage+> musicToBO inf is m = AppendToBuffer $ musicToMsgs inf is m+ + +----------------------+ | Device Selection | +----------------------+selectInput and selectOutput are shortcut widgets for producing a set +of radio buttons corresponding to the available input and output devices +respectively. The output is the DeviceID for the chosen device rather +that just the radio button index as the radio widget would return.++> selectInput :: UISF () (Maybe InputDeviceID)+> selectOutput :: UISF () (Maybe OutputDeviceID)+> selectInput = selectDev "Input device" (liftM fst $ getAllDevices)+> selectOutput = selectDev "Output device" (liftM snd $ getAllDevices)++> selectDev :: String -> IO [(deviceid, DeviceInfo)] -> UISF () (Maybe deviceid)+> selectDev t getDevs = initialAIO getDevs $ \devices ->+> let devs = filter (\(i,d) -> name d /= "Microsoft MIDI Mapper") devices+> defaultChoice = if null devs then (-1) else 0+> in title t $ proc _ -> do+> r <- radio (map (name . snd) devs) defaultChoice -< ()+> returnA -< if r == -1 then Nothing else Just $ fst (devs !! r)+++The selectInputM and selectOutputM widgets use checkboxes instead of +radio buttons to allow the user to select multiple inputs and outputs.+These widgets should be used with midiInM and midiOutM respectively.++> selectInputM :: UISF () [InputDeviceID]+> selectOutputM :: UISF () [OutputDeviceID]+> selectInputM = selectDevM "Input devices" (liftM fst $ getAllDevices)+> selectOutputM = selectDevM "Output devices" (liftM snd $ getAllDevices)++> selectDevM :: String -> IO [(deviceid, DeviceInfo)] -> UISF () [deviceid]+> selectDevM t getDevs = initialAIO getDevs $ \devices ->+> let devs = filter (\(i,d) -> name d /= "Microsoft MIDI Mapper") devices+> in title t $ checkGroup $ map (\(i,d) -> (name d, i)) devs+++
+ Euterpea/IO/MUI/Piano.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE Arrows #-}+module Euterpea.IO.MUI.Piano where+import FRP.UISF+import FRP.UISF.SOE+import FRP.UISF.UITypes (Layout(..))+import FRP.UISF.Widget+import Euterpea.Music.Note.Music hiding (transpose)+import Euterpea.IO.MUI.InstrumentBase+import qualified Codec.Midi as Midi+import Data.Maybe+import qualified Data.Char as Char++--Note, only valid for standard US keyboards:+--Also, this is an ugly hack that can't stay+--it's mostly to test the new key events+toUpper :: Char -> Char+toUpper c = fromMaybe (Char.toUpper c) (lookup c keyMap)+ where keyMap = [('`', '~'), ('1', '!'), ('2', '@'), ('3', '#'), ('4', '$'),+ ('5', '%'), ('6', '^'), ('7', '&'), ('8', '*'), ('9', '('),+ ('0', ')'), ('-', '_'), ('=', '+'), ('[', '{'), (']', '}'),+ ('|', '\\'), ('\'', '\"'), (';', ':'), ('/', '?'), ('.', '>'),+ (',', '<')]++isUpper :: Char -> Bool+isUpper c = toUpper c == c++data KeyType = White1 | White2 | White3 | Black1 deriving (Show, Eq)++defaultKeyLayout :: [KeyType]+defaultKeyLayout = cycle [White1, Black1, White2, Black1, White3, White1, Black1, White2, Black1, White2, Black1, White3]++-- Width Height of White and Black notes+ww, wh, bw, bh, tw, th :: Int+(ww, wh) = (35, 100)+(bw, bh) = (25, 60)+(tw, th) = (8, 16)++topW :: KeyType -> Int+topW Black1 = bw `div` 2+topW White1 = ww - bw `div` 2+topW White2 = ww - bw `div` 2+topW White3 = ww++insideKey :: KeyType -> (Int,Int) -> ((Int,Int),(Int,Int)) -> Bool+insideKey Black1 pt ((x, y), (w, h)) = pt `inside` ((x,y),(bw,bh))+insideKey White1 pt ((x, y), (w, h)) =+ let b1 = ((x,y), (ww - bw `div` 2, bh))+ b2 = ((x, y+bh), (ww, wh-bh))+ in (pt `inside` b1) || (pt `inside` b2)+insideKey White2 pt ((x, y), (w, h)) =+ let b1 = ((x+bw `div` 2,y), (ww - bw, bh))+ b2 = ((x, y+bh), (ww, wh-bh))+ in (pt `inside` b1) || (pt `inside` b2)+insideKey White3 pt ((x, y), (w, h)) =+ let b1 = ((x+bw `div` 2,y), (bw `div` 2, bh))+ b2 = ((x, y+bh), (ww, wh-bh))+ in (pt `inside` b1) || (pt `inside` b2)++isBlack :: KeyType -> Bool+isBlack Black1 = True+isBlack _ = False+++-- *****************************************************************************+-- Drawing routines for each key type+-- *****************************************************************************+-- This has a complicated type, so I'm leaving it out.+drawBox kt | kt == White1 = white1+ | kt == White2 = white2+ | kt == White3 = white3+ | kt == Black1 = black1+drawBox _ = error "Euterpea.IO.MUI.Piano.drawBox: Unexpected input"++white1 [] _ = nullGraphic+white1 ((t, b):cs) ((x, y), (w, h)) =+ let x' = x + w - bw `div` 2+ y' = y + bh+ in white1 cs ((x + 1, y + 1), (w - 2, h - 2)) //+ withColor' t (line (x, y) (x, y + h - 1) //+ line (x, y) (x' - 2, y) //+ line (x' - 2, y+bh) (x + w - 2, y+bh)) //+ withColor' b (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) //+ line (x + w - 2 - bw `div` 2, y) (x + w - 2 - bw `div` 2, y+bh) //+ line (x + w - 1, y + bh) (x + w - 1, y + h - 1))++white2 [] _ = nullGraphic+white2 ((t, b):cs) ((x, y), (w, h)) = + let x1 = x + bw `div` 2+ x2 = x + w - bw `div` 2+ y' = y + bh+ in white2 cs ((x + 1, y + 1), (w - 2, h - 2)) //+ withColor' t (line (x1+2, y) (x1+2, y' - 1) //+ line (x1+2, y) (x2 - 2, y) //+ line (x - 2, y') (x1 - 2, y') //+ line (x2- 2, y') (x + w - 2, y')) //+ withColor' b (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) //+ line (x2 - 1, y) (x2 - 1, y') //+ line (x + w - 1, y + bh) (x + w - 1, y + h - 1))++white3 [] _ = nullGraphic+white3 ((t, b):cs) ((x, y), (w, h)) =+ let x1 = x + bw `div` 2+ y' = y + bh+ in white3 cs ((x + 1, y + 1), (w - 2, h - 2)) //+ withColor' t (line (x1+2, y) (x1+2, y' - 1) //+ line (x1+2, y) (x + w - 2, y) //+ line (x - 2, y') (x1 - 2, y')) //+ withColor' b (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) //+ line (x + w - 1, y) (x + w - 1, y') //+ line (x + w - 1, y + bh) (x + w - 1, y + h - 1))++black1 [] _ = nullGraphic+black1 ((t, b):cs) ((x, y), (w, h)) =+ black1 cs ((x + 1, y + 1), (w - 2, h - 2)) //+ withColor' t (line (x, y) (x, y + h - 1) //+ line (x, y) (x + w - 2, y)) //+ withColor' b (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) //+ line (x + w - 1, y) (x + w - 1, y + h - 1))++colorKey Black1 b = withColor Black $ block b+colorKey kt ((x,y), (w,h)) = withColor White $ block ((x, y+bh), (ww, wh-bh)) // f kt+ where f White1 = block ((x,y), (ww - bw `div` 2, bh))+ f White2 = block ((x+ bw `div` 2, y), (ww-bw, bh))+ f White3 = block ((x+ bw `div` 2, y), (ww-bw `div` 2, bh))+ f _ = error "Euterpea.IO.MUI.Piano.colorKey: Unexpected input"++-- *****************************************************************************+-- Single-key widget: handles key/mouse input and check if the song is playing+-- *****************************************************************************+mkKey :: Char -> KeyType -> UISF KeyData KeyState+mkKey c kt = mkWidget iState d process draw where+ iState = (KeyState False False False 127, Nothing)++ d = Layout 0 0 0 minh minw minh+ minw = topW kt+ minh | isBlack kt = bh+ | otherwise = wh++ draw rect inFocus (kb, showNote) = + let isDown = isKeyDown kb+ b@((x,y),(w,h)) = realBBX rect+ x' = x + (w - tw) `div` 2 + if isDown then 0 else -1+ y' = y + h `div` 3 + (h - th) `div` 2 + if isDown then 0 else -1+ drawNotation s = withColor Red $ text (x'+(1-length s)*tw `div` 2, y'- th + 2) s+ in withColor (if isBlack kt then White else Black) (text (x',y') [c]) + // maybe nullGraphic drawNotation showNote + // withColor White (drawBox kt (if isDown then pushed else popped) b) + // colorKey kt b+ realBBX ((x,y),(w,h)) = let (w', h') | isBlack kt = (bw,bh)+ | otherwise = (ww,wh)+ in ((x,y),(w',h'))++ process kd (kb,_) bbx evt = (kb'', (kb'', notation kd), kb /= kb'') where+ kb' = if isJust (pressed kd) then kb { song = fromJust $ pressed kd } else kb+ kb'' = case evt of+ Key c' ms down ->+ if detectKey c' (hasShiftModifier ms)+ then kb' { keypad = down, vel = 127 }+ else kb'+ Button pt True down -> case (mouse kb', down, insideKey kt pt bbx) of + (False, True, True) -> kb' { mouse = True, vel = getVel pt bbx }+ (True, False, True) -> kb' { mouse = False, vel = getVel pt bbx }+ otherwise -> kb'+ MouseMove pt -> if insideKey kt pt bbx then kb' else kb' { mouse = False }+ _ -> kb'+ where getVel (u,v) ((x,y),(w,h)) = 40 + 87 * round (fromIntegral (v - y) / fromIntegral h)+ detectKey c' s = toUpper c == toUpper c' && isUpper c == s -- This line should be more robust++-- *****************************************************************************+-- Group all keys together+-- *****************************************************************************++mkKeys :: [(Char, KeyType, AbsPitch)] -> UISF InstrumentData (SEvent [(AbsPitch, Bool, Midi.Velocity)])+mkKeys [] = proc instr -> returnA -< Nothing+mkKeys ((c,kt,ap):ckas) = proc instr -> do+ msg <- unique <<< mkKey c kt -< getKeyData ap instr+ let on = maybe False isKeyPlay msg+ ped = pedal instr+ ret | not on && not ped = [(ap, False, maybe 0 vel msg)]+ | on = [(ap, True, maybe 127 vel msg)]+ | otherwise = []+ msgs <- mkKeys ckas -< instr+ returnA -< fmap (const ret) msg ~++ msgs++-- *****************************************************************************+-- Main widget: piano that takes a map (string) of characters to map to notes+-- and the pitch of the first note+-- two default maps are provided so that two piano can be loaded concurrently+-- *****************************************************************************+type PianoKeyMap = (String, Pitch)+defaultMap1, defaultMap2, defaultMap0 :: PianoKeyMap+defaultMap1 = ("q2w3er5t6y7uQ@W#ERT^Y&U*", (C,2))+defaultMap2 = ("zsxdcvgbhnjmZSXDCVGBHNJM", (C,3))+defaultMap0 = (fst defaultMap1 ++ fst defaultMap2, (C,3))++piano :: PianoKeyMap -> Midi.Channel -> UISF (InstrumentData,EMM) EMM+piano (s,p) chn = focusable $ proc (instr,emm) -> do+ let emm' = fmap (setChannel chn) emm+ let instrData = instr { keyPairs = fmap mmToPair emm' }+ keys <- leftRight $ mkKeys (zip3 s defaultKeyLayout (iterate (1+) (absPitch p))) -< instrData+ returnA -< fmap (pairToMsg chn) keys ~++ emm'
+ Euterpea/IO/MUI/UISFCompat.lhs view
@@ -0,0 +1,31 @@++> {-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}++> module Euterpea.IO.MUI.UISFCompat where+> import FRP.UISF.AuxFunctions+> import FRP.UISF.UISF+> import Control.SF.SF+> import Control.CCA.ArrowP+> import Euterpea.IO.Audio.Types+> import Control.DeepSeq+> import Control.Concurrent (killThread, ThreadId)++The below function is useful for making use of asyncUISF*+which both make use of Automatons rather than SFs.+NOTE: Actually, SF and Automaton (->) are the same thing. Perhaps we should + replace our definition of SF with just a type synonym instead.++> toAutomaton :: forall a b . SF a b -> Automaton (->) a b+> toAutomaton ~(SF f) = Automaton $ \a -> let (b, sf) = f a in (b, toAutomaton sf)++The below function is useful for directly asynchronizing AudSFs and CtrSFs in UISF.++> clockedSFToUISF :: forall a b c . (NFData b, Clock c) => Double -> SigFun c a b -> UISF a [(b, Time)]+> clockedSFToUISF buffer ~(ArrowP sf) = let r = rate (undefined :: c) +> in asyncUISFV r buffer (toAutomaton sf)++This function is the standard UISF asynchronous thread handler:++> uisfAsyncThreadHandler :: ThreadId -> UISF a a+> uisfAsyncThreadHandler = addTerminationProc . killThread+
+ Euterpea/Music/Note/MoreMusic.hs view
@@ -0,0 +1,262 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/MoreMusic.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Music.Note.MoreMusic where +import Euterpea.Music.Note.Music +line, chord :: [Music a] -> Music a +line = foldr (:+:) (rest 0) +chord = foldr (:=:) (rest 0) + +line1, chord1 :: [Music a] -> Music a +line1 = foldr1 (:+:) +chord1 = foldr1 (:=:) +delayM :: Dur -> Music a -> Music a +delayM d m = rest d :+: m + +timesM :: Int -> Music a -> Music a +timesM 0 m = rest 0 +timesM n m = m :+: timesM (n-1) m + +repeatM :: Music a -> Music a +repeatM m = m :+: repeatM m +lineToList :: Music a -> [Music a] +lineToList (Prim (Rest 0)) = [] +lineToList (n :+: ns) = n : lineToList ns +lineToList _ = + error "lineToList: argument not created by function line" +invert :: Music Pitch -> Music Pitch +invert m = + let l@(Prim (Note _ r) : _) = lineToList m + inv (Prim (Note d p)) = + note d (pitch (2 * absPitch r - absPitch p)) + inv (Prim (Rest d)) = rest d + in line (map inv l) +retro, retroInvert, invertRetro :: Music Pitch -> Music Pitch +retro = line . reverse . lineToList +retroInvert = retro . invert +invertRetro = invert . retro + +pr1, pr2 :: Pitch -> Music Pitch +pr1 p = tempo (5/6) + ( tempo (4/3) ( mkLn 1 p qn :+: + tempo (3/2) ( mkLn 3 p en :+: + mkLn 2 p sn :+: + mkLn 1 p qn ) :+: + mkLn 1 p qn) :+: + tempo (3/2) ( mkLn 6 p en)) +pr2 p = + let m1 = tempo (5/4) (tempo (3/2) m2 :+: m2) + m2 = mkLn 3 p en + in tempo (7/6) ( m1 :+: + tempo (5/4) (mkLn 5 p en) :+: + m1 :+: + tempo (3/2) m2) + +mkLn :: Int -> p -> Dur -> Music p +mkLn n p d = line $ take n $ repeat $ note d p +pr12 :: Music Pitch +pr12 = pr1 (C,4) :=: pr2 (G,4) + +(=:=) :: Dur -> Dur -> Music a -> Music a +old =:= new = tempo (new/old) +dur :: Music a -> Dur +dur (Prim (Note d _)) = d +dur (Prim (Rest d)) = d +dur (m1 :+: m2) = dur m1 + dur m2 +dur (m1 :=: m2) = dur m1 `max` dur m2 +dur (Modify (Tempo r) m) = dur m / r +dur (Modify _ m) = dur m +revM :: Music a -> Music a +revM n@(Prim _) = n +revM (Modify c m) = Modify c (revM m) +revM (m1 :+: m2) = revM m2 :+: revM m1 +revM (m1 :=: m2) = + let d1 = dur m1 + d2 = dur m2 + in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) + else (rest (d2-d1) :+: revM m1) :=: revM m2 + +takeM :: Dur -> Music a -> Music a +takeM d m | d <= 0 = rest 0 +takeM d (Prim (Note oldD p)) = note (min oldD d) p +takeM d (Prim (Rest oldD)) = rest (min oldD d) +takeM d (m1 :=: m2) = takeM d m1 :=: takeM d m2 +takeM d (m1 :+: m2) = let m'1 = takeM d m1 + m'2 = takeM (d - dur m'1) m2 + in m'1 :+: m'2 +takeM d (Modify (Tempo r) m) = tempo r (takeM (d*r) m) +takeM d (Modify c m) = Modify c (takeM d m) +cut :: Dur -> Music a -> Music a +cut = takeM +dropM :: Dur -> Music a -> Music a +dropM d m | d <= 0 = m +dropM d (Prim (Note oldD p)) = note (max (oldD-d) 0) p +dropM d (Prim (Rest oldD)) = rest (max (oldD-d) 0) +dropM d (m1 :=: m2) = dropM d m1 :=: dropM d m2 +dropM d (m1 :+: m2) = let m'1 = dropM d m1 + m'2 = dropM (d - dur m1) m2 + in m'1 :+: m'2 +dropM d (Modify (Tempo r) m) = tempo r (dropM (d*r) m) +dropM d (Modify c m) = Modify c (dropM d m) +removeZeros :: Music a -> Music a +removeZeros (Prim p) = Prim p +removeZeros (m1 :+: m2) = + let m'1 = removeZeros m1 + m'2 = removeZeros m2 + in case (m'1,m'2) of + (Prim (Note 0 p), m) -> m + (Prim (Rest 0 ), m) -> m + (m, Prim (Note 0 p)) -> m + (m, Prim (Rest 0 )) -> m + (m1, m2) -> m1 :+: m2 +removeZeros (m1 :=: m2) = + let m'1 = removeZeros m1 + m'2 = removeZeros m2 + in case (m'1,m'2) of + (Prim (Note 0 p), m) -> m + (Prim (Rest 0 ), m) -> m + (m, Prim (Note 0 p)) -> m + (m, Prim (Rest 0 )) -> m + (m1, m2) -> m1 :=: m2 +removeZeros (Modify c m) = Modify c (removeZeros m) +type LazyDur = [Dur] +durL :: Music a -> LazyDur +durL m@(Prim _) = [dur m] +durL (m1 :+: m2) = let d1 = durL m1 + in d1 ++ map (+(last d1)) (durL m2) +durL (m1 :=: m2) = mergeLD (durL m1) (durL m2) +durL (Modify (Tempo r) m) = map (/r) (durL m) +durL (Modify _ m) = durL m +mergeLD :: LazyDur -> LazyDur -> LazyDur +mergeLD [] ld = ld +mergeLD ld [] = ld +mergeLD ld1@(d1:ds1) ld2@(d2:ds2) = + if d1<d2 then d1 : mergeLD ds1 ld2 + else d2 : mergeLD ld1 ds2 +minL :: LazyDur -> Dur -> Dur +minL [] d' = d' +minL [d] d' = min d d' +minL (d:ds) d' = if d < d' then minL ds d' else d' +takeML :: LazyDur -> Music a -> Music a +takeML [] m = rest 0 +takeML (d:ds) m | d <= 0 = takeML ds m +takeML ld (Prim (Note oldD p)) = note (minL ld oldD) p +takeML ld (Prim (Rest oldD)) = rest (minL ld oldD) +takeML ld (m1 :=: m2) = takeML ld m1 :=: takeML ld m2 +takeML ld (m1 :+: m2) = + let m'1 = takeML ld m1 + m'2 = takeML (map (\d -> d - dur m'1) ld) m2 + in m'1 :+: m'2 +takeML ld (Modify (Tempo r) m) = tempo r (takeML (map (*r) ld) m) +takeML ld (Modify c m) = Modify c (takeML ld m) +(/=:) :: Music a -> Music a -> Music a +m1 /=: m2 = takeML (durL m2) m1 :=: takeML (durL m1) m2 +trill :: Int -> Dur -> Music Pitch -> Music Pitch +trill i sDur (Prim (Note tDur p)) = + if sDur >= tDur then note tDur p + else note sDur p :+: + trill (negate i) sDur + (note (tDur-sDur) (trans i p)) +trill i d (Modify (Tempo r) m) = tempo r (trill i (d*r) m) +trill i d (Modify c m) = Modify c (trill i d m) +trill _ _ _ = + error "trill: input must be a single note." +trill' :: Int -> Dur -> Music Pitch -> Music Pitch +trill' i sDur m = trill (negate i) sDur (transpose i m) +trilln :: Int -> Int -> Music Pitch -> Music Pitch +trilln i nTimes m = trill i (dur m / fromIntegral nTimes) m +trilln' :: Int -> Int -> Music Pitch -> Music Pitch +trilln' i nTimes m = trilln (negate i) nTimes (transpose i m) +roll :: Dur -> Music Pitch -> Music Pitch +rolln :: Int -> Music Pitch -> Music Pitch + +roll dur m = trill 0 dur m +rolln nTimes m = trilln 0 nTimes m +ssfMel :: Music Pitch +ssfMel = line (l1 ++ l2 ++ l3 ++ l4) + where l1 = [ trilln 2 5 (bf 6 en), ef 7 en, ef 6 en, ef 7 en ] + l2 = [ bf 6 sn, c 7 sn, bf 6 sn, g 6 sn, ef 6 en, bf 5 en ] + l3 = [ ef 6 sn, f 6 sn, g 6 sn, af 6 sn, bf 6 en, ef 7 en ] + l4 = [ trill 2 tn (bf 6 qn), bf 6 sn, denr ] + +starsAndStripes :: Music Pitch +starsAndStripes = instrument Flute ssfMel +grace :: Int -> Rational -> Music Pitch -> Music Pitch +grace n r (Prim (Note d p)) = + note (r*d) (trans n p) :+: note ((1-r)*d) p +grace n r _ = + error "grace: can only add a grace note to a note" +grace2 :: Int -> Rational -> + Music Pitch -> Music Pitch -> Music Pitch +grace2 n r (Prim (Note d1 p1)) (Prim (Note d2 p2)) = + note (d1-r*d2) p1 :+: note (r*d2) (trans n p2) :+: note d2 p2 +grace2 _ _ _ _ = + error "grace2: can only add a grace note to a note" +data PercussionSound = + AcousticBassDrum -- MIDI Key 35 + | BassDrum1 -- MIDI Key 36 + | SideStick -- ... + | AcousticSnare | HandClap | ElectricSnare | LowFloorTom + | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom + | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 + | HighTom | RideCymbal1 | ChineseCymbal | RideBell + | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 + | Vibraslap | RideCymbal2 | HiBongo | LowBongo + | MuteHiConga | OpenHiConga | LowConga | HighTimbale + | LowTimbale | HighAgogo | LowAgogo | Cabasa + | Maracas | ShortWhistle | LongWhistle | ShortGuiro + | LongGuiro | Claves | HiWoodBlock | LowWoodBlock + | MuteCuica | OpenCuica | MuteTriangle + | OpenTriangle -- MIDI Key 82 + deriving (Show,Eq,Ord,Enum) + +perc :: PercussionSound -> Dur -> Music Pitch +perc ps dur = note dur (pitch (fromEnum ps + 35)) +funkGroove :: Music Pitch +funkGroove + = let p1 = perc LowTom qn + p2 = perc AcousticSnare en + in tempo 3 $ instrument Percussion $ takeM 8 $ repeatM + ( ( p1 :+: qnr :+: p2 :+: qnr :+: p2 :+: + p1 :+: p1 :+: qnr :+: p2 :+: enr) + :=: roll en (perc ClosedHiHat 2) ) +pMap :: (a -> b) -> Primitive a -> Primitive b +pMap f (Note d x) = Note d (f x) +pMap f (Rest d) = Rest d +mMap :: (a -> b) -> Music a -> Music b +mMap f (Prim p) = Prim (pMap f p) +mMap f (m1 :+: m2) = mMap f m1 :+: mMap f m2 +mMap f (m1 :=: m2) = mMap f m1 :=: mMap f m2 +mMap f (Modify c m) = Modify c (mMap f m) +type Volume = Int +addVolume :: Volume -> Music Pitch -> Music (Pitch,Volume) +addVolume v = mMap (\p -> (p,v)) +data NoteAttribute = + Volume Int -- MIDI convention: 0=min, 127=max + | Fingering Integer + | Dynamics String + | Params [Double] + deriving (Eq, Show) +mFold :: (Primitive a -> b) -> (b->b->b) -> (b->b->b) -> + (Control -> b -> b) -> Music a -> b +mFold f (+:) (=:) g m = + let rec = mFold f (+:) (=:) g + in case m of + Prim p -> f p + m1 :+: m2 -> rec m1 +: rec m2 + m1 :=: m2 -> rec m1 =: rec m2 + Modify c m -> g c (rec m) +rep :: (Music a -> Music a) -> (Music a -> Music a) -> Int + -> Music a -> Music a +rep f g 0 m = rest 0 +rep f g n m = m :=: g (rep f g (n-1) (f m)) +run, cascade, cascades, final :: Music Pitch +run', cascade', cascades', final' :: Music Pitch +run = rep (transpose 5) (delayM tn) 8 (c 4 tn) +cascade = rep (transpose 4) (delayM en) 8 run +cascades = rep id (delayM sn) 2 cascade +final = cascades :+: revM cascades +run' = rep (delayM tn) (transpose 5) 8 (c 4 tn) +cascade' = rep (delayM en) (transpose 4) 8 run' +cascades' = rep (delayM sn) id 2 cascade' +final' = cascades' :+: revM cascades'
+ Euterpea/Music/Note/Music.hs view
@@ -0,0 +1,206 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Music.lhs. (See HSoM/MakeCode.bat.) + +module Euterpea.Music.Note.Music where +infixr 5 :+:, :=: + +type Octave = Int +type Pitch = (PitchClass, Octave) +type Dur = Rational +data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs + | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss + deriving (Show, Eq, Ord, Read, Enum, Bounded) +data Primitive a = Note Dur a + | Rest Dur + deriving (Show, Eq, Ord) +data Music a = + Prim (Primitive a) -- primitive value + | Music a :+: Music a -- sequential composition + | Music a :=: Music a -- parallel composition + | Modify Control (Music a) -- modifier + deriving (Show, Eq, Ord) +data Control = + Tempo Rational -- scale the tempo + | Transpose AbsPitch -- transposition + | Instrument InstrumentName -- instrument label + | Phrase [PhraseAttribute] -- phrase attributes + | Player PlayerName -- player label + | KeySig PitchClass Mode -- key signature and mode + deriving (Show, Eq, Ord) + +type PlayerName = String +data Mode = Major | Minor + deriving (Show, Eq, Ord) +data InstrumentName = + AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano + | HonkyTonkPiano | RhodesPiano | ChorusedPiano + | Harpsichord | Clavinet | Celesta + | Glockenspiel | MusicBox | Vibraphone + | Marimba | Xylophone | TubularBells + | Dulcimer | HammondOrgan | PercussiveOrgan + | RockOrgan | ChurchOrgan | ReedOrgan + | Accordion | Harmonica | TangoAccordion + | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz + | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar + | DistortionGuitar | GuitarHarmonics | AcousticBass + | ElectricBassFingered | ElectricBassPicked | FretlessBass + | SlapBass1 | SlapBass2 | SynthBass1 + | SynthBass2 | Violin | Viola + | Cello | Contrabass | TremoloStrings + | PizzicatoStrings | OrchestralHarp | Timpani + | StringEnsemble1 | StringEnsemble2 | SynthStrings1 + | SynthStrings2 | ChoirAahs | VoiceOohs + | SynthVoice | OrchestraHit | Trumpet + | Trombone | Tuba | MutedTrumpet + | FrenchHorn | BrassSection | SynthBrass1 + | SynthBrass2 | SopranoSax | AltoSax + | TenorSax | BaritoneSax | Oboe + | Bassoon | EnglishHorn | Clarinet + | Piccolo | Flute | Recorder + | PanFlute | BlownBottle | Shakuhachi + | Whistle | Ocarina | Lead1Square + | Lead2Sawtooth | Lead3Calliope | Lead4Chiff + | Lead5Charang | Lead6Voice | Lead7Fifths + | Lead8BassLead | Pad1NewAge | Pad2Warm + | Pad3Polysynth | Pad4Choir | Pad5Bowed + | Pad6Metallic | Pad7Halo | Pad8Sweep + | FX1Train | FX2Soundtrack | FX3Crystal + | FX4Atmosphere | FX5Brightness | FX6Goblins + | FX7Echoes | FX8SciFi | Sitar + | Banjo | Shamisen | Koto + | Kalimba | Bagpipe | Fiddle + | Shanai | TinkleBell | Agogo + | SteelDrums | Woodblock | TaikoDrum + | MelodicDrum | SynthDrum | ReverseCymbal + | GuitarFretNoise | BreathNoise | Seashore + | BirdTweet | TelephoneRing | Helicopter + | Applause | Gunshot | Percussion + | Custom String + deriving (Show, Eq, Ord) +data PhraseAttribute = Dyn Dynamic + | Tmp Tempo + | Art Articulation + | Orn Ornament + deriving (Show, Eq, Ord) + +data Dynamic = Accent Rational | Crescendo Rational | Diminuendo Rational + | StdLoudness StdLoudness | Loudness Rational + deriving (Show, Eq, Ord) + +data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF + deriving (Show, Eq, Ord, Enum) + +data Tempo = Ritardando Rational | Accelerando Rational + deriving (Show, Eq, Ord) + +data Articulation = Staccato Rational | Legato Rational | Slurred Rational + | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath + | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz + | BartokPizz | Swell | Wedge | Thumb | Stopped + deriving (Show, Eq, Ord) + +data Ornament = Trill | Mordent | InvMordent | DoubleMordent + | Turn | TrilledTurn | ShortTrill + | Arpeggio | ArpeggioUp | ArpeggioDown + | Instruction String | Head NoteHead + | DiatonicTrans Int + deriving (Show, Eq, Ord) + +data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead + | TremoloHead | SlashHead | ArtHarmonic | NoHead + deriving (Show, Eq, Ord) + +note :: Dur -> a -> Music a +note d p = Prim (Note d p) + +rest :: Dur -> Music a +rest d = Prim (Rest d) + +tempo :: Dur -> Music a -> Music a +tempo r m = Modify (Tempo r) m + +transpose :: AbsPitch -> Music a -> Music a +transpose i m = Modify (Transpose i) m + +instrument :: InstrumentName -> Music a -> Music a +instrument i m = Modify (Instrument i) m + +phrase :: [PhraseAttribute] -> Music a -> Music a +phrase pa m = Modify (Phrase pa) m + +player :: PlayerName -> Music a -> Music a +player pn m = Modify (Player pn) m + +keysig :: PitchClass -> Mode -> Music a -> Music a +keysig pc mo m = Modify (KeySig pc mo) m +cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f, + fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss :: + Octave -> Dur -> Music Pitch + +cff o d = note d (Cff, o); cf o d = note d (Cf, o) +c o d = note d (C, o); cs o d = note d (Cs, o) +css o d = note d (Css, o); dff o d = note d (Dff, o) +df o d = note d (Df, o); d o d = note d (D, o) +ds o d = note d (Ds, o); dss o d = note d (Dss, o) +eff o d = note d (Eff, o); ef o d = note d (Ef, o) +e o d = note d (E, o); es o d = note d (Es, o) +ess o d = note d (Ess, o); fff o d = note d (Fff, o) +ff o d = note d (Ff, o); f o d = note d (F, o) +fs o d = note d (Fs, o); fss o d = note d (Fss, o) +gff o d = note d (Gff, o); gf o d = note d (Gf, o) +g o d = note d (G, o); gs o d = note d (Gs, o) +gss o d = note d (Gss, o); aff o d = note d (Aff, o) +af o d = note d (Af, o); a o d = note d (A, o) +as o d = note d (As, o); ass o d = note d (Ass, o) +bff o d = note d (Bff, o); bf o d = note d (Bf, o) +b o d = note d (B, o); bs o d = note d (Bs, o) +bss o d = note d (Bss, o) +bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn, + dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur + +bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr, + dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch + +bn = 2; bnr = rest bn -- brevis rest +wn = 1; wnr = rest wn -- whole note rest +hn = 1/2; hnr = rest hn -- half note rest +qn = 1/4; qnr = rest qn -- quarter note rest +en = 1/8; enr = rest en -- eighth note rest +sn = 1/16; snr = rest sn -- sixteenth note rest +tn = 1/32; tnr = rest tn -- thirty-second note rest +sfn = 1/64; sfnr = rest sfn -- sixty-fourth note rest + +dwn = 3/2; dwnr = rest dwn -- dotted whole note rest +dhn = 3/4; dhnr = rest dhn -- dotted half note rest +dqn = 3/8; dqnr = rest dqn -- dotted quarter note rest +den = 3/16; denr = rest den -- dotted eighth note rest +dsn = 3/32; dsnr = rest dsn -- dotted sixteenth note rest +dtn = 3/64; dtnr = rest dtn -- dotted thirty-second note rest + +ddhn = 7/8; ddhnr = rest ddhn -- double-dotted half note rest +ddqn = 7/16; ddqnr = rest ddqn -- double-dotted quarter note rest +dden = 7/32; ddenr = rest dden -- double-dotted eighth note restt251 :: Music Pitch +t251 = let dMinor = d 4 wn :=: f 4 wn :=: a 4 wn + gMajor = g 4 wn :=: b 4 wn :=: d 5 wn + cMajor = c 4 bn :=: e 4 bn :=: g 4 bn + in dMinor :+: gMajor :+: cMajor +type AbsPitch = Int +absPitch :: Pitch -> AbsPitch +absPitch (pc,oct) = 12*oct + pcToInt pc +pcToInt :: PitchClass -> Int +pcToInt pc = case pc of + Cff -> -2; Cf -> -1; C -> 0; Cs -> 1; Css -> 2; + Dff -> 0; Df -> 1; D -> 2; Ds -> 3; Dss -> 4; + Eff -> 2; Ef -> 3; E -> 4; Es -> 5; Ess -> 6; + Fff -> 3; Ff -> 4; F -> 5; Fs -> 6; Fss -> 7; + Gff -> 5; Gf -> 6; G -> 7; Gs -> 8; Gss -> 9; + Aff -> 7; Af -> 8; A -> 9; As -> 10; Ass -> 11; + Bff -> 9; Bf -> 10; B -> 11; Bs -> 12; Bss -> 13 +pitch :: AbsPitch -> Pitch +pitch ap = + let (oct, n) = divMod ap 12 + in ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct) +trans :: Int -> Pitch -> Pitch +trans i p = pitch (absPitch p + i)
+ Euterpea/Music/Note/Performance.hs view
@@ -0,0 +1,201 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Performance.lhs. (See HSoM/MakeCode.bat.) + +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + +module Euterpea.Music.Note.Performance where + +import Euterpea.Music.Note.Music +import Euterpea.Music.Note.MoreMusic + +type Performance = [Event] + +data Event = Event { eTime :: PTime, + eInst :: InstrumentName, + ePitch :: AbsPitch, + eDur :: DurT, + eVol :: Volume, + eParams :: [Double]} + deriving (Show,Eq,Ord) +type PTime = Rational +type DurT = Rational +data Context a = Context { cTime :: PTime, + cPlayer :: Player a, + cInst :: InstrumentName, + cDur :: DurT, + cPch :: AbsPitch, + cVol :: Volume, + cKey :: (PitchClass, Mode) } + deriving Show +metro :: Int -> Dur -> DurT +metro setting dur = 60 / (fromIntegral setting * dur) + +type PMap a = PlayerName -> Player a + +merge :: Performance -> Performance -> Performance +merge [] es2 = es2 +merge es1 [] = es1 +merge a@(e1:es1) b@(e2:es2) = + if eTime e1 < eTime e2 then e1 : merge es1 b + else e2 : merge a es2 + +perform :: PMap a -> Context a -> Music a -> Performance +perform pm c m = fst (perf pm c m) + +perf :: PMap a -> Context a -> Music a -> (Performance, DurT) +perf pm + c@Context {cTime = t, cPlayer = pl, cDur = dt, cPch = k} m = + case m of + Prim (Note d p) -> (playNote pl c d p, d*dt) + Prim (Rest d) -> ([], d*dt) + m1 :+: m2 -> + let (pf1,d1) = perf pm c m1 + (pf2,d2) = perf pm (c {cTime = t+d1}) m2 + in (pf1++pf2, d1+d2) + m1 :=: m2 -> + let (pf1,d1) = perf pm c m1 + (pf2,d2) = perf pm c m2 + in (merge pf1 pf2, max d1 d2) + Modify (Tempo r) m -> perf pm (c {cDur = dt / r}) m + Modify (Transpose p) m -> perf pm (c {cPch = k + p}) m + Modify (Instrument i) m -> perf pm (c {cInst = i}) m + Modify (KeySig pc mo) m -> perf pm (c {cKey = (pc,mo)}) m + Modify (Player pn) m -> perf pm (c {cPlayer = pm pn}) m + Modify (Phrase pas) m -> interpPhrase pl pm c pas m +type Note1 = (Pitch, [NoteAttribute]) +type Music1 = Music Note1 + +toMusic1 :: Music Pitch -> Music1 +toMusic1 = mMap (\p -> (p, [])) + +toMusic1' :: Music (Pitch, Volume) -> Music1 +toMusic1' = mMap (\(p, v) -> (p, [Volume v])) +data Player a = MkPlayer { pName :: PlayerName, + playNote :: NoteFun a, + interpPhrase :: PhraseFun a, + notatePlayer :: NotateFun a } + +type NoteFun a = Context a -> Dur -> a -> Performance +type PhraseFun a = PMap a -> Context a -> [PhraseAttribute] + -> Music a -> (Performance, DurT) +type NotateFun a = () + +instance Show a => Show (Player a) where + show p = "Player " ++ pName p +defPlayer :: Player Note1 +defPlayer = MkPlayer + { pName = "Default", + playNote = defPlayNote defNasHandler, + interpPhrase = defInterpPhrase defPasHandler, + notatePlayer = () } +defPlayNote :: (Context (Pitch,[a]) -> a -> Event-> Event) + -> NoteFun (Pitch, [a]) +defPlayNote nasHandler + c@(Context cTime cPlayer cInst cDur cPch cVol cKey) d (p,nas) = + let initEv = Event { eTime = cTime, eInst = cInst, + eDur = d * cDur, eVol = cVol, + ePitch = absPitch p + cPch, + eParams = [] } + in [ foldr (nasHandler c) initEv nas ] + +defNasHandler :: Context a -> NoteAttribute -> Event -> Event +defNasHandler c (Volume v) ev = ev {eVol = v} +defNasHandler c (Params pms) ev = ev {eParams = pms} +defNasHandler _ _ ev = ev + +defInterpPhrase :: + (PhraseAttribute -> Performance -> Performance) -> + ( PMap a -> Context a -> [PhraseAttribute] -> --PhraseFun + Music a -> (Performance, DurT) ) +defInterpPhrase pasHandler pm context pas m = + let (pf,dur) = perf pm context m + in (foldr pasHandler pf pas, dur) + +defPasHandler :: PhraseAttribute -> Performance -> Performance +defPasHandler (Dyn (Accent x)) = + map (\e -> e {eVol = round (x * fromIntegral (eVol e))}) +defPasHandler (Art (Staccato x)) = + map (\e -> e {eDur = x * eDur e}) +defPasHandler (Art (Legato x)) = + map (\e -> e {eDur = x * eDur e}) +defPasHandler _ = id +defPMap :: PMap Note1 +defPMap "Fancy" = fancyPlayer +defPMap "Default" = defPlayer +defPMap n = defPlayer { pName = n } + +defCon :: Context Note1 +defCon = Context { cTime = 0, + cPlayer = fancyPlayer, + cInst = AcousticGrandPiano, + cDur = metro 120 qn, + cPch = 0, + cKey = (C, Major), + cVol = 127 } + +fancyPlayer :: Player (Pitch, [NoteAttribute]) +fancyPlayer = MkPlayer { pName = "Fancy", + playNote = defPlayNote defNasHandler, + interpPhrase = fancyInterpPhrase, + notatePlayer = () } + +fancyInterpPhrase :: PhraseFun a +fancyInterpPhrase pm c [] m = perf pm c m +fancyInterpPhrase pm + c@Context { cTime = t, cPlayer = pl, cInst = i, + cDur = dt, cPch = k, cVol = v} + (pa:pas) m = + let pfd@(pf,dur) = fancyInterpPhrase pm c pas m + loud x = fancyInterpPhrase pm c (Dyn (Loudness x) : pas) m + stretch x = let t0 = eTime (head pf); r = x/dur + upd (e@Event {eTime = t, eDur = d}) = + let dt = t-t0 + t' = (1+dt*r)*dt + t0 + d' = (1+(2*dt+d)*r)*d + in e {eTime = t', eDur = d'} + in (map upd pf, (1+x)*dur) + inflate x = let t0 = eTime (head pf); + r = x/dur + upd (e@Event {eTime = t, eVol = v}) = + e {eVol = round ( (1+(t-t0)*r) * + fromIntegral v)} + in (map upd pf, dur) + in case pa of + Dyn (Accent x) -> + ( map (\e-> e {eVol = round (x * fromIntegral (eVol e))}) pf, dur) + Dyn (StdLoudness l) -> + case l of + PPP -> loud 40; PP -> loud 50; P -> loud 60 + MP -> loud 70; SF -> loud 80; MF -> loud 90 + NF -> loud 100; FF -> loud 110; FFF -> loud 120 + Dyn (Loudness x) -> fancyInterpPhrase pm + c{cVol = round x} pas m + Dyn (Crescendo x) -> inflate x ; Dyn (Diminuendo x) -> inflate (-x) + Tmp (Ritardando x) -> stretch x ; Tmp (Accelerando x) -> stretch (-x) + Art (Staccato x) -> (map (\e-> e {eDur = x * eDur e}) pf, dur) + Art (Legato x) -> (map (\e-> e {eDur = x * eDur e}) pf, dur) + Art (Slurred x) -> + let lastStartTime = foldr (\e t -> max (eTime e) t) 0 pf + setDur e = if eTime e < lastStartTime + then e {eDur = x * eDur e} + else e + in (map setDur pf, dur) + Art _ -> pfd + Orn _ -> pfd +class Performable a where + perfDur :: PMap Note1 -> Context Note1 -> Music a -> (Performance, DurT) + +instance Performable Note1 where + perfDur pm c m = perf pm c m + +instance Performable Pitch where + perfDur pm c = perfDur pm c . toMusic1 + +instance Performable (Pitch, Volume) where + perfDur pm c = perfDur pm c . toMusic1' + +defToPerf :: Performable a => Music a -> Performance +defToPerf = fst . perfDur defPMap defCon + +toPerf :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Performance +toPerf pm con = fst . perfDur pm con
+ Euterpea/Music/Signal/SpectrumAnalysis.hs view
@@ -0,0 +1,57 @@+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SpectrumAnalysis.lhs. (See HSoM/MakeCode.bat.)++{-# LANGUAGE Arrows #-}++module Euterpea.Music.Signal.SpectrumAnalysis where++import Euterpea+import Euterpea.Experimental (fftA)++import Data.Complex (Complex ((:+)), polar)+import Data.Maybe (listToMaybe, catMaybes)++dft :: RealFloat a => [Complex a] -> [Complex a]+dft xs = + let lenI = length xs+ lenR = fromIntegral lenI+ lenC = lenR :+ 0+ in [ let i = -2 * pi * fromIntegral k / lenR+ in (1/lenC) * sum [ (xs!!n) * exp (0 :+ i * fromIntegral n)+ | n <- [0,1..lenI-1] ]+ | k <- [0,1..lenI-1] ]+mkTerm :: Int -> Double -> [Complex Double]+mkTerm num n = let f = 2 * pi / fromIntegral num+ in [ sin (n * f * fromIntegral i) / n :+ 0+ | i <- [0,1..num-1] ]++mkxa, mkxb, mkxc :: Int-> [Complex Double]+mkxa num = mkTerm num 1+mkxb num = zipWith (+) (mkxa num) (mkTerm num 3)+mkxc num = zipWith (+) (mkxb num) (mkTerm num 5)+printComplexL :: [Complex Double] -> IO ()+printComplexL xs =+ let f (i,rl:+im) = + do putStr (spaces (3 - length (show i)) )+ putStr (show i ++ ": (" )+ putStr (niceNum rl ++ ", " )+ putStr (niceNum im ++ ")\n" )+ in mapM_ f (zip [0..length xs - 1] xs)++niceNum :: Double -> String+niceNum d =+ let d' = fromIntegral (round (1e10 * d)) / 1e10+ (dec, fra) = break (== '.') (show d')+ (fra',exp) = break (== 'e') fra+ in spaces (3 - length dec) ++ dec ++ take 11 fra'+ ++ exp ++ spaces (12 - length fra' - length exp)++spaces :: Int -> String+spaces n = take n (repeat ' ')+mkPulse :: Int -> [Complex Double]+mkPulse n = 100 : take (n-1) (repeat 0)+x1 num = let f = pi * 2 * pi / fromIntegral num+ in map (:+ 0) [ sin (f * fromIntegral i)+ | i <- [0,1..num-1] ]+mkPolars :: [Complex Double] -> [Complex Double]+mkPolars = map ((\(m,p)-> m:+p) . polar)
+ HSoM/Additive.lhs view
@@ -0,0 +1,963 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Additive.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter{Additive and Subtractive Synthesis} +\label{ch:additive} + +\begin{code} +{-# LANGUAGE Arrows #-} + +module Euterpea.Examples.Additive where +import Euterpea +\end{code} + +There are many techniques for synthesizing sound. In this chapter we +will discuss two of them: \emph{additive synthesis} and +\emph{subtractive synthesis}. In practice it is rare for either of +these, or any of the ones discussed in future chapters, to be utilized +alone---a typical application may in fact employ all of them. But it +is helpful to \emph{study} them in isolation, so that the sound +designer has a suitably rich toolbox of techniques at his or her +disposal. + +\emph{Additive synthesis} is, conceptually at least, the simplest of +the many sound synthesis techniques. Simply put, the idea is to add +signals (usually sine waves of differing amplitudes, frequencies and +phases) together to form a sound of interest. It is based on +Fourier's theorem as discussed in the previous chapter, and indeed is +sometimes called \emph{Fourier synthesis}. + +\emph{Subtractive synthesis} is the dual of additive synthesis. The +basic ideas is to start with a signal rich in harmonoc content, and +seletively ``remove'' signals to create a desired effect. + +In understanding the difference between the two, it is helpful to +consider the following analogy to art: +\begin{itemize} +\item Additive synthesis is like painting a picture---each stroke of + the brush, each color, each shape, each texture, and so on, adds to + the artist's conception of the final artistic artifact. +\item In contract, subtractive synthesis is like creating a sculpture + from stone---each stroke of the chisel takes away material that is + unwanted, eventually revealing the artist's conception of what the + artistic artifact should be. +\end{itemize} + +Additive synthesis in the context of Euterpea will be discussed in +Section \ref{sec:additive}, and substractive synthesis in Section +\ref{sec:subtractive}. + +\section{Additive Synthesis} +\label{sec:additive} + +\subsection{Preliminaries} + +When doing pure additive synthesis it is often convenient to work with +a \emph{list of signal sources} whose elements are eventually summed +together to form a result. To facilitate this, we define a few +auxiliary functions, as shown in Figure~\ref{fig:foldSF}. + +|constSF s sf| simply lifts the value |s| to the signal function +level, and composes that with |sf|, thus yielding a signal source. + +|foldSF f b sfs| is analogous to |foldr| for lists: it returns the +signal source |constA b| if the list is empty, and otherwise uses |f| +to combine the results, pointwise, from the right. In other words, if +|sfs| has the form: +\begin{spec} +[sf1, sf2, ..., sfn] +\end{spec} +%% sf1 : sf2 : ... : sfn : [] +then the result will be: +\begin{spec} +proc () -> do + s1 <- sf1 -< () + s2 <- sf2 -< () + ... + sn <- sfn -< () + outA -< f s1 (f s2 ( ... (f sn b))) +\end{spec} + +\begin{figure} +\begin{spec} +constSF :: Clock c => a -> SigFun c a b -> SigFun c () b +constSF s sf = constA s >>> sf + +foldSF :: Clock c => + (a -> b -> b) -> b -> [SigFun c () a] -> SigFun c () b +foldSF f b sfs = + foldr g (constA b) sfs where + g sfa sfb = + proc () -> do + s1 <- sfa -< () + s2 <- sfb -< () + outA -< f s1 s2 +\end{spec} +\caption{Working With Lists of Signal Sources} +\label{fig:foldSF} +\end{figure} + +\syn{|constSF| and |foldSF| are actually predefined in Euterpea, but + with slightly more general types: +\begin{spec} +constSF :: Arrow a => b -> a b d -> a c d +foldSF :: Arrow a => (b -> c -> c) -> c -> [a () b] -> a () c +\end{spec} +The more specific types shown in Figure~\ref{fig:foldSF} reflect how +we will use the functions in this chapter.} + +\subsection{Overtone Synthsis} + +Perhaps the simplest form of additive synthesis is combining a sine +wave with some of its overtones to create a rich sound that is closer +in harmonic content to that of a real instrument, as discussed in +Chapter \ref{ch:signals}. Indeed, in Chapter \ref{ch:sigfuns} we saw +several ways to do this using built-in Euterpea signal functions. +For example, recall the function: +\begin{spec} +oscPartials :: Clock c => + Table -> Double -> SigFun c (Double,Int) Double +\end{spec} +|oscPartials tab ph| is a signal function whose pair of dynamic inputs +determines the frequency, as well as the number of harmonics of that +frequency, of the output. So this is a ``built-in'' notion of +additive synthesis. A problem with this approach in modelling a +conventional instrument is that the partials all have the same +strength, which does not reflect the harmonic content of most physical +instruments. + +A more sophisticated approach, also described in Chapter +\ref{ch:sigfuns}, is based on various ways to build look-up tables. +In particular, this function was defined: +\begin{spec} +tableSines3 :: + TableSize -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table +\end{spec} +Recall that |tableSines3 size triples| is a table of size |size| that +represents a sinusoidal wave and an arbitrary number of partials, +whose relationship to the fundamental frequency, amplitude, and phase +are determined by each of the triples in |triples|. + +\subsection{Resonance and Standing Waves} +\label{sec:resonance} + +As we know from Fourier's Theorem, any periodic signal can be +represented as a sum of a fundemental frequency and multiples of that +fundamental frequency. We also know that a musical instrument's sound +consists primarily of the sum of a fundamental frequency (the +preceived pitch) and some of the multiples of that pitch (called +harmonics, partials, or overtones). But what is it that makes a +musical instrument behave this way in the first place? Answering this +question can help us in understanding how to use additive synthesis to +generate an instrument sound, but becomes even more important in +Chapter~\ref{physical-modeling} where we attempt to model the physical +attributes of a particular instrument. + +\subsubsection{String Instruments} +\label{sec:string-instruments} + +To answer this question, let's start with a simple string, fixed at +both ends. Now imagine that energy is inserted at some point along +the string---perhaps by a finger pluck, a guitar pick, a violin bow, +or the hammer on a piano. This energy will cause the string to +vibrate in some way. The energy will flow along the string as a wave, +just like a pebble dropped in water, except that the energy only flows +in one dimension, i.e.\ only along the orientation of the string. How +fast the wave travels will depend on the string material and how taut +it is. For example, the tauter the string, the faster the wave +travels. + +Because the ends of the string are fixed, however, the string can only +vibrate in certain ways, which are called \emph{modes}, or +\emph{resonances}. The most obvious mode for a string is shown in +Figure~\ref{fig:string-mode}a, where the center of the string is +moving up and down, say, and the end-points do not move at all. +Energy that is not directly contributing to a particular mode is +quickly absorbed by the fixed endpoints. A mode is sometimes called a +"standing wave" since it appears to be standing still---it does not +seem to be moving up or down the string. But another way to think of +it is that the energy in the string is being \emph{reflected back} at +each endpoint of the string, and those reflections reinforce each +other to form the standing wave. + +%% Now, when this energy wave hits the end of the string, i.e.\ where +%% it is fixed, it has to go somewhere. If the fixed point is +%% sufficiently firm, that energy will therefore be reflected back +%% along the string, like a ball bouncing off of a wall---it has +%% nowhere else to go. And like waves in the water, those waves +%% traveling in opposite directions on the string just pass through +%% one another. + +Eventually, of course, even the energy in a mode will dissipate, for +three reasons: (1) since the ends of the string are never perfectly +fixed, the reflections are not perfect either, and thus some energy is +absorbed, (2) the movement of the string creates friction in the +string material, generating heat and also absorbing energy, and (3) +the transverse vibration of the string induces a longitudinal +vibration in the air---i.e.\ the sound we hear---and that also absorbs +some energy. + +%% However, some of the reflected energy will actually +%% \emph{reinforce} energy traveling in the other direction, and will +%% thus take much longer to die out. This is what forms what is +%% called a "standing wave," because the perfect alignment of these +%% supporting waves depends precisely on the length and tautness of of +%% the string, and so appears to "stand still." It is also what +%% accounts for the "resonant frequency," i.e.\ the perceived pitch. + +To better understand the nature of modes, suppose a pulse of energy is +introduced at one end of the string. If $v$ is the velocity of the +resulting wave traveling along the string, and $\lambda$ is the string +length, then it takes $\lambda/v$ seconds for a wave to travel the +length of the string, and $p = 2\lambda/v$ for it to travel up and +back. So if the pulse is repeated every $p$ seconds, it will +reinforce the previous pulse. If we think of $p$ as the period of a +periodic signal, its frequency in Hertz is the \emph{reciprocol} of +the period $p$, namely: +\[ f_0 = v / (2\lambda) \] +Indeed, this is the frequency of the mode shown in +Figure~\ref{fig:string-mode}a, and corresponds to the fundamental +frequency, i.e.\ the observed pitch. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=8.5in]{pics/DPlots/StringModes.eps} +\caption{The Modes of a Stringed Instrument} +\label{fig:string-mode} +\end{figure} + +But note that this is not the only possible mode---another is shown in +Figure~\ref{fig:string-mode}b. This mode can be interpreted as +repeating the pulse of energy inserted at the end of the string every +$p/2$ seconds, thus corresponding to a frequency of: +\[ f_1 = 1/(p/2) = v / \lambda = 2f_0 \] +In other words, this is the first overtone. + +Indeed, each subsequent mode corresponds to an overtone, and can be +derived in the same way. A pulse of energy every $p/n$ seconds +corresponds to the (n-1)th overtone with frequency $nf_0$ Hz. +Figure~\ref{fig:string-mode} shows these derivations for the first +four modes; i.e.\ the fundamental plus three overtones. + +Note: The higher overtones generally---but not always---decay more +quickly primarily because they are generated by a quicker bending of +the string, causing more friction and a quicker loss of energy. + +%% We can plot this phonomenon as shown in +%% Figure~\ref{fig:string-resonance}. At the top of the figure is the +%% string, fixed at both ends. The first plot below that corresponds to +%% the fundamental resonant frequency. Further below are the first +%% couple of partials. + +\subsubsection{Wind Instruments} +\label{sec:wind-instruments} + +Resonances in other musical instruments behave similarly. But in the +case of a wind instrument, there a couple of important differences. +First of all, the resonance happens within the air itelf, rather than +a string. For example, a clarinet can be thought of as a +\emph{cylindical tube} closed at one end. The closed end is the +mouthpiece, and the open end is called the "bell." The closed end, +like the fixed end of a string, reflects energy directly back in the +opposite direction. But because the open end is open, it behaves +differently. In particular, as energy (a wave) escapes the open end, +its pressure is dissipated into the air. This causes a pressure drop +that induces a negative pressure---i.e.\ a vacumm---in the opposite +direction, causing the wave to reflect back, \emph{but inverted}! + +%% A wave traveling toward the mouthpiece, on the other hand, is like +%% the fixed end of a string---it is reflected back uninverted. + +Unfortuntely, we cannot easily visualize the standing wave in a +clarinet, partly because the air is invisible, but also because, (1) +the wave is \emph{longitudinal}, whereas for a string it is +transverse, and (2) as just discussed, the open end inverts the signal +upon reflection. The best we can do is create a transverse +representation. For example, Figure~\ref{fig:clarinet-mode}a +represents the fundamental mode, or fundamantal frequency. Note that +the left, closed end looks the same as for a fixed string---i.e.\ it +is at the zero crossing of the sine wave. But the right end is +different---it is intended to depict the inversion at the open end of +the clarinet as the maximum absolute value of the sine wave. If the +signal comes in at +1, it is inverted to the value -1, and so on. + +Analogously to our detailed analysis of a string, we can analyze a +clarinet's acoustic behavior as follows: Suppose a pulse of energy is +introduced at the mouthpiece (i.e.\ closed end). If $v$ is the +velocity of sound in the air, and $\lambda$ is the length of the +clarinet, that wave appears at the open end in $\lambda/v$ seconds. +Its \emph{inverted} reflection then appears back at the mouthpiece in +$2*\lambda/v$ seconds. But because it is inverted, \emph{it will +cancel out another pulse emitted $2*\lambda/v$ seconds after the +first!} On the other hand, suppose we let that reflection bounce off +the closed end, travel back to the open end to be inverted a second +time, and then return to the closed end. Two inversions are like no +inversion at all, and so if we were to insert another pulse of energy +at that moment, the two signals will be "in synch." In other words, +if we repeat the pulse every $4\lambda/v$ seconds, the peaks and the +troughs of the signals line up, and they will reinforce one another. +This corresponds to a frequency of: +\[ f_0 = v / (4\lambda) \] +and is in fact the fundamental mode, i.e.\ fundamental frequency, of +the clarinet. This situation corresponds precisely to +Figure~\ref{fig:clarinet-mode}a. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=8.5in]{pics/DPlots/ClarinetModes.eps} +\vspace{-.2in} +\caption{The Modes of a Clarinet Seen as a Cylindrical Tube} +\label{fig:clarinet-mode} +\end{figure} + +Now here is the interesting part: If we were to double the pulse rate +in hopes of generating the first overtone, we arrive precisely at the +situation we were in above: the signals cancel out. Thus, \emph{a +clarinet has no first overtone!} On the other hand, if we triple the +pulse rate, the signals line up again, corresponding to a frequency +of: +\[ f_1 = v / ((4/3)\lambda) = (3v)/(4\lambda) = 3f_0 \] +This is the clarinet's second mode, and corresponds to +Figure~\ref{fig:clarinet-mode}b. + +By a similar argument, it can be shown that all the even overtones of +a clarinet don't exist (or, equivalently, have zero amplitude), +whereas all of the odd overtones do exist. +Figure~\ref{fig:clarinet-mode} shows the first three modes of a +clarinet, corresponding to the fundamental frequency, and third and +fifth overtones. (Note, by the way, the similarity of this to the +spectral content of a square wave.) + +[Todo: discuss other wind instruments] + +%% Quote from somewhere: A clarinet is an example of a cylindrical +%% bore instrument closed at one end. Hence, the normal resonant +%% modes must have a pressure maximum at the closed end (the +%% mouthpiece) and a pressure minimum near the first open key (or the +%% bell). These conditions result in the presence of only odd +%% harmonics in the sound. This contrasts to the saxophone or oboe, +%% which have a conical bore and hence include the even harmonics. + +%% Consider changing the cylindrical tube diagrams so that the signals +%% are shifted by 90 degrees, with the idea that the ``zero crossing'' +%% corresponds to minimal energy, and is thus at the open end, not at +%% the mouthpiece. On the other hand, the current figure has a nice +%% analogy to a jump rope fixed at one end, and ``shaken'' at the +%% other. + +\begin{exercise}{\em +If $\omega = 2\pi f$ is the fundamental radial frequency, the sound of +a sustained note for a typical clarinet can be approximated \cite{} by: +\begin{eqnarray*} +s(t) & = & \sin(\omega t)\ +\ 0.75\sin(3\omega t)\ +\ 0.5\sin(5\omega t) + + 0.14\sin(7\omega t)\ \\ + & & +\ 0.5\sin(9\omega t)\ +\ 0.12\sin(11\omega t)\ +\ + 0.17\sin(13\omega t) +\end{eqnarray*} +Define an instrument |clarinet :: Instr (Mono AudRate)| that simulates +this sound. Add an envelope to it to make it more realistic. Then +test it with a simple melody.} +\end{exercise} + +\subsection{Deviating from Pure Overtones} + +Sometimes, however, these built-in functions don't achieve exactly +what we want. In that case, we can define our own, customized notion +of additive synthesis, in whatever way we desire. For a simple +example, traditional harmony is the simultaneous playing of more than +one note at a time, and thus an instance of additive synthesis. More +interestingly, richer sounds can be created by using slightly +``out-of-tune'' overtones; that is, overtones that are not an exact +multiple of the fundamental frequency. For example: +\begin{code} +-- TBD +\end{code} +This creates a kind of ``chorusing'' effect, very ``electronic'' in +nature. + +Some real instruments in fact exhibit this kind of behavior, and +sometimes the degree of being ``out of tune'' is not quite fixed. +Here's a variation of the above example where the detuning varies +sinusoidally: +\begin{code} +-- TBD +\end{code} + +\subsection{A Bell Sound} + +Synthesizing a bell or gong sound is a good example of ``brute force'' +additive synthesis. Physically, a bell or gong can be thought of as a +bunch of concentric rings, each having a different resonant frequency +because they differ in diameter depending on the shape of the bell. +Some of the rings will be more dominant than others, but the important +thing to note is that these resonant frequencies often do not have an +integral relationship with each other, and sometimes the higher +frequencies can be quite strong, rather than rolling off significantly +as with many other instruments. Indeed, it is sometime difficult to +say exactly what the pitch of a particular bell is (especially large +bells), so complex is its sound. Of course, the pitch of a bell can +be controlled by mimimizing the taper of its shape (especially for +small bells), thus giving it more of a pitched sound. + +In any case, a pitched instrument representing a bell sound can be +designed using additive synthesis by using the instrument's absolute +pitch to create a series of partials that are conspicuously +non-integral multiples of the fundamental. If this sound is then +shaped by an envelope having a sharp rise time and a relatively slow, +exponentially decreasing decay, we get a decent result. A Euterpea +program to achieve this is shown in Figure~\ref{fig:bell1}. Note the +use of |map| to create the list of partials, and |foldSF| to add them +together. Also note that some of the partials are expressed as +\emph{fractions} of the fundamental---i.e.\ their frequencies are less +than that of the fundamental! + +\begin{figure} +\begin{code} +bell1 :: Instr (Mono AudRate) + -- |Dur -> AbsPitch -> Volume -> AudSF () Double| +bell1 dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + d = fromRational dur + sfs = map (\p-> constA (f*p) >>> osc tab1 0) + [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56] + in proc () -> do + aenv <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< () + a1 <- foldSF (+) 0 sfs -< () + outA -< a1*aenv*v/9 + +tab1 = tableSinesN 4096 [1] + +bellTest1 = outFile "bell1.wav" 6 (bell1 6 (absPitch (C,5)) 100 []) +\end{code} +\caption{A Bell Instrument} +\label{fig:bell1} +\end{figure} + +\out{ +\begin{code} +bell'1 :: Instr (Mono AudRate) +bell'1 dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + d = fromRational dur + in proc () -> do + aenv <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< () + a1 <- osc tab1' 0 -< f + outA -< a1*aenv*v + +tab1' = tableSines3N 4096 [(4.07,1,0), (3.76,1,0), (3,1,0), + (2.74,1,0), (2,1,0), (1.71,1,0), (1.19,1,0), (0.92,1,0), (0.56,1,0)] + +bellTest1' = outFile "bell'1.wav" 6 (bell'1 6 (absPitch (C,5)) 100 []) +\end{code} +} + +The reader might wonder why we don't just use one of Euterpea's table +generating functions, such as |tableSines3| discussed above, to +generate a table with all the desired partials. The problem is, even +though the |PartialNum| argument to |tableSines3| is a |Double|, the +normal intent is that the partial numbers all be integral. To see +why, suppose 1.5 were one of the partial numbers---then 1.5 cycles of +a sine wave would be written into the table. But the whole point of +wavetable lookup synthesis is to repeatedly cycle through the table, +which means that this 1.5 cycle would get repeated, since the +wavetable is a periodic representation of the desired sound. The +situation gets worse with partials such as 4.07, 3.75, 2.74, 0.56, and +so on. + +In any case, we can do even better than |bell1|. An important aspect +of a bell sound that is not captured by the program in +Figure~\ref{fig:bell1} is that the higher-frequency partials tend to +decay more quickly than the lower ones. We can remedy this by giving +each partial its own envelope (recall Section \ref{sec:envelopes}), and +making the duration of the envelope inversely proportional to the +partial number. Such a more sophisticated instrument is shown in +Figure~\ref{fig:bell2}. This results in a much more pleasing and +realistic sound. + +\begin{figure} +\begin{code} +bell2 :: Instr (Mono AudRate) + -- |Dur -> AbsPitch -> Volume -> AudSF () Double| +bell2 dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + d = fromRational dur + sfs = map (mySF f d) + [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56] + in proc () -> do + a1 <- foldSF (+) 0 sfs -< () + outA -< a1*v/9 + +mySF f d p = proc () -> do + s <- osc tab1 0 <<< constA (f*p) -< () + aenv <- envExponSeg [0,1,0.001] [0.003,d/p-0.003] -< () + outA -< s*aenv + +bellTest2 = outFile "bell2.wav" 6 (bell2 6 (absPitch (C,5)) 100 []) +\end{code} +\caption{A More Sophisticated Bell Instrument} +\label{fig:bell2} +\end{figure} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +A problem with the more sophisticated bell sound in +Figure~\ref{fig:bell2} is that the duration of the resulting sound +exceeds the specified duration of the note, because some of the +partial numbers are less than one. Fix this.} +\end{exercise} + +\begin{exercise}{\em +Neither of the bell sounds shown in Figures~\ref{fig:bell1} and +\ref{fig:bell2} actually contain the fundamental frequency---i.e. a +partial number of 1.0. Yet they contain the partials at the integer +multiples 2 and 3. How does this affect the result? What happens if +you add in the fundamental?} +\end{exercise} + +\begin{exercise}{\em +Use the idea of the ``more sophisticated bell'' to synthesize sounds +other than a bell. In particular, try using only integral multiples +of the fundamental frequency.} +\end{exercise} + +\vspace{.1in}\hrule + +\out{ ---------------------------------------------------------- +sine f r = + proc () -> do + a1 <- osc f1 0 -< f*r + outA -< a1 + +loop :: [AudSF () Double] -> AudSF () Double +loop [] = constA 0 +loop (sf:sfs) = + proc () -> do + a1 <- sf -< () + a2 <- loop sfs -< () + outA -< a1 + a2 +------------------------------------------------------------------- } + +\section{Subtractive Synthesis} +\label{sec:subtractive} + +As mentioned in the introduction to this chapter, subtractive +synthesis involves starting with a harmonically rich sound source, and +selectively taking away sounds to create a desired effect. In signal +processing terms, we ``take away'' sounds using \emph{filters}. + +\subsection{Filters} + +Filters can be arbitrarily complex, but are characterized by a +\emph{transfer function} that captures, in the frequency domain, how +much of each frequency component of the input is transferred to the +output. Figure \ref{fig:filter-types} shows the general transfer +function for the four most common forms of filters: + +\begin{figure}[hbtp] +\centering +\includegraphics[height=7.5in]{pics/DPlots/FilterTypes.eps} +\vspace{-.2in} +\caption{Transfer Functions for Four Common Filter Types} +\label{fig:filter-types} +\end{figure} + +\begin{enumerate} +\item +A \emph{low-pass} filter passes low frequencies and rejects +(i.e.\ attenuates) high frequencies. +\item +A \emph{high-pass} filter passes high frequencies and rejects +(i.e.\ attenuates) low frequencies. +\item +A \emph{band-pass} filter passes a particular band of frequencies +while rejecting others. +\item +A \emph{band-reject} (or \emph{band-stop}, or \emph{notch}) filter +rejects a particular band of frequencies, while passing others. +\end{enumerate} +It should be clear that filters can be combined in sequence or in +parallel to achieve more complex transfer functions. For example, a +low-pass and a high-pass filter can be combined in sequence to create +a band-pass filter, and can be combined in parallel to create a +band-reject filter. + +In the case of a low-pass or high-pass filter, the \emph{cut-off + frequency} is usually defined as the point at which the signal is +attenuated by 6dB. A similar strategy is used to define the upper and +lower bounds of the band that is passed by a band-pass filter or +rejected by a band-reject filter, except that the band is usually +specified using a \emph{center frequency} (the midpoint of the band) +and a \emph{bandwidth} {the width of the band). + +It is important to realize that not all filters of a particular type +are alike. Two low-pass filters, for example, may, of course, have +different cutoff frequencies, but even if the cutoff frequencies are +the same, the ``steepness'' of the cutoff curves may be different (a +filter with an ideal step curve for its transfer function does not +exist), and the other parts of the curve might not be the same---they +are never completely flat or even linear, and might not even be +monotonically increasing or decreasing. (Although the diagrams in +Figure~\ref{fig:filter-types} at least do not show a step curve, they +are stll over-simplified in the smoothness and flatness of the +curves.) Furthermore, all filters have some degree of \emph{phase + distortion}, which is to say that the transferred phase angle can +vary with frequency. + +In the digital domain, filters are often described using +\emph{recurrence equations} of varying degrees, and there is an +elegant theory of filter design that can help predict and therefore +control the various characteristics mentioned above. However, this +theory is beyond the scope of this textbook. A good book on digital +signal processing will elaborate on these issues in detail. + +\subsection{Euterpea's Filters} +\label{sec:euterpea-filters} + +Instead of designing our own filters, we will use a set of pre-defined +filters in Euterpea that are adequate for most sound synthesis +applications. Their type sinatures are shown in +Figure~\ref{fig:euterpea-filters}. As you can see, each of the filter +types discussed previously is included, but their use requires a bit +more explanation. + +\begin{figure} +\begin{spec} +filterLowPass, filterHighPass, filterLowPassBW, filterHighPassBW :: + Clock p => SigFun p (Double, Double) Double + +filterBandPass, filterBandStop :: + Clock p => Int -> SigFun p (Double, Double, Double) Double + +filterBandPassBW, filterBandStopBW :: + Clock p => SigFun p (Double, Double, Double) Double +\end{spec} +\caption{Euterpea's Filters} +\label{fig:euterpea-filters} +\end{figure} + +First of all, all of the filters ending in ``|BW|'' are what are called +\emph{Butterworth filters}, which are based on a second-order filter +design that represents a good balance of filter characteristics: a +good cutoff steepness, little phase distortion, and a reasonably flat +response in both the pass and reject regions. Those filters without +the |BW| suffix are first-order filters whose characteristics are not +quite as good as the Butterworth filters, but are computationally more +efficient. + +In addition, the following points help explain the details of specific +Euterpea filters: +\begin{itemize} +\item +|filterLowPass| is a signal function whose input is a pair consisting +of the signal being filtered, and the cutoff frequency (in that +order). Note that this means the cutoff frequency can be varied +dynamically. |filterHighPass|, |filterLowPassBW|, and +|filterHighPassBW| behave analogously. +\item +|filterBandPassBW| is a signal function taking a triple as input: the +signal being filtered, the center frequency of the band, and the width +of the band, in that order. For example: +\begin{spec} +... +filterBandPassBW -< (s, 2000, 100) +... +\end{spec} +will pass the frequencies in |s| that are in the range 1950 to 2050 +Hz, and reject the others. |filterBandStop| behaves analogously. +\item +|filterBandPass| and |filterBandStop| also behave analogously, except +that they take a static |Int| argument, let's call it |m|, that has +the following effect on the magnitude of the output: +\begin{itemize} +\item +|m = 0| signifies no scaling of the output signal. +\item +|m = 1| signifies a peak response factor of 1; i.e.\ all +frequencies other than the center frequency are attenuated in accordance with +a normalized response curve. +\item +|m = 2| raises the response factor so that the output signal's overall +RMS value equals 1. +\end{itemize} +\end{itemize} + +\subsection{Noisy Sources} + +Returning to the art metaphor at the beginning of this chapter, +filters are like the chisels and other tools that a sculptor might use +to fashion his or her work. But what about the block of stone that +the sculptor begins with? What is the sound synthesis analogy to +that? + +The answer is some kind of a ``noisy signal.'' It does not have to be +pure noise in a signal processing sense, but in general its frequency +spectrum will be rather broad and dense. Indeed, we have already seen +(but not discussed) one way to do this in Euterpea: Recall the table +generators |tableSines|, |tableSinesN|, |tableSines3|, and +|tableSines3N|. When used with |osc|, these can generate very dense +series of partials, which in the limit sound like pure noise. + +In addition, Euterpea provides three sources of pure noise, that is, +noise derived from a random number generator: |noiseWhite|, +|noiseBLI|, and |noiseBLH|. More specifically: +\begin{enumerate} +\item +|noiseWhite :: Clock p => Int -> SigFun p () Double| \\ +|noiseWhite n| is a signal source that generates uniform white noise +with an RMS value of $1/\sqrt{2}$, where |n| is the ``seed'' of the +underlying random number generator. +\item +|noiseBLI :: Clock p => Int -> SigFun p Double Double| \\ +|noiseBLI n| is like |noiseWhite n| except that the signal samples are +generated at a rate controlled by the (dynamic) input signal +(presumably less than 44.1kHz), with interpolation performed between +samples. Such a signal is called ``band-limited'' because the slower +rate prevents spectral content higher than half the rate. +\item +|noiseBLH :: Clock p => Int -> SigFun p Double Double| \\ +|noiseBLH| is like |noiseBLI| but does not interpolate between +samples; rather, it ``holds'' the value fo the last sample. +\end{enumerate} + +\subsection{Examples} + +\begin{code} +sineTable :: Table +sineTable = tableSinesN 4096 [1] + +env1 :: AudSF () Double +env1 = envExpon 20 10 10000 +\end{code} + +\out{ +\end{spec} +doAll :: IO () +doAll = do tLow; tHi; tLowBW; tHiBW + tBP; tBS; tBPBW; tBSBW + tBP'; tBS'; tBPBW'; tBSBW' + test1; test2; test3; test4 + test5; test6; test7; test8 + test9 + return () +\end{spec} +} + +|envExpon| is better than |envLine| for sweeping a range of +frequencies, because our ears hear pitches logarithmically. To +demonstrate: + +\begin{code} +good = outFile "good.wav" 10 + (osc sineTable 0 <<< envExpon 20 10 10000 :: AudSF () Double) + +bad = outFile "bad.wav" 10 + (osc sineTable 0 <<< envLine 20 10 10000 :: AudSF () Double) +\end{code} + +Helper function for filter tests: + +\begin{code} +sfTest1 :: AudSF (Double,Double) Double -> Instr (Mono AudRate) + -- |AudSF (Double,Double) Double -> | + -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double| +sfTest1 sf dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + in proc () -> do + a1 <- osc sineTable 0 <<< env1 -< () + a2 <- sf -< (a1,f) + outA -< a2*v +\end{code} + +Tests for low and highpass filters: + +\begin{code} +tLow = outFile "low.wav" 10 $ + sfTest1 filterLowPass 10 (absPitch (C,5)) 80 [] + +tHi = outFile "hi.wav" 10 $ + sfTest1 filterHighPass 10 (absPitch (C,5)) 80 [] + +tLowBW = outFile "lowBW.wav" 10 $ + sfTest1 filterLowPassBW 10 (absPitch (C,5)) 80 [] + +tHiBW = outFile "hiBW.wav" 10 $ + sfTest1 filterHighPassBW 10 (absPitch (C,5)) 80 [] +\end{code} + +Tests for bandpass and bandstop filters (varying center frequency): + +\begin{code} +addBandWidth :: AudSF (Double,Double,Double) Double -> + AudSF (Double,Double) Double +addBandWidth filter = + proc (a,f) -> do filter -< (a,f,200) + +tBP = outFile "bp.wav" 10 $ + sfTest1 (addBandWidth (filterBandPass 1)) 10 (absPitch (C,6)) 80 [] + +tBS = outFile "bs.wav" 10 $ + sfTest1 (addBandWidth (filterBandStop 1)) 10 (absPitch (C,6)) 80 [] + +tBPBW = outFile "bpBW.wav" 10 $ + sfTest1 (addBandWidth filterBandPassBW) 10 (absPitch (C,6)) 80 [] + +tBSBW = outFile "bsBW.wav" 10 $ + sfTest1 (addBandWidth filterBandStopBW) 10 (absPitch (C,6)) 80 [] +\end{code} + +Pure white noise: + +\begin{code} +noise1 :: Instr (Mono AudRate) + -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double| +noise1 dur ap vol [] = + let v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseWhite 42 -< () + outA -< a1*v +test1 = outFile "noise1.wav" 6 (noise1 6 (absPitch (C,5)) 100 []) +\end{code} + +Tests for bandpass and bandstop filters (varying bandwidth): + +\begin{code} +env2 :: AudSF () Double +env2 = envExpon 1 10 2000 + +sfTest2 :: AudSF (Double,Double,Double) Double -> Instr (Mono AudRate) + -- |AudSF (Double,Double,Double) Double -> | + -- |Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double| +sfTest2 sf dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseWhite 42 -< () + bw <- env2 -< () + a2 <- sf -< (a1,f,bw) + outA -< a2 + +tBP' = outFile "bp'.wav" 10 $ + sfTest2 (filterBandPass 1) 10 (absPitch (C,5)) 80 [] + +tBS' = outFile "bs'.wav" 10 $ + sfTest2 (filterBandStop 1) 10 (absPitch (C,5)) 80 [] + +tBPBW' = outFile "bpBW'.wav" 10 $ + sfTest2 filterBandPassBW 10 (absPitch (C,5)) 80 [] + +tBSBW' = outFile "bsBW'.wav" 10 $ + sfTest2 filterBandStopBW 10 (absPitch (C,5)) 80 [] +\end{code} + +Bandlimited noise: + +\begin{code} +noise2 :: Instr (Mono AudRate) +noise2 dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseBLI 42 -< f + outA -< a1*v +test2 = outFile "noise2.wav" 6 (noise2 6 (absPitch (C,5)) 100 []) +\end{code} + +Simple subtractive synthesis: + +\begin{code} +ss1 :: Instr (Mono AudRate) +ss1 dur ap vol [] = + let v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseWhite 42 -< () + a2 <- filterBandPass 2 -< (a1, 1000, 200) + outA -< a2*v/5 +test3 = outFile "ss1.wav" 6 (ss1 6 (absPitch (C,5)) 100 []) +\end{code} + +Howling wind: + +\begin{code} +wind :: Instr (Mono AudRate) +wind dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseWhite 42 -< () + lfo1 <- osc sineTable 0 -< 0.9 + lfo2 <- osc sineTable 0 -< 1.3 + a2 <- filterBandPass 2 -< (a1, f + 100*(lfo1+lfo2), 200) + outA -< a2*v/5 +test4 = outFile "wind.wav" 6 (wind 6 (absPitch (C,7)) 100 []) +\end{code} + +Dense partials ("buzz") + +\begin{code} +buzzy :: Instr (Mono AudRate) +buzzy dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + in proc () -> do + a1 <- oscPartials sineTable 0 -< (f,20) + outA -< a1*v +test5 = outFile "buzzy.wav" 6 (buzzy 6 (absPitch (C,5)) 100 []) +\end{code} + +Dense partials filtered and Shaped: + +\begin{code} +buzzy2 :: Instr (Mono AudRate) +buzzy2 dur ap vol [] = + let f = apToHz ap + v = fromIntegral vol / 100 + d = fromRational dur + in proc () -> do + a1 <- oscPartials sineTable 0 -< (f,20) + env <- envExponSeg [0, 1, 0.001] [0.003, d - 0.003] -< () + a2 <- filterLowPass -< (a1,20000*env) + outA -< a2*v*env +test6 = outFile "buzzy2.wav" 6 (buzzy2 6 (absPitch (C,5)) 100 []) +\end{code} + +Sci-Fi-1: + +\begin{code} +scifi1 :: Instr (Mono AudRate) +scifi1 dur ap vol [] = + let v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseBLH 42 -< 8 + a2 <- osc sineTable 0 -< 600 + 200*a1 + outA -< a2*v +test7 = outFile "scifi1.wav" 10 (scifi1 10 (absPitch (C,5)) 100 []) +\end{code} + +Sci-Fi-2: + +\begin{code} +scifi2 :: Instr (Mono AudRate) +scifi2 dur ap vol [] = + let v = fromIntegral vol / 100 + in proc () -> do + a1 <- noiseBLI 44 -< 8 + a2 <- osc sineTable 0 -< 600 + 200*a1 + outA -< a2*v +test8 = outFile "scifi2.wav" 10 (scifi2 10 (absPitch (C,5)) 100 []) +\end{code} +`
+ HSoM/Algebra.lhs view
@@ -0,0 +1,583 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%% Todo: +%% -- Add exercise to prove mel1 = mel2 from Intro + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{An Algebra of Music} +\label{ch:algebra} + +In this chapter we will explore a number of properties of the |Music| +data type and functions defined on it, properties that collectively +form an \emph{algebra of music} \cite{PTM-PADL}. With this algebra we +can reason about, transform, and optimize computer music programs in a +meaning preserving way. + +\section{Musical Equivalance} + +\index{algebraic properties} +Suppose we have two values |m1 :: Music Pitch| and |m2 :: Music Pitch|, +and we want to know if they are equal. If we treat them simply as +Haskell values, we could easily write a function that compares their +structures recursively to see if they are the same at every level, all +the way down to the |Primitive| rests and notes. This is in fact what +the Haskell function |(==)| does. For example, if: +\begin{spec} +m1 = c 4 en :+: d 4 qn +m2 = revM (revM m1) +\end{spec} +Then |m1 == m2| is |True|. + +Unfortunately, as we saw in the last chapter, if we reverse a parallel +composition, things do not work out as well. For example: +\begin{spec} +revM (revM (c 4 en :=: d 4 qn)) +==> (rest 0 :+: c 4 en :+: rest en) :=: d 4 qn +\end{spec} + +In addition, as we discussed briefly in Chapter \ref{ch:intro}, there +are musical properties for which standard Haskell equivalence is +insufficient to capture. For example, we would expect the following +two musical values to \emph{sound} the same, regardless of the actual +values of |m1|, |m2|, and |m3|: +\begin{spec} +(m1 :+: m2) :+: m3 +m1 :+: (m2 :+: m3) +\end{spec} +In other words, we expect the operator |(:+:)| to be \emph{associative}. + +The problem is that, as data structures, these two values are +\emph{not} equal in general, in fact there are no finite values that +can be assigned to |m1|, |m2|, and |m3| to make them +equal.\footnote{If |m1 = m1 :+: m2| and |m3 = m2 :+: m3| then the two + expressions are equal, but these are infinite values that cannot + be reversed or even performed.} + +The obvious way out of this dilemma is to define a new notion of +equality that captures the fact that the \emph{performances} are the +same---i.e.\ if two things \emph{sound} the same, they must be +musically equivalent. And thus we define a formal notion of musical +equivalence: + +\paragraph*{Definition:} +Two musical values |m1| and |m2| are \emph{equivalent}, written \newline +|m1 === m2|, if and only if: +\[ (\forall|pm,c|)\ \ |perf pm c m1 = perf pm c m2| \] + +We will study a number of properties in this chapter that capture +musical equivalences, similar in spirit to the associativity of +|(:+:)| above. Each of them can be thought of as an \emph{axiom}, and +the set of valid axioms collectively forms an \emph{algebra of music}. +By proving the validity of each axiom we not only confirm our +intuitions about how music is interpreted, but also gain confidence +that our |perform| function actually does the right thing. +Furthermore, with these axioms in hand, we can \emph{transform} +musical values in meaning-preserving ways. + +Speaking of the |perform| function, recall from Chapter +\ref{ch:performance} that we defined \emph{two} versions of |perform|, +and the definition above uses the function |perf|, which includes the +duration of a musical value in its result. The following Lemma +captures the connection between these functions: + +\begin{lemma} +\label{lem:perf} +{\em +For all |pm|, |c|, and |m|: +\begin{spec} +perf pm c m = (perform pm c m, dur m * cDur c) +\end{spec} +where |perform| is the function defined in Figure \ref{fig:perform}. +} +\end{lemma} + +To see the importance of including duration in the definition of +equivalence, we first note that if two musical values are equivalent, +we should be able to substitute one for the other in any valid musical +context. But if duration is not taken into account, then all rests +are equivalent (because their performances are just the empty list). +This means that, for example, |m1 :+: rest 1 :+: m2| is equivalent to +|m1 :+: rest 2 :+: m2|, which is surely not what we want.\footnote{A + more striking example of this point is John Cage's composition + \emph{4'33''}, which consists basically of four minutes and + thirty-three seconds of silence \cite{}.} + +Note that we could have defined |perf| as above, i.e.\ in terms of +|perform| and |dur|, but as mentioned in Section \ref{sec:performance} +it would have been computationally inefficient to do so. On the other +hand, if the Lemma above is true, then our proofs might be simpler if +we first proved the property using |perform|, and then using |dur|. +That is, to prove |m1 === m2| we need to prove: +\begin{spec} +perf pm c m1 = perf pm c m2 +\end{spec} +Instead of doing this directly using the definition of |perf|, we +could instead prove both of the following: +\begin{spec} +perform pm c m1 = perform pm c m2 +dur m1 = dur m2 +\end{spec} + +\subsection{Literal Player} + +The only problem with this strategy for defining musical equivalence +is that the notion of a \emph{player} can create situations where +certain properties that we would like to hold, in fact do not. After +all, a player may interpret a note or phrase in whatever way it (or he +or she) may desire. For example, it seems that this property should +hold: +\begin{spec} +tempo 1 m === m +\end{spec} +However, a certain (rather perverse) player might interpret anything +tagged with a |Tempo| modifier as an empty performance---in which case +the above property will fail! To solve this problem, we assume that... + +\section{Some Simple Axioms} + +% \setcounter{axiom}{0} + +Let's look at a few simple axioms, and see how we can prove each of +them using the proof techniques that we have developed so far. + +(Note: In the remainder of this chapter we will use the functions +|tempo r| and |trans p| to represent their unfolded versions, |Modify +(Tempo r)| and |Modify (Transpose t)|, respectively. In the proofs we +will not bother with the intermediate steps of unfolding these +functions.) + +Here is the first axiom that we will consider: +\begin{axiom}{\em +For any |r1|, |r2|, and |m|: +\begin{spec} +tempo r1 (tempo r2 m) === tempo (r1*r2) m +\end{spec} +} +\end{axiom} +In other words, \emph{tempo scaling is multiplicative}. + +We can prove this by calculation, starting with the definition of +musical equivalence. For clarity we will first prove the property for +|perform|, and then for |dur|, as suggested in the last section: +\begin{spec} +let dt = cDur c + +perform pm c (tempo r1 (tempo r2 m)) +==> { unfold perform } +perform pm (c {cDur = dt/r1}) (tempo r2 m) +==> { unfold perform } +perform pm (c {cDur = (dt/r1)/r2}) m +==> { arithmetic } +perform pm (c {cDur = dt/(r1*r2)}) m +==> { fold perform } +perform pm c (tempo (r1*r2) m) +\end{spec} + +\begin{spec} +dur (tempo r1 (tempo r2 m)) +==> { unfold dur } +dur (tempo r2 m) / r1 +==> { unfold dur } +(dur m / r2) / r1 +==> {arithmetic } +dur m / (r1*r2) +==> { fold dur } +dur (tempo (r1*r2) m) +\end{spec} + +Here is another useful axiom and its proof: +\begin{axiom}{\em +For any |r|, |m1|, and |m2|: +\begin{spec} +tempo r (m1 :+: m2) === tempo r m1 :+: tempo r m2 +\end{spec} +} +\end{axiom} +In other words, {\em tempo scaling distributes over sequential +composition}. + +{\noindent \bf Proof:} + +\begin{spec} +let t = cTime c; dt = cDur c + t1 = t + dur m1 * (dt/r) + t2 = t + (dur m1 / r) * dt + t3 = t + dur (tempo r m1) * dt + +perform pm c (tempo r (m1 :+: m2)) +==> { unfold perform } +perform pm (c {cDur = dt/r}) (m1 :+: m2) +==> { unfold perform } +perform pm (c {cDur = dt/r}) m1 + ++ perform pm (c {cTime = t1, cDur = dt/r}) m2 +==> { fold perform } +perform pm c (tempo r m1) + ++ perform pm (c {cTime = t1}) (tempo r m2) +==> { arithmetic } +perform pm c (tempo r m1) + ++ perform pm (c {cTime = t2}) (tempo r m2) +==> { fold dur } +perform pm c (tempo r m1) + ++ perform pm (c {cTime = t3}) (tempo r m2) +==> { fold perform } +perform pm c (tempo r m1 :+: tempo r m2) +\end{spec} + +\begin{spec} +dur (tempo r (m1 :+: m2)) +==> dur (m1 :+: m2) / r +==> (dur m1 + dur m2) / r +==> dur m1 / r + dur m2 / r +==> dur (tempo r m1) + dur (tempo r m2) +==> dur (tempo r m1 :+: tempo r m2) +\end{spec} + +An even simpler axiom is given by: +\begin{axiom}{\em +For any |m|, |tempo 1 m === m|. +} +\end{axiom} +In other words, {\em unit tempo scaling is the identity function for +type} |Music|. + +{\noindent\bf Proof:} + +\begin{spec} +let dt = cDur c + +perform pm c (tempo 1) m) +==> { unfold perform } +perform pm (c {cDur = dt/1}) m +==> { arithmetic } +perform pm c m +\end{spec} + +\begin{spec} +dur (tempo 1) m) +==> dur m / 1 +==> dur m +\end{spec} + +Note that the above three proofs, being used to establish axioms, all +involve the definitions of |perform| and |dur|. In contrast, we can +also establish {\em theorems} whose proofs involve only the axioms. +For example, Axioms 1, 2, and 3 are all needed to prove the following: + +\begin{theorem}{\em +For any |r|, |m1|, and |m2|: +\begin{spec} +tempo r m1 :+: m2 === tempo r (m1 :+: tempo (1/r) m2) +\end{spec} +} +\end{theorem} + +{\noindent\bf Proof:} + +\begin{spec} +tempo r m1 :+: m2 +==> { Axiom 3 } +tempo r m1 :+: tempo 1 m2 +==> { arithmetic } +tempo r m1 :+: tempo (r*(1/r)) m2 +==> { Axiom 1 } +tempo r m1 :+: tempo r (tempo (1/r) m2) +==> { Axiom 2 } +tempo r (m1 :+: tempo (1/r) m2) +\end{spec} + +%% This theorem justifies the equivalence of the two phrases shown in +%% Figure \ref{equiv}. + +%% \begin{figure*} +%% \vspace*{1in} +%% \centerline{ +%% \epsfysize=.6in +%% \epsfbox{Pics/equiv.eps} +%% } +%% \caption{Equivalent Phrases} +%% \label{equiv} +%% \end{figure*} + +\section{The Fundamental Axiom Set} + +There are many other useful axioms, but we do not have room to include +all of their proofs here. They are listed below, which include the axioms +from the previous section as special cases, and the proofs are left as +exercises. + +\begin{axiom}{\em +|Tempo| is {\em multiplicative} and |Transpose| is {\em +additive}. That is, for any |r1|, |r2|, |p1|, |p2|, and +|m|: +\begin{spec} +tempo r1 (tempo r2 m) === tempo (r1*r2) m + +trans p1 (trans p2 m) === trans (p1+p2) m +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +Function composition is {\em commutative} with respect to both tempo +scaling and transposition. That is, for any |r1|, |r2|, |p1| +and |p2|: +\begin{spec} +tempo r1 . tempo r2 === tempo r2 . tempo r1 + +trans p1 . trans p2 === trans p2 . trans p1 + +tempo r1 . trans p1 === trans p1 . tempo r1 +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +Tempo scaling and transposition are {\em distributive} over both +sequential and parallel composition. That is, for any |r|, +|p|, |m1|, and |m2|: +\begin{spec} +tempo r (m1 :+: m2) === tempo r m1 :+: tempo r m2 + +tempo r (m1 :=: m2) === tempo r m1 :=: tempo r m2 + +trans p (m1 :+: m2) === trans p m1 :+: trans p m2 + +trans p (m1 :=: m2) === trans p m1 :=: trans p m2 +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +Sequential and parallel composition are {\em associative}. That is, +for any |m0|, |m1|, and |m2|: +\begin{spec} +m0 :+: (m1 :+: m2) === (m0 :+: m1) :+: m2 + +m0 :=: (m1 :=: m2) === (m0 :=: m1) :=: m2 +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +Parallel composition is {\em commutative}. That is, for any |m0| +and |m1|: +\begin{spec} +m0 :=: m1 === m1 :=: m0 +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +|rest 0| is a {\em unit} for |tempo| and |trans|, and a {\em +zero} for sequential and parallel composition. That is, for any +|r|, |p|, and |m|: +\begin{spec} +tempo r (rest 0) === rest 0 + +trans p (rest 0) === rest 0 + +m :+: rest 0 === m === rest 0 :+: m + +m :=: rest 0 === m === rest 0 :=: m +\end{spec} +} +\end{axiom} + +\begin{axiom}{\em +A rest can be used to ``pad'' a parallel composition. That is, for +any |m1|, |m2|, such that |diff = dur m1 > dur m2 >= 0|, and any |d <= +diff|: +\begin{spec} +m1 :=: m2 === m1 :=: (m2 :+: rest d) +\end{spec} +\label{ax:pad} +} +\end{axiom} + +\begin{axiom}{\em +There is a duality between |(:+:)| and |(:=:)|, namely that, for any +|m0|, |m1|, |m2|, and |m3| such that |dur m0 = dur m2|: +\begin{spec} +(m0 :+: m1) :=: (m2 :+: m3) === (m0 :=: m2) :+: (m1 :=: m3) +\end{spec} +} +\end{axiom} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Prove Lemma \ref{lem:perf}.} +\end{exercise} + +\begin{exercise}{\em +Establish the validity of each of the above axioms.} +\end{exercise} + +\begin{exercise}{\em +Recall the polyphonic and contrapuntal melodies |mel1| and |mel2| from +Chapter~\ref{ch:intro}. Prove that |mel1 === mel2|.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{An Algebraic Semantics} + +Discuss formal semantics. Denotational, operational (relate to +``proof by calculation''), and algebraic. + +Soundness and Completeness. + +\cite{PTM-PADL} + +\section{Other Musical Properties} + +Aside from the axioms discussed so far, there are many other +properties of |Music| values and its various operators, just as we saw +in Chapter~\ref{ch:induction} for lists. For example, this property +of |map| taken from Figure~\ref{fig:list-props1}: +\begin{spec} +map (f . g) = map f . map g +\end{spec} +suggests and analogous property for |mMap|: +\begin{spec} +map (f . g) = map f . map g +\end{spec} +Not all of the properties in Figures~\ref{fig:list-props1} and +\ref{fig:list-props2} have analogous musical renditions, and there +are also others that are special only to |Music| values. +Figure~\ref{fig:music-props} summarizes the most important of these +properties, including the one above. Note that some of the properties +are expressed as strict equality---that is, the left-hand and +right-hand sides are equivalent as Haskell values. But others are +expressed using musical equivalence---that is, using |(===)|. We +leave the proofs of all these properties as an exercise. + +\begin{figure} +\cbox{ +\begin{minipage}{4.75in} +{\bf Properties of |mMap|:} + +\vspace{0.1in} +\begin{spec} +mMap (\x->x) = \x->x +mMap (f . g) = mMap f . mMap g +mMap f . dropM d = dropM d . mMap f +mMap f . takeM d = takeM d . mMap f +\end{spec} + +\vspace{0.1in} +{\bf Properties of |takeM| and |dropM|:} + +\vspace{0.1in} For all non-negative |d1| and |d2|: +\begin{spec} +takeM d1 . takeM d2 = takeM (min d1 d2) +dropM d1 . dropM d2 = dropM (d1 + d2) +takeM d1 . dropM d2 = dropM d1 . takeM (d1 + d2) +\end{spec} +For all non-negative |d1| and |d2| such that |d2 >= d1|: +\begin{spec} +dropM d1 . takeM d2 = takeM (d2 - d1) . dropM d1 +\end{spec} + +\vspace{0.1in} +{\bf Properties of |revM|:} + +\vspace{0.1in} For all finite-duration |m|: +\begin{spec} +revM (revM m) === m +revM (takeM d m) === dropM (dur m - d) (revM m) +revM (dropM d m) === takeM (dur m - d) (revM m) +takeM d (revM m) === revM (dropM (dur m - d) m) +dropM d (revM m) === revM (takeM (dur m - d) m) +\end{spec} + +\vspace{0.1in} +{\bf Properties of |dur|:} + +\vspace{0.1in} +\begin{spec} +dur (revM m) = dur m +dur (takeM d m) = min d (dur m) +dur (dropM d m) = max 0 (dur m - d) +\end{spec} +\end{minipage}} +\caption{Useful Properties of Other Musical Functions} +\label{fig:music-props} +\end{figure} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Prove that |timesM a m :+: timesM b m === timesM (a+b) m|.} +\end{exercise} + +\begin{exercise}{\em +Prove as many of the axioms from Figure~\ref{fig:music-props} as you +can.} +\end{exercise} + +\out{ +Proof that revM (revM m) === m: + +revM (revM (Prim p)) +==> revM (Prim p) +==> Prim p + +revM (revM (Modify c m)) +==> revM (Modify c (revM m)) +==> Modify c (revM (revM m)) +==> Modify c m + +revM (revM (m1 :+: m2)) +==> revM (revM m2 :+: revM m1) +==> revM (revM m1) :+: revM (revM m2) +==> m1 :+: m2 + +revM (revM (m1 :=: m2)) +==> revM (let d1 = dur m1; d2 = dur m2 + in if d1>d2 + then revM m1 :=: (rest (d1 − d2) :+: revM m2) + else (rest (d2 − d1) :+: revM m1) :=: revM m2 ) +==> let d1 = dur m1; d2 = dur m2 + in if d1>d2 + then revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) + else revM ((rest (d2−d1) :+: revM m1) :=: revM m2) +==> let d1 = dur m1; d2 = dur m2 + in if d1>d2 + then revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) + else revM ((rest (d2−d1) :+: revM m1) :=: revM m2) + +Taking each branch of the conditional separately, first assume d1>d2: + +revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) +==> let d1' = dur (revM m1) + d2' = dur (rest (d1−d2) :+: revM m2) + in if d1'>d2' + then revM (revM m1) :=: (rest (d1'-d2') :+: + revM (rest (d1−d2) :+: revM m2)) + else (rest (d2'-d1') :+: revM (revM m1)) :=: + revM (rest (d1−d2) :+: revM m2) +==> let d1' = dur m1 = d1 + d2' = (d1−d2) + d2 = d1 + in if d1'>d2' + then revM (revM m1) :=: (rest (d1'-d2') :+: + revM (rest (d1−d2) :+: revM m2)) + else (rest (d2'-d1') :+: revM (revM m1)) :=: + revM (rest (d1−d2) :+: revM m2) +==> (rest (d2'-d1') :+: revM (revM m1)) :=: revM (rest (d1−d2) :+: revM m2) +==> (rest 0 :+: revM (revM m1)) :=: revM (rest (d2−d1) :+: revM m2) +=== revM (revM m1) :=: revM (rest (d1−d2) :+: revM m2) +==> m1 :=: revM (rest (d1−d2) :+: revM m2) +==> m1 :=: (revM (revM m2) :+: revM (rest (d1−d2))) +==> m1 :=: (m2 :+: revM (rest (d1−d2))) +==> m1 :=: (m2 :+: rest (d1−d2)) +=== m1 :=: m2 + +Note: The last step relies on Axiom \ref{ax:pad}. + +The other branch of the conditional follows similarly. +} + +\vspace{.1in}\hrule
+ HSoM/Bitans.lhs view
@@ -0,0 +1,112 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{Built-in Types Are Not Special} +\label{ch:bitans} + +\index{type} +Throughout this text we have introduced many ``built-in'' types such +as lists, tuples, integers, and characters. We have also shown how +new user-defined types can be defined. Aside from special syntax, you +might be wondering if the built-in types are in any way more special +than the user-defined ones. The answer is {\em no}. The special +syntax is for convenience and for consistency with historical +convention, but has no semantic consequence. + +We can emphasize this point by considering what the type +declarations would look like for these built-in types if in fact we +were allowed to use the special syntax in defining them. For example, +the \indexwdhs{Char} type might be written as: +\begin{spec} +data Char = 'a' | 'b' | 'c' | ... -- This is not valid + | 'A' | 'B' | 'C' | ... -- Haskell code! + | '1' | '2' | '3' | ... +\end{spec} +These constructor names are not syntactically valid; to fix them we +would have to write something like: +\begin{spec} +data Char = Ca | Cb | Cc | ... + | CA | CB | CC | ... + | C1 | C2 | C3 | ... +\end{spec} +Even though these constructors are actually more concise, they are +quite unconventional for representing characters, and thus the special +syntax is used instead. + +In any case, writing ``pseudo-Haskell'' code in this way helps us to +see through the special syntax. We see now that \hs{Char} is just a +data type consisting of a large number of nullary (meaning they take +no arguments) constructors. Thinking of \hs{Char} in this way makes +it clear why, for example, we can pattern-match against characters; +i.e., we would expect to be able to do so for any of a data type's +constructors. + +Similarly, using pseudo-Haskell, we could define \indexwdhs{Int} and +\indexwdhs{Integer} by: +\begin{spec} + -- more pseudo-code: +data Int = (-2^29) | ... | -1 | 0 | 1 | ... | (2^29-1) +data Integer = ... -2 | -1 | 0 | 1 | 2 ... +\end{spec} +(Recall that $-2^{29}$ to $2^{29-1}$ is the minimum range for the +\hs{Int} data type.) \hs{Int} is clearly a much larger enumeration +than \hs{Char}, but it's still finite! In contrast, the pseudo-code +for \hs{Integer} (the type of arbitrary precision integers) is +intended to convey an {\em infinite} enumeration (and in that sense +only, the \hs{Integer} data type {\em is} somewhat special). + +\index{unit type} +Haskell has a data type called \hs{unit} which has exactly one value: +\hs{()}. The name of this data type is also written \hs{()}. This is +trivially expressed in Haskell pseudo-code: +\begin{spec} +data () = () -- more pseudo-code +\end{spec} +Tuples are also easy to define playing this game: +\index{tuples} +\begin{spec} +data (a,b) = (a,b) -- more pseudo-code +data (a,b,c) = (a,b,c) +data (a,b,c,d) = (a,b,c,d) +\end{spec} +and so on. Each declaration above defines a tuple type of a +particular length, with parentheses playing a role in both the +expression syntax (as data constructor) and type-expression syntax (as +type constructor). By ``and so on'' we mean that there are an +infinite number of such declarations, reflecting the fact that tuples +of all finite lengths are allowed in Haskell. + +The list data type is also easily handled in pseudo-Haskell, and more +interestingly, it is recursive: +\begin{spec} +data [a] = [] | a : [a] -- more pseudo-code +infixr 5 : +\end{spec} +We can now see clearly what we described about lists earlier: \hs{[]} +is the empty list, and \hs{(:)} is the infix list constructor; thus +\hs{[1,2,3]} must be equivalent to the list \hs{1:2:3:[]}. (Note that +\hs{(:)} is right associative.) The type of \hs{[]} is \hs{[a]}, and +the type of \hs{(:)} is \hs{a->[a]->[a]}. + +\syn{The way \hs{(:)} is defined here is actually legal syntax---\indexwd{infix +constructors} are permitted in \hs{data} declarations, and are +distinguished from infix operators (for pattern-matching purposes) by +the fact that they must begin with a colon (a property trivially +satisfied by ``\hs{:}'').} + +At this point the reader should note carefully the differences between +tuples and lists, which the above definitions make abundantly clear. +In particular, note the recursive nature of the list type whose +elements are homogeneous and of arbitrary length, and the +non-recursive nature of a (particular) tuple type whose elements are +heterogeneous and of fixed length. The typing rules for tuples and +lists should now also be clear: + +For \hs{(e1,e2,...,en)}, $n\geq2$, if \hs{Ti} is the type of \hs{ei}, +then the type of the tuple is \hs{(T1,T2,...,Tn)}. + +For \hs{[e1,e2,...,en]},$n\geq0$, each \hs{ei} must have the same type +$T$, and the type of the list is \hs{[T]}. +
+ HSoM/Class-tour.lhs view
@@ -0,0 +1,602 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\chapter{Haskell's Standard Type Classes}+\label{ch:class-tour}++This provides a ``tour'' through the predefined standard type classes+in Haskell, as was done for lists in Chapter \ref{ch:list-tour}. We+have simplified these classes somewhat by omitting some of the less+interesting methods; the Haskell Report and Standard Library Report+contain more complete descriptions.++% Haskell's standard classes form the somewhat imposing inclusion+% structure shown in Figure \ref{tut-classes-figure}. At the top of the+% figure, we see \hs{Eq} with its subclass \hs{Ord} below it. These were+% defined in the previous section.++\section{The Ordered Class}+\label{sec:ord-class}++The equality class \hs{Eq} was defined precisely in Chapter+\ref{ch:qualified-types}, along with a simplified version of the class+\indexwdhs{Ord}. Here is its full specification of class \hs{Ord};+note the many default methods. \indexhs{max} \indexhs{min}+\indexhs{compare} \indexhs{(<=)} \indexhs{(<)} \indexhs{(>=)} \indexhs{(>)}+\begin{spec}+class (Eq a) => Ord a where+ compare :: a -> a -> Ordering+ (<), (<=), (>=), (>) :: a -> a -> Bool+ max, min :: a -> a -> a++ compare x y+ | x == y = EQ+ | x <= y = LT+ | otherwise = GT++ x <= y = compare x y /= GT+ x < y = compare x y == LT+ x >= y = compare x y /= LT+ x > y = compare x y == GT++ max x y + | x >= y = x+ | otherwise = y+ min x y+ | x < y = x+ | otherwise = y+data Ordering = LT | EQ | GT+ deriving (Eq, Ord, Enum, Read, Show, Bounded)+\end{spec}++Note that the default method for \hs{compare} is defined in terms of+\hs{(<=)}, and that the default method for \hs{(<=)} is defined in+terms of \hs{compare}. This means that an instance of \hs{Ord} should+contain a method for at least one of these for everything to be well+defined. (Using \hs{compare} can be more efficient for complex+types.) This is a common idea in designing a type class.++\section{The Enumeration Class}+\label{sec:enum-class}++Class \indexwdhs{Enum} has a set of operations that underlie the syntactic+sugar of {\em arithmetic sequences}; for example, the arithmetic+sequence \hs{[1,3..]} is actually shorthand for \hs{enumFromThen 1 3}.+If this is true, then we should be able to generate arithmetic+sequences for any type that is an instance of \hs{Enum}. This+includes not only most numeric types, but also \hs{Char}, so that, for+instance, \hs{['a'..'z']} denotes the list of lower-case letters in+alphabetical order. Furthermore, a user-defined enumerated type such+as \hs{Color}:+\begin{spec}+data Color = Red | Orange | Yellow | Green | Blue | Indigo | Violet+\end{spec}+can easily be given an \hs{Enum} instance declaration, after which we+can calculate the following results:+\begin{spec}+[Red .. Violet] ===> [ Red, Orange, Yellow, Green, + Blue, Indigo, Violet]+[Red, Yellow ..] ===> [ Red, Yellow, Blue, Violet]+fromEnum Green ===> 3+toEnum 5 :: Color ===> Indigo+\end{spec}+Indeed, the derived instance will give this result. Note that the+sequences are still {\em arithmetic} in the sense that the increment+between values is constant, even though the values are not numbers.++The complete definition of the \hs{Enum} class is given below:++\newpage+\indexhs{toEnum}+\indexhs{fromEnum}+\indexhs{enumFrom}+\indexhs{enumFromThen}+\indexhs{enumFromTo}+\indexhs{enumFromThenTo}+\begin{spec}+class Enum a where+ succ, pred :: a -> a+ toEnum :: Int -> a+ fromEnum :: a -> Int+ enumFrom :: a -> [a] -- [n..]+ enumFromThen :: a -> a -> [a] -- [n,n'..]+ enumFromTo :: a -> a -> [a] -- [n..m]+ enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]++ -- Minimal complete definition: toEnum, fromEnum+ succ = toEnum . (+1) . fromEnum+ pred = toEnum . (subtract 1) . fromEnum+ enumFrom x = map toEnum [fromEnum x ..]+ enumFromThen x y = map toEnum [fromEnum x, fromEnum y .. ]+ enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]+ enumFromThenTo x y z = + map toEnum [fromEnum x, fromEnum y .. fromEnum z]+\end{spec}+The six default methods are sufficient for most applications, so when+writing your own instance declaration it is usually sufficient to only+provide methods for the remaining two operations: \hs{toEnum} and+\hs{fromEnum}.++In terms of arithmetic sequences, the expressions on the left below+are equivalent to those on the right:++\begin{tabular}{rl}+\hs{enumFrom n} & \hs{[n..]} \\+\hs{enumFromThen n n'} & \hs{[n,n'..]} \\+\hs{enumFromTo n m} & \hs{[n..m]} \\+\hs{enumFromThenTo n n' m} & \hs{[n,n'..m]}\\+\end{tabular}++\section{The Bounded Class}+\label{sec:bounded-class}++The class \hs{Bounded} captures data types that are linearly bounded+in some way; i.e.\ they have both a minimum value and a maximum value.+\indexhs{Bounded}+\indexhs{minBound}+\indexhs{maxBound}+\begin{spec}+class Bounded a where+ minBound :: a+ maxBound :: a+\end{spec}+\section{The Show Class}+\label{sec:show-class}++Instances of the class \indexwdhs{Show} are those types that can be+converted to character strings. This is useful, for example, when+writing a representation of a value to the standard output area or to+a file. The class \indexwdhs{Read} works in the other direction: it+provides operations for parsing character strings to obtain the values+that they represent. In this section we will look at the \hs{Show}+class; in the next we will look at \hs{Read}.++For efficiency reasons the primitive operations in these classes are+somewhat esoteric, but they provide good lessons in both algorithm and+software design, so we will look at them in some detail.++First, let's look at one of the higher-level functions that is defined+in terms of the lower-level primitives:+\begin{spec}+show :: (Show a) => a -> String+\end{spec}+Naturally enough, \indexwdhs{show} takes a value of any type that is a+member of \hs{Show}, and returns its representation as a string. For+example, \hs{show (2+2)} yields the string \hs{"4"}, as does +\hs{show (6-2)} and \hs{show} applied to any other expression whose+value is \hs{4}.++Furthermore, we can construct strings such as:+\begin{spec}+"The sum of " ++ show x ++ " and " ++ show y ++ " is " + ++ show (x+y) ++ "."+\end{spec}+with no difficulty. In particular, because \hs{(++)} is right+associative, the number of steps to construct this string is directly+proportional to its total length, and we can't expect to do any better+than that. (Since \hs{(++)} needs to reconstruct its left argument,+if it were left associative the above expression would repeatedly+reconstruct the same sub-string on each application of \hs{(++)}. If+the total string length were $n$, then in the worst case the number of+steps needed to do this would be proportional to $n^2$, instead of+proportional to $n$ in the case where \hs{(++)} is right associative.)++Unfortunately, this strategy breaks down when construction of the list+is nested. A particularly nasty version of this problem arises for+tree-shaped data structures. Consider a function \hs{showTree} that+converts a value of type \hs{Tree} into a string, as in:+\begin{spec}+showTree (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4))+===> "< <2|3>|4>"+\end{spec}+We can define this behavior straightforwardly as follows:+\begin{spec}+showTree :: (Show a) => Tree a -> String+showTree (Leaf x) + = show x+showTree (Branch l r) + = "<" ++ showTree l ++ "|" ++ showTree r ++ ">"+\end{spec}+Each of the recursive calls to \hs{showTree} introduces more+applications of \hs{(++)}, but since they are nested, a large amount+of list reconstruction takes place (similar to the problem that would+arise if \hs{(++)} were left associative). If the tree being+converted has size $n$, then in the worst case the number of steps+needed to perform this conversion is proportional to $n^2$. This is+no good!++To restore linear complexity, suppose we had a function+\indexwdhs{shows}:+\begin{spec}+shows :: (Show a) => a -> String -> String+\end{spec}+which takes a showable value and a string and returns that string with+the value's representation concatenated at the front. For example, we+would expect \hs{shows (2+2) "hello"} to return the string+\hs{"4hello"}. The string argument should be thought of as an+``\indexwd{accumulator}'' for the final result.++Using \hs{shows} we can define a more efficient version of+\hs{showTree} which, like \hs{shows}, has a string accumulator+argument. Let's call this function \hs{showsTree}:+\begin{spec}+showsTree :: (Show a) => Tree a -> String -> String+showsTree (Leaf x) s + = shows x s+showsTree (Branch l r) s + = "<" ++ showsTree l ("|" ++ showsTree r (">" ++ s))+\end{spec}+This function requires a number of steps directly proportional to the+size of the tree, thus solving our efficiency problem. To see why+this is so, note that the accumulator argument \hs{s} is never+reconstructed. It is simply passed as an argument in one recursive+call to \hs{shows} or \hs{showsTree}, and is incrementally extended to+its left using \hs{(++)}.++\hs{showTree} can now be re-defined in terms of \hs{showsTree} using an+empty accumulator:+\begin{spec}+showTree t = showsTree t ""+\end{spec}++\begin{exercise}\em+Prove that this version of \hs{showTree} is equivalent to the old.+\end{exercise}++Although this solves our efficiency problem, the presentation of this+function (and others like it) can be improved somewhat. First, let's+create a type synonym (part of the Standard Prelude):+\indexhs{ShowS}+\begin{spec}+type ShowS = String -> String+\end{spec}++% This is the type of a function that returns a string representation of+% something followed by an accumulator string. ++Second, we can avoid carrying accumulators around, and also avoid+amassing parentheses at the right end of long sequences of+concatenations, by using functional composition:+\begin{spec}+showsTree :: (Show a) => Tree a -> ShowS+showsTree (Leaf x) + = shows x+showsTree (Branch l r) + = ("<"++) . showsTree l . ("|"++) . showsTree r . (">"++)+\end{spec}++\syn{This can be simplified slightly more by noting that \hs{("c"++)}+is equivalent to \hs{('c':)} for any character \hs{c}.}++Something more important than just tidying up the code has come about+by this transformation: We have raised the presentation from an {\em+object level} (in this case, strings) to a {\em function level}. You+can read the type signature of \hs{showsTree} as saying that+\hs{showsTree} maps a tree into a {\em showing function}. Functions+like \hs{("<"++)} and \hs{("a string" ++)} are primitive showing+functions, and we build up more complex ones by function composition.++The actual \hs{Show} class in Haskell has two additional levels of+complexity (and functionality): (1) the ability to specify the {\em+precedence} of a string being generated, which is important when+\hs{show}ing a data type that has infix constructors, since it+determines when parentheses are needed, and (2) a function for+\hs{show}ing a {\em list} of values of the type under consideration,+since lists have special syntax in Haskell and are so commonly used+that they deserve special treatment. The full definition of the+\hs{Show} class is given by:+\indexhs{showsPrec}+\indexhs{showList}+\begin{spec}+class Show a where+ showsPrec :: Int -> a -> ShowS+ showList :: [a] -> ShowS++ showList [] = showString "[]"+ showList (x:xs) = showChar '[' . shows x . showl xs+ where showl [] = showChar ']'+ showl (x:xs) = showString ", " . shows x . showl xs+\end{spec}+Note the default method for \hs{showList}, and its ``function level''+style of definition. ++In addition to this class declaration the Standard Prelude defines the+following functions, which return us to where we started our journey+in this section:+\indexhs{shows}+\indexhs{show}+\begin{spec}+shows :: (Show a) => a -> ShowS+shows = showsPrec 0++show :: (Show a) => a -> String+show x = shows x ""+\end{spec}++Some details about \hs{showsPrec} can be found in the Haskell Report,+but if you are not displaying constructors in infix notation, the+precedence can be ignored. Furthermore, the default method for+\hs{showList} is perfectly good for most uses of lists that you will+encounter. Thus, for example, we can finish our \hs{Tree} example by+declaring it to be an instance of the class \hs{Show} very simply as:+\begin{spec}+instance (Show a) => Show (Tree a) where+ showsPrec n = showsTree+\end{spec}++\section{The Read Class}+\label{sec:read-class}+\indexhs{Read}++Now that we can convert trees into strings, let's turn to the inverse+problem: converting strings into trees. The basic idea is to define a+{\em \indexwd{parser}} for a type \hs{a}, which at first glance seems as if it+should be a function of type \hs{String -> a}. This simple approach+has two problems, however: (1) it's possible that the string is+ambiguous, leading to more than one way to interpret it as a value of+type \hs{a}, and (2) it's possible that only a prefix of the string+will parse correctly. Thus we choose instead to return a list of+\hs{(a, String)} pairs as the result of a parse. If all goes well we+will always get a singleton list such as \hs{[(v,"")]} as the result+of a parse, but we cannot count on it (in fact, when recursively+parsing sub-strings, we will expect a singleton list with a {\em+non-empty} trailing string).++The Standard Prelude provides a type synonym for parsers of the kind+just described:+\indexhs{ReadS}+\begin{spec}+type ReadS a = String -> [(a,String)]+\end{spec}+and also defines a function \indexwdhs{reads} that by analogy is+similar to \hs{shows}:+\begin{spec}+reads :: (Read a) => ReadS a+\end{spec}+We will return later to the precise definition of this function, but+for now let's use it to define a parser for the \hs{Tree} data type,+whose string representation is as described in the previous section.+List comprehensions give us a convenient idiom for constructing such+parsers:\footnote{An even more elegant approach to parsing uses monads+and parser combinators. These are part of a standard parsing library+distributed with most Haskell systems.}+\begin{spec}+readsTree :: (Read a) => ReadS (Tree a)+readsTree ('<':s) = [(Branch l r, u) | (l, '|':t) <- readsTree s,+ (r, '>':u) <- readsTree t ]+readsTree s = [(Leaf x, t) | (x,t) <- reads s]+\end{spec}+Let's take a moment to examine this function definition in detail.+There are two main cases to consider: If the string has the form+\hs{'<':s} we should have the representation of a branch, in which+case parsing \hs{s} as a tree should yield a left branch \hs{l}+followed by a string of the form \hs{'|':t}; parsing \hs{t} as a tree+should then yield the right branch \hs{r} followed by a string of the+form \hs{'>':u}. The resulting tree \hs{Branch l r} is then returned,+along with the trailing string \hs{u}. Note the expressive power we+get from the combination of pattern matching and list comprehension.++If the initial string is not of the form \hs{'<':s}, then we must+have a leaf, in which case the string is parsed using the generic+\hs{reads} function, and the result is directly returned.++If we accept on faith for the moment that there is a \hs{Read}+instance for \hs{Int} that behaves as one would expect, e.g.:+\begin{spec}+(reads "5 golden rings") :: [(Int,String)]+===> [(5, " golden rings")]+\end{spec}+then you should be able to verify the following calculations:+\begin{spec}+readsTree "< <1|2>|3>"+===> [(Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 1)), "")]++readsTree "<1|2" ===> []+\end{spec}+There are a couple of shortcomings, however, in our definition of+\hs{readsTree}. One is that the parser is quite rigid in that it+allows no ``white space'' (such as extra spaces, tabs, or line feeds)+before or between the elements of the tree representation. The other+is that the way we parse our punctuation symbols (\hs{'<'}, \hs{'|'},+and \hs{'>'}) is quite different from the way we parse leaf values and+sub-trees. This lack of uniformity makes the function definition+harder to read.++We can address both of these problems by using a {\em lexical+analyzer}, which parses a string into primitive ``lexemes" defined by+some rules about the string construction. The Standard Prelude+defines a lexical analyzer:+\indexhs{lex}+\begin{spec}+lex :: ReadS String+\end{spec}+whose lexical rules are those of the Haskell language, which can be+found in the Haskell Report. For our purposes, an informal+explanation is sufficient:++\hs{lex} normally returns a singleton list containing a pair of+strings: the first string is the first lexeme in the input string, and+the second string is the remainder of the input. White space --+including Haskell comments -- is completely ignored. If the input+string is empty or contains only white-space and comments, \hs{lex}+returns \hs{[("","")]}; if the input is not empty in this sense, but+also does not begin with a valid lexeme after any leading white-space,+\hs{lex} returns \hs{[]}.++Using this lexical analyzer, our tree parser can be rewritten as:+\begin{spec}+readsTree :: (Read a) => ReadS (Tree a)+readsTree s = [(Branch l r, x) | ("<", t) <- lex s,+ (l, u) <- readsTree t,+ ("|", v) <- lex u,+ (r, w) <- readsTree v,+ (">", x) <- lex w ]+ +++ [(Leaf x, t) | (x, t) <- reads s ]+\end{spec}+This definition solves both problems mentioned earlier: white-space is+suitably ignored, and parsing of sub-strings has a more uniform+structure.++To tie all of this together, let's first look at the definition of the+class \hs{Read} in the Standard Prelude:+\indexhs{readsPrec}+\indexhs{readList}+\indexhs{readParen}+\begin{spec}+class Read a where+ readsPrec :: Int -> ReadS a+ readList :: ReadS [a]++ readList = readParen False (\r -> [pr | ("[",s) <- lex r,+ pr <- readl s])+ where readl s = [([],t) | ("]",t) <- lex s] +++ [(x:xs,u) | (x,t) <- reads s,+ (xs,u) <- readl' t]+ readl' s = [([],t) | ("]",t) <- lex s] +++ [(x:xs,v) | (",",t) <- lex s,+ (x,u) <- reads t,+ (xs,v) <- readl' u]++readParen :: Bool -> ReadS a -> ReadS a+readParen b g = if b then mandatory else optional+ where optional r = g r ++ mandatory r+ mandatory r = [(x,u) | ("(",s) <- lex r,+ sc (x,t) <- optional s,+ (")",u) <- lex t ]+\end{spec}+The default method for \hs{readList} is rather tedious, but otherwise+straightforward.+\indexhs{reads}+\indexhs{read}++\hs{reads} can now be defined, along with an even higher-level+function, \hs{read}:+\begin{spec}+reads :: (Read a) => ReadS a+reads = readsPrec 0++read :: (Read a) => String -> a+read s = case [x | (x,t) <- reads s, ("","") <- lex t] of+ [x] -> x+ [] -> error "PreludeText.read: no parse"+ _ -> error "PreludeText.read: ambiguous parse"+\end{spec}+The definition of \hs{reads} (like \hs{shows}) should not be+surprising. The definition of \hs{read} assumes that exactly one+parse is expected, and thus causes a run-time error if there is no+unique parse or if the input contains anything more than a+representation of exactly one value of type \hs{a} (and possibly+comments and white-space).++You can test that the \hs{Read} and \hs{Show} instances for a+particular type are working correctly by applying \hs{(read . show)}+to a value in that type, which in most situations should be the+identity function.++\section{The Index Class}+\label{sec:index-class}+\indexhs{Ix}+\indexhs{range}+\indexhs{index}+\indexhs{inRange}++The Standard Prelude defines a type class of array indices:+\begin{spec}+class (Ord a) => Ix a where+ range :: (a,a) -> [a]+ index :: (a,a) -> a -> Int+ inRange :: (a,a) -> a -> Bool+\end{spec}+Arrays are defined elsewhere, but the index class is useful for other+things besides arrays, so I will describe it here.++Instance declarations are provided for \hs{Int}, \hs{Integer},+\hs{Char}, \hs{Bool}, and tuples of \hs{Ix} types; in addition,+instances may be automatically derived for enumerated and tuple types.+You should think of the primitive types as vector indices, and tuple+types as indices of multidimensional rectangular arrays. Note that+the first argument of each of the operations of class \hs{Ix} is a+pair of indices; these are typically the {\em bounds} (first and last+indices) of an array. For example, the bounds of a 10-element,+zero-origin vector with \hs{Int} indices would be \hs{(0,9)}, while a+100 by 100 1-origin matrix might have the bounds+\hs{((1,1),(100,100))}. (In many other languages, such bounds would+be written in a form like \hs{1:100, 1:100}, but the present form fits+the type system better, since each bound is of the same type as a+general index.)++The \hs{range} operation takes a bounds pair and produces the list of+indices lying between those bounds, in index order. For example,+\begin{spec}+range (0,4) ===> [0,1,2,3,4]+range ((0,0),(1,2)) ===> [(0,0), (0,1), (0,2), (1,0), (1,1), (1,2)]+\end{spec}+The \hs{inRange} predicate determines whether an index lies between a+given pair of bounds. (For a tuple type, this test is performed+componentwise, and then combined with \hs{(&&)}.) Finally, the+\hs{index} operation determines the (zero-based) position of an index+within a bounded range; for example:+\begin{spec}+index (1,9) 2 ===> 1+index ((0,0),(1,2)) (1,1) ===> 4+\end{spec}+\section{The Numeric Classes}+\label{sec:numeric-classes}++The \indexwdhs{Num} class and the numeric class hierarchy were briefly+described in Section \ref{sec:standard-type-classes}. Figure+\ref{fig:numeric-class-decls} gives the full class declarations.++\begin{figure}+\begin{spec}+class (Eq a, Show a) => Num a where+ (+), (-), (*) :: a -> a -> a+ negate :: a -> a+ abs, signum :: a -> a+ fromInteger :: Integer -> a++class (Num a, Ord a) => Real a where+ toRational :: a -> Rational++class (Real a, Enum a) => Integral a where+ quot, rem, div, mod :: a -> a -> a+ quotRem, divMod :: a -> a -> (a,a)+ toInteger :: a -> Integer++class (Num a) => Fractional a where+ (/) :: a -> a -> a+ recip :: a -> a+ fromRational :: Rational -> a++class (Fractional a) => Floating a where+ pi :: a+ exp, log, sqrt :: a -> a+ (**), logBase :: a -> a -> a+ sin, cos, tan :: a -> a+ asin, acos, atan :: a -> a+ sinh, cosh, tanh :: a -> a+ asinh, acosh, atanh :: a -> a++class (Real a, Fractional a) => RealFrac a where+ properFraction :: (Integral b) => a -> (b,a)+ truncate, round :: (Integral b) => a -> b+ ceiling, floor :: (Integral b) => a -> b++class (RealFrac a, Floating a) => RealFloat a where+ floatRadix :: a -> Integer+ floatDigits :: a -> Int+ floatRange :: a -> (Int,Int)+ decodeFloat :: a -> (Integer,Int)+ encodeFloat :: Integer -> Int -> a+ exponent :: a -> Int+ significand :: a -> a+ scaleFloat :: Int -> a -> a+ isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE + :: a -> Bool+\end{spec}+\caption{Standard Numeric Classes}+\label{fig:numeric-class-decls}+\end{figure}
+ HSoM/HSoM.bib view
@@ -0,0 +1,637 @@+@Article{Leak07, + author = "Paul Liu and Paul Hudak", + title = "Plugging a Space Leak With an Arrow", + journal = "Electronic Notes in Theoretical Computer Science", + publisher = "Elsevier", + volume = "193", + pages = "29--45", + month = nov, + year = "2007" +} + +@InProceedings{Paterson2001, + author = "Ross Paterson", + title = "A New Notation for Arrows", + booktitle = "{ICFP'01}: International Conference on Functional + Programming", + pages = "229--240", + year = 2001, + address = "Firenze, Italy" +} + +@Article{Hughes2000, + author = "John Hughes", + title = "Generalising Monads to Arrows", + journal = "Science of Computer Programming", + year = 2000, + volume = 37, + pages = "67--111", + month = may +} + +@techreport{csound + ,author={Vercoe, B.} + ,title={Csound: A Manual for the Audio Processing System + and Supporting Programs} + ,institution={MIT Media Lab} + ,year=1986 + } + +@article{backus:fortran78 + ,author={Backus, J.} + ,title={The history of {FORTRAN} {I}, {II}, and {III}} + ,journal={ACM Sigplan Notices} + ,volume=13 + ,number=8 + ,year=1978 + ,month=Aug + ,pages={165-180} + } + +@article{mccarthy78 + ,author={McCarthy, J.} + ,title={History of {L}isp} + ,journal={ACM Sigplan Notices} + ,volume=13 + ,number=8 + ,year=1978 + ,month=Aug + ,pages={217-223} + } + +@article{algol + ,author={de Morgan, R.M. and Hill, I.D. and Wichmann, B.A.} + ,title={Modified Report on the Algorithmic Language {ALGOL} 60} + ,journal={Computer Journal} + ,volume=19 + ,number=4 + ,year=1976 + ,pages={364-379} + } + +@article{haskell-tutorial + ,author={Hudak, P. and Fasel, J.} + ,title={A Gentle Introduction to {H}askell} + ,journal={ACM SIGPLAN Notices} + ,volume=27 + ,number=5 + ,month=May + ,year=1992 + } + +@techreport{turn76 + ,key={turner} + ,author={Turner, D.A.} + ,title={{SASL} language manual} + ,institution={University of St. Andrews} + ,year=1976 + } + +@InProceedings{turn85 + ,key={turner} + ,author={Turner, D.A.} + ,title={Miranda: a non-strict functional language with polymorphic types} + ,booktitle={Functional Programming Languages and Computer Architecture} + ,month=Sep + ,year=1985 + ,publisher={Springer-Verlag LNCS 201} + ,pages={1-16} + } + +@book{K&R + ,author = "Brian W. Kernighan and Dennis M. Ritchie" + ,title = "The C Programming Language" + ,publisher = {Prentice-Hall} + ,year = 1978 + } + +@misc{cobol + ,key={Cobol} + ,title={{A}merican {N}ational {S}tandard {COBOL} ({ANS} {X}3.23-1968)} + ,organization={American National Standards Institue, New York} + ,year=1968 + } + +@misc{ada + ,key={Ada} + ,title={Rationale for the Design of the {A}da Programming Language} + ,organization={United States Department of Defense} + ,journal={ACM Sigplan Notices} + ,volume=14 + ,number=6 + ,year=1979 + ,month=Jun + } + +@Article{r3rs + ,author = "Rees, J. and Clinger, W." + ,title = "Revised$^3$ Report on the Algorithmic Language {S}cheme" + ,journal = "SIGPLAN Notices" + ,year = "1986" + ,volume = "21" + ,number = "12" + ,pages = "37-79" +} + +@book{ML-definition + ,author={Milner, R. and Tofte, M. and Harper, R.} + ,title={The Definition of Standard ML} + ,publisher={The MIT Press} + ,address={Cambridge, MA} + ,year=1990 + } + +@article{hindley69 + ,key={hindley} + ,author={Hindley, R.} + ,title={The Principal Type Scheme of an Object in Combinatory Logic} + ,journal={Transactions of the American Mathematical Society} + ,volume=146 + ,year=1969 + ,month=Dec + ,pages={29-60} + } + + @article{milner78 + ,key={milner} + ,author={Milner, R.A.} + ,title={A Theory of Type Polymorphism in Programming} + ,journal={Journal of Computer and System Sciences} + ,volume=17 + ,number=3 + ,year=1978 + ,month=Dec + ,pages={348-375} + } + +@article{huda89a + ,author={Hudak, P.} + ,title={Conception, Evolution, and Application of Functional + Programming Languages} + ,journal={ACM Computing Surveys} + ,volume=21 + ,number=3 + ,year=1989 + ,pages={359-411} + } + +@book{Hofstadter + ,author={Hofstadter, D.R.} + ,title={G\"{o}del, Escher, Bach: an Eternal Golden Braid} + ,publisher={Vintage} + ,address={New York} + ,year=1979 + } + +@book{Quine + ,author={Quine, W.V.O.} + ,title={The Ways of Paradox, and Other Essays} + ,publisher={Random House} + ,address={New York} + ,year=1966 + } + +@book{graphics-bible + ,author={Foley, J.D. and van Dam, A. and Feiner, S.K. and Hughes, J.F.} + ,title={Computer Graphics -- Principles and Practice, 2nd Edition} + ,publisher={Addison-Wesley} + ,address={Reading, MA} + ,year=1996 + } + +@book{papp80 + ,key={Pappert} + ,author={Pappert, S.} + ,title={Mindstorms: Children, Computers and Powerful Ideas} + ,publisher={Basic Books} + ,place={New York} + ,year=1980 + } + +@book{karel + ,author={Pattis, R.E.} + ,title={Karel the Robot + -- A Gentle Intoduction to the Art of Programming with Pascal} + ,publisher={John Wiley} + ,address={New York} + ,year=1981 + } + +@book{Wiitala + ,author={Wiitala, S.A.} + ,title={Discrete Mathematics -- A Unified Approach} + ,publisher={McGraw-Hill} + ,address={New York} + ,year=1987 + } + +@inproceedings{wadler-popl92 + ,author={Wadler, P.} + ,title={The Essence of Functional Programming} + ,booktitle={Proceedings 19th Symposium on Principles of Programming + Languages} + ,organization={ACM} + ,month=Jan + ,year=1992 + ,pages={1-14} + } + +@inproceedings{moggi89 + ,author={Moggi, E.} + ,title={Computational Lambda-Calculus and Monads} + ,booktitle={Proceedings of Symposium on Logic in Computer Science} + ,organization={IEEE} + ,year=1989 + ,month=Jun + ,pages={14--23} + } + +@inproceedings{peytonjoneswadler-popl93 + ,author={Peyton Jones, S. and Wadler, P.} + ,title={Imperative Functional Programming} + ,booktitle={Proceedings 20th Symposium on Principles of Programming + Languages} + ,organization={ACM} + ,month=Jan + ,year=1993 + ,note={71--84} + } + +@book{pierce-ct + ,author={Pierce, B.} + ,title={Basic Category Theory for Computer Scientists} + ,publisher={MIT Press} + ,address={Cambridge, MA} + ,year=1991 + } + +@book{birdwadler88 + ,author={Bird, R. and Wadler, P.} + ,title={Introduction to Functional Programming} + ,publisher={Prentice Hall} + ,address={New York} + ,year=1988 + } + +@book{bird98 + ,author={Bird, R.} + ,title={Introduction to Functional Programming using Haskell + (second edition)} + ,publisher={Prentice Hall} + ,address={London} + ,year=1998 + } + +@inproceedings{Fran + ,author={Elliott, C. and Hudak, P.} + ,title={Functional Reactive Animation} + ,booktitle={International Conference on Functional Programming} + ,month=Jun + ,year=1997 + ,pages={163--173} + } + +@inproceedings{fran-dsl + ,author={Elliott, C.} + ,title={Modeling Interactive {3D} and Multimedia Animation + with an Embedded Language} + ,booktitle={Proceedings of the first conference on + Domain-Specific Languages} + ,organization={USENIX} + ,year=1997 + ,month=Oct + ,pages={285-296} + } + +@inproceedings{icra99 + ,author={Peterson, J. and Hager, G. and Hudak, P.} + ,title={A Language for Declarative Robotic Programming} + ,booktitle={International Conference on Robotics and Automation} + ,year=1999 + ,pages={} + } + +@InProceedings{padl99 + ,author = "Peterson, J. and Hudak, P. and Elliott, C." + ,title = "Lambda in Motion: Controlling Robots With Haskell" + ,booktitle = "First International Workshop on + Practical Aspects of Declarative Languages" + ,organization = "SIGPLAN" + ,month = Jan + ,year = "1999" +} + +@article{Arya86 + ,author={Arya, K.} + ,title={A Functional Approach To Animation} + ,journal={Computer Graphics Forum} + ,volume=5 + ,number=4 + ,month=Dec + ,year=1986 + ,pages={297--311} + } + +@inproceedings{arya89 + ,author={Arya, K.} + ,title={Processes in a Functional Animation System} + ,booktitle={Proceedings of the Conference on Functional Programming + Languages and Computer Architecture} + ,organization={ACM/IFIP} + ,year=1989 + ,pages={382-395} + } + +@inproceedings{Escher88 + ,author={Zilles, S.N. and Lucas, P. and Linden, T.M. and Lotspiech, J.B. + and Harbury, A.R.} + ,title={The {E}scher Document Imaging Model} + ,booktitle={Proceedings of the ACM Conference on + Document Processing Systems} + ,month=Dec + ,year=1988 + ,pages={159-168} + } + +@inproceedings{HaggisGraphics95 + ,author={Finne, S. and Peyton Jones, S.} + ,title={Pictures: A Simple Structured Graphics Model} + ,booktitle={Proceedings of Glasgow Functional Programming Workshop} + ,month=Jul + ,year=1995 + ,pages={} + } + +@techreport{LucasZilles87 + ,author={Lucas, P. and Zilles, S.N.} + ,title={Graphics in an Applicative Context} + ,institution={IBM Almaden Research Center} + ,type={Technical Report} + ,number={} + ,month=Jul + ,year=1987 + } + +@inproceedings{Schecht94 + ,author={Schechter, G. and Elliott, C. and Yeung, R. and Abi-Ezzi, S.} + ,title={Functional 3{D} Graphics in {C}++ -- + With an Object-Oriented, Multiple Dispatching Implementation} + ,booktitle={Proceedings of the 1994 Eurographics Object-Oriented + Graphics Workshop} + ,organization={Eurographics, Springer Verlag} + ,year=1994 + ,pages={} + } + +@inproceedings{henderson82 + ,author={Henderson, P.} + ,title={Functional Geometry} + ,booktitle={Proceedings of the 1982 ACM Symposium on Lisp and + Functional Programmming} + ,organization={ACM} + ,year=1982 + ,pages={179--187} + } + +@inproceedings{haskore-tutorial + ,author={Paul Hudak} + ,title={Haskore Music Tutorial} + ,booktitle={Second International School on Advanced Functional Programming} + ,publisher={Springer Verlag, LNCS 1129} + ,year=1996 + ,month=Aug + ,pages={38-68} + } + +@article{haskore + ,author={Paul Hudak and Tom Makucevich and + Syam Gadde and Bo Whong} + ,title={Haskore Music Notation -- An Algebra of Music} + ,month=May + ,year=1996 + ,volume=6 + ,number=3 + ,pages={465--483} + ,journal={Journal of Functional Programming} + } + +@inproceedings{grame94 + ,author={Orlarey, O. and Fober, D. and Letz, S. and Bilton, M.} + ,title={Lambda Calculus and Music Calculi} + ,booktitle={Proceedings of International Computer Music Conference} + ,organization={Int'l Computer Music Association} + ,year=1994 + } + +@incollection{fugue + ,author={Dannenberg, R.B. and Fraley, C.L. and Velikonja, P.} + ,title={A Functional Language for Sound Synthesis with + Behavioral Abstraction and Lazy Evaluation} + ,booktitle={Computer Generated Music} + ,publisher={IEEE Computer Society Press} + ,year=1992 + ,editor={Denis Baggi} + } + +@book{dijkstra + ,author = "Dijkstra, E.W." + ,title = "A Discipline of Programming" + ,publisher = {Prentice-Hall} + ,year = 1976 +} + +@book{java + ,author={Gosling, J. and Joy, B. and Steele, G.} + ,title={The Java Language Specification} + ,publisher={Addison-Wesley} + ,address={Reading, MA} + ,year=1996 + } + +@article{scho24 + ,key={schonfinkel} + ,author={Sch\"{o}nfinkel, M.} + ,title={Uber die bausteine der mathematischen logik} + ,journal={Mathematische Annalen} + ,volume=92 + ,year=1924 + ,pages={305} + } + +@book{church41 + ,key={church} + ,author={Church, A.} + ,title={The Calculi of Lambda Conversion} + ,publisher={Princeton University Press} + ,address={Princeton, NJ} + ,year=1941 + } + +@book{Barnsley + ,author={Barnsley, M.} + ,title={Fractals Everywhere} + ,publisher={Academic Press} + ,address={New York} + ,year=1993 + } + +@incollection{haskore-fop + ,author={Paul Hudak} + ,title={Describing and Interpreting Music in {H}askell} + ,booktitle={The Fun of Programming} + ,chapter=4 + ,editors={Jeremy Gibbons and Oege de Moor} + ,year=2003 + ,publisher={Palgrave} + } + +@book{soe + ,author={Paul Hudak} + ,title={The Haskell School of Expression -- + Learning Functional Programming through Multimedia} + ,isbn={0521644089} + ,publisher={Cambridge University Press} + ,address={New York} + ,year=2000 + } + +@article{haskell98, + author = {Simon {Peyton Jones} and others}, + title = {The {Haskell} 98 Language and Libraries: The Revised Report}, + journal = {Journal of Functional Programming}, + volume = 13, + number = 1, + pages = {0--255}, + month = {Jan}, + year = 2003, + url = {www.haskell.org/definition}, +} + +@book{Corea94, + author = {Chick Corea}, + title = {Children's Songs -- 20 Pieces for Keyboard (ED 7254)}, + year = {1994}, + publisher = {Schott}, + ISBN = {978-3-7957-9588-7}, + address = {Mainz} +} + +@book{Cage433 + ,author={Cage, John} + ,title={Silence: Lectures and Writings} + ,year={1961,1986} + ,publisher={Wesleyan University Press} + ,address={Middletown, CT} + ,ISBN={0-8195-6028-6} +} + +@book{Moore90 + ,author={Moore, F. Richard} + ,title={Elements of Computer Music} + ,year={1990} + ,publisher={Prentice-Hall} + ,address={Englewood Cliffs, NJ} +} + +@inproceedings{AFP2002 + ,author={Paul Hudak and Antony Courtney and Henrik Nilsson and + John Peterson} + ,title={Arrows, Robots, and Functional Reactive Programming} + ,booktitle={Summer School on Advanced Functional Programming, + Oxford University} + ,publisher={Springer Verlag, LNCS 2638} + ,year=2003} + +@InProceedings{fruit, + author = "Antony Courtney and Conal Elliott", + title = "Genuinely Functional User Interfaces", + booktitle = "Proc. of the 2001 Haskell Workshop", + year = 2001, + month = "September", +} + +@misc{MIDI + ,author={MIDI Manufacturers Association} + ,title={Complete MIDI 1.0 Detailed Specification} + ,published={MIDI Manufacturers Association} + ,ISBN={0-9728831-0-X} + ,address={La Habre, CA} + ,year={1995-2013} + ,url={http://www.midi.org/techspecs/} +} + +@misc{General-MIDI + ,author={MIDI Manufacturers Association} + ,title={General MIDI 1, 2 and Lite Specifications} + ,published={MIDI Manufacturers Association} + ,address={La Habre, CA} + ,year={1995-2013} + ,url={http://www.midi.org/techspecs/} +} + +@InProceedings{PTM-PADL, + author = "Paul Hudak", + title = "An Algebraic Theory of Polymorphic Temporal Media", + booktitle = "Proceedings of {PADL'04}: 6th International Workshop on + Practical Aspects of Declarative Languages", + publisher = "Springer Verlag LNCS 3057", + pages = "1-15", + month = jun, + year = 2004 + } + +@phdthesis{courtney-phd + ,author={Antony Courtney} + ,title={Modelling User Interfaces in a Functional Language} + ,school={Department of Computer Science, Yale University} + ,month=May + ,year=2004 + } + +@misc{nelson-bifurcate + ,author={Gary Lee Nelson} + ,title={Bifurcate me, baby!} + ,year={1995} + ,school={Oberline College} +} + +@article{shepard + ,author={Roger N. Shepard} + ,month={December} + ,year=1964 + ,title={Circularity in Judgements of Relative Pitch} + ,journal={Journal of the Acoustical Society of America} + ,volume=36 + ,number=12 + ,pages={2346-2353} +} + +@article{Chowning73 + ,author={John M. Chowning} + ,title={The Synthesis of Complex Audio Spectra + by Means of Frequency Modulation} + ,year=1973 + ,journal={Journal of Audio Engineering Society} + ,volume=21 + ,number=7 + ,pages={526-534} +} + +@article{Karplus-Strong83 + ,author={Kevin Karplus and Alex Strong} + ,title={Digital Synthesis of Plucked String and Drum Timbres} + ,journal={Computer Music Journal} + ,publisher={MIT Press} + ,volume=7 + ,number=2 + ,year=1983 + ,pages={43-55} +} + +@book{Cook2002 + ,author={Perry Cook} + ,title={Real Sound Synthesis for Interactive Applications} + ,year={2002} + ,publisher={A.K. Peters Press} + ,address={Natick MA, USA} +}
+ HSoM/HSoM.lhs view
@@ -0,0 +1,298 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++\documentclass[11pt,fleqn,oneside]{book} % ++\newcommand{\HSoMVersion}{2.6 (January 2014)}++%% \usepackage[pdftex,bookmarks=true]{hyperref}++\usepackage{amssymb}+\usepackage{amsmath}+\usepackage{nicefrac}+\usepackage{hyperref}+\usepackage{suffix}++%% pdftex]++\hypersetup{+ pdfauthor={Paul Hudak},+ pdftitle={The Haskell School of Music},+ colorlinks,+ citecolor={magenta},+ bookmarks={true},+ pdfstartview={Fit},+ pdfpagelayout={SinglePage}+}++\usepackage{graphicx}+\usepackage{epsfig}+\usepackage{subfigure}+\usepackage{shading}+\usepackage{enumerate}+\usepackage{url}+%% \usepackage{diagrams}++% If using --poly+\usepackage{polytable}+\usepackage{lazylist}++% The (working) code can be extracted from each section via:+% > lhs2TeX --code fileName.lhs > code.hs+%+% Pre-processing of each section for LaTeX should be done via:+% > lhs2TeX --poly fileName.lhs > fileName.tex++% The following should be at the top of each section for lhs2TeX:+% +%include lhs2TeX.fmt+%include myFormat.fmt++\setlength{\parskip}{0.05in}++% theorem-like environments+\newtheorem{axiom}{Axiom}[section]+\newtheorem{theorem}{Theorem}[section]+\newtheorem{corollary}{Corollary}[section]+\newtheorem{definition}{Definition}[section]+\newtheorem{lemma}{Lemma}[section]+\newtheorem{example}{Example}[section]+\newtheorem{exercise}{Exercise}[chapter]+% \newtheorem{proof}{Proof}[section]++% \newcommand{\lb}{[\hspace*{-.4 mm}[}+% \newcommand{\rb}{]\hspace*{-.4 mm}]}++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% All this indexing should change to be more %%%%+%%%% standard and to use lhs2tex for formatting %%%%++% new commands used for the index:+\newcommand{\indexwd}[1]{#1\index{#1}}+\newcommand{\indexwdhs}[1]{\ihs{#1}\index{#1@@\protect\ihs{#1}}}+\newcommand{\indexwdkw}[1]{\hkw{#1}\index{#1@@\protect\hkw{#1}}}+\newcommand{\indexhs}[1]{\index{#1@@\protect\ihs{#1}}}+\newcommand{\indexkw}[1]{\index{#1@@\protect\hkw{#1}}}+\newcommand{\indexamb}[2]{\index{#1@@\protect\ihs{#1} (#2)}}++% the following are two hacks because we're no longer using Mark+% Jones' preprocessor+% \newcommand{\ihs}[1]{\hs{#1}}+\newcommand{\ihs}[1]{{\em #1}}+\newcommand{\hkw}[1]{{\bf #1}}++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%++\newcommand{\out}[1]{}+\newcommand{\prh}[1]{{\bf #1}}+\newcommand{\todo}[1]{}+%% \newcommand{\todo}[1]{{\bf [To do:} #1 {\bf ]}}+\newcommand{\red}{\Longrightarrow}++\newcommand{\syn}[1]{\begin{quote} + \parashade[0.9]{roundcorners}{\gdef\outlineboxwidth{.5}+ {\small\sf {\bf Details:} #1}}+ \end{quote}}++\newcommand{\cbox}[1]{\begin{quote} + \parashade[1.0]{roundcorners}{\gdef\outlineboxwidth{.5}+ {#1}}+ \end{quote}}++%% The following few commands are for supporting chapter authors+%% code was taken from:+%% http://tex.stackexchange.com/questions/156862/displaying-author-for-each-chapter-in-book+\newcommand\chapterauthor[1]{\authortoc{#1}\printchapterauthor{#1}}++\newcommand{\printchapterauthor}[1]{+ {\parindent0pt\vspace*{-25pt}+ \linespread{1.1}\large\scshape#1+ \par\nobreak\vspace*{35pt}}+}+\newcommand{\authortoc}[1]{+ \addtocontents{toc}{\vskip-10pt}+ \addtocontents{toc}{+ \protect\contentsline{chapter}+ {\hskip1.3em\mdseries\scshape\protect\scriptsize#1}{}{}}+ \addtocontents{toc}{\vskip5pt}+}++\begin{document}++%---------------------------------------------------------------------++\frontmatter++\begin{titlepage}++\vspace*{.1in}++\begin{center}+{\huge\sl The Haskell School of Music}\\[.2in]+{\Large --- From Signals to Symphonies ---}+\end{center}+\vspace{0.5in}++\centerline{+\epsfysize=3in +\epsfbox{pics/muse_euterpe.eps}+}++\vspace{.1in}+\begin{center}+%% {\Large\bf by}\\[.3in]+{\Large\bf Paul Hudak}\\[.2in]+{\large\bf Yale University}\\+{\large\bf Department of Computer Science}\\[.5in]+{\large\bf Version \HSoMVersion}+\end{center}++\end{titlepage}++\newpage++\vspace*{3.0in}+\fbox{+\begin{minipage}{5in}+\begin{center}+\vspace{.1in}+{\sl The Haskell School of Music}\\+{\sl --- From Signals to Symphonies ---}\\[.1in]+{\sl Paul Hudak}\\[.1in]+{\sl Yale University}\\+{\sl Department of Computer Science}\\+{\sl New Haven, CT, USA}\\+{\sl Version \HSoMVersion}\\[.1in]+Copyright \copyright\ Paul Hudak\\+January 2011, 2012, 2013, 2014\\+All rights reserved. No part of this publication may be reproduced or+distributed in any form or by any means, or stored in a data base or+retrieval system, without the prior written permission of the author.+\vspace{.1in}\\+Cover image: \emph{Euterpe}, the Greek Muse of Music\\+(attribution unknown)\\[.1in]+%% \vspace{.1in}+\end{center}+\end{minipage}+}++\newpage++\tableofcontents++\listoffigures++\listoftables++% Preface+\include{Preface}++%---------------------------------------------------------------------++\mainmatter++% An Overview of Computer Music, Euterpea, and Haskell+\include{Intro}++% Simple Music+\include{Music}++% Polymorphic and Higher-order Functions+\include{Poly}++% A Musical Interlude+\include{Interlude}++% Syntactic Magic+\include{Syntax}++% More Music+\include{MoreMusic}++% Qualified Types and Type Classes+\include{QualifiedTypes}++% Interpretation and Performance+\include{Performance}++% Self-Similar Music+\include{SelfSimilar}++% Proof by Induction+\include{Induction}++% An Algebra of Music+\include{Algebra}++% Musical L-Systems+\include{LSystems}++% Random Numbers, Probability Distributions, and Markov Chains+\include{RandomMusic}++% From Performance to Midi+\include{ToMidi}++% Basic Input/Output+\include{IO}++% Higher-Order Types and Monads+\include{Monads}++% Musical User Interface+\include{MUI}++% Sound and Signals+\include{Signals}++% Euterpea Signal Functions+\include{SigFuns}++% Spectrum Analysis+\include{SpectrumAnalysis}++% Additive and Subtractive Synthesis+\include{Additive}++% Amplitude and Frequency Modulation+\include{AMAndFM}++% Physical Modelling+\include{PhysicalModelling}++% Effects+\include{Effects}++% Programming with Streams+% \include{streams}++% Communicating With the Outside World+% \include{ioproc}++% ---------------------------------------------------------------------+% \backmatter++\appendix++% Tour of PreludeList+\include{List-tour}++% A Tour of Haskell's Standard Type Classes+\include{Class-tour}++% Built-In Types Are Not Special+\include{Bitans}++% Pattern-Matching Details+\include{Patterns}++\newpage++% Bibliography+\bibliographystyle{alpha}+\bibliography{HSoM}++% Index+% \printindex++\end{document}
+ HSoM/IO.lhs view
@@ -0,0 +1,283 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{Basic Input/Output} +\label{ch:IO} + +\begin{code} + +\end{code} + +So far the only input/output (IO) that we have seen in Euterpea is the +use of the |play| function to generate the MIDI output corresponding +to a |Music| value. But we have said very little about the |play| +function itself. What is its type? How does it work? How does one +do IO in a purely functional language such as Haskell? Our goal in +this chapter is to answer these questions. Then in +Chapter~\ref{ch:MUI} we will describe an elegant way to do IO +involving a ``musical user interface,'' or \emph{MUI}. + +%% In doing so we will introduce a key idea in Haskell, namely +%% \emph{monads}. + +\section{IO in Haskell} +\label{sec:IO} +\index{action (IO)} + +The Haskell Report defines the result of a program to be the value of +the variable \indexwdhs{main} in the module \indexwdhs{Main}. This is +a mere technicality, however, only having relevance when you compile a +program as a stand-alone executable (see the GHC documentation for a +discussion of how to do that). + +The way most people run Haskell programs, especially during program +development, is through the GHCi command prompt. As you know, the +GHCi implementation of Haskell allows you to type whatever expression +you wish to the command prompt, and it will evaluate it for you. + +In both cases, the Haskell system ``executes a program'' by evaluating +an expression, which (for a well-behaved program) eventually yields a +value. The system must then display that value on your computer +screen in some way that makes sense to you. GHC does this by +insisting that the type of the value be an instance of the |Show| +class---in which case it ``shows'' the result by converting it to a +string using the |show| function (recall the discussion in Section +\ref{sec:qualified-types}). So an integer is printed as an integer, a +string as a string, a list as a list, and so on. We will refer to the +area of the computer screen where this result is printed as the {\em + standard output area}, which may vary from one implementation to +another. + +But what if a program is intended to write to a file? Or print a file +on a printer? Or, the main topic of this book, to play some music +through the computer's sound card, or an external MIDI device? These +are examples of {\em output}, and there are related questions about +{\em input}: for example, how does a program receive input from the +computer keyboard or mouse, or receive input from a MIDI keyboard? + +In general, how does Haskell's ``expression-oriented'' notion of +``computation by calculation'' accommodate these various kinds of +input and output? + +The answer is fairly simple: in Haskell there is a special kind of +value called an {\em action}. When a Haskell system evaluates an +expression that yields an action, it knows not to try to display the +result in the standard output area, but rather to ``take the +appropriate action.'' There are primitive actions---such as writing a +single character to a file or receiving a single character from a MIDI +keyboard---as well as compound actions---such as printing an entire +string to a file or playing an entire piece of music. Haskell +expressions that evaluate to actions are commonly called {\em + commands}. + +%% since they command the Haskell system to perform some kind of action. +%% Haskell functions that yield actions when they are applied are also +%% commonly called commands. + +% \footnote{The Haskell Report does not use the terms ``action'' or +% ``command'' to describe IO, but I find that using these special names +% helps clarify the presentation.} + +\indexhs{IO} \indexhs{return} + +Some commands return a value for subsequent use by the program: a +character from the keyboard, for instance. A command that returns a +value of type |T| has type |IO T|. If no useful value is returned, +the command has type |IO ()|. The simplest example of a command is +|return x|, which for a value |x :: T| immediately returns |x| and has +type |IO T|. + +\index{unit type} \index{()} +\syn{The type |()| is called the {\em unit type}, and has exactly +one value, which is also written |()|. Thus |return ()| has +type |IO ()|, and is often called a ``noop'' because it is an +operation that does nothing and returns no useful result. Despite the +negative connotation, it is used quite often!} + +Remember that all expressions in Haskell must be well-typed before a +program is run, so a Haskell implementation knows ahead of time, by +looking at the type, that it is evaluating a command, and is thus +ready to ``take action.'' + +\section{|do| Syntax} + +To make these ideas clearer, let's consider a few examples. One +useful IO command is \indexwdhs{putStr}, which prints a string +argument to the standard output area, and has type +|String -> IO ()|. The |()| simply indicates that there is no +useful result returned from this action; its sole purpose is to print +its argument to the standard output area. So the program: +\begin{spec} +module Main where +main = putStr "Hello World\n" +\end{spec} +is the canonical ``Hello World'' program that is often the first +program that people write in a new language. + +Suppose now that we want to perform {\em two} actions, such as first +writing to a file named |"testFile.txt"|, then printing to the +standard output area. Haskell has a special keyword, |do|, to +denote the beginning of a sequence of commands such as this, and so we +can write: \indexkw{do} +\begin{spec} +do writeFile "testFile.txt" "Hello File System" + putStr "Hello World\n" +\end{spec} +where the file-writing function \indexwdhs{writeFile} has type: +\begin{spec} +writeFile :: FilePath -> String -> IO () +type FilePath = String +\end{spec} + +\indexhs{FilePath} +\syn{A |do| expression allows one to sequence an arbitrary number of +commands, each of type |IO ()|, using layout to distinguish them +(just as in a |let| or |where| expression). When used in this +way, the result of a |do| expression also has type |IO ()|.} + +So far we have only used actions having type |IO ()|; i.e.\ output +actions. But what about input? As above, we will consider input from +both the user and the file system. + +To receive a line of input from the user (which will be typed in the +{\em standard input area} of the computer screen, usually the same as +the standard output area) we can use the function: +\begin{spec} +getLine :: IO String +\end{spec} +\indexhs{getLine} +Suppose, for example, that we wish to read a line of input using this +function, and then write that line (a string) to a file. To do this +we write the compound command: +\begin{spec} +do s <- getLine + writeFile "testFile.txt" s +\end{spec} + +\syn{Note the syntax for binding |s| to the result of executing the + |getLine| command---when doing this in your program, you will have + to type {\tt <-}. Since the type of |getLine| is |IO String|, the + type of |s| is |String|. Its value is then used in the next line as + an argument to the |writeFile| command.} + +Similarly, we can read the entire contents of a file using the command +|readFile :: FilePath -> IO String|, and then print the result to +standard output: +\begin{spec} +do s <- readFile "testFile.txt" + putStr s +\end{spec} + +\syn{Any type that is an instance of the |Monad| type class can be + used with the |do| syntax to sequence actions. The |Monad| class is + discussed in detail in Chapter \ref{ch:monads}. It suffices to say + for now that the |IO| type is an instance of the |Monad| class.} + +\section{Actions are Just Values} +\label{sec:actions-are-value} + +There are many other commands available for file, system, and user IO, +some in the Standard Prelude, and some in various libraries (such as +|IO|, |Directory|, |System|, and |Time|). We will not discuss many of +these here, other than the MIDI IO commands described in +Section~\ref{sec:midi-io}. + +Before that, however, we wish to emphasize that, despite the special +|do| syntax, Haskell's IO commands are no different in status from +any other Haskell function or value. For example, it is possible to +create a {\em list} of actions, such as: +\begin{spec} +actionList = [ putStr "Hello World\n", + writeFile "testFile.txt" "Hello File System", + putStr "File successfully written." ] +\end{spec} +However, a list of actions is just a list of values: they actually do +not {\em do} anything until they are sequenced appropriately using a +|do| expression, and then returned as the value of the overall program +(either as the variable |main| in the module |Main|, or typed at the +GHCi prompt). Still, it is often convenient to place actions into a +list as above, and the Haskell provides some useful functions for +turning them into single commands. In particular, the function +\indexhs{sequence\_} |sequence_| in the Standard Prelude, when used +with IO, has type: +\begin{spec} +sequence_ :: [IO a] -> IO () +\end{spec} +and can thus be applied to the |actionList| above to yield the +single command: +\begin{spec} +main :: IO () +main = sequence_ actionList +\end{spec} + +For a more interesting example of this idea, we first note that +Haskell's strings are really just {\em lists of characters}. Indeed, +|String| is a type synonym for a list of characters: +\begin{spec} +type String = [Char] +\end{spec} +Because strings are used so often, Haskell allows you to write +|"Hello"| instead of |['H', 'e', 'l', 'l', 'o']|. But keep in +mind that this is just syntax---strings really are just lists of +characters, and these two ways of writing them are identical from +Haskell's perspective. + +(Earlier the type synonym |FilePath| was defined for |String|. This +shows that type synonyms can be created using other type synonyms.) + +Now back to the example. From the function |putChar :: Char -> IO ()|, +which prints a single character to the standard output area, we can +define the function |putStr| used earlier, which prints an entire +string. To do this, let's first define a function that converts a +list of characters (i.e.\ a string) into a list of IO actions: +\indexhs{putCharList} +%% \begin{spec} +%% putCharList :: String -> [IO ()] +%% putCharList [] = [] +%% putCharList (c:cs) = putChar c : putCharList cs +%% \end{spec} +\begin{spec} +putCharList :: String -> [IO ()] +putCharList = map putChar +\end{spec} + +With this, \indexwdhs{putStr} is easily defined: +\begin{spec} +putStr :: String -> IO () +putStr = sequence_ . putCharList +\end{spec} +Or, more succinctly: +\begin{spec} +putStr :: String -> IO () +putStr = sequence_ . map putStr +\end{spec} + +%% Note that the expression |putCharList s| is a list of actions, and +%% |sequence_| is used to turn them into a single (compound) command, +%% just as we did earlier. + +Of course, |putStr| can also be defined directly as a recursive +function, which we do here just to emphasize that actions are just +values, so we can use all of the functional programming skills that we +normally use: +\begin{spec} +putStr :: String -> IO () +putStr [] = return () +putStr (c:cs) = do putChar c + putStr cs +\end{spec} + +IO processing in Haskell is consistent with everything we have learned +about programming with expressions and reasoning through calculation, +although that may not be completely obvious yet. Indeed, it turns out +that a |do| expression is just syntax for a more primitive way of +combining actions using functions, namely a \emph{monad}, to be +revealed in full in Chapter \ref{ch:monads}. + +\section{Reading and Writing MIDI Files} +\label{sec:midi-io} + +[TODO: Explain MIDI-file IO functions defined in |Codec.Midi|, +as well as the Euterpea functions for writing MIDI files.]
+ HSoM/Induction.lhs view
@@ -0,0 +1,1110 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{Proof by Induction} +\label{ch:induction} + +In this chapter we will study a powerful proof technique based on +\emph{mathematical induction}. With it we will be able to prove +complex and important properties of programs that cannot be +accomplished with proof-by-calculation alone. The inductive proof +method is one of the most powerful and common methods for proving +program properties. + +\section{Induction and Recursion} +\index{induction} \index{recursion} + +\emph{Induction} is very closely related to \emph{recursion}. In +fact, in certain contexts the terms are used interchangeably; in +others, one is preferred over the other primarily for historical +reasons. Think of them as being duals of one another: induction is +used to describe the process of starting with something small and +simple, and building up from there, whereas recursion describes the +process of starting with something large and complex, and working +backward to the simplest case. + +For example, although we have previously used the phrase +\emph{recursive data type}, in fact data types are often described +\emph{inductively}, such as a list: +\begin{quote} +A \emph{list} is either empty, or it is a pair consisting of a value +and another list. +\end{quote} +On the other hand, we usually describe functions that manipulate +lists, such as |map| and |foldr|, as being recursive. This is +because when you apply a function such as |map|, you apply it +initially to the whole list, and work backwards toward |[]|. + +But these differences between induction and recursion run no deeper: +they are really just two sides of the same coin. + +This chapter is about \emph{inductive properties} of programs (but +based on the above argument could just as rightly be called +\emph{recursive properties}) that are not usually proven via +calculation alone. Proving inductive properties usually involves the +inductive nature of data types and the recursive nature of functions +defined on the data types. + +As an example, suppose that |p| is an inductive property of a list. +In other words, |p(l)| for some list |l| is either true or false (no +middle ground!). To prove this property inductively, we do so based +on the length of the list: starting with length 0, we first prove +|p([])| (using our standard method of proof-by-calculation). + +Now for the key step: assume for the moment that |p(xs)| is true for +any list |xs| whose length is less than or equal to |n|. Then if we +can prove (via calculation) that |p(x:xs)| is true for any |x|---i.e.\ +that |p| is true for lists of length |n+1|---then the claim is that +|p| is true for lists of \emph{any} (finite) length. + +Why is this so? Well, from the first step above we know that |p| is +true for length 0, so the second step tells us that it is also true for +length 1. But if it is true for length 1 then it must also be true for +length 2; similarly for lengths 3, 4, etc.\ So |p| is true for lists +of any length! + +(It it important to realize, however, that a property being true for +every finite list does not necessarily imply that it is true for every +infinite list. The property ``the list is finite'' is a perfect +example of this! We will see how to prove properties of infinite lists +in Chapter \ref{ch:streams}.) \index{list!infinite} + +To summarize, to prove a property |p| by induction on the length of a +list, we proceed in two steps: +\begin{enumerate} +\item Prove |p([])| (this is called the \emph{base case}). +\item Assume that |p(xs)| is true (this is called the \emph{induction +hypothesis}, and prove that |p(x:xs)| is true (this is called the +\emph{induction step}). +\end{enumerate} + +\section{Examples of List Induction} +\label{sec:list-examples} + +Ok, enough talk, let's see this idea in action. Recall in Section +\ref{sec:poly-types} the following property about \indexwdhs{foldr}: +\[(\forall|xs|)\ \ |foldr (:) [] xs ===> xs|\] +We will prove this by induction on the length of |xs|. Following +the ideas above, we begin with the base case by proving the property +for length 0; i.e.\ for |xs = []|: +\begin{spec} +foldr (:) [] [] +==> { unfold foldr } +[] +\end{spec} +This step is immediate from the definition of |foldr|. Now for +the induction step: we first \emph{assume} that the property is true +for all lists |xs| of length |n|, and then prove the property for +list |x:xs|. Again proceeding by calculation: +\begin{spec} +foldr (:) [] (x:xs) +==> { unfold foldr } +x : foldr (:) [] xs +==> { induction hypothesis } +x : xs +\end{spec} +And we are done; the induction hypothesis is what justifies the second +step. + +Now let's do something a bit harder. Suppose we are interested in +proving the following property: +\[(\forall|xs,ys|)\ \ |length (xs ++ ys) = length xs + length ys|\] +Our first problem is to decide which list to perform the induction +over. A little thought (in particular, a look at how the definitions +of \indexwdhs{length} and |(++)| are structured) should convince you that +|xs| is the right choice. (If you do not see this, you are +encouraged to try the proof by induction over the length of |ys|!) +Again following the ideas above, we begin with the base case by +proving the property for length 0; i.e.\ for |xs = []|: +\begin{spec} +length ([] ++ ys) +==> { unfold (++) } +length ys +==> { fold (+) } +0 + length ys +==> { fold length } +length [] + length ys +\end{spec} +For the induction step, we first assume that the property is true for +all lists |xs| of length |n|, and then prove the property for list +|x:xs|. Again proceeding by calculation: +\begin{spec} +length ((x:xs) ++ ys) +==> { unfold (++) } +length (x : (xs ++ ys)) +==> { unfold length } +1 + length (xs ++ ys) +==> { induction hypothesis } +1 + (length xs + length ys) +==> { associativity of (+) } +(1 + length xs) + length ys +==> { fold length } +length (x:xs) + length ys +\end{spec} +And we are done. The transition from the 3rd line to the 4th is where +the induction hypothesis is used. + +\section{Proving Function Equivalences} + +At this point it is a simple matter to return to Chapter~\ref{ch:poly} +and supply the proofs that functions defined using |map| and |fold| +are equivalent to the recursively defined versions. In particular, +recall these two definitions of |toAbsPitches|: +\begin{spec} +toAbsPitches1 [] = [] +toAbsPitches1 (p:ps) = absPitch p : toAbsPitches1 ps + +toAbsPitches2 = map absPitch +\end{spec} +We want to prove that |toAbsPitches1 = toAbsPitches2|. To do so, we +use the extensionality principle (briefly discussed in +Section~\ref{sec:currying-simplification}), which says that two +functions are equal if, when applied to the same value, they always +yield the same result. We can change the specification slightly to +reflect this. For any finite list |ps|, we want to prove: +\begin{spec} +toAbsPitches1 ps = toAbsPitches2 ps +\end{spec} + +We proceed by induction, starting with the base case |ps = []|: +\begin{spec} +toAbsPitches1 [] +==> [] +==> map absPitch [] +==> toAbsPitches2 [] +\end{spec} +Next we assume that |toAbsPitches1 ps = toAbsPitches2 ps| holds, and +try to prove that |toAbsPitches1 (p:ps) = toAbsPitches2 (p:ps)|: +\begin{spec} +toAbsPitches1 (p:ps) +==> absPitch p : toAbsPitches1 ps +==> absPitch p : toAbsPitches2 ps +==> absPitch p : map absPitch ps +==> map absPitch (p:ps) +\end{spec} +Note the use of the induction hypothesis in the second step. + +%% The proof that the two versions of |toPitches| given in +%% Chapter~\ref{ch:poly} is very similar, and is left as an exercise. + +For a proof involving |foldr|, recall from Chapter~\ref{ch:poly} this +recursive definition of |line|: +\begin{spec} +line1 [] = rest 0 +line1 (m:ms) = m :+: line1 ms +\end{spec} +and this non-recursive version: +\begin{spec} +line2 = foldr (:+:) (rest 0) +\end{spec} +We can prove that these two functions are equivalent by induction. +First the base case: +\begin{spec} +line1 [] +==> rest 0 +==> foldr (:+:) (rest 0) [] +==> line2 [] +\end{spec} +Then the induction step: +\begin{spec} +line1 (m:ms) +==> m :+: line1 ms +==> m :+: line2 ms +==> m :+: foldr (:+:) (rest 0) ms +==> foldr (:+:) (rest 0) (m:ms) +==> line2 (m:ms) +\end{spec} + +The proofs of equivalence of the definitions of |toPitches|, |chord|, +|maxPitch|, and |hList| from Chapter~\ref{ch:poly} are similar, and +left as an exercise. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +From Chapter~\ref{ch:poly}, prove that the original recursive versions +of the following functions are equivalent to the versions using |map| +or |fold|: |toPitches|, |chord|, |maxPitch|, and |hList|.} +\end{exercise} + +\vspace{.1in}\hrule + +\subsection{[Advanced] Reverse} + +The proofs of function equivalence in the last section were fairly +straightforward. For something more challenging, consider the +definition of \indexwdhs{reverse} given in Section \ref{sec:reverse}: +\begin{spec} +reverse1 [] = [] +reverse1 (x:xs) = reverse1 xs ++ [x] +\end{spec} +and the version given in Section \ref{sec:currying}: +\begin{spec} +reverse2 xs = foldl (flip (:)) [] xs +\end{spec} +We would like to show that these are the same; i.e.\ that +|reverse1 xs = reverse2 xs| for any finite list |xs|. In +carrying out this proof one new idea will be demonstrated, namely + the need for an \emph{auxiliary property} +which is proved independently of the main result. + +%% the first being that induction can be used to prove the equivalence of +%% two programs. The second is + +The base case is easy, as it often is: +\begin{spec} +reverse1 [] +==> [] +==> foldl (flip (:)) [] [] +==> reverse2 [] +\end{spec} +Assume now that |reverse1 xs = reverse2 xs|. The induction step +proceeds as follows: +\begin{spec} +reverse1 (x:xs) +==> reverse1 xs ++ [x] +==> reverse2 xs ++ [x] +==> foldl (flip (:)) [] xs ++ [x] +==> ??? +\end{spec} +But now what do we do? Intuitively, it seems that the following +property, which we will call property (1), should hold: +\begin{spec} +foldl (flip (:)) [] xs ++ [x] +==> foldl (flip (:)) [] (x:xs) +\end{spec} +in which case we could complete the proof as follows: +\begin{spec} +... +==> foldl (flip (:)) [] xs ++ [x] +==> foldl (flip (:)) [] (x:xs) +==> reverse2 (x:xs) +\end{spec} + +The ability to see that if we could just prove one thing, then perhaps +we could prove another, is a useful skill in conducting proofs. In +this case we have reduced the overall problem to one of proving +property (1), which simplifies the structure of the proof, although +not necessarily the difficulty. These auxiliary properties are often +called \emph{lemmas} in mathematics, and in many cases their proofs +become the most important contributions, since they are often at the +heart of a problem. + +In fact if you try to prove property (1) directly, you will run into a +problem, namely that it is not \emph{general} enough. So first let's +generalize property (1) (while renaming |x| to |y|), as follows: +\index{generalization} +\begin{spec} +foldl (flip (:)) ys xs ++ [y] +==> foldl (flip (:)) (ys++[y]) xs +\end{spec} +Let's call this property (2). If (2) is true for any finite |xs| +and |ys|, then property (1) is also true, because: +\begin{spec} +foldl (flip (:)) [] xs ++ [x] +==> { property (2) } +foldl (flip (:)) ([]++[x]) xs +==> { unfold (++) } +foldl (flip (:)) [x] xs +==> { fold (flip (:)) } +foldl (flip (:)) (flip (:) [] x) xs +==> { fold foldl } +foldl (flip (:)) [] (x:xs) +\end{spec} + +You are encouraged to try proving property (1) directly, in which case +you will likely come to the same conclusion, namely that the property +needs to be generalized. This is not always easy to see, but is +sometimes an important step is constructing a proof, because, despite +being somewhat counterintuitive, it is often the case that making a +property more general (and therefore more powerful) makes it easier to +prove. + +In any case, how do we prove property (2)? Using induction, of +course! Setting |xs| to |[]|, the base case is easy: +\begin{spec} +foldl (flip (:)) ys [] ++ [y] +==> { unfold foldl } +ys++[y] +==> { fold foldl } +foldl (flip (:)) (ys++[y]) [] +\end{spec} +and the induction step proceeds as follows: +\begin{spec} +foldl (flip (:)) ys (x:xs) ++ [y] +==> { unfold foldl } +foldl (flip (:)) (flip (:) ys x) xs ++ [y] +==> { unfold flip } +foldl (flip (:)) (x:ys) xs ++ [y] +==> { induction hypothesis } +foldl (flip (:)) ((x:ys)++[y]) xs +==> { unfold (++) } +foldl (flip (:)) (x:(ys++[y])) xs +==> { fold foldl } +foldl (flip (:)) (ys++[y]) (x:xs) +\end{spec} + +\out{ +Here is why the generalization is needed. If we just try to prove: + +foldl (flip (:)) [] xs ++ [x] +==> foldl (flip (:)) [x] xs + +Then the base case is fine: + +foldl (flip (:)) [] [] ++ [x] +==> { unfold foldl } +[]++[x] +==> { unfold (++) } +[x] +==> { fold foldl } +foldl (flip (:)) [x] [] + +But the induction step runs into trouble: + +foldl (flip (:)) [] (x:xs) ++ [y] +==> { unfold foldl } +foldl (flip (:)) (flip (:) [] x) xs ++ [y] +==> { unfold flip } +foldl (flip (:)) [x] xs ++ [y] +==> ??? + +What now? We are stuck. In particular, we cannot apply the induction +hypothesis because foldl's third argument is |[x]| and not |[]|. +} + +\section{Useful Properties on Lists} +\label{sec:list-properties} + +There are many useful properties of functions on lists that require +inductive proofs. Figures \ref{fig:list-props1} and +\ref{fig:list-props2} list a number of them involving functions used +in this text, but their proofs are left as exercises (except for one; +see below). You may assume that these properties are true, and use +them freely in proving other properties of your programs. In fact, +some of these properties can be used to simplify the proof that +|reverse1| and |reverse2| are the same; see if you can find +them!\footnote{More thorough discussions of these properties and their + proofs may be found in \cite{birdwadler88,bird98}.} + +(Note, by the way, that in the first rule for |map| in Figure +\ref{fig:list-props1}, the type of |\x -> x| on the left-hand +side is |a->b|, whereas on the right-hand side it is |[a]->[b]|; +i.e. these are really two different functions.) + +\begin{figure} +\cbox{ +\begin{minipage}{4.75in} +{\bf Properties of |map|:} + +\begin{spec} +map (\x->x) = \x->x +map (f . g) = map f . map g +map f . tail = tail . map f +map f . reverse = reverse . map f +map f . concat = concat . map (map f) +map f (xs ++ ys) = map f xs ++ map f ys +\end{spec} +For all strict |f|: +\begin{spec} +f . head = head . map f +\end{spec} +\vspace{0.1in} + +{\bf Properties of the |fold| functions:} + +\begin{enumerate} +\item If |op| is associative, and |e `op` x = x| and |x `op` e = x| +for all |x|, then for all finite |xs|: +\begin{spec} +foldr op e xs = foldl op e xs +\end{spec} +\item If the following are true: +\begin{spec} +x `op1` (y `op2` z) = (x `op1` y) `op2` z +x `op1` e = e `op2` x +\end{spec} +then for all finite |xs|: +\begin{spec} +foldr op1 e xs = foldl op2 e xs +\end{spec} +\item For all finite |xs|: +\begin{spec} +foldr op e xs = foldl (flip op) e (reverse xs) +\end{spec} +\end{enumerate} +\end{minipage}} +\caption{Some Useful Properties of |map| and |fold|.} +\label{fig:list-props1} +\end{figure} + +\begin{figure} +\cbox{ +\begin{minipage}{4.75in} +{\bf Properties of |(++)|:} + +\vspace{0.1in} For all |xs|, |ys|, and |zs|: +\begin{spec} +(xs ++ ys) ++ zs = xs ++ (ys ++ zs) +xs ++ [] = [] ++ xs = xs +\end{spec} + +\vspace{0.1in} +{\bf Properties of |take| and |drop|:} + +\vspace{0.1in} +\begin{spec} +take m . take n = take (min m n) +drop m . drop n = drop (m + n) +take m . drop n = drop n . take (m + n) +\end{spec} +For all non-negative |m| and |n| such that $n \geq m$: +\begin{spec} +drop m . take n = take (n - m) . drop m +\end{spec} +For all non-negative |m| and |n|, and finite |xs|: +\begin{spec} +take n xs ++ drop n xs = xs +\end{spec} + +\vspace{0.1in} +{\bf Properties of |reverse|:} + +\vspace{0.1in} For all finite |xs|: +\begin{spec} +reverse (reverse xs) = xs +head (reverse xs) = last xs +last (reverse xs) = head xs +\end{spec} +\end{minipage}} +\caption{Useful Properties of Other Functions Over Lists} +\label{fig:list-props2} +\end{figure} + +\subsection{[Advanced] Function Strictness} + +\index{function!strict} \index{bottom} +Note that the last rule for |map| in Figure \ref{fig:list-props1} +is only valid for \emph{strict} functions. A function |f| is said to +be strict if |f bottom| $=$ |bottom|. Recall from Section +\ref{sec:expressions} that |bottom| is the value associated with a +non-terminating computation. So another way to think about a strict +function is that it is one that, when applied to a non-terminating +computation, results in a non-terminating computation. For example, +the successor function |(+1)| is strict, because |(+1) bottom| +$=$ |bottom + 1| $=$ |bottom|. In other words, if you apply +|(+1)| to a non-terminating computation, you end up with a +non-terminating computation. + +Not all functions in Haskell are strict, and we have to be careful to +say on which argument a function is strict. For example, |(+)| is +strict on both of its arguments, which is why the section |(+1)| is +also strict. On the other hand, the constant function: +\begin{spec} +const x y = x +\end{spec} +is strict on its first argument (why?), but not its second, because +|const x bottom| $=$ |x|, for any |x|. + +\indexhs{(\&\&)} +\syn{Understanding strictness requires a careful understanding of +Haskell's pattern-matching rules. For example, consider the +definition of |(&&)| from the Standard Prelude: +\begin{spec} +(&&) :: Bool -> Bool -> Bool +True && x = x +False && _ = False +\end{spec} + +\index{pattern!matching} +When choosing a pattern to match, Haskell starts with the top, +left-most pattern, and works to the right and downward. So in the +above, |(&&)| first evaluates its left argument. If that value is +|True|, then the first equation succeeds, and the second argument +gets evaluated because that is the value that is returned. But if the +first argument is |False|, the second equation succeeds. In +particular, \emph{it does not bother to evaluate the second argument at +all}, and simply returns |False| as the answer. This means that +|(&&)| is strict in its first argument, but not its second. + +A more detailed discussion of pattern matching is found in Appendix +\ref{ch:patterns}. +} + +Let's now look more closely at the last law for |map|, which says +that for all strict |f|: +\begin{spec} +f . head = head . map f +\end{spec} +Let's try to prove this property, starting with the base case, but +ignoring for now the strictness constraint on |f|: +\begin{spec} +f (head []) +==> f bottom +\end{spec} +|head []| is an error, which you will recall has value |bottom|. +So you can see immediately that the issue of strictness might play a +role in the proof, because without knowing anything about |f|, +there is no further calculation to be done here. Similarly, if we +start with the right-hand side: +\begin{spec} +head (map f []) +==> head [] +==> bottom +\end{spec} +It should be clear that for the base case to be true, it must be that +|f bottom| $=$ |bottom|; i.e., |f| must be strict. Thus we +have essentially ``discovered'' the constraint on the theorem through +the process of trying to prove it! (This is not an uncommon +phenomenon.) + +The induction step is less problematic: +\begin{spec} +f (head (x:xs)) +==> f x +==> head (f x : map f xs) +==> head (map f (x:xs)) +\end{spec} +and we are done. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Prove as many of the properties in Figures \ref{fig:list-props1} and +\ref{fig:list-props2} as you can.} +\end{exercise} + +\begin{exercise}{\em +Which of the following functions are strict (if the function takes +more than one argument, specify on which arguments it is strict): +|reverse|, |simple|, |map|, |tail|, |dur|, |revM|, +|(&&)|, |(True &&)|, |(False &&)|, and +the following function: +\begin{spec} +ifFun :: Bool -> a -> a -> a +ifFun pred cons alt = if pred then cons else alt +\end{spec} +} +\end{exercise} + +\vspace{.1in}\hrule +\vspace{.1in} + +\section{Induction on the Music Data Type} +\label{sec:induction-others} + +Proof by induction is not limited to lists. In particular, we can use +it to reason about |Music| values. + +For example, recall this property intuitively conjectured in +Section~\ref{sec:music-fold}: +\begin{spec} +mFold Prim (:+:) (:=:) Modify m = m +\end{spec} +To prove this, we again use the extensionality principle, and then +proceed by induction. But what is the base case? Recall that the +|Music| data type is defined as: + +\begin{spec} +data Music a = + Prim (Primitive a) + | Music a :+: Music a + | Music a :=: Music a + | Modify Control (Music a) +\end{spec} +The only constructor that does not take a |Music| value as an argument +is |Prim|, so that in fact is the only base case. + +So, starting with this base case: +\begin{spec} +mFold Prim (:+:) (:=:) Modify (Prim p) +==> Prim p +==> id (Prim p) +\end{spec} +That was easy! Next, we develop an induction step for each of the +three non-base cases: +\begin{spec} +mFold Prim (:+:) (:=:) Modify (m1 :+: m2) +==> mFold Prim (:+:) (:=:) Modify m1 :+: + mFold Prim (:+:) (:=:) Modify m2 +==> m1 :+: m2 +==> id (m1 :+: m2) +\end{spec} + +\begin{spec} +mFold Prim (:+:) (:=:) Modify (m1 :=: m2) +==> mFold Prim (:+:) (:=:) Modify m1 :=: + mFold Prim (:+:) (:=:) Modify m2 +==> m1 :=: m2 +==> id (m1 :=: m2) +\end{spec} + +\begin{spec} +mFold Prim (:+:) (:=:) Modify (Modify c m) +==> Modify c (mFold Prim (:+:) (:=:) Modify m) +==> Modify c m +==> id (Modify c m) +\end{spec} +These three steps were quite easy as well, but is not something we +could have done without induction. + +For something more challenging, let's consider the following: +\begin{spec} +dur (revM m) = dur m +\end{spec} +%% , if dur m /= bottom +%% The side condition adds an extra twist to this problem. +Again we proceed by induction, starting with the base case: +\begin{spec} +dur (revM (Prim p)) +==> dur (Prim p) +\end{spec} +Sequential composition is straightforward: +\begin{spec} +dur (revM (m1 :+: m2)) +==> dur (revM m2 :+: revM m1) +==> dur (revM m2) + dur (revM m1) +==> dur m2 + dur m1 +==> dur m1 + dur m2 +==> dur (m1 :+: m2) +\end{spec} + +But things get more complex with parallel composition: +\begin{spec} +dur (revM (m1 :=: m2)) +==> dur ( let d1 = dur m1 + d2 = dur m2 + in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) + else (rest (d2-d1) :+: revM m1) :=: revM m2) +==> let d1 = dur m1 + d2 = dur m2 + in if d1>d2 then dur (revM m1 :=: (rest (d1-d2) :+: revM m2)) + else dur ((rest (d2-d1) :+: revM m1) :=: revM m2) +... +\end{spec} +At this point, to make things easier to understand, we will consider +each branch of the conditional in turn. First the consequent branch: +\begin{spec} +dur (revM m1 :=: (rest (d1-d2) :+: revM m2)) +==> max (dur (revM m1)) (dur (rest (d1-d2) :+: revM m2)) +==> max (dur m1) (dur (rest (d1-d2) :+: revM m2)) +==> max (dur m1) (dur (rest (d1-d2)) + dur (revM m2)) +==> max (dur m1) ((d1-d2) + dur m2) +==> max (dur m1) (dur m1) +==> dur m1 +\end{spec} +And then the alternative: +\begin{spec} +dur ((rest (d2-d1) :+: revM m1) :=: revM m2) +==> max (dur ((rest (d2-d1) :+: revM m1)) (dur (revM m2)) +==> max (dur ((rest (d2-d1) :+: revM m1)) (dur m2) +==> max (dur (rest (d2-d1)) + dur (revM m1)) (dur m2) +==> max ((d2-d1) + dur m1) (dur m2) +==> max (dur m2) (dur m2) +==> dur m2 +\end{spec} + +Now we can continue the proof from above: +\begin{spec} +... +==> let d1 = dur m1 + d2 = dur m2 + in if d1>d2 then dur m1 + else dur m2 +==> max (dur m1) (dur m2) +==> dur (m1 :=: m2) +\end{spec} + +The final inductive step involves the |Modify| constructor, but recall +that |dur| treats a |Tempo| modification specially, and thus we treat +it specially as well: +\begin{spec} +dur (revM (Modify (Tempo r) m)) +==> dur (Modify (Tempo r) (revM m)) +==> dur (revM m) / r +==> dur m / r +==> dur (Modify (Tempo r) m) +\end{spec} +Finally, we consider the case that |c /= Tempo r|: +\begin{spec} +dur (revM (Modify c m)) +==> dur (Modify c (revM m)) +==> Modify c (dur (revM m)) +==> Modify c (dur m) +==> dur (Modify c m) +\end{spec} +And we are done. + +\vspace{.1in}\hrule +\vspace{.1in} + +\begin{exercise}{\em +Recall Exercises \ref{ex:chrom} and \ref{ex:mkscale}. Prove that, if +|p2 >= p1|: +\begin{spec} +chrom p1 p2 = mkScale p1 (take (absPitch p2 - absPitch p1) + (repeat 1)) +\end{spec} +using the lemma: +\begin{spec} +[m..n] = scanl (+) m (take (n-m) (repeat 1)) +\end{spec} +} +\end{exercise} + +%% \begin{exercise}{\em +%% Prove that:} +%% \begin{code} +%% mFold (:+:) (:=:) Prim Modify = id +%% \end{code} +%% \end{exercise} + +\begin{exercise}{\em +Prove the following facts involving |dur|:} +\begin{spec} +dur (timesM n m) = n * dur m +dur (takeM d m) = d, if d <= dur m +\end{spec} +%% dur (revM m) = dur m, if dur m /= bottom +\end{exercise} + +\begin{exercise}{\em +Prove the following facts involving |mMap|:} +\begin{spec} +mMap id m = m +mMap f (mMap g m) = mMap (f . g) m +\end{spec} +\end{exercise} + +\begin{exercise}{\em +Prove that, for all |pmap|, |c|, and |m|: +\begin{spec} +perf pmap c m = (perform pmap c m, dur m) +\end{spec} +where |perform| is the function defined in Figure \ref{fig:perform}. +} +\end{exercise} + +\vspace{.1in}\hrule +\vspace{.1in} + +\subsection{The Need for Musical Equivalence} + +In Chapter \ref{ch:intro} we discussed the need for a notion of +\emph{musical equivalence}, noting that, for example, |m :+: rest 0| +``sounds the same'' as |m|, even if the two |Music| values are not +equal as Haskell values. That same issue can strike us here as we try +to prove intuitively natural properties such as: +\begin{spec} +revM (revM m) = m +\end{spec} +To see why this property cannot be proved without a notion of musical +equivalence, note that: +\begin{spec} +revM (revM (c 4 en :=: d 4 qn)) +===> revM ((rest en :+: c 4 en) :=: d 4 qn) +===> (rest 0 :+: c 4 en :+: rest en) :=: d 4 qn +\end{spec} +Clearly the last line above is not equal, as a Haskell value, to |c 4 +en :=: d 4 qn|. But somehow we need to show that these two values +``sound the same'' as musical values. In the next chapter we will +formally develop the notion of musical equivalence, and with it be +able to prove the validity of our intuitions regarding |revM|, as well +as many other important musical properties. + +\section{[Advanced] Induction on Other Data Types} + +Proof by induction can be used to reason about many data types. For +example, we can use it to reason about natural +numbers.\footnote{Indeed, one could argue that a proof by induction + over finite lists is really an induction over natural numbers, since + it is an induction over the \emph{length} of the list, which is a + natural number.} Suppose we define an exponentiation function as +follows: \index{|(^)|} +\begin{spec} +(^) :: Integer -> Integer -> Integer +x^0 = 1 +x^n = x * x^(n-1) +\end{spec} + +\syn{|(*)| is defined in the Standard Prelude to have precedence +level 7, and recall that if no |infix| declaration is given for an +operator it defaults to \indexwd{precedence} level 9, which means that +|(^)| has precedence level 9, which is higher than that for +|(*)|. Therefore no parentheses are needed to disambiguate the +last line in the definition above, which corresponds nicely to +mathematical convention.} + +Now suppose that we want to prove that: +\[(\forall x, n\geq0, m\geq0)\ \ |x^(n+m) = x^n * x^m|\] +We proceed by induction on |n|, beginning with |n=0|: +\begin{spec} +x^(0+m) +==> x^m +==> 1 * (x^m) +==> x^0 * x^m +\end{spec} + +Next we assume that the property is true for numbers less than or +equal to |n|, and prove it for |n+1|: +\begin{spec} +x^((n+1)+m) +==> x * x^(n+m) +==> x * (x^n * x^m) +==> (x * x^n) * x^m +==> x^(n+1) * x^m +\end{spec} +and we are done. + +Or are we? What if, in the definition of |(^)|, |x| or |n| +is \emph{negative}? Since a negative integer is not a natural number, +we could dispense with the problem by saying that these situations +fall beyond the bounds of the property we are trying to prove. But +let's look a little closer. If |x| is negative, the property we +are trying to prove still holds (why?). But if |n| is negative, +|x^n| will not terminate (why?). As diligent programmers we may +wish to defend against the latter situation by writing: +\begin{spec} +(^) :: Integer -> Integer -> Integer +x^0 = 1 +x^n | n<0 = error "negative exponent" + | otherwise = x * x^(n-1) +\end{spec} +If we consider non-terminating computations and ones that produce an +error to both have the same value, namely |bottom|, then these two +versions of |(^)| are equivalent. Pragmatically, however, the +latter is clearly superior. + +Note that the above definition will test for |n<0| on every +recursive call, when actually the only call in which it could happen +is the first. Therefore a slightly more efficient version of this +program would be: + +\begin{spec} +(^) :: Integer -> Integer -> Integer +x^n | n<0 = error "negative exponent" + | otherwise = f x n + where f x 0 = 1 + f x n = x * f x (n-1) +\end{spec} +Proving the property stated earlier for this version of the program is +straightforward, with one minor distinction: what we really need to +prove is that the property is true for |f|; that is: +\[(\forall x, n\geq0, m\geq0)\ \ |f x (n+m) = f x n * f x m|\] +from which the proof for the whole function follows trivially. + +\subsection{A More Efficient Exponentiation Function} + +\index{efficiency} +But in fact there is a more serious inefficiency in our exponentiation +function: we are not taking advantage of the fact that, for any even +number $n$, $x^n = (x*x)^{n/2}$. Using this fact, here is a more +clever way to accomplish the exponentiation task, using the names +|(^!)| and |ff| for our functions to distinguish them from the +previous versions: +\begin{spec} +(^!) :: Integer -> Integer -> Integer +x^!n | n<0 = error "negative exponent" + | otherwise = ff x n + where ff x n | n==0 = 1 + | even n = ff (x*x) (n `quot` 2) + | otherwise = x * ff x (n-1) +\end{spec} + +\syn{\indexwdhs{quot} is Haskell's \emph{quotient} operator, which +returns the integer quotient of the first argument divided by the +second, rounded toward zero.} + +You should convince yourself that, intuitively at least, this version +of exponentiation is not only correct, but also more efficient. More +precisely, |(^)| executes a number of steps proportional to |n|, +whereas |(^!)| executes a number of steps proportional to the +$\log_2$ of |n|. The Standard Prelude defines |(^)| similarly +to the way in which |(^!)| is defined here. + +Since intuition is not always reliable, let's \emph{prove} that this +version is equivalent to the old. That is, we wish to prove that +|x^n = x^!n| for all |x| and |n|. + +A quick look at the two definitions reveals that what we really need +to prove is that |f x n = ff x n|, from which it follows +immediately that |x^n = x^!n|. We do this by induction on |n|, +beginning with the base case |n=0|: +\begin{spec} +f x 0 ==> 1 ==> ff x 0 +\end{spec} +so the base case holds trivially. The induction step, however, is +considerably more complicated. We must consider two cases: |n+1| +is either even, or it is odd. If it is odd, we can show that: +\begin{spec} +f x (n+1) +==> x * f x n +==> x * ff x n +==> ff x (n+1) +\end{spec} +and we are done (note the use of the induction hypothesis in the +second step). + +If |n+1| is even, we might try proceeding in a similar way: +\begin{spec} +f x (n+1) +==> x * f x n +==> x * ff x n +\end{spec} +But now what shall we do? Since |n| is odd, we might try +unfolding the call to |ff|: +\begin{spec} +x * ff x n +==> x * (x * ff x (n-1)) +\end{spec} +but this does not seem to be getting us anywhere. Furthermore, +\emph{folding} the call to |ff| (as we did in the odd case) would +involve \emph{doubling} |n| and taking the square root of |x|, +neither of which seems like a good idea! + +We could also try going in the other direction: +\begin{spec} +ff x (n+1) +==> ff (x*x) ((n+1) `quot` 2) +==> f (x*x) ((n+1) `quot` 2) +\end{spec} +The use of the induction hypothesis in the second step needs to be +justified, because the first argument to |f| has changed from +|x| to |x*x|. But recall that the induction hypothesis states +that for \emph{all} values |x|, and all natural numbers up to |n|, +|f x n| is the same as |ff x n|. So this is OK. + +But even allowing this, we seem to be stuck again! + +Instead of pushing this line of reasoning further, let's pursue a +different tact based on the (valid) assumption that if |m| is even, +then: +\[ |m = m `quot` 2 + m `quot` 2| \] +Let's use this fact together with the property that we proved in the +last section: +\begin{spec} +f x (n+1) +==> f x ((n+1) `quot` 2 + (n+1) `quot` 2) +==> f x ((n+1) `quot` 2) * f x ((n+1) `quot` 2) +\end{spec} +Next, as with the proof in the last section involving |reverse|, +let's make an assumption about a property that will help us along. +Specifically, what if we could prove that |f x n * f x n| is equal +to |f (x*x) n|? If so, we could proceed as follows: +\begin{spec} +f x ((n+1) `quot` 2) * f x ((n+1) `quot` 2) +==> f (x*x) ((n+1) `quot` 2) +==> ff (x*x) ((n+1) `quot` 2) +==> ff x (n+1) +\end{spec} +and we are finally done. Note the use of the induction hypothesis in +the second step, as justified earlier. The proof of the auxiliary +property is not difficult, but also requires induction; it is shown in +Figure \ref{fig:exp-lemma}. + +\begin{figure} +\cbox{ +\begin{minipage}{4.75in} +Base case (|n=0|): +\begin{spec} +f x 0 * f x 0 +==> 1 * 1 +==> 1 +==> f (x*x) 0 +\end{spec} +Induction step (|n+1|): +\begin{spec} +f x (n+1) * f x (n+1) +==> (x * f x n) * (x * f x n) +==> (x*x) * (f x n * f x n) +==> (x*x) * f (x*x) n +==> f (x*x) (n+1) +\end{spec} +\end{minipage}} +\caption{Proof that |f x n * f x n = f (x*x) n|.} +\label{fig:exp-lemma} +\end{figure} + +Aside from improving efficiency, one of the pleasant outcomes of +proving that |(^)| and |(^!)| are equivalent is that +\emph{anything that we prove about one function will be true for the + other}. For example, the validity of the property that we proved +earlier: +\[ |x^(n+m) = x^n * x^m| \] +immediately implies the validity of: +\[ |x^!(n+m) = x^!n * x^!m| \] +Although |(^!)| is more efficient than |(^)|, it is also more +complicated, so it makes sense to try proving new properties for +|(^)|, since the proofs will likely be easier. + +The moral of this story is that you should not throw away old code that +is simpler but less efficient than a newer version. That old code can +serve at least two good purposes: First, if it is simpler, it is +likely to be easier to understand, and thus serves a useful role in +documenting your effort. Second, as we have just discussed, if it is +provably equivalent to the new code, then it can be used to simplify +the task of proving properties about the new code. + +\vspace{.1in}\hrule + +\begin{exercise}\em +The function |(^!)| can be made more efficient by noting that in +the last line of the definition of |ff|, |n| is odd, and +therefore |n-1| must be even, so the test for |n| being even on +the next recursive call could be avoided. Redefine |(^!)| so that +it avoids this (minor) inefficiency. +\end{exercise} + +\begin{exercise}\em +Consider this definition of the \emph{factorial} function:\footnote{The +factorial function is defined mathematically as: +\[\mathit{factorial}(n) = + \left\{ \begin{array}{ll} + 1 & \mbox{if $n=0$} \\ + n * \mathit{factorial} (n-1) & \mbox{otherwise} + \end{array} + \right. +\] } +\begin{spec} +fac1 :: Integer -> Integer +fac1 0 = 1 +fac1 n = n * fac1 (n-1) +\end{spec} +and this alternative definition that uses an ``accumulator:'' +\begin{spec} +fac2 :: Integer -> Integer +fac2 n = fac' n 1 + where fac' 0 acc = acc + fac' n acc = fac' (n-1) (n*acc) +\end{spec} +Prove that |fac1 = fac2|. +\end{exercise} + +\vspace{.1in}\hrule + +\out{ + +There are several points that you should remember about this proof process: +\begin{enumerate} +\item Two programs can be proved equivalent using induction. +\item It is often the case that auxiliary properties are needed to +prove certain properties, whose proofs in turn can be treated +separately. +\item The most obvious proof strategy is not always best. +\end{enumerate} + +Indeed, the full definition of |(^)| as given in the Standard +Prelude is: +\begin{spec} +(^) :: (Num a, Integral b) => a -> b -> a +x ^ 0 = 1 +x ^ n | n > 0 = f x (n-1) x + where f _ 0 y = y + f x n y = g x n + where g x n | even n = g (x*x) (n `quot` 2) + | otherwise = f x (n-1) (x*y) +_ ^ _ = error "Prelude.^: negative exponent" +\end{spec} +}
+ HSoM/Interlude.lhs view
@@ -0,0 +1,451 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Interlude.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter{A Musical Interlude} +\label{ch:interlude} + +At this point enough detail about Haskell and Euterpea has been +covered that it is worth developing a small but full application or +two. In this chapter an existing composition will be transcribed into +Euterpea, thus exemplifying how to express conventional musical ideas +in Euterpea. Then a simple form of algorithmic composition will be +presented, where it will become apparent that more exotic things can +be easily expressed as well. + +But before tackling either of these, Haskell's \emph{modules} will be +described in more detail. + +\section{Modules} +\label{sec:modules} + +Haskell programs are partitioned into \emph{modules} that capture +common types, functions, etc.\ that naturally comprise an application. +The first part of a module is called the module \emph{header}, which +declares what the name of the module is, and what other modules +it might import. For this chapter the module's name is |Interlude|, +into which the module |Euterpea| is imported: +\indexkw{module} +\begin{spec} +module Interlude where +import Euterpea +\end{spec} + +\syn{Module names must always be capitalized (just like type names).} + +Maintaining the name space of modules in a large software system can +be a daunting task. So Haskell provides a way to structure module +names \emph{hierachically}. Indeed, because the |Interlude| module is +part of the overall Euterpea library, the actual module declaration +that is used is: +\begin{spec} +module Euterpea.Examples.Interlude where +import Euterpea +\end{spec} +This says that the |Interlude| module is part of the |Examples| folder +in the overall |Euterpea| library. In general, these hierarchical +names correspond to the folder (directory) structure of a particular +implementation. Similarly, the name of the file containing the module +is generally the same as the module name, plus the file extension (in +this case, the name of the file is |Interlude.lhs|). + +If we wish to use this module in another module |M|, say, it may be +imported into |M|, just as was done above in importing |Euterpea| into +|Interlude|: +\begin{spec} +module M where +import Euterpea.Examples.Interlude +\end{spec} +This will make available in |M| all of the names of functions, types, +and so on that are defined at the top-level of |Interlude|. + +\index{module!interface} +\index{module!\hkw{import}} \indexkw{import} + +But this is not always what the programmer would like. Another +purpose of a module is to manage the overall name space of an +application. Modules allow us to structure an application in such a +way that only the functionality intended for the end user is +visible---everything else needed to implement the system is +effectively hidden. In the case of |Interlude|, there are only two +names whose visibillity is desirable: |childSong6|, and |prefix|. +This can be achieved by writing the module header as follows: +\begin{spec} +module Euterpea.Examples.Interlude(childSong6, prefix) where +import Euterpea +\end{spec} +This set of visible names is sometimes called the \emph{export list} +of the module. If the list is omitted, as was done initially, then +\emph{all} names defined at the top level of the module are exported. + +Although explicit type signatures in export lists are +not allowed, it is sometime useful to add them as comments, at least, +as in: +\begin{code} +module Euterpea.Examples.Interlude + ( childSong6, -- :: Music Pitch, + prefix -- :: [Music a] -> Music a) + ) where +import Euterpea +\end{code} +In this case the list of names is sometimes called the {\em interface} +to the module. + +There are several other rules concerning the import and export of +names to and from modules. Rather than introduce them all at once, +they will be introduced as needed in future chapters. + +\begin{figure*} +\IfFileExists{pics/ChildSong6.eps}{ + \centerline{ + \epsfysize=7in + \epsfbox{pics/ChildSong6.eps}} +}{ +% We use a parbox here to make sure that the figure takes up a full page, +% just like ChildSong6, so that page numbers will remain consistent. + \parbox[c][8in][c]{\textwidth}{\center{\framebox[1.1\width]{Image omitted due to respository space issues.}}} +} +\caption{Excerpt from Chick Corea's \emph{Children's Songs No.\ 6}} +\label{fig:childsong6} +\end{figure*} + +\section{Transcribing an Existing Score} + +Figure \ref{fig:childsong6} shows the first 28 bars of Chick Corea's +\emph{Children's Songs No.\ 6}, written for electric piano +\cite{Corea94}. Analyzing the structure of this tune explores several +basic issues that arise in the transcription of an existing score into +Euterpea, including repeating phrases, grace notes, triplets, tempo, +and specifying an instrument. To begin, however, we will define a +couple of auxiliary functions to make our job easier. + +\subsection{Auxiliary Functions} + +For starters, note that there are several repeating patterns of notes +in this composition, each enclosed in a rectangle in Figure +\ref{fig:childsong6}. In fact, the bass line consists \emph{entirely} +of three repeating phrases. In anticipation of this, a function can +be defined that repeats a phrase a particular number of times: +\begin{spec} + +timesM :: Int -> Music a -> Music a +timesM 0 m = rest 0 +timesM n m = m :+: timesM (n-1) m +\end{spec} + +\syn{Note that pattern-matching can be used on numbers. As mentioned + earlier, when there is more than one equation that defines a + function, the first equation is tried first. If it fails, the + second equation is tried, and so on. In the case above, if the + first argument to |timesM| is not 0, the first equation will fail. + The second equation is then tried, which always succeeds. +} + +%% An expression \hs{if pred then cons else alt} is called a {\em +%% conditional expression}. If \hs{pred} (called the {\em +%% predicate}) evaluates to |True|, then \hs{cons} (called the {\em +%% consequence}) is the result; if \hs{pred} evaluates to |False|, +%% then \hs{alt} (called the {\em alternative}) is the result. + +So, for example, |timesM 3 b1| will repeat the baseline |b1| (to be +defined shortly) three times. + +To motivate the second auxiliary function, note in Figure +\ref{fig:childsong6} that there are many melodic lines that consist of +a sequence of consecutive notes having the same duration (for example +eighth notes in the melody, and dotted quarter notes in the bass). To +avoid having to write each of these durations explicitly, we will +define a function that specifies them just once. To do this, recall +that |a 4 qn| is a concert A quarter note. Then note that, because of +currying, |a 4| is a function that can be applied to any +duration---i.e.\ its type is |Dur -> Music a|. In other words, it is +a note whose duration has not been specified yet. + +With this thought in mind, we can return to the original problem and +define a function that takes a duration and a \emph{list} of notes with +the aforementioned type, returning a |Music| value with the duration +attached to each note appropriately. In Haskell: + +\begin{code} + +addDur :: Dur -> [Dur -> Music a] -> Music a +addDur d ns = let f n = n d + in line (map f ns) +\end{code} +(Compare this idea with Exercise \ref{ex:fuse} in Chapter +\ref{ch:poly}.) + +Finally, a function to add a grace note to a note is defined. Grace +notes can approach the principal note from above or below; sometimes +starting a half-step away, and sometimes a whole step; and having a +rhythmic interpretation that is to a large extent up to the performer. +In the case of the six uses of grace notes in \emph{Children's Songs + No.\ 6}, we will assume that the grace note begins on the downbeat +of the principal note, and thus its duration will subtract from that +of the principal note. We will also assume that the grace note +duration is 1/8 of that of the principal note. Thus the goal is to +define a function: +\begin{code} +graceNote :: Int -> Music Pitch -> Music Pitch +\end{code} +such that |graceNote n (note d p)| is a |Music| value consisting of +two notes, the first being the grace note whose duration is +$\nicefrac{d}{8}$ and whose pitch is |n| semitones higher (or lower if +|n| is negative) than |p|, and the second being the principal note at +pitch |p| but now with duration $\nicefrac{7d}{8}$. In Haskell: +\begin{code} +graceNote n (Prim (Note d p)) = + note (d/8) (trans n p) :+: note (7*d/8) p +graceNote n _ = + error "Can only add a grace note to a note." +\end{code} +Note that pattern-matching is performed against the nested +constructors of |Prim| and |Note|---we cannot match against the +application of a function such as |note|. Also note the error +message---programs are not expected to ever apply |graceNote| to +something other than a single note. + +(In Chapter~\ref{ch:more-music} a slightly more general form of +|graceNote| will be defined.) + +The only special cases that will not be handled using auxiliary +functions are the single staccato on note four of bar fifteen, and the +single portamento on note three of bar sixteen. These situations will +be addressed differently in a later chapter. + +\subsection{Bass Line} + +With these auxilary functions now defined, the base line in +Figure~\ref{fig:childsong6} can be defined by first noting the three +repeating phrases (enclosed in rectangular boxes), which can be +captured as follows: +\begin{code} + +b1 = addDur dqn [b 3, fs 4, g 4, fs 4] +b2 = addDur dqn [b 3, es 4, fs 4, es 4] +b3 = addDur dqn [as 3, fs 4, g 4, fs 4] +\end{code} + +Using |timesM| it is then easy to define the entire 28 bars of the +base line: +\begin{code} +bassLine = timesM 3 b1 :+: timesM 2 b2 :+: + timesM 4 b3 :+: timesM 5 b1 +\end{code} + +\subsection{Main Voice} + +The upper voice of this composition is a bit more tedious to define, +but is still straightforward. At the highest level, it consists of +the phrase |v1| in the first two bars (in the rectangular box) +repeated three times, followed by the remaining melody, which will be +named |v2|: +\begin{code} +mainVoice = timesM 3 v1 :+: v2 +\end{code} + +The repeating phrase |v1| is defined by: +\begin{code} +v1 = v1a :+: graceNote (-1) (d 5 qn) :+: v1b -- bars 1-2 +v1a = addDur en [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4] +v1b = addDur en [cs 5, b 4] +\end{code} +Note the treatment of the grace note. + +The remainder of the main voice, |v2|, is defined in seven pieces: +\begin{code} +v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g +\end{code} +with each of the pieces defined in Figure \ref{fig:bars7-28}. Note that: +\begin{itemize} +\item The phrases are divided so as to (for the most part) line up + with bar lines, for convenience. But it may be that this is not the + best way to organize the music---for example, we could argue that + the last two notes in bar 20 form a ``pick-up'' to the phrase that + follows, and thus more logically fall with that following phrase. + The organization of the Euterpea code in this way is at the + discretion of the composer. + +\item The stacatto is treated by playing the qurater note as an eighth + note; the portamento is ignored. As mentioned earlier, these + ornamentations will be addressed differently in a later chapter. + +\item The triplet of eighth notes in bar 25 is addressed by scaling the + tempo by a factor of |3/2|. +\end{itemize} + +\begin{figure} +\cbox{\small +\begin{code} +v2a = line [ cs 5 (dhn+dhn), d 5 dhn, + f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en] -- bars 7-11 +v2b = addDur en [ fs 5, e 5, cs 5, as 4] :+: a 4 dqn :+: + addDur en [ as 4, cs 5, fs 5, e 5, fs 5] -- bars 12-13 +v2c = line [ g 5 en, as 5 en, cs 6 (hn+en), d 6 en, cs 6 en] :+: + e 5 en :+: enr :+: + line [ as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en] + -- bars 14-16 +v2d = addDur en [ fs 5, cs 5, e 5, cs 5, + a 4, as 4, d 5, e 5, fs 5] -- bars 17-18.5 +v2e = line [ graceNote 2 (e 5 qn), d 5 en, graceNote 2 (d 5 qn), cs 5 en, + graceNote 1 (cs 5 qn), b 4 (en+hn), cs 5 en, b 4 en ] + -- bars 18.5-20 +v2f = line [ fs 5 en, a 5 en, b 5 (hn+qn), a 5 en, fs 5 en, e 5 qn, + d 5 en, fs 5 en, e 5 hn, d 5 hn, fs 5 qn] -- bars 21-23 +v2g = tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: + b 4 (3*dhn+hn) -- bars 24-28 +\end{code}} +\caption{Bars 7-28} +\label{fig:bars7-28} +\end{figure} + +\subsection{Putting It All Together} + +In the Preface to \emph{Children's Songs -- 20 Pieces for Keyboard} +\cite{Corea94}, Chick Corea notes that, ``Songs 1 through 15 were +composed for the Fender Rhodes.'' Therefore the MIDI instrument +|RhodesPiano| is a logical choice for the transcription of his +composition. Furthermore, note in the score that a dotted half-note +is specified to have a metronome value of 69. By default, the |play| +function in Euterpea uses a tempo equivalent to a quarter note having +a metronome value of 120. Therefore the tempo should be scaled by a +factor of |(dhn/qn)*(69/120)|. + +These two observations lead to the final definition of the +transcription of \emph{Children's Songs No.\ 6} into Euterpea: +\begin{code} +childSong6 :: Music Pitch +childSong6 = let t = (dhn/qn)*(69/120) + in instrument RhodesPiano + (tempo t (bassLine :=: mainVoice)) +\end{code} +The intent is that this is the only value that will be of interest to +users of this module, and thus |childSong6| is the only name exported +from this section of the module, as discussed in Section +\ref{sec:modules}. + +This example can be played through the command |play childSong6|. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Find a simple piece of music written by your favorite composer, and +transcribe it into Euterpea. In doing so, look for repeating patterns, +transposed phrases, etc.\ and reflect this in your code, thus revealing +deeper structural aspects of the music than that found in common +practice notation.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Simple Algorithmic Composition} +\label{sec:alg-comp} + +\emph{Algorithmic composition} is the process of designing an +algorithm (or heuristic) for generating music. There are unlimited +possibilites, with some trying to duplicate a particular style of +music, others exploring more exotic styles; some based on traditional +notions of music theory, others not; some completely deterministic, +others probabilistic; and some requiring user interaction, others being +completely automatic. Some even are based simply on ``interpreting'' +data---like New York Stock Exchange numbers---in interesting ways! In +this textbook a number of algorithmic composition techniques are +explored, but the possibilities are endless---hopefully what is +presented will motivate the reader to invent new, exciting algorithmic +composition techniques. + +To give a very tiny glimpse into algorithmic composition, we end this +chapter with a very simple example. We will call this example +``prefix,'' for reasons that will become clear shortly. + +The user of this algorithm provides an initial melody (or ``motif'') +represented as a list of notes. The main idea is to play every proper +(meaning non-empty) prefix of the given melody in succession. So the +first thing we do is define a polymorphic function |prefixes :: [a] -> +[[a]]| that returns all proper prefixes of a list: +\begin{code} +prefixes :: [a] -> [[a]] +prefixes [] = [] +prefixes (x:xs) = let f pf = x:pf + in [x] : map f (prefixes xs) +\end{code} +We can use this to play all prefixes of a given melody |mel| in +succession as follows: +\begin{spec} +play (line (concat (prefixes mel))) +\end{spec} + +But let's do a bit more. Let's create two voices (each using a +different instrument), one voice being the reverse of the other, and +play them in parallel. And then let's play the whole thing once, then +transposed up a perfect fourth (i.e.\ five semitones), then repeat the +whole thing a final time. And, let's package it all into one +function: +\begin{code} +prefix :: [Music a] -> Music a +prefix mel = let m1 = line (concat (prefixes mel)) + m2 = transpose 12 (line (concat (prefixes (reverse mel)))) + m = instrument Flute m1 :=: instrument VoiceOohs m2 + in m :+: transpose 5 m :+: m +\end{code} + +Here are two melodies (differing only in rhythm) that you can try with +this algorithm: +\begin{code} +mel1 = [c 5 en, e 5 sn, g 5 en, b 5 sn, a 5 en, f 5 sn, d 5 en, b 4 sn, c 5 en] +mel2 = [c 5 sn, e 5 sn, g 5 sn, b 5 sn, a 5 sn, f 5 sn, d 5 sn, b 4 sn, c 5 sn] +\end{code} +Although not very sophisticated at all, |prefix| can generate some +interesting music from a very small seed. + +Another typical approach to algorithmic composition is to specify some +constraints on the solution space, and then generate lots of solutions +that satisfy those constraints. The user can then choose one of the +solutions based on aesthetic preferences. + +As a simple example of this, how do we choose the original melody in +the prefix program above? We could require that all solutions be a +multiple of some preferred meter. For example, in triple meter (say, +$\nicefrac{3}{4}$ time) we might wish for the solutions to be +multiples of 3 quarter-note beats (i.e. one measure), or in +$\nicefrac{4}{4}$ time, multiples of 4 beats. In this way the result +is always an integer number of measures. If the original melody +consists of notes all of the same duration, say one beat, then the +prefixes, when played sequentially, will have a total duration that is +the sum of the numbers 1 through |n|, where |n| is the length of melody +in beats. That sum is $\nicefrac{n*(n+1)}{2}$. The first ten sums in +this series are: +\[1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...\] +The second, third, fifth, sixth, eighth, and ninth of these are +divisible by 3, and the seventh and eighth are divisible by 4. When +rendering the result we could then, for exaple, place an accent on the +first note in each of these implied measures, thus giving the result +more of a musical feel. (Placing an accent on a note will be +explained in Chapters \ref{ch:more-music} and \ref{ch:performane}.) + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Try using |prefix| on your own melodies. Indeed, note that the list of notes +could in general be a list of any |Music| values.} +\end{exercise} + +\begin{exercise}{\em +Try making the following changes to |prefix|: +\begin{enumerate} +\item Use different instruments. +\item Change the definition of |m| in some way. +\item Compose the result in a different way. +\end{enumerate} } +\end{exercise} + +\vspace{.1in}\hrule
+ HSoM/Intro.lhs view
@@ -0,0 +1,1508 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\chapter[Computer Music, Euterpea, and Haskell]{Overview of + Computer Music, Euterpea, and Haskell}+\label{ch:intro}++Computers are everywhere. And so is music! Although some might think+of the two as being at best distant relatives, in fact they share many+deep properties. Music comes from the soul, and is inspired by the+heart, yet it has the mathematical rigor of computers. Computers have+mathematical rigor of course, yet the most creative ideas in+mathematics and computer science come from the soul, just like music.+Both disciplines demand both left-brain and right-brain skills. It+always surprises me how many computer scientists and mathematicians+have a serious interest in music. It seems that those with a strong+affinity or acuity in one of these disciplines is often strong in the+other as well.++It is quite natural then to consider how the two might interact. In+fact there is a long history of interactions between music and+mathematics, dating back to the Greeks' construction of musical scales+based on arithmetic relationships, and including many classical+composers use of mathematical structures, the formal harmonic analysis+of music, and many modern music composition techniques. Advanced+music theory uses ideas from diverse branches of mathematics such as+number theory, abstract algebra, topology, category theory, calculus,+and so on.++There is also a long history of efforts to combine computers and+music. Most consumer electronics today are digital, as are most forms+of audio processing and recording. But in addition, digital musical+instruments provide new modes of expression, notation software and+sequencers have become standard tools for the working musician, and+those with the most computer science savvy use computers to explore+new modes of composition, transformation, performance, and analysis.++This textbook explores the fundamentals of computer music using a+language-centric approach. In particular, the functional programming+language \emph{Haskell} is used to express all of the computer music+concepts. Thus a by-product of learning computer music concepts will+be learning how to program in Haskell. The core musical ideas are+collected into a Haskell library called \emph{Euterpea}. The name+``Euterpea'' is derived from \emph{Euterpe}, who was one of the nine+Greek muses, or goddesses of the arts, specifically the muse of music.+A hypothetical picture of Euterpe graces the cover of this textbook.++\section{The Note vs. Signal Dichotomy}++The field of computer music has grown astronomically over the past+several decades, and the material can be structured and organized+along several dimensions. A dimension that proves particulary useful+with respect to a programming language is one that separates+\emph{high-level} musical concerns from \emph{low-level} musical+concerns. Since a ``high-level'' programming language---namely+Haskell---is used to program at both of these musical levels, to avoid+confusion the terms \emph{note level} and \emph{signal level} will be+used in the musical dimension.++At the \emph{note level}, a \emph{note} (i.e.\ pitch and duration) is+the lowest musical entity that is considered, and everything else is+built up from there. At this level, in addition to conventional+representations of music, we can study interesting aspects of+so-called \emph{algorithmic composition}, including the use of+fractals, grammar-based systems, stochastic processes, and so on.+From this basis we can also study the harmonic and rhythmic+\emph{analysis} of music, although that is not currently an emphasis+in this textbook. Haskell facilitates programming at this level+through its powerful data abstraction facilities, higher-order+functions, and declarative semantics.++In contrast, at the \emph{signal level} the focus is on the actual+sound generated in a computer music application, and thus a+\emph{signal} is the lowest entity that is considered. Sound is+concretely represented in a digital computer by a discrete sampling of+the continuous audio signal, at a high enough rate that human ears+cannot distinguish the discrete from the continuous, usually 44,100+samples per second (the standard sampling rate used for CDs, mp3+files, and so on). But in Euterpea, these details are hidden: signals+are treated abstractly as continuous quantities. This greatly eases+the burden of programming with sequences of discrete values. At the+signal level, we can study sound synthesis techniques (to simulate+the sound of a conventional instrument, say, or something completely+artificial), audio processing (e.g.\ determining the frequency+spectrum of a signal), and special effects (reverb, panning,+distortion, and so on).++Suppose for a moment that a musician is playing music using a+metro\-nome set at 96, which corresponds to 96 beats per minute. That+means that one beat takes $\nicefrac{60}{96}$ = 0.625 seconds. At a+stereo sampling rate of 44,100 samples per second, that in turn+translates into $2\times 0.625\times 44,100$ = 55,125 samples, and+each sample typically occupies several bytes of computer memory. This+is typical of the minimum memory requirements of a computation at the+signal level. In contrast, at the note level, we only need some kind+of operator or data structure that says ``play this note,'' which+requires a total of only a small handful of bytes. This dramatic+difference highlights one of the key computational differences between+programming at the note level versus the signal level.++Of course, many computer music applications involve both the note+level \emph{and} the signal level, and indeed there needs to be a+mechanism to mediate between the two. Although such mediation can+take many forms, it is for the most part straightforward. Which is+another reason why the distinction between the note level and the+signal level is so natural.++This textbook begins with a treatment of the note level+(Chapters~\ref{ch:intro}-\ref{ch:MUI}) and follows with a treatment of+the signal level (Chapters~\ref{ch:signals}-\ref{ch:additive}). If+you are interested only in the signal level, you could skip+Chapters~\ref{ch:performance}-\ref{ch:MUI}.++\section{Basic Principles of Programming}++Programming, in its broadest sense, is \emph{problem solving}. It+begins by recognizing problems that can and should be solved using a+digital computer. Thus the first step in programming is answering the+question, ``What problem am I trying to solve?''++% ``Solving the wrong problem'' is a phrase often heard in many+% contexts, and we certainly do not want to be victims of that crime.++% \footnote{Of course, not all problems fall into this category, and+% some problems are solved (or are attempted to be solved) using+% computers that probably should not be. But I will avoid this+% digression.}++Once the problem is understood, a solution must be found. This may+not be easy, of course, and in fact you may discover several+solutions, so a way to measure success is needed. There are various+dimensions in which to do this, including correctness (``Will I get+the right answer?'') and efficiency (``Will it run fast enough, or use+too much memory?''). But the distinction of which solution is better+is not always clear, since the number of dimensions can be large, and+programs will often excel in one dimension and do poorly in others.+For example, there may be one solution that is fastest, one that uses+the least amount of memory, and one that is easiest to understand.+Deciding which to choose can be difficult, and is one of the more+interesting challenges in programming.++The last measure of success mentioned above---clarity of a+program---is somewhat elusive: difficult to quantify and measure.+Nevertheless, in large software systems clarity is an especially+important goal, since such systems are worked on by many people over+long periods of time, and evolve considerably as they mature. Having+easy-to-understand code makes it much easier to modify.++In the area of computer music, there is another reason why clarity is+important: namely, that the code often represents the author's thought+process, musical intent, and artistic choices. A conventional+musical score does not say much about what the composer thought as she+wrote the music, but a program often does. So when you write your+programs, write them for others to see, and aim for elegance and beauty,+just like the musical result that you desire.++Programming is itself a creative process. Sometimes programming+solutions (or artistic creations) come to mind all at once, with+little effort. More often, however, they are discovered only after+lots of hard work! We may write a program, modify it, throw it away+and start over, give up, start again, and so on. It is important to+realize that such hard work and reworking of programs is the norm, and+in fact you are encouraged to get into the habit of doing so. Do not+always be satisfied with your first solution, and always be prepared+to go back and change or even throw away those parts of your program+that you are not happy with.++\section{Computation by Calculation}+\index{computation by calculation}++It is helpful when learning a new programming language to have a good+grasp of how programs in that language are executed---in other words,+an understanding of what a program \emph{means}. The execution of+Haskell programs is perhaps best understood as \emph{computation by+ calculation}. Programs in Haskell can be viewed as \emph{functions}+whose input is that of the problem being solved, and whose output is+the desired result---and the behavior of functions can be effectively+understood as computation by calculation.++An example involving numbers might help to demonstrate these ideas.+Numbers are used in many applications, and computer music is no+exception. For example, integers might be used to represent pitch,+and floating-point numbers might be used to perform calculations+involving frequency or amplitude.++Suppose we wish to perform an arithmetic calculation such as+$3\times(9+5)$. In Haskell this would be written as |3*(9+5)|, since+most standard computer keyboards and text editors do not recognize the+special symbol $\times$. The result can be calculated as follows:+\begin{spec}+3*(9+5) +==> 3*14 +==> 42+\end{spec}+It turns out that this is not the only way to compute the result, as+evidenced by this alternative calculation:\footnote{This assumes that+ multiplication distributes over addition in the number system being+ used, a point that will be returned to later in the text.}+\begin{spec}+3*(9+5) +==> 3*9 + 3*5 +==> 27 + 3*5 +==> 27+15 +==> 42+\end{spec}+\index{efficiency}% ++Even though this calculation takes two extra steps, it at least gives+the same, correct answer. Indeed, an important property of each and+every program written in Haskell is that it will always yield the same+answer when given the same inputs, regardless of the order chosen to+perform the calculations.\footnote{This is true as long as a+ non-terminating sequence of calculations is not chosen, another+ issue that will be addressed later.} This is precisely the+mathematical definition of a \emph{function}: for the same inputs, it+always yields the same output.++On the other hand, the first calculation above required fewer steps+than the second, and thus it is said to be more \emph{efficient}.+Efficiency in both space (amount of memory used) and time (number of+steps executed) is important when searching for solutions to problems.+Of course, if the computation returns the wrong answer, efficiency is+a moot point. In general it is best to search first for an elegant+(and correct!) solution to a problem, and later refine it for better+performance. This strategy is sometimes summarized as, ``Get it right+first!''++The above calculations are fairly trivial, but much more sophisticated+computations will be introduced soon enough. For starters---and to+introduce the idea of a Haskell function---the arithmetic operations+performed in the previous example can be \emph{generalized} by+defining a function to perform them for any numbers |x|, |y|, and |z|:+\indexhs{simple}+\begin{spec}+simple x y z = x*(y+z)+\end{spec}+This equation defines |simple| as a function of three+\emph{arguments}, |x|, |y|, and |z|. In mathematical notation this+definition might be written differently, such as one of the following:+\[\begin{array}{l}+{\it simple}(x,y,z) = x\times(y+z)\\+{\it simple}(x,y,z) = x\cdot(y+z)\\+{\it simple}(x,y,z) = x(y+z)+\end{array}\]+In any case, it should be clear that ``|simple 3 9 5|'' is the same+as ``|3*(9+5)|.'' In fact the proper way to calculate the result is:+\begin{spec}+simple 3 9 5 +==> 3*(9+5)+==> 3*14+==> 42+\end{spec}+\index{unfold (in a calculation)}+The first step in this calculation is an example of \emph{unfolding} a+function definition: 3 is substituted for |x|, 9 for |y|, and 5+for |z| on the right-hand side of the definition of |simple|.+This is an entirely mechanical process, not unlike what the computer+actually does to execute the program.++|simple 3 9 5| is said to \emph{evaluate} to 42. To express the fact+that an expression $e$ evaluates (via zero, one, or possibly many more+steps) to the value $v$, we will write $e \Longrightarrow v$ (this arrow+is longer than that used earlier). So we can say directly, for+example, that |simple 3 9 5 ===> 42|, which should be read ``|simple 3+9 5| evaluates to 42.''++With |simple| now suitably defined, we can repeat the sequence of+arithmetic calculations as often as we like, using different values+for the arguments to |simple|. For example, +|simple 4 3 2 ===> 20|.++We can also use calculation to \emph{prove properties} about+programs. For example, it should be clear that for any |a|, |b|, and+|c|, |simple a b c| should yield the same result as |simple a c b|.+For a proof of this, we calculate \emph{symbolically}; that is,+using the symbols |a|, |b|, and |c| rather than concrete numbers such+as 3, 5, and 9:+\begin{spec}+simple a b c +==> a*(b+c) +==> a*(c+b)+==> simple a c b+\end{spec}+Note that the same notation is used for these symbolic steps as for+concrete ones. In particular, the arrow in the notation reflects the+direction of formal reasoning, and nothing more. In general, if |e1+==> e2|, then it is also true that |e2 ==> e1|.++These symbolic steps are also referred to as as ``calculations,'' even+though the computer will not typically perform them when executing a+program (although it might perform them \emph{before} a program is run+if it thinks that it might make the program run faster). The second+step in the calculation above relies on the commutativity of addition+(namely that, for any numbers $x$ and $y$, $x+y=y+x$). The third step+is the reverse of an unfold step, and is appropriately called a+\emph{fold} calculation. \index{fold (in a calculation)} It would be+particularly strange if a computer performed this step while executing+a program, since it does not seem to be headed toward a final answer.+But for proving properties about programs, such ``backward reasoning''+is quite important.++When we wish to spell out the justification for each step, whether+symbolic or concrete, a calculation can be annotated with more detail,+as in:+\begin{spec}+simple a b c+==> { unfold }+a*(b+c)+==> { commutativity }+a*(c+b)+==> { fold }+simple a c b+\end{spec}+In most cases, however, this will not be necessary.++Proving properties of programs is another theme that will be repeated+often in this text. Computer music applications often have some kind+of a mathematical basis, and that mathematics must be reflected+somewhere in our programs. But how do we know if we got it right?+Proof by calculation is one way to connect the problem specification+with the program solution.++More broadly speaking, as the world begins to rely more and more on+computers to accomplish not just ordinary tasks such as writing term+papers, sending email, and social networking, but also life-critical+tasks such as controlling medical procedures and guiding spacecraft,+then the correctness of programs gains in importance. Proving complex+properties of large, complex programs is not easy---and rarely if ever+done in practice---but that should not deter us from proving simpler+properties of the whole system, or complex properties of parts of the+system, since such proofs may uncover errors, and if not, will at+least give us confidence in our effort.++If you are someone who is already an experienced programmer, the idea+of computing \emph{everything} by calculation may seem odd at best,+and na\"{i}ve at worst. How do we write to a file, play a sound,+draw a picture, or respond to mouse-clicks? If you are wondering+about these things, it is hoped that you have patience reading the+early chapters, and that you find delight in reading the later+chapters where the full power of this approach begins to shine.++In many ways this first chapter is the most difficult, since it+contains the highest density of new concepts. If the reader has+trouble with some of the concepts in this overview chapter, keep in+mind that most of them will be revisited in later chapters. And do not+hesitate to return to this chapter later to re-read difficult+sections; they will likely be much easier to grasp at that time.++\syn{In the remainder of this textbook the need will often arise to+ explain some aspect of Haskell in more detail, without distracting+ too much from the primary line of discourse. In those circumstances+ the explanations will be offset in a shaded box such as this one,+ proceeded with the word ``Details.''}++\vspace{.1in}\hrule++\begin{exercise}{\em+Write out all of the steps in the calculation of the value of+\begin{spec}+simple (simple 2 3 4) 5 6+\end{spec}+}+\end{exercise}++\begin{exercise}{\em+Prove by calculation that |simple (a-b) a b ===>| $a^2 - b^2$.}+\end{exercise}++\vspace{.1in}\hrule++\section{Expressions and Values}+\label{sec:expressions}++In Haskell, the entities on which calculations are performed are+called \emph{\indexwd{expressions}}, and the entities that result from+a calculation---i.e.\ ``the answers''---are called+\emph{\indexwd{values}}. It is helpful to think of a value just as an+expression on which no more calculation can be carried out---every+value is an expression, but not the other way around.++Examples of expressions include \emph{atomic} (meaning, indivisible)+values such as the integer |42| and the character |'a'|, which are+examples of two \emph{primitive} atomic values in Haskell. The next+chapter introduces examples of \emph{constructor} atomic values, such+as the musical notes |C|, |D|, |Ef|, |Fs|, etc., which in standard+music notation are written C, D, E$\flat$, F$\sharp$, etc., and are+pronounced C, D, E-flat, F-sharp, etc. (In music theory, note names+are called \emph{pitch classes}.).++In addition, there are \emph{structured} expressions (i.e., made from+smaller pieces) such as the \emph{\indexwd{list}} of pitches+|[C,D,Ef]|, the character/number \emph{\indexwd{pair}} |('b',4)|+(lists and pairs are different in a subtle way, to be described+later), and the string |"Euterpea"|. Each of these structured+expressions is also a value, since by themselves there is no further+calculation that can be carried out. As another example, |1+2| is an+expression, and one step of calculation yields the expression |3|,+which is a value, since no more calculations can be performed. As a+final example, as was expained earlier, the expression |simple 3 9 5|+evaluates to the value 42.++Sometimes, however, an expression has only a never-ending+sequence of calculations. For example, if |x| is defined as:+\begin{spec}+x = x + 1+\end{spec}+then here is what happens when trying to calculate the value of |x|:+\begin{spec}+x +==> x + 1+==> (x + 1) + 1+==> ((x + 1) + 1) + 1+==> (((x + 1) + 1) + 1) + 1+...+\end{spec}+Similarly, if a function |f| is defined as:+\begin{spec}+f x = f (x-1)+\end{spec}+then an expression such as |f 42| runs into a similar problem:+\begin{spec}+f 42+==> f 41+==> f 40+==> f 39+...+\end{spec}+Both of these clearly result in a never-ending sequence of+calculations. Such expressions are said to not terminate, or+\emph{diverge}. In such cases the symbol |bottom|\index{bottom},+pronounced ``bottom,'' is used to denote the value of the expression.+This means that every diverging computation in Haskell denotes the+same |bottom| value,\footnote{Technically, each type has its own+ version of |bottom|.} reflecting the fact that, from an observer's+point of view, there is nothing to distinguish one diverging+computation from another.++\section{Types}++Every expression (and therefore every value) also has an associated+\emph{\indexwd{type}}. It is helpful to think of types as sets of+expressions (or values), in which members of the same set have much in+common. Examples include the primitive atomic types+\indexwdhs{Integer} (the set of all integers) and \indexwdhs{Char}+(the set of all characters), the user-defined atomic type |PitchClass|+(the set of all pitch classes, i.e.\ note names), as well as the+structured types |[Integer]| and |[PitchClass]| (the sets of all lists+of integers and lists of pitch classes, respectively), and |String|+(the set of all Haskell strings).++The association of an expression or value with its type is very+useful, and there is a special way of expressing it in Haskell.+Using the examples of values and types above:+\begin{spec}+D :: PitchClass+42 :: Integer+'a' :: Char+"Euterpea" :: String+[C,D,Ef] :: [PitchClass]+('b',4) :: (Char,Integer)+\end{spec}+\indexhs{::}+Each association of an expression with its type is called a \emph{type+ signature}.++\index{case sensitivity}++\syn{Note that the names of specific types are capitalized, such as+ |Integer| and |Char|, as are the names of some atomic values such as+ |D| and |Fs|. These will never be confused in context, since things+ to the right of ``|::|'' are types, and things to the left are+ values. Note also that user-defined names of values are \emph{not}+ capitalized, such as |simple| and |x|. This is not just a+ convention: it is required when programming in Haskell. In+ addition, the case of the other characters matters, too. For+ example, |test|, |teSt|, and |tEST| are all distinct names for+ values, as are |Test|, |TeST|, and |TEST| for types.}++\syn{Literal characters are written enclosed in single forward quotes+ (apostrophes), as in |'a'|, |'A'|, |'b'|, |','|, |'!'|, |' '| (a+ space), and so on. (There are some exceptions, however; see the+ Haskell Report for details.) Strings are written enclosed in double+ quote characters, as in |"Euterpea"| above. The connection between+ characters and strings will be explained in a later chapter.++The ``|::|'' should be read ``has type,'' as in ``42 has type+|Integer|.'' Note that square braces are used both to construct a+list value (the left-hand side of |(::)| above), and to describe its+type (the right-hand side above). Analogously, the round braces used+for pairs are used in the same way. But also note that all of the+elements in a list, however long, must have the same type, whereas the+elements of a pair can have different types.}++Haskell's \emph{type system} ensures that Haskell programs are +\emph{\indexwd{well-typed}}; that is, that the programmer has not+mismatched types in some way. For example, it does not make much+sense to add together two characters, so the expression |'a' + 'b'| is+\emph{\indexwd{ill-typed}}. The best news is that Haskell's type+system will tell you if your program is well-typed \emph{before you run+ it}. This is a big advantage, since most programming errors are+manifested as type errors.++%% The idea of dividing the world of values into types should be a+%% familiar idea to most people. We do it all of the time for just about+%% every kind of object you can think of. Take boxes, for example. Just+%% as we have integers and reals, lists and tuples, etc., we also have+%% large boxes and small boxes, cardboard boxes and wooden boxes, and so+%% on. And just as we have lists of integers and lists of characters, we+%% also have boxes of nails and boxes of shoes. And just as we would not+%% expect to be able to take the square of a list, or add two characters,+%% we would not expect to be able to use a box to pay for our groceries.++%% Types help us to make sense of the world by organizing it into groups+%% of common shape, size, functionality, etc. The same is true for+%% programming, where types help us to organize values into groups of+%% common shape, size, and functionality, amongst other things. Of+%% course, the kinds of commonality between values will not be the same+%% as those between objects in the real world, and in general we will be+%% more restricted---and more formal---about just what we can say about+%% types and how we say it.++% Nevertheless, the analogy holds.++\section{Function Types and Type Signatures}++\index{function!type||(} What should the \indexwd{type} of a function+be? It seems that it should at least convey the fact that a function+takes values of one type---|T1|, say---as input, and returns values of+(possibly) some other type---|T2|, say---as output. In Haskell this+is written |T1 -> T2|, and such a function is said to ``map values of+type |T1| to values of type |T2|.''\footnote{In mathematics |T1| is+ called the \emph{domain} of the function, and |T2| the+ \emph{range}.} If there is more than one argument, the notation is+extended with more arrows. For example, if the intent is that the+function |simple| defined in the previous section has type+|Integer->Integer->Integer->Integer|, we can include a type signature+with the definition of |simple|: \index{type!signature}+\begin{spec}+simple :: Integer -> Integer -> Integer -> Integer+simple x y z = x*(y+z)+\end{spec}+\syn{When writing Haskell programs using a typical text editor, there+ typically will not be nice fonts and arrows as in |Integer ->+ Integer|. Rather, you will have to type {\tt Integer -> Integer}.}++\index{type!inference} Haskell's type system also ensures that+user-supplied type signatures such as this one are correct. Actually,+Haskell's type system is powerful enough to allow us to avoid writing+any type signatures at all, in which case the type system is said to+\emph{infer} the correct types.\footnote{There are a few exceptions to+ this rule, and in the case of |simple| the inferred type is actually+ a bit more general than that written above. Both of these points+ will be returned to later.} Nevertheless, judicious placement of+type signatures, as was done for |simple|, is a good habit, since type+signatures are an effective form of documentation and help bring+programming errors to light. In fact, it is a good habit to first+write down the type of each function you are planning to define, as a+first approximation to its full specification---a way to grasp its+overall functionality before delving into its details.++\index{function!application}+The normal use of a function is referred to as \emph{function+ application}. For example, |simple 3 9 5| is the application of+the function |simple| to the arguments 3, 9, and 5. Some+functions, such as |(+)|, are applied using what is known as+\emph{\indexwd{infix} syntax}; that is, the function is written+between the two arguments rather than in front of them (compare+|x+y| to |f x y|).++\syn{Infix functions are often called \emph{\indexwd{operators}}, and+are distinguished by the fact that they do not contain any numbers or+letters of the alphabet. Thus |^!| and |*#:| are infix+operators, whereas |thisIsAFunction| and |f9g| are not (but are+still valid names for functions or other values). The only exception+to this is that the symbol \emph{'} is considered to be alphanumeric;+thus |f'| and |one's| are valid names, but not operators.++In Haskell, when referring to an infix operator as a value, it is enclosed+in parentheses, such as when declaring its type, as in:+\begin{spec}+(+) :: Integer -> Integer -> Integer+\end{spec}+Also, when trying to understand an expression such as |f x + g y|,+there is a simple rule to remember: function application \emph{always}+has ``higher \indexwd{precedence}'' than operator application, so that+|f x + g y| is the same as |(f x) + (g y)|.++Despite all of these syntactic differences, however, operators are+still just functions.}+\index{function!type||)}++\vspace{.1in}\hrule++\begin{exercise}{\em+Identify the well-typed expressions in the following, and, for each,+give its proper type:+\begin{spec}+[ A, B, C ]+[ D, 42 ]+( -42, Ef )+[ ('a',3), ('b',5) ]+simple 'a' 'b' 'c'+( simple 1 2 3, simple )+["I","love","Euterpea"]+\end{spec}+For those expressions that are ill-typed, explain why.+}+\end{exercise} +\out{+\begin{spec}+[ (2,3), (4,5) ]+[ D, 42 ]+( Ef, -42 )+simple 'a' 'b' 'c'+( simple 1 2 3, simple )+["hello","world"]+\end{spec}+}++\vspace{.1in}\hrule++\section{Abstraction, Abstraction, Abstraction}+\label{sec:abstraction}+\index{abstraction||(}++The title of this section is the answer to the question: ``What are+the three most important ideas in programming?'' Webster defines the+verb ``abstract'' as follows:+\begin{quote}+{\bf abstract}, \emph{vt} (1) remove, separate (2) to consider apart+from application to a particular instance.+\end{quote}+In programming this happens when a pattern repeats itself and we wish+to ``separate'' that pattern from the ``particular instances'' in+which it appears. In this textbook this process is called the+\emph{abstraction principle}.\index{abstraction!principle} The+following sections introduce several different kinds of abstraction,+using examples involving both simple numbers and arithmetic (things+everyone should be familiar with) as well as musical examples (that+are specific to Euterpea).++\subsection{Naming}+\index{abstraction!naming||(}++One of the most basic ideas in programming---for that matter, in every+day life---is to \emph{name} things. For example, we may wish to give+a name to the value of $\pi$, since it is inconvenient to retype (or+remember) the value of $\pi$ beyond a small number of digits. In+mathematics the greek letter $\pi$ in fact \emph{is} the name for this+value, but unfortunately we do not have the luxury of using greek+letters on standard computer keyboards and/or text editors. So in+Haskell we write:+\begin{spec}+pi :: Double+pi = 3.141592653589793+\end{spec}+to associate the name |pi| with the number 3.141592653589793. The+type signature in the first line declares |pi| to be a+\emph{double-precision floating-point number}, which mathematically+and in Haskell is distinct from an integer.\footnote{We will have more+ to say about floating-point numbers later.} Now the name |pi| can be+used in expressions whenever it is in scope; it is an abstract+representation, if you will, of the number 3.141592653589793.+Furthermore, if there is ever a need to change a named value (which+hopefully will not ever happen for |pi|, but could certainly happen+for other values), we would only have to change it in one place,+instead of in the possibly large number of places where it is used.++For a simple musical example, note first that in music theory, a+\emph{pitch} consists of a \emph{pitch class} and an \emph{octave}.+For example, in Euterpea we simply write |(A,4)| to represent the+pitch class |A| in the fourth octave. This particular note is called+``concert A'' (because it is often used as the note to which an+orchestra tunes its instruments) or ``A440'' (because its frequency is+440 cycles per second). Because this particular pitch is so common,+it may be desirable to give it a name, which is easily done in+Haskell, as was done above for $\pi$:+\begin{spec}+concertA, a440 :: (PitchClass, Octave)+concertA = (A,4) -- concert A+a440 = (A,4) -- A440+\end{spec}++\syn{This example demonstrates the use of program {\em+ \indexwd{comments}}. Any text to the right of ``{\tt --}'' till+ the end of the line is considered to be a programmer comment, and is+ effectively ignored. Haskell also permits {\em nested} comments+ that have the form |{- this is a comment -}| and can appear anywhere+ in a program, including across multiple lines.}++This example demonstrates the (perhaps obvious) fact that several+different names can be given to the same value---just as your brother+John might have the nickname ``Moose.'' Also note that the name+|concertA| requires more typing than |(A,4)|; nevertheless, it has+more mnemonic value, and, if mistyped, will more likely result in a+syntax error. For example, if you type ``|concrtA|'' by mistake, you+will likely get an error saying, ``Undefined variable,'' whereas if+you type ``|(A,5)|'' you will not.++\syn{This example also demonstrates that two names having the same+ type can be combined into the same type signature, separated by a+ comma. Note finally, as a reminder, that these are names of values,+ and thus they both begin with a lowercase letter.}++Consider now a problem whose solution requires writing some larger+expression more than once. For example:+\begin{spec}+x :: Float+x = f (pi*r**2) + g (pi*r**2)+\end{spec}++\syn{|(**)| is Haskell's floating-point exponentiation operator. Thus+ |pi*r**2| is analogous to $\pi r^2$ in mathematics. |(**)| has+ higher precedence than |(*)| and the other binary arithmetic+ operators in Haskell.}++Note in the definition of |x| that the expression |pi*r**2|+(presumably representing the area of a circle whose radius is |r|) is+repeated---it has two instances---and thus, applying the abstraction+principle, it can be separated from these instances. From the+previous examples, doing this is straightforward---it is called+\emph{naming}---so we might choose to rewrite the single equation+above as two:+\begin{spec}+area = pi*r**2+x = f area + g area+\end{spec}+If, however, the definition of |area| is not intended for use+elsewhere in the program, then it is advantageous to ``hide'' it+within the definition of |x|. This will avoid cluttering up the+namespace, and prevents |area| from clashing with some other value+named |area|. To achieve this, we could simply use a \indexwdkw{let}+expression:+\begin{spec}+x = let area = pi*r**2+ in f area + g area+\end{spec}+A {\bf let} expression restricts the \emph{visibility} of the names+that it creates to the internal workings of the {\bf let} expression+itself. For example, if we were to write:+\begin{spec}+area = 42+x = let area = pi*r**2+ in f area + g area+\end{spec}+then there is no conflict of names---the ``outer'' |area| is+completely different from the ``inner'' one enclosed in the {\bf let}+expression. Think of the inner |area| as analogous to the first name+of someone in your household. If your brother's name is ``John'' he+will not be confused with John Thompson who lives down the street when+you say, ``John spilled the milk.''++So you can see that naming---using either top-level equations or+equations within a {\bf let} expression---is an example of the+abstraction principle in action. +%% It is often the case, of course, that we \emph{anticipate} the need for+%% abstraction; for example, directly writing down the final solution+%% above, because we knew that we would need to use the expression+%% |a-b+2| more than once. +\index{abstraction!naming||)}++\syn{An equation such as |c = 42| is called a+\emph{\indexwd{binding}}. A simple rule to remember when programming in+Haskell is never to give more than one binding for the same name in a+context where the names can be confused, whether at the top level of+your program or nestled within a |let| expression. For example,+this is not allowed:+\begin{spec}+a = 42+a = 43+\end{spec}+nor is this:+\begin{spec}+a = 42+b = 43+a = 44+\end{spec}+}++% (On the other hand, as you will soon see, functions can be defined+% with multiple equations, each defining the function's behavior on a+% different kind of argument. But in such cases all of the equations+% for the same function must appear together (one after the other).)++\subsection{Functional Abstraction}+\label{sec:fun-abstract}+\index{abstraction!functional||(}++The design of functions such as |simple| can be viewed as the+abstraction principle in action. To see this using the example above+involving the area of a circle, suppose the original program looked+like this:+\begin{spec}+x :: Float+x = f (pi*r1**2) + g (pi*r2**2)+\end{spec}+Note that there are now two areas involved---one of a circle whose+radius is |r1|, the other |r2|. Now the expressions in parentheses+have a \emph{repeating pattern of operations}. In discerning the+nature of a repeating pattern it is sometimes helpful to first identify+those things that are \emph{not} repeating, i.e.\ those things that+are \emph{changing}. In the case above, it is the radius that is+changing. A repeating pattern of operations can be abstracted as a+\emph{function} that takes the changing values as arguments. Using+the function name |areaF| (for ``area function'') we can write:+\begin{spec}+x = let areaF r = pi*r**2+ in f (areaF r1) + g (areaF r2)+\end{spec}+This is a simple generalization of the previous example, where the+function now takes the ``variable quantity''---in this case the+radius---as an argument. A very simple proof by calculation, in which+|areaF| is unfolded where it is used, can be given to demonstrate that+this program is equivalent to the old.++This application of the abstraction principle is called+\emph{functional abstraction}, since a sequence of operations is+abstracted as a \emph{function} such as |areaF|. ++For a musical example, a few more concepts from Euterpea are first+introduced, concepts that are addressed more formally in the next+chapter:+\begin{enumerate}+\item+In music theory a \emph{note} is a \emph{pitch} combined with a+\emph{duration}. Duration is measured in beats, and in Euterpea has+type |Dur|. A note whose duration is one beat is called a whole note,+one with duration $\nicefrac{1}{2}$ is called a half note, and so on.+A note in Euterpea is the smallest entity, besides a rest, that is+actually a performable piece of music, and its type is |Music Pitch|+(other variations of this type will be introduced in later chapters).++\item+In Euterpea there are functions:+\begin{spec}+note :: Dur -> Pitch -> Music Pitch+rest :: Dur -> Music Pitch+\end{spec}+such that |note d p| is a note whose duration is |d| and pitch is |p|,+and |rest d| is a rest with duration |d|. For example, |note (1/4)+(A,4)| is a quarter note concert A.++\item+In Euterpea the following infix operators combine smaller |Music|+values into larger ones:+\begin{spec}+(:+:) :: Music Pitch -> Music Pitch -> Music Pitch+(:=:) :: Music Pitch -> Music Pitch -> Music Pitch+\end{spec}+Intuitively:+\begin{itemize}+\item |m1 :+: m2| is the music value that represents the playing of+ |m1| followed by |m2|.+\item |m1 :=: m2| is the music value that represents the playing of+ |m1| and |m2| simultaneously.+\end{itemize}++\item+Eutperepa also has a function |trans :: Int -> Pitch -> Pitch|+such that |trans i p| is a pitch that is |i| semitones (half steps, or+steps on a piano) higher than |p|.+\end{enumerate}++Now for the example. Consider the simple melody:+\begin{spec}+note qn p1 :+: note qn p2 :+: note qn p3+\end{spec}+where |qn| is a quarter note:+\begin{spec}+qn = 1/4+\end{spec}+Suppose we wish to harmonize each note with a note played a minor+third lower. In music theory, a minor third corresponds to three+semitones, and thus the harmonized melody can be written as:+\begin{spec}+mel = (note qn p1 :=: note qn (trans (-3) p1)) !:+: + (note qn p2 :=: note qn (trans (-3) p2)) !:+: + (note qn p3 :=: note qn (trans (-3) p3))+\end{spec}++Note as in the previous example a repeating pattern of+operations---namely, the operations that harmonize a single note with+a note three semitones below it. As before, to abstract a sequence of+operations such as this, a function can be defined that takes the+``variable quantities''---in this case the pitch---as arguments. We+can take this one step further, however, by noting that in some other+context we might wish to vary the duration. Recognizing this is to+\emph{anticipate} the need for abstraction. Calling this function+|hNote| (for ``harmonize note'') we can then write:+\begin{spec}+hNote :: Dur -> Pitch -> Music Pitch+hNote d p = note d p :=: note d (trans (-3) p)+\end{spec}+There are three instances of the pattern in |mel|, each of which can+be replaced with an application of |hNote|. This leads to:+\begin{spec}+mel :: Music Pitch+mel = hNote qn p1 :+: hNote qn p2 :+: hNote qn p3+\end{spec}+Again using the idea of unfolding described earlier in this chapter,+it is easy to prove that this definition is equivalent to the previous+one.++As with |areaF|, this use of |hNote| is an example of functional+abstraction. In a sense, functional abstraction can be seen as a+generalization of naming. That is, |area r1| is just a name for+|pi*r1**2|, |hNote d p| is just a name for |note d p :=: note d+(trans (-3) p)|, and so on. Stated another way, named quantities+such as |area|, |pi|, |concertA|, and |a440| defined earlier can be+thought of as functions with no arguments.++Of course, the definition of |hNote| could also be hidden within |mel|+using a |let| expression as was done in the previous example:+\begin{spec}+mel :: Music Pitch+mel = let hNote d p = note d p :=: note d (trans (-3) p)+ in hNote qn p1 :+: hNote qn p2 :+: hNote qn p3+\end{spec}++\subsection{Data Abstraction}+\label{sec:basic-list-abstraction}+\index{abstraction!data||(}++The value of |mel| is the sequential composition of three harmonized+notes. But what if in another situation we must compose together+five harmonized notes, or in other situations even more? In+situations where the number of values is uncertain, it is useful to+represent them in a \emph{data structure}. For the example at hand, a+good choice of data structure is a \emph{\indexwd{list}}, briefly+introduced earlier, that can have any length. The use of a data+structure motivated by the abstraction principle is one form of+\emph{data abstraction}.++Imagine now an entire list of pitches, whose length is not known at the+time the program is written. What now? It seems that a function is+needed to convert a list of pitches into a sequential composition of+harmonized notes. Before defining such a function, however, there is+a bit more to say about lists.++Earlier the example |[C,D,Ef]| was given, a list of pitch classes+whose type is thus |[PitchClass]|. A list with \emph{no} elements+is---not surprisingly---written |[]|, and is called the \emph{empty+ list}.++To add a single element |x| to the front of a list |xs|, we write+|x:xs| in Haskell. (Note the naming convention used here; |xs| is the+plural of |x|, and should be read that way.) For example, |C :+[D,Ef]| is the same as |[C,D,Ef]|. In fact, this list is equivalent+to |C:(D:(Ef:[]))|, which can also be written |C:D:Ef:[]| since the+infix operator |(:)| is right associative. \index{associativity}++\syn{In mathematics we rarely worry about whether the notation+ $a+b+c$ stands for $(a+b)+c$ (in which case $+$ would be ``left+ associative'') or $a+(b+c)$ (in which case $+$ would ``right+ associative''). This is because in situations where the parentheses+ are left out it is usually the case that the operator is+ \emph{mathematically} associative, meaning that it does not matter+ which interpretation is chosen. If the interpretation \emph{does}+ matter, mathematicians will include parentheses to make it clear.+ Furthermore, in mathematics there is an implicit assumption that+ some operators have higher \emph{precedence} than others; for+ example, $2\times a + b$ is interpreted as $(2\times a) + b$, not $2+ \times (a+b)$.++In many programming languages, including Haskell, each operator is+defined to have a particular precedence level and to be left+associative, right associative, or to have no associativity at all.+For arithmetic operators, mathematical convention is usually followed;+for example, |2*a+b| is interpreted as |(2*a)+b| in Haskell. The+predefined list-forming operator |(:)| is defined to be right+associative. Just as in mathematics, this associativity can be+overridden by using parentheses: thus |(a:b):c| is a valid Haskell+expression (assuming that it is well-typed; it must be a list of+lists), and is very different from |a:b:c|. A way to specify the+precedence and associativity of user-defined operators will be+discussed in a later chapter.}++%% [consider eliminating the next paragraph]++%% Examples of predefined functions defined on lists in Haskell include+%% \indexwdhs{head} and \indexwdhs{tail}, which return the ``head'' and+%% ``tail'' of a list, respectively. That is, |head (x:xs) ==> x| and+%% |tail (x:xs) ==> xs| (we will define these two functions formally+%% in Section \ref{sec:poly-types}). Another example is the function+%% |(++)| which \emph{concatenates}, or \emph{appends}, together its two+%% list arguments. For example, +%% |[1,2,3] ++ [4,5,6] ==> [1,2,3,4,5,6]| (|(++)| will be defined+%% in Section \ref{sec:append}). \indexhs{(++)}++Returning now to the problem of defining a function (call it |hList|)+to turn a list of pitches into a sequential composition of harmonized+notes, we should first express what its type should be:+\begin{spec}+hList :: Dur -> [Pitch] -> Music Pitch+\end{spec}+To define its proper behavior, it is helpful to consider, one by one,+all possible cases that could arise on the input. First off, the list+could be empty, in which case the sequential composition should be a+|Music Pitch| value that has zero duration. So:+\begin{spec}+hList d [] = rest 0+\end{spec}++The other possibility is that the list \emph{is not} empty---i.e.\ it+contains at least one element, say |p|, followed by the rest of the+elements, say |ps|. In this case the result should be the+harmonization of |p| followed by the sequential composition of the+harmonization of |ps|. Thus:+\begin{spec}+hList d (p:ps) = hNote d p :+: hList d ps+\end{spec}+Note that this part of the definition of |hList| is+\emph{recursive}---it refers to itself! But the original+problem---the harmonization of |p:ps|---has been reduced to the+harmonization of |p| (previously captured in the function |hNote|) and+the harmonization of |ps| (a slightly smaller problem than the+original one).++Combining these two equations with the type signature yields the+complete definition of the function |hList|:+\begin{spec}+hList :: Dur -> [Pitch] -> Music Pitch+hList d [] = rest 0+hList d (p:ps) = hNote d p :+: hList d ps+\end{spec}+\index{pattern!matching}++Recursion is a powerful technique that will be used many times in this+textbook. It is also an example of a general problem-solving+technique where a large problem is broken down into several smaller+but similar problems; solving these smaller problems one-by-one leads+to a solution to the larger problem. \index{recursion}++\syn{Although intuitive, this example highlights an important aspect+of Haskell: \emph{pattern matching}. The left-hand sides of+the equations contain \emph{patterns} such as |[]| and |x:xs|.+When a function is applied, these patterns are \emph{matched} against+the argument values in a fairly intuitive way (|[]| only matches+the empty list, and |p:ps| will successfully match any list with at+least one element, while naming the first element |p| and the rest+of the list |ps|). If the match succeeds, the right-hand side is+evaluated and returned as the result of the application. If it fails,+the next equation is tried, and if all equations fail, an error+results. All of the equations that define a particular function must+appear together, one after the other.++Defining functions by pattern matching is quite common in Haskell, and+you should eventually become familiar with the various kinds of+patterns that are allowed; see Appendix \ref{ch:patterns} for a+concise summary.} \index{pattern}++%% This is called a \emph{recursive} function definition since |hList|+%% ``refers to itself'' on the right-hand side of the second equation.++Given this definition of |hList| the definition of |mel| can be+rewritten as:+\begin{spec}+mel = hList qn [p1, p2, p3]+\end{spec}++We can prove that this definition is equivalent to the old via+calculation:+\begin{spec}+mel = hList qn [p1, p2, p3]+==> hList qn (p1:p2:p3:[])+==> hNote qn p1 :+: hList qn (p2:p3:[])+==> hNote qn p1 :+: hNote qn p2 :+: hList qn (p3:[])+==> hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: hList qn []+==> hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: rest 0+\end{spec}+The first step above is not really a calculation, but rather a+rewriting of the list syntax. The remaining calculations each+represent an unfolding of |hList|. +\index{abstraction!data||)}+\index{abstraction||)}++Lists are perhaps the most commonly used data structure in Haskell,+and there is a rich library of functions that operate on them. In+subsequent chapters lists will be used in a variety of interesting+computer music applications.++\vspace{.1in}\hrule++\begin{exercise}{\em+Modify the definitions of |hNote| and |hList| so that they each take+an extra argument that specifies the interval of harmonization (rather+than being fixed at -3). Rewrite the definition of |mel| to take these+changes into account.}+\end{exercise}++\vspace{.1in}\hrule++\section{Haskell Equality vs.\ Euterpean Equality}++The astute reader will have objected to the proof just completed,+arguing that the original version of |mel|:+\begin{spec}+hNote qn p1 :+: hNote qn p2 :+: hNote qn p3+\end{spec}+is not the same as the terminus of the above proof:+\begin{spec}+hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: rest 0+\end{spec}+Indeed, that reader would be right! As Haskell values, these+expressions are \emph{not} equal, and if you printed each of them you+would get different results. So what happened? Did proof by+calculation fail?++No, proof by calculation did not fail, since, as just pointed out,+as Haskell values these two expressions are not the same, and proof by+calculation is based on the equality of Haskell values. The problem+is that a ``deeper'' notion of equivalence is needed, one based on the+notion of \emph{musical} equality. Adding a rest of zero duration to+the beginning or end of any piece of music should not change what we+\emph{hear}, and therefore it seems that the above two expressions are+\emph{musically} equivalent. But it is unreasonable to expect Haskell+to figure this out for the programmer!++As an analogy, consider the use of an ordered list to represent a set+(which is unordered). The Haskell values |[x1,x2]| and |[x2,x1]| are+not equal, yet in a program that ``interprets'' them as sets, they+\emph{are} equal.++The way this problem is approached in Euterpea is to formally define a+notion of \emph{musical interpretation}, from which the notion+of \emph{musical equivalence} is defined. This leads to a kind of+``algebra of music'' that includes, among others, the following axiom:+\begin{spec}+m :+: rest 0 === m+\end{spec}+The operator |(===)| should be read, ``is musically equivalent to.''+With this axiom it is easy to see that the original two expressions+above \emph{are} in fact musically equivalent.++For a more extreme example of this idea, and to entice the reader to+learn more about musical equivalence in later chapters, note that+|mel|, given pitches |p1 = Ef|, |p2 = F|, |p3 = G|, and duration |d =+1/4|, generates the harmonized melody shown in Figure \ref{fig:mel};+we can write this concretely in Euterpea as:+\begin{spec}+mel1 = (note (1/4) (Ef, 4) :=: note (1/4) (C,4)) !:+:+ (note (1/4) (F, 4) :=: note (1/4) (D,4)) !:+:+ (note (1/4) (G, 4) :=: note (1/4) (E,4))+\end{spec}+The definition of |mel1| can then be seen as a \emph{polyphonic}+interpretation of the musical phrase in Figure \ref{fig:mel}, where+each pair of notes is seen as a harmonic unit. In contrast, a+\emph{contrapuntal} interpretation sees two independent \emph{lines},+or \emph{voices}, in this case the line $\langle$E$\flat$,F,G$\rangle$+and the line $\langle$C,D,E$\rangle$. In Euterpea we can write this+as:+\begin{spec}+mel2 = (note (1/4) (Ef, 4) :+: note (1/4) (F,4) :+: note (1/4) (G,4))+ :=:+ (note (1/4) (C, 4) :+: note (1/4) (D,4) :+: note (1/4) (E,4))+\end{spec}+|mel1| and |mel2| are clearly not equal as Haskell values. Yet if+they are played, they will \emph{sound} the same---they are, in the+sense described earlier, \emph{musically equivalent}. But proving+these two phrases musically equivalent will require far more than a+simple axiom involving |rest 0|. In fact this can be done in an+elegant way, using the algebra of music developed in Chapter+\ref{ch:algebra}.++\begin{figure*}+%% \includegraphics{pics/threenoteharm.pdf}+\centerline{+\epsfysize=0.6in +\epsfbox{pics/threenoteharm.eps}+}+\caption{Polyphonic vs.\ Contrapuntal Interpretation}+\label{fig:mel}+\end{figure*}++\section{Code Reuse and Modularity}+\label{sec:code-reuse}++There does not seem to be much repetition in the last definition of+|hList|, so perhaps the end of the abstraction process has been+reached. In fact, it is worth considering how much progress has been+made. The original definition:+\begin{spec}+mel = (note qn p1 :=: note qn (trans (-3) p1)) !:+: + (note qn p2 :=: note qn (trans (-3) p2)) !:+: + (note qn p3 :=: note qn (trans (-3) p3))+\end{spec}+was replaced with:+\begin{spec}+mel = hList qn [p1, p2, p3]+\end{spec}+But additionally, definitions for the auxiliary functions |hNote| and+|hList| were introduced:+\begin{spec}+hNote :: Dur -> Pitch -> Music Pitch+hNote d p = note d p :=: note d (trans (-3) p)++hList :: Dur -> [Pitch] -> Music Pitch+hList d [] = rest 0+hList d (p:ps) = hNote d p :+: hList d ps+\end{spec}+In terms of code size, the final program is actually larger than the+original! So has the program improved in any way?++Things have certainly gotten better from the standpoint of ``removing+repeating patterns,'' and we could argue that the resulting program+therefore is easier to understand. But there is more. Now that+auxiliary functions such as |hNote| and |hList| have been defined, we+can \emph{reuse} them in other contexts. Being able to reuse code is+also called \emph{\indexwd{modularity}}, since the reused components+are like little modules, or building blocks, that can form the+foundation of many applications.\footnote{``Code reuse'' and+ ``modularity'' are important software engineering principles.} In a+later chapter, techniques will be introduced---most notably,+\emph{higher-order functions} and \emph{polymorphism}---for improving+the modularity of this example even more, and substantially increasing+the ability to reuse code.++\section{[Advanced] Programming with Numbers}+\label{sec:numbers-caveat}+\index{number systems||(}++In computer music programming, it is often necessary to program with+numbers. For example, it is often convenient to represent pitch on a+simple absolute scale using integer values. And when computing with+analog signals that represent a particular sound wave, it is necessary+to use floating point numbers as an approximation to the reals. So it+is a good idea to understand precisely how numbers are represented+inside a computer, and within a particular language such as Haskell.++In mathematics there are many different kinds of number systems. For+example, there are integers, natural numbers (i.e.\ non-negative+integers), real numbers, rational numbers, and complex numbers. These+number systems possess many useful properties, such as the fact that+multiplication and addition are commutative, and that multiplication+distributes over addition. You have undoubtedly learned many of these+properties in your studies, and have used them often in algebra,+geometry, trigonometry, physics, and so on.++Unfortunately, each of these number systems places great demands on+computer systems. In particular, a number can in general require an+\emph{arbitrary amount of memory} to represent it. Clearly, for+example, an irrational number such as $\pi$ cannot be represented+exactly; the best we can do is approximate it, or possibly write a+program that computes it to whatever (finite) precision is needed in a+given application. But even integers (and therefore rational numbers)+present problems, since any given integer can be arbitrarily large.++Most programming languages do not deal with these problems very well.+In fact, most programming languages do not have exact forms of many of+these number systems. Haskell does slightly better than most, in that+it has exact forms of integers (the type \indexwdhs{Integer}) as well+as rational numbers (the type \indexwdhs{Rational}, defined in the+Ratio Library). But in Haskell and most other languages there is no+exact form of real numbers, for example, which are instead+approximated by \emph{floating-point numbers} with either single-word+precision (\indexwdhs{Float} in Haskell) or double-word precision+(\indexwdhs{Double}). Even worse, the behavior of arithmetic+operations on floating-point numbers can vary somewhat depending on+what kind of computer is being used, although hardware standardization+in recent years has reduced the degree of this problem.++The bottom line is that, as simple as they may seem, great care must+be taken when programming with numbers. Many computer errors, some+quite serious and renowned, were rooted in numerical incongruities.+The field of mathematics known as \emph{ \indexwd{numerical analysis}} is+concerned precisely with these problems, and programming with+floating-point numbers in sophisticated applications often requires a+good understanding of numerical analysis to devise proper algorithms+and write correct programs.++As a simple example of this problem, consider the distributive law,+expressed here as a calculation in Haskell, and used earlier in+this chapter in calculations involving the function |simple|:+\begin{spec}+a*(b+c) ==> a*b + a*c+\end{spec}+For most floating-point numbers, this law is perfectly valid. For+example, in the GHC implementation of Haskell, the expressions+|pi*(3+4) :: Float| and |pi*3+pi*4 :: Float| both yield the same+result: 21.99115. But funny things can happen when the magnitude of+|b+c| differs significantly from the magnitude of either |b| or+|c|. For example, the following two calculations are from GHC:+\begin{spec}+5*(-0.123456 + 0.123457) :: Float ==> 4.991889e-6+5*(-0.123456) + 5*(0.123457) :: Float ==> 5.00679e-6+\end{spec}+Although the discrepancy here is small, its very existence is+worrisome, and in certain situations it could be disastrous. The+precise behavior of floating-point numbers will not be discussed+further in this textbook. Just remember that they are+\emph{approximations} to the real numbers. If real-number accuracy is+important to your application, further study of the nature of+floating-point numbers is probably warranted.++On the other hand, the distributive law (and many others) is valid in+Haskell for the exact data types |Integer| and |Ratio Integer|+(i.e.\ rationals). Although the representation of an |Integer| in+Haskell is not normally something to be concerned about, it should be+clear that the representation must be allowed to grow to an arbitrary+size. For example, Haskell has no problem with the following number:+\begin{spec}+veryBigNumber :: Integer+veryBigNumber = 43208345720348593219876512372134059+\end{spec}+and such numbers can be added, multiplied, etc.\ without any loss of+accuracy. However, such numbers cannot fit into a single word of+computer memory, most of which are limited to 32 or 64 bits. Worse,+since the computer system does not know ahead of time exactly how many+words will be required, it must devise a dynamic scheme to allow just+the right number of words to be used in each case. The overhead of+implementing this idea unfortunately causes programs to run slower.++For this reason, Haskell (and most other languages) provides another+integer data type called \indexwdhs{Int} that has maximum and minimum+values that depend on the word-size of the particular computer being+used. In other words, every value of type |Int| fits into one word of+memory, and the primitive machine instructions for binary numbers can+be used to manipulate them efficiently.\footnote{The Haskell Report+ requires that every implementation support |Int|s at least in the+ range $-2^{29}$ to $2^{29}-1$, inclusive. The GHC implementation+ running on a 32-bit processor, for example, supports the range+ $-2^{31}$ to $2^{31}-1$.} Unfortunately, this means that+\emph{overflow} or \emph{underflow} errors could occur when an |Int|+value exceeds either the maximum or minimum values. Sadly, most+implementations of Haskell (as well as most other languages) do not+tell you when this happens. For example, in GHC running on a 32-bit+processor, the following |Int| value:+\begin{spec}+i :: Int+i = 1234567890+\end{spec}+works just fine, but if you multiply it by two, GHC returns the value+|-1825831516|! This is because twice |i| exceeds the maximum allowed+value, so the resulting bits become nonsensical,\footnote{Actually,+ these bits are perfectly sensible in the following way: the 32-bit+ binary representation of |i| is 01001001100101100000001011010010,+ and twice that is 10010011001011000000010110100100. But the latter+ number is seen as negative because the 32nd bit (the highest-order+ bit on the CPU on which this was run) is a one, which means it is a+ negative number in ``twos-complement'' representation. The+ twos-complement of this number is in turn+ 01101100110100111111101001011100, whose decimal representation is+ 1825831516.} and are interpreted in this case as a negative number+of the given magnitude.++This is alarming! Indeed, why should anyone ever use |Int| when+|Integer| is available? The answer, as implied earlier, is+efficiency, but clearly care should be taken when making this choice.+If you are indexing into a list, for example, and you are confident+that you are not performing index calculations that might result in+the above kind of error, then |Int| should work just fine, since a+list longer than $2^{31}$ will not fit into memory anyway! But if you+are calculating the number of microseconds in some large time+interval, or counting the number of people living on earth, then+|Integer| would most likely be a better choice. Choose your number+data types wisely!++In this textbook the numeric data types |Integer|, |Int|, |Float|,+|Double|, |Rational|, and |Complex| will be used for a variety of+different applications; for a discussion of the other number types,+consult the Haskell Report. As these data types are used, there will+be little discussion about their properties---this is not, after all,+a book on numerical analysis---but a warning will be cast whenever+reasoning about, for example, floating-point numbers, in a way that+might not be technically sound. \index{number systems||)}++%% ---++\out{+\section{Qualified Types}+\label{sec:qualified-types}++A polymorphic type such as |(a->a)| can be viewed as shorthand for+$\forall($|a|$)|a->a|$, which can be read ``\emph{for all} types |a|,+functions mapping elements of type |a| to elements of type |a|.''+Note the emphasis on ``\emph{for all}.''++In practice, however, there are times when we would prefer to limit a+polymorphic type to a smaller number of possibilities. A good example+is a function such as |(+)|. It is probably not a good idea to limit+|(+)| to a \emph{single} (that is, \emph{monomorphic}) type such as+|Integer->Integer->Integer|, since there are other kinds of+numbers---such as rational and floating-point numbers---that we would+like to perform addition on as well. Nor is it a good idea to have a+different addition function for each type of number that we wish to+add, since that would require giving each a different name, such as+|addInteger|, |addRational|, |addFloat|, etc. And, unfortunately,+giving |(+)| a type such as |a->a->a| will not work, since this would+imply that we could add things other than numbers, such as+characters, pitch classes, lists, tuples, functions, and any type that+you might define on your own!++\index{type!qualified} \index{class} ++Haskell provides a solution to this problem through the use of {\em+ qualified types}. Conceptually, it is helpful to think of a+qualified type just as a polymorphic type, except that in place of+``\emph{for all} types |a|'' it will be possible to say ``for all+types |a| \emph{that are members of the type class} |C|,'' where the+type class |C| can be thought of as a set of types. For example,+suppose there is a type class \indexwdhs{Num} with members |Integer|,+|Rational|, and |Float|. Then an accurate type for |(+)| is+$\forall($|a|$\in$|Num|$)$|a -> a -> a|. But in Haskell, instead of+writing $\forall(|a|\in|Num|)\cdots$, the notation |Num a =>|$\cdots$+is used. So the proper type signature for |(+)| is:+\begin{spec}+(+) :: Num a => a -> a -> a+\end{spec}+which should be read: ``for all types |a| that are members of the type+class |Num|, |(+)| has type |a -> a -> a|.'' Members of a type class+are also called \emph{instances} of the class, and these two terms+will be used interchangeably in the remainder of the text. The |Num a+=>|$\cdots$ part of the type signature is often called a+\emph{context}, or \emph{constraint}.++\index{class}+\syn{It is important not to confuse |Num| with a data type or a+constructor within a data type, even though the same syntax +(``|Num a|'') is used. |Num| is a \emph{type class}, and the+context of its use (namely, to the left of a |=>|) is always+sufficient to determine this fact.}++\begin{figure}+\begin{tabular}{||||l||l||l||||} \hline+{\bf Type} & {\bf Key} & {\bf Key} \\+{\bf Class} & {\bf functions} & {\bf instances} \\+\hline+|Num| & |(+),(-),(*) :: Num a => a->a->a| & |Integer, Int, Float, Double,| \\ + & |negate :: Num a => a->a| & |Rational| \\++\hline+|Eq| & |(==),(/=) :: Eq a => a->a->Bool| & |Integer, Int, Float, Double,| \\+&& |Rational, Char, Bool, ... | \\+\hline+|Ord| & |(>),(<),(>=),(<=) ::| & |Integer, Int, Float, Double,| \\+ & \ \ \ \ |Ord a => a->a->Bool| & |Rational, Char, Bool, ... | \\+ & |max,min :: Ord a => a->a->Bool| & \\+\hline+|Enum| & |succ,pred :: Enum a => a->a| & |Integer, Int, Float, Double,| \\+ & also enables arithmetic sequences & |Rational, Char, Bool, ... | \\+\hline+|Show| & |show :: Show a => a -> String| & Almost every type except \\+ & & for functions \\+\hline+|Read| & |read :: Read a => String -> a| & Almost every type except \\+ & & for functions \\+\hline+\end{tabular}+\caption{Common Type Classes and Their Instances}+\label{fig:common-type-classes}+\end{figure}++Recall now the type signature previously given for |simple|:+\begin{spec}+simple :: Integer -> Integer -> Integer -> Integer+simple x y z = x*(y+z)+\end{spec}+Note that |simple| uses the operator |(+)| discussed above. It also+uses |(*)|, whose type is the same as that for |(+)|:+\begin{spec}+(*) :: Num a => a -> a -> a+\end{spec}+This suggests that a more general type for |simple| is:+\begin{spec}+simple :: Num a => a -> a -> a -> a+simple x y z = x*(y+z)+\end{spec}+Indeed, this is the preferred, most general type that can be given for+|simple|. It can now be used with any type that is a member of the+|Num| class, which includes |Integer|, |Int|, |Rational|, |Float| and+|Double|, among others.++The ability to qualify polymorphic types is a unique feature of+Haskell, and, as you will soon see, provides great expressiveness. In+particular, you will see that it is possible to define your own type+class and its members. For now, all you need to know is that some+functions and operators are predefined to be instances of certain+type classes, such as |(+)| and |(*)| above. Table+\ref{fig:common-type-classes} shows a number of others. For example,+the |Show| class allows us to convert values to strings:+\begin{spec}+show D ==> "D"+show concertA ==> "(A,4)"+show (simple 3 9 5) ==> "42"+\end{spec}+The |Read| class allows us to go the other way around:+\begin{spec}+read "D" ==> D+read "(A,4)" ==> (A,4)+read "42" ==> 42+\end{spec}+The |Eq| class allows testing values for equality:+\begin{spec}+simple 3 9 5 == 42 ==> True+concertA == (A,5) ==> False+\end{spec}+And the |Ord| class has relational operators for types whose values+can be ordered:+\begin{spec}+simple 3 9 5 > 41 ==> True+max 42 27 ==> 42+'a' < 'b' ==> True+\end{spec}+The |Enum| class allows us to use \emph{arithmetic sequences}, which+will be explained in a later chapter.+}
+ HSoM/LSystems.lhs view
@@ -0,0 +1,485 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/LSystems.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter[L-Systems and Generative Grammars] +{Musical L-Systems and Generative Grammars} +\label{ch:lsystems} + +\begin{code} +module Euterpea.Examples.LSystems where + +import Euterpea +import Data.List hiding (transpose) +import System.Random +\end{code} + +\section{Generative Grammars} +\label{sec:grammars} + +A \emph{grammar} describes a \emph{formal language}. One can either +design a \emph{recognizer} (or \emph{parser}) for that language, or +design a \emph{generator} that generates sentences in that language. +We are interested in using grammars to generate music, and thus we are +only interested in generative grammars. + +A generative grammar is a four-tuple $(N,T,n,P)$, where: +\begin{itemize} +\item $N$ is the set of \emph{non-terminal symbols}. +\item $T$ is the set of \emph{terminal symbols}. +\item $n$ is the \emph{initial symbol}. +\item $P$ is a set of \emph{production rules}, where each production + rule is a pair $(X,Y)$, often written $X \rightarrow Y$. $X$ and + $Y$ are sentences (or \emph{sentential forms}) formed over the + alphabet $N \cup T$, and $X$ contains at least one non-terminal. +\end{itemize} + +A \emph{Lindenmayer system}, or \emph{L-system}, is an example of a +generative grammer, but is different in two ways: +\begin{enumerate} +\item The \emph{sequence} of sentences is as important as the + individual sentences, and +\item A new sentence is generated from the previous one by applying as + many productions as possible on each step---a kind of ``parallel + production.'' +\end{enumerate} + +Lindenmayer was a biologist and mathematician, and he used L-systems +to describe the growth of certain biological organisms (such as +plants, and in particular algae). + +We will limit our discussion to L-systems that have the following +additional characteristics: +\begin{enumerate} +\item They are \emph{context-free}: the left-hand side of each + production (i.e.\ $X$ above) is a single non-terminal. +\item No distinction is made between terminals and non-terminals (with + no loss of expressive power---why?). +\end{enumerate} + +We will consider both \emph{deterministic} and \emph{non-deterministic} +grammars. A deterministic grammar has exactly one production +corresponding to each non-terminal symbol in the alphabet, whereas a +non-deterministic grammar may have more than one, and thus we will +need some way to choose between them. + +\subsection{A Simple Implementation} + +A framework for simple, context-free, deterministic grammars can be +designed in Haskell as follows. We represent the set of productions +as a list of symbol/list-of-symbol pairs: +\begin{code} + +data DetGrammar a = DetGrammar a -- start symbol + [(a,[a])] -- productions + deriving Show +\end{code} +To generate a succession of ``sentential forms,'' we need to define a +function that, given a grammar, returns a list of lists of symbols: +\begin{code} +detGenerate :: Eq a => DetGrammar a -> [[a]] +detGenerate (DetGrammar st ps) = iterate (concatMap f) [st] + where f a = maybe [a] id (lookup a ps) +\end{code} + +\syn{|maybe| is a convenient function for conditionally giving a + result based on the structure of a value of type |Maybe a|. It is + defined in the Standard Prelude as: +\begin{spec} +maybe :: b -> (a -> b) -> Maybe a -> b +maybe _ f (Just x) = f x +maybe z _ Nothing = z +\end{spec} + +|lookup :: Eq a => a -> [(a,b)] -> Maybe b| is a convenient function +for finding the value associated with a given key in an association +list. For example: +\begin{spec} +lookup 'b' [('a',0),('b',1),('c',2)] ==> Just 1 +lookup 'd' [('a',0),('b',1),('c',2)] ==> Nothing +\end{spec} +} +%% |lookup| is defined in the Standard Prelude as: +%% \begin{spec} +%% lookup :: (Eq a) => a -> [(a,b)] -> Maybe b +%% lookup _ [] = Nothing +%% lookup key ((x,y):xys) +%% | key == x = Just y +%% | otherwise = lookup key xys +%% \end{spec} + +Note that we expand each symbol ``in parallel'' at each step, using +|concatMap|. The repetition of this process at each step is achieved +using |iterate|. Note also that a list of productions is essentially +an \emph{association list}, and thus the |Data.List| library function +|lookup| works quite well in finding the production rule that we seek. +Finally, note once again how the use of higher-order functions makes +this definition concise yet efficient. + +As an example of the use of this simple program, a Lindenmayer grammer +for red algae (taken from \cite{}) is given by: +\begin{code} +redAlgae = DetGrammar 'a' + [ ('a',"b|c"), ('b',"b"), ('c',"b|d"), + ('d',"e\\d"), ('e',"f"), ('f',"g"), + ('g',"h(a)"), ('h',"h"), ('|',"|"), + ('(',"("), (')',")"), ('/',"\\"), + ('\\',"/") + ] +\end{code} +%% a -> bc +%% c -> bd +%% d -> e\d +%% e -> f +%% f -> g +%% g -> h(a) +%% \ -> / +%% / -> \ + +\syn{Recall that |'\\'| is how the backslash character is written in + Haskell, because a single backslash is the ``escape'' character for + writing special characters such as newline (|'\n'|), tab (|'\t'|), + and so on. Since the backslash is used in this way, it also is a + special character, and must be escaped using itself, i.e.\ |'\\'|. } + +Then |detGenerate redAlgae| gives us the result that we want---or, to +make it look nicer, we could do: +\begin{code} +t n g = sequence_ (map putStrLn (take n (detGenerate g))) +\end{code} +For example, |t 10 redAlgae| yields: +\begin{verbatim} +a +b|c +b|b|d +b|b|e\d +b|b|f/e\d +b|b|g\f/e\d +b|b|h(a)/g\f/e\d +b|b|h(b|c)\h(a)/g\f/e\d +b|b|h(b|b|d)/h(b|c)\h(a)/g\f/e\d +b|b|h(b|b|e\d)\h(b|b|d)/h(b|c)\h(a)/g\f/e\d +\end{verbatim} + +\todo{Include a graphical rendering of the red algae.} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Define a function |strToMusic :: AbsPitch -> Dur -> String -> Music +Pitch| that interprets the strings generated by |redAlgae| as music. +Specifically, |strToMusic ap d str| interprets the string |str| in the +following way: +\begin{enumerate} +\item +Characters |'a'| through |'h'| are interpreted as notes, each with +duration |d| and absolute pitches |ap|, |ap+2|, |ap+4|, |ap+5|, +|ap+7|, |ap+9|, |ap+11|, and |ap+12|, respectively (i.e.\ a major +scale). +\item +|'||'| is interpreted as a no-op. +\item +|'/'| and |'\\'| are both interpreted as a rest of length |d|. +\item +|'('| is interpreted as a transposition by 5 semitones (a perfect fourth). +\item +|')'| is interpreted as a transposition by -5 semitones. +\end{enumerate} } +\end{exercise} + +\begin{exercise}{\em Design a function |testDet :: Grammar a -> Bool| + such that |testDet g| is |True| if |g| has exactly one rule for + each of its symbols; i.e.\ it is deterministic. Then modify the + |generate| function above so that it returns an error if a grammer + not satisfying this constraint is given as argument.} +\end{exercise} + +\vspace{.1in}\hrule + +\subsection{A More General Implementation} + +The design given in the last section only captures deterministic +context-free grammars, and the generator considers only parallel +productions that are charactersitic of L-Systems. + +We would also like to consider non-deterministic grammars, where a +user can specify the probability that a particular rule is selected, +as well as possibly non-context free (i.e.\ context sensitive) +grammars. Thus we will represent a generative grammar a bit more +abstractly, as a data structure that has a starting sentence in an +(implicit, polymorphic) alphabet, and a list of production rules: +\begin{code} +data Grammar a = Grammar a -- start sentence + (Rules a) -- production rules + deriving Show +\end{code} +The production rules are instructions for converting sentences in the +alphabet to other sentences in the alphabet. A rule set is either a +set of uniformly distributed rules (meaning that those with the same +left-hand side have an equal probability of being chosen), or a set of +stochastic rules (each of which is paired with a probabilty). A +specific rule consists of a left-hand side and a right-hand side. +\begin{code} +data Rules a = Uni [Rule a] + | Sto [(Rule a, Prob)] + deriving (Eq, Ord, Show) + +data Rule a = Rule { lhs :: a, rhs :: a } + deriving (Eq, Ord, Show) + +type Prob = Double +\end{code} + +One of the key sub-problems that we will have to solve is how to +probabilistically select a rule from a set of rules, and use that rule +to expand a non-terminal. We define the following type to capture +this process: +\begin{code} +type ReplFun a = [[(Rule a, Prob)]] -> (a, [Rand]) -> (a, [Rand]) +type Rand = Double +\end{code} +The idea here is that a function |f :: ReplFun a| is such that |f rules +(s,rands)| will return a new sentence |s'| in which each symbol in |s| +has been replaced according to some rule in |rules| (which are grouped +by common left-hand side). Each rule is chosen probabilitically based +on the random numbers in |rands|, and thus the result also includes a +new list of random numbers to account for those ``consumed'' by the +replacement process. + +With such a function in hand, we can now define a function that, given +a grammar, generates an infinite list of the sentences produced by +this replacement process. Because the process is non-deterministic, +we also pass a seed (an integer) to generate the initial pseudo-random +number sequence to give us repeatable results. +\begin{code} +gen :: Ord a => ReplFun a -> Grammar a -> Int -> [a] +gen f (Grammar s rules) seed = + let Sto newRules = toStoRules rules + rands = randomRs (0.0,1.0) (mkStdGen seed) + in if checkProbs newRules + then generate f newRules (s,rands) + else (error "Stochastic rule-set is malformed.") +\end{code} + +|toStoRules| converts a list of uniformly distributed rules to an +equivalent list of stochastic rules. Each set of uniform rules with +the same LHS is converted to a set of stochastic rules in which the +probability of each rule is one divided by the number of uniform +rules. + +\begin{code} +toStoRules :: (Ord a, Eq a) => Rules a -> Rules a +toStoRules (Sto rs) = Sto rs +toStoRules (Uni rs) = + let rs' = groupBy (\r1 r2 -> lhs r1 == lhs r2) (sort rs) + in Sto (concatMap insertProb rs') + +insertProb :: [a] -> [(a, Prob)] +insertProb rules = let prb = 1.0 / fromIntegral (length rules) + in zip rules (repeat prb) +\end{code} + +\syn{|groupBy :: (a->a->Bool) -> [a] -> [[a]]| is a |Data.List| + library function that behaves as follows: |groupBy eqfn xs| returns + a list of lists such that all elements in each sublist are ``equal'' + in the sense defined by |eqfn|.} + +|checkProbs| takes a list of production rules and checks whether, for +every rule with the same LHS, the probabilities sum to one (plus or +minus some epsilon, currenty set to |0.001|). +\begin{code} +checkProbs :: (Ord a, Eq a) => [(Rule a, Prob)] -> Bool +checkProbs rs = and (map checkSum (groupBy sameLHS (sort rs))) + +eps = 0.001 + +checkSum :: [(Rule a, Prob)] -> Bool +checkSum rules = let mySum = sum (map snd rules) + in abs (1.0 - mySum) <= eps + +sameLHS :: Eq a => (Rule a, Prob) -> (Rule a, Prob) -> Bool +sameLHS (r1,f1) (r2,f2) = lhs r1 == lhs r2 +\end{code} + +|generate| takes a replacement function, a list of rules, a starting +sentence, and a source of random numbers. It returns an infinite list +of sentences. +\begin{code} +generate :: Eq a => + ReplFun a -> [(Rule a, Prob)] -> (a,[Rand]) -> [a] +generate f rules xs = + let newRules = map probDist (groupBy sameLHS rules) + probDist rrs = let (rs,ps) = unzip rrs + in zip rs (tail (scanl (+) 0 ps)) + in map fst (iterate (f newRules) xs) +\end{code} + +A key aspect of the |generate| algorithm above is to compute the +\emph{probability density} of each successive rule, which is +basically the sum of its probability plus the probabilities of all +rules that precede it. + +\section{An L-System Grammar for Music} +\label{sec:musical-lsystem} + +The previous section gave a generative framework for a generic +grammar. For a musical L-system we will define a specific grammar, +whose sentences are defined as follows. A musical L-system sentence +is either: +\begin{itemize} +\item A non-terminal symbol |N a|. +\item A sequential composition |s1 :+ s2|. +\item A functional composition |s1 :. s2|. +\item The symbol |Id|, which will eventually be interpeted as the + identity function. +\end{itemize} +We capture this in the |LSys| data type: +\begin{code} +data LSys a = N a + | LSys a :+ LSys a + | LSys a :. LSys a + | Id + deriving (Eq, Ord, Show) +\end{code} +The idea here is that sentences generated from this grammar are +relative to a starting note, and thus the above constructions will be +interpreted as functions that take that starting note as an argument. +This will all become clear shortly, but first we need to define a +replacement function for this grammar. + +We will treat |(:+)| and |(:.)| as binary branches, and recursively +traverse each of their arguments. We will treat |Id| as a constant that +never gets replaced. Most importantly, each non-terminal of the form +|N x| could each be the left-hand side of a rule, so we call the +function |getNewRHS| to generate the replacement term for it. + +\begin{code} +replFun :: Eq a => ReplFun (LSys a) +replFun rules (s, rands) = + case s of + a :+ b -> let (a',rands') = replFun rules (a, rands ) + (b',rands'') = replFun rules (b, rands') + in (a' :+ b', rands'') + a :. b -> let (a',rands') = replFun rules (a, rands ) + (b',rands'') = replFun rules (b, rands') + in (a' :. b', rands'') + Id -> (Id, rands) + N x -> (getNewRHS rules (N x) (head rands), tail rands) +\end{code} + +%% Note the use of |filter| to select only the rules whose left-hand +%% side matches the non-terminal. + +|getNewRHS| is defined as: +\begin{code} +getNewRHS :: Eq a => [[(Rule a, Prob)]] -> a -> Rand -> a +getNewRHS rrs ls rand = + let loop ((r,p):rs) = if rand <= p then rhs r else loop rs + loop [] = error "getNewRHS anomaly" + in case (find (\ ((r,p):_) -> lhs r == ls) rrs) of + Just rs -> loop rs + Nothing -> error "No rule match" +\end{code} + +\syn{|find :: (a->Bool) -> [a] -> Maybe a| is another |Data.List| + function that returns the first element of a list that satisfies a + predicate, or |Nothing| if there is no such element.} + +\subsection{Examples} + +The final step is to interpret the resulting sentence (i.e.\ a value +of type |LSys a|) as music. As mentioned earlier, the intent of the +|LSys| design is that a value is interpreted as a \emph{function} that +is applied to a single note (or, more generally, a single |Music| +value). The specific constructors are interpreted as follows: +\begin{code} +type IR a b = [(a, Music b -> Music b)] -- ``interpetation rules'' + +interpret :: (Eq a) => LSys a -> IR a b -> Music b -> Music b +interpret (a :. b) r m = interpret a r (interpret b r m) +interpret (a :+ b) r m = interpret a r m :+: interpret b r m +interpret Id r m = m +interpret (N x) r m = case (lookup x r) of + Just f -> f m + Nothing -> error "No interpetation rule" +\end{code} + +For example, we could define the following interpretation rules: +\begin{code} +data LFun = Inc | Dec | Same + deriving (Eq, Ord, Show) + +ir :: IR LFun Pitch +ir = [ (Inc, transpose 1), + (Dec, transpose (-1)), + (Same, id)] + +inc, dec, same :: LSys LFun +inc = N Inc +dec = N Dec +same = N Same +\end{code} +In other words, |inc| transposes the music up by one semitone, |dec| +transposes it down by a semitone, and |same| does nothing. + +Now let's build an actual grammar. |sc| increments a note followed by +its decrement---the two notes are one whole tone apart: +\begin{code} +sc = inc :+ dec +\end{code} + +Now let's define a bunch of rules as follows: +\begin{code} +r1a = Rule inc (sc :. sc) +r1b = Rule inc sc +r2a = Rule dec (sc :. sc) +r2b = Rule dec sc +r3a = Rule same inc +r3b = Rule same dec +r3c = Rule same same +\end{code} +and the corresponding grammar: +\begin{code} +g1 = Grammar same (Uni [r1b, r1a, r2b, r2a, r3a, r3b]) +\end{code} + +Finally, we generate a sentence at some particular level, and +interpret it as music: +\begin{code} +t1 n = instrument Vibraphone $ + interpret (gen replFun g1 42 !! n) ir (c 5 tn) +\end{code} +\out{$ } +Try ``|play (t1 3)|'' or ``|play (t1 4)|'' to hear the result. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Play with the L-System grammar defined above. Change the production +rules. Add probabilities to the rules, i.e.\ change it into a |Sto| +grammar. Change the random number seed. Change the depth of +recursion. And also try changing the ``musical seed'' (i.e.\ the note +|c 5 tn|).} +\end{exercise} + +\begin{exercise}{\em +Define a new L-System structure. In particular, (a) define a new +version of |LSys| (for example, add a parallel constructor) and its +associated interpretation, and/or (b) define a new version of |LFun| +(perhaps add something to control the volume) and its associated +interpretation. Then define some grammars with the new design to +generate interesting music.} +\end{exercise} + +\vspace{.1in}\hrule + +
+ HSoM/List-tour.lhs view
@@ -0,0 +1,521 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\chapter{The PreludeList Module}+\label{ch:list-tour}++The use of lists is particularly common when programming in Haskell,+and thus, not surprisingly, there are many pre-defined polymorphic+functions for lists. The list data type itself, plus some of the most+useful functions on it, are contained in the Standard Prelude's+\hs{PreludeList} module, which we will look at in detail in this+chapter. There is also a Standard Library module called \hs{List}+that has additional useful functions. It is a good idea to become+familiar with both modules. \indexamb{List}{library}+\indexhs{PreludeList}++Although this chapter may feel like a long list of ``Haskell+features,'' the functions described here capture many common patterns+of list usage that have been discovered by functional programmers over+many years of trials and tribulations. In many ways higher-order+declarative programming with lists takes the place of lower-level+imperative control structures in more conventional languages. By+becoming familiar with these list functions you will be able to more+quickly and confidently develop your own applications using lists.+Furthermore, if all of us do this, we will have a common vocabulary+with which to understand each others' programs. Finally, by reading+through the code in this module you will develop a good feel for how+to write proper function definitions in Haskell.++It is not necessary for you to understand the details of every+function, but you should try to get a sense for what is available so+that you can return later when your programming needs demand it. In+the long run you are well-advised to read the rest of the Standard+Prelude as well as the various Standard Libraries, to discover a host+of other functions and data types that you might someday find useful+in your own work.++\section{The PreludeList Module}++To get a feel for the \hs{PreludeList} module, let's first look at its+module declaration:+\begin{spec}+module PreludeList (+ map, (++), filter, concat,+ head, last, tail, init, null, length, (!!), + foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+ iterate, repeat, replicate, cycle,+ take, drop, splitAt, takeWhile, dropWhile, span, break,+ lines, words, unlines, unwords, reverse, and, or,+ any, all, elem, notElem, lookup,+ sum, product, maximum, minimum, concatMap, + zip, zip3, zipWith, zipWith3, unzip, unzip3)+ where++import qualified Char(isSpace)++infixl 9 !!+infixr 5 +++infix 4 `elem`, `notElem`+\end{spec}+We will not discuss all of the functions listed above, but will cover+most of them (and some were discussed in previous chapters).++\section{Simple List Selector Functions}+\label{sec:list-selectors}++\indexwdhs{head} and \indexwdhs{tail} extract the first element and remaining+elements, respectively, from a list, which must be non-empty.+\indexwdhs{last} and \indexwdhs{init} are the dual functions that work from the end+of a list, rather than from the beginning.+\begin{spec}+head :: [a] -> a+head (x:_) = x+head [] = error "PreludeList.head: empty list"++last :: [a] -> a+last [x] = x+last (_:xs) = last xs+last [] = error "PreludeList.last: empty list"++tail :: [a] -> [a]+tail (_:xs) = xs+tail [] = error "PreludeList.tail: empty list"++init :: [a] -> [a]+init [x] = []+init (x:xs) = x : init xs+init [] = error "PreludeList.init: empty list"+\end{spec}+Although \hs{head} and \hs{tail} were previously discussed in Section+\ref{sec:poly-types}, the definitions here include an equation+describing their behaviors under erroneous situations---such as+selecting the head of an empty list---in which case the \hs{error}+function is called. It is a good idea to include such an equation for+any definition in which you have not covered every possible case in+pattern-matching; i.e.\ if it is possible that the pattern-matching+could ``run off the end'' of the set of equations. The string+argument that you supply to the \hs{error} function should be detailed+enough that you can easily track down the precise location of the+error in your program.++\syn{If such an error equation is omitted, and then during+pattern-matching all equations fail, most Haskell systems will invoke+the \indexwdhs{error} function anyway, but most likely with a string that+will be less informative than one you can supply on your own.}++The \indexwdhs{null} function tests to see if a list is empty.+\begin{spec}+null :: [a] -> Bool+null [] = True+null (_:_) = False+\end{spec}++\section{Index-Based Selector Functions}+\label{sec:list-index-fns}++To select the $n$th element from a list, with the first element being+the $0$th element, we can use the indexing function \hs{(!!)}:+\index{list!indexing}+\begin{spec}+(!!) :: [a] -> Int -> a+(x:_) !! 0 = x+(_:xs) !! n | n > 0 = xs !! (n-1)+(_:_) !! _ = error "PreludeList.!!: negative index"+[] !! _ = error "PreludeList.!!: index too large"+\end{spec}+\syn{Note the definition of two error conditions; be sure that you+understand under what conditions these two equations would succeed.+In particular, recall that equations are matched in top-down order:+the first to match is the one that is chosen.}++\hs{take n xs} returns the prefix of \hs{xs} of length \hs{n}, or+\hs{xs} itself if \hs{n > length xs}. Similarly, \hs{drop n xs} returns+the suffix of \hs{xs} after the first \hs{n} elements, or \hs{[]} if+\hs{n > length xs}. Finally, \hs{splitAt n xs} is equivalent to+\hs{(take n xs, drop n xs)}.+\indexhs{take}+\indexhs{drop}+\indexhs{splitAt}+\indexhs{length}+\begin{spec}+take :: Int -> [a] -> [a]+take 0 _ = []+take _ [] = []+take n (x:xs) | n > 0 = x : take (n-1) xs+take _ _ = + error "PreludeList.take: negative argument"++drop :: Int -> [a] -> [a]+drop 0 xs = xs+drop _ [] = []+drop n (_:xs) | n > 0 = drop (n-1) xs+drop _ _ = + error "PreludeList.drop: negative argument"++splitAt :: Int -> [a] -> ([a],[a])+splitAt 0 xs = ([],xs)+splitAt _ [] = ([],[])+splitAt n (x:xs) | n > 0 = (x:xs',xs'') + where (xs',xs'') = splitAt (n-1) xs+splitAt _ _ = + error "PreludeList.splitAt: negative argument"++length :: [a] -> Int+length [] = 0+length (_:l) = 1 + length l+\end{spec}+For example:+\begin{spec}+take 3 [0, 1 .. 5] ==> [0,1,2]+drop 3 [0, 1 .. 5] ==> [3,4,5]+splitAt 3 [0, 1 .. 5] ==> ([0,1,2],[3,4,5])+\end{spec}++\section{Predicate-Based Selector Functions}+\label{sec:list-pred-fns}+\indexhs{takeWhile}+\indexhs{dropWhile}+\indexhs{span}+\indexhs{break}++\hs{takeWhile p xs} returns the longest (possibly empty) prefix of+\hs{xs}, all of whose elements satisfy the predicate \hs{p}.+\hs{dropWhile p xs} returns the remaining suffix. Finally,+\hs{span p xs} is equivalent to \hs{(takeWhile p xs, dropWhile p xs)},+while \hs{break p} uses the negation of \hs{p}.+\begin{spec}+takeWhile :: (a -> Bool) -> [a] -> [a]+takeWhile p [] = []+takeWhile p (x:xs) + | p x = x : takeWhile p xs+ | otherwise = []++dropWhile :: (a -> Bool) -> [a] -> [a]+dropWhile p [] = []+dropWhile p xs@(x:xs')+ | p x = dropWhile p xs'+ | otherwise = xs++span, break :: (a -> Bool) -> [a] -> ([a],[a])+span p [] = ([],[])+span p xs@(x:xs') + | p x = (x:xs',xs'') where (xs',xs'') = span p xs+ | otherwise = (xs,[])++break p = span (not . p)+\end{spec}+\indexwdhs{filter} removes all elements not satisfying a predicate:+\begin{spec}+filter :: (a -> Bool) -> [a] -> [a]+filter p [] = []+filter p (x:xs) | p x = x : filter p xs+ | otherwise = filter p xs+\end{spec}++\section{Fold-like Functions}++\indexwdhs{foldl1} and \indexwdhs{foldr1} are variants of+\indexwdhs{foldl} and \indexwdhs{foldr} that have no starting value+argument, and thus must be applied to non-empty lists.+\begin{spec}+foldl :: (a -> b -> a) -> a -> [b] -> a+foldl f z [] = z+foldl f z (x:xs) = foldl f (f z x) xs++foldl1 :: (a -> a -> a) -> [a] -> a+foldl1 f (x:xs) = foldl f x xs+foldl1 _ [] = error "PreludeList.foldl1: empty list"++foldr :: (a -> b -> b) -> b -> [a] -> b+foldr f z [] = z+foldr f z (x:xs) = f x (foldr f z xs)++foldr1 :: (a -> a -> a) -> [a] -> a+foldr1 f [x] = x+foldr1 f (x:xs) = f x (foldr1 f xs)+foldr1 _ [] = error "PreludeList.foldr1: empty list"+\end{spec} +\hs{foldl1} and \hs{foldr1} are best used in cases where an empty list+makes no sense for the application. For example, computing the+maximum or mimimum element of a list does not make sense if the list+is empty. Thus \hs{foldl1 max} is a proper function to compute the+maximum element of a list.++\hs{scanl} is similar to \hs{foldl}, but returns a list of successive+reduced values from the left:+\begin{spec}+scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+\end{spec}+For example:+\begin{spec}+scanl (+) 0 [1,2,3] ==> [0,1,3,6]+\end{spec}+Note that \hs{last (scanl f z xs) = foldl f z xs}. \hs{scanl1} is+similar, but without the starting element:+\begin{spec}+scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+\end{spec}+Here are the full definitions:+\indexhs{scanl}+\indexhs{scanl1}+\indexhs{scanr}+\indexhs{scanr1}+\begin{spec}+scanl :: (a -> b -> a) -> a -> [b] -> [a]+scanl f q xs = q : (case xs of+ [] -> []+ x:xs -> scanl f (f q x) xs)+scanl1 :: (a -> a -> a) -> [a] -> [a]+scanl1 f (x:xs) = scanl f x xs+scanl1 _ [] = error "PreludeList.scanl1: empty list"++scanr :: (a -> b -> b) -> b -> [a] -> [b]+scanr f q0 [] = [q0]+scanr f q0 (x:xs) = f x q : qs+ where qs@(q:_) = scanr f q0 xs ++scanr1 :: (a -> a -> a) -> [a] -> [a]+scanr1 f [x] = [x]+scanr1 f (x:xs) = f x q : qs+ where qs@(q:_) = scanr1 f xs +scanr1 _ [] = error "PreludeList.scanr1: empty list"+\end{spec}++\section{List Generators}+\label{sec:list-generators}++There are some functions which are very useful for generating lists+from scratch in interesting ways. To start, \hs{iterate f x} returns+an {\em infinite list} of repeated applications of \hs{f} to \hs{x}.+That is: \indexhs{iterate}+\begin{spec}+iterate f x ==> [x, f x, f (f x), ...]+\end{spec}+The ``infinite'' nature of this list may at first seem alarming, but+in fact is one of the more powerful and useful features of Haskell.++[say more]+\begin{spec}+iterate :: (a -> a) -> a -> [a]+iterate f x = x : iterate f (f x)+\end{spec}+\hs{repeat x} is an infinite list, with {x} the value of every+element. \hs{replicate n x} is a list of length \hs{n} with \hs{x}+the value of every element. And \hs{cycle} ties a finite list into a+circular one, or equivalently, the infinite repetition of the original+list.+\indexhs{repeat}+\indexhs{replicate}+\indexhs{cycle}+\begin{spec}+repeat :: a -> [a]+repeat x = xs where xs = x:xs++replicate :: Int -> a -> [a]+replicate n x = take n (repeat x)++cycle :: [a] -> [a]+cycle [] = error "Prelude.cycle: empty list" +cycle xs = xs' where xs' = xs ++ xs'+\end{spec} ++\section{String-Based Functions}+\label{sec:list-string-fns}++Recall that strings in Haskell are just lists of characters.+Manipulating strings (i.e.\ text) is a very common practice, so it+makes sense that Haskell would have a few pre-defined functions to+make this easier for you.++\indexwdhs{lines} breaks a string at every newline character (written+as \hs{'\n'} in Haskell), thus yielding a {\em list} of strings, each+of which contains no newline characters. Similary, \indexwdhs{words}+breaks a string up into a list of words, which were delimited by white+space. Finally, \indexwdhs{unlines} and \indexwdhs{unwords} are the+inverse operations: \hs{unlines} joins lines with terminating newline+characters, and \hs{unwords} joins words with separating spaces.+(Because of the potential presence of multiple spaces and newline+characters, however, these pairs of functions are not true inverses of+each other.)+\begin{spec}+lines :: String -> [String]+lines "" = []+lines s = let (l, s') = break (== '\n') s+ in l : case s' of+ [] -> []+ (_:s'') -> lines s''++words :: String -> [String]+words s = case dropWhile Char.isSpace s of+ "" -> []+ s' -> w : words s''+ where (w, s'') = break Char.isSpace s'++unlines :: [String] -> String+unlines = concatMap (++ "\n")++unwords :: [String] -> String+unwords [] = ""+unwords ws = foldr1 (\w s -> w ++ ' ':s) ws+\end{spec}++\indexwdhs{reverse} reverses the elements in a finite list.+\begin{spec}+reverse :: [a] -[a]+reverse = foldl (flip (:)) []+\end{spec}++\section{Boolean List Functions}+\label{sec:list-boolean-fns}++\indexwdhs{and} and \indexwdhs{or} compute the logical ``and'' and+``or,'' respectively, of all of the elements in a list of Boolean+values.+\begin{spec}+and, or :: [Bool] -> Bool+and = foldr (&&) True+or = foldr (||) False+\end{spec}+Applied to a predicate and a list, \indexwdhs{any} determines if any+element of the list satisfies the predicate. An analogous behavior+holds for \indexwdhs{all}.+\begin{spec}+any, all :: (a -> Bool) -> [a] -> Bool+any p = or . map p+all p = and . map p+\end{spec}++\section{List Membership Functions}++\indexwdhs{elem} is the list membership predicate, usually written in+infix form, e.g., \hs{x `elem` xs} (which is why it was given a fixity+declaration at the beginning of the module). \indexwdhs{notElem} is+the negation of this function.+\begin{spec}+elem, notElem :: (Eq a) => a -> [a] -> Bool+elem x = any (== x)+notElem x = all (/= x)+\end{spec}+It is common to store ``key/value'' pairs in a list, and to access the+list by finding the value associated with a given key (for this reason+the list is often called an {\em association list}). The function+\indexwdhs{lookup} looks up a key in an association list, returning+\hs{Nothing} if it is not found, or \hs{Just y} if \hs{y} is the+value associated with the key.+\begin{spec}+lookup :: (Eq a) => a -> [(a,b)] -> Maybe b+lookup key [] = Nothing+lookup key ((x,y):xys)+ | key == x = Just y+ | otherwise = lookup key xys+\end{spec}++\section{Arithmetic on Lists}++\indexwdhs{sum} and \indexwdhs{product} compute the sum and product,+respectively, of a finite list of numbers.+\begin{spec}+sum, product :: (Num a) => [a] -> a+sum = foldl (+) 0 +product = foldl (*) 1+\end{spec}+\indexwdhs{maximum} and \indexwdhs{minimum} return the maximum and+minimum value, respectively from a non-empty, finite list whose+element type is ordered.+\begin{spec}+maximum, minimum :: (Ord a) => [a] -> a+maximum [] = error "Prelude.maximum: empty list"+maximum xs = foldl1 max xs++minimum [] = error "Prelude.minimum: empty list"+minimum xs = foldl1 min xs+\end{spec}+Note that even though \hs{foldl1} is used in the definition, a test is+made for the empty list to give an error message that more accurately+reflects the source of the problem.++\section{List Combining Functions}+\label{sec:list-combining-fns}++\hs{map} and \hs{(++)} were defined in previous chapters, but+are repeated here for completeness: \indexhs{map} \indexhs{(++)}+\begin{spec}+map :: (a -> b) -> [a] -> [a]+map f [] = []+map f (x:xs) = f x : map f xs++(++) :: [a] -> [a] -> [a]+[] ++ ys = ys+(x:xs) ++ ys = x : (xs ++ ys)+\end{spec}+\indexwdhs{concat} appends together a list of lists:+\begin{spec}+concat :: [[a]] -> [a]+concat xss = foldr (++) [] xss+\end{spec}+\indexwdhs{concatMap} does what it says: it concatenates the result of+mapping a function down a list.+\begin{spec}+concatMap :: (a -> [b]) -> [a] -> [b]+concatMap f = concat . map f+\end{spec}+\indexwdhs{zip} takes two lists and returns a list of corresponding+pairs. If one input list is short, excess elements of the longer list+are discarded. \indexwdhs{zip3} takes three lists and returns a list+of triples. (``Zips'' for larger tuples are contained in the List+Library.)+\begin{spec}+zip :: [a] -> [b] -> [(a,b)]+zip = zipWith (,)++zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]+zip3 = zipWith3 (,,)+\end{spec}+\syn{The functions \indexwdhs{(,)} and \indexwdhs{(,,)} are the pairing+and tripling functions, respectively:+\begin{spec}+(,) ==> \x y -> (x,y)+(,,) ==> \x y z -> (x,y,z)+\end{spec}+}++The \indexwdhs{zipWith} family generalises the \hs{zip} and \hs{map}+families (or, in a sense, combines them) by applying a function (given+as the first argument) to each pair (or triple, etc.) of values. For+example, \hs{zipWith (+)} is applied to two lists to produce the list+of corresponding sums. \indexhs{zipWith3}+\begin{spec}+zipWith :: (a->b->c) -> [a]->[b]->[c]+zipWith z (a:as) (b:bs)+ = z a b : zipWith z as bs+zipWith _ _ _ = []++zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]+zipWith3 z (a:as) (b:bs) (c:cs)+ = z a b c : zipWith3 z as bs cs+zipWith3 _ _ _ _ = []+\end{spec}+The following two functions perform the inverse operations of \hs{zip}+and \hs{zip3}, respectively.+\indexhs{unzip}+\indexhs{unzip3}+\begin{spec}+unzip :: [(a,b)] -> ([a],[b])+unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])++unzip3 :: [(a,b,c)] -> ([a],[b],[c])+unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))+ ([],[],[])+\end{spec}++% \begin{exercise}\em+% Write at least two (stylistically different) definitions for a+% factorial function in Haskell. Include the fact that, pragmatically+% speaking, we would expect an {\em error} to result if the function is+% applied to a negative argument.+% \end{exercise}++
+ HSoM/MUI.lhs view
@@ -0,0 +1,1629 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\out{+\begin{code}+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.)++\end{code}+}++\chapter{Musical User Interface}+\chapterauthor{Daniel Winograd-Cort}+\label{ch:MUI}++\begin{code}+{-# LANGUAGE Arrows #-}++module Euterpea.Examples.MUI where+import Euterpea+import Data.Maybe (mapMaybe)++\end{code}++This module is not part of the standard Euterpea module hierarchy+(i.e.\ those modules that get imported by the header command ``|import+Euterpea|''), but it can be found in the |Examples| folder in the+Euterpea distribution, and can be imported into another module by the+header command:+\begin{spec}+import Euterpea.Examples.MUI+\end{spec}++\syn{To use the \emph{arrow syntax} described in this chapter, it is+ necessary to use the following compiler pragma in GHC:+\begin{spec}+{-# LANGUAGE Arrows #-}+\end{spec}+}++%% In addition, the ``TupleSections'' pragma permits the use of tuple+%% sections---for example, |(,42)| is the same as the function+%% |\x->(x,42)|.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Introduction}++Many music software packages have a graphical user interface (aka+``GUI'') that provides varying degrees of functionality to the user.+In Euterpea a basic set of widgets is provided that are collectively+referred to as the \emph{musical user interface}, or MUI. +This interface is quite different from+the GUI interfaces found in most conventional languages, and is built+around the concepts of \emph{signal functions} and \emph{arrows}+\cite{AFP2002,Hughes2000}.\footnote{The+ Euterpea MUI is built using the arrow-based GUI library \emph{UISF}, + which is its own standalone package. UISF, in turn, borrows concepts + from \emph{Fruit} \cite{fruit,courtney-phd}.} +Signal functions are an abstraction of the+time-varying values inherent in an interactive system such as a GUI or+Euterpea's MUI. Signal functions are provided for creating graphical+sliders, pushbuttons, and so on for input; textual displays, +graphs, and graphic images for output; and textboxes, virtual keyboards, +and more for combinations of input and output. +In addition to these graphical widgets, the MUI also+provides an interface to standard MIDI input and output devices.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - Basic Concepts %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Basic Concepts}++A \emph{signal} is a time-varying quantity. Conceptually, at least,+most things in our world, and many things that we program with, are+time-varying. The position of a mouse is time-varying. So is the+voltage used to control a motor in a robot arm. Even an animation can+be thought of as a time-varying image.++A \emph{signal function} is an abstract function that converts one+signal into another. Using the examples above, a signal function may+be one that adds an offset to a time-varying mouse position, filters+out noise from the time-varying voltage for a robot motor, or speeds+up or slows down an animation.++Perhaps the simplest way to understand Euterpea's approach to+programming with signals is to think of it as a language for+expressing \emph{signal processing diagrams} (or equivalently,+electrical circuits). We can think of the lines in a typical signal+processing diagram as signals, and the boxes that convert one signal+into another as signal functions. For example, this very simple+diagram has two signals, |x| and |y|, and one signal function,+|sigfun|:+\begin{center}+ \includegraphics[scale=0.70]{pics/frp-circuit}+\end{center}+Using Haskell's \emph{arrow syntax} \cite{Hughes2000,Paterson2001},+this diagram can be expressed as a code fragment in Euterpea simply+as:+\begin{spec}+y <- sigfun -< x+\end{spec}+\syn{The syntax |<-| and |-<| is typeset here in an attractive way,+ but the user will have to type \verb+<-+ and \verb+-<+,+ respectively, in her source file.}++In summary, the arrow syntax provides a convenient way to compose+signal functions together---i.e.\ to wire together the boxes that make+up a signal processing diagram.++%% \section{Signals}+%% \label{sec:signals}++%% A value of type |Signal T| is a time-varying value of type |T|. For+%% example, |Signal Float| is a time-varying floating-point number,+%% |Signal AbsPitch| is a time-varing absolute pitch, and so on.+%% Abstractly, we can think of a signal as a function:+%% \begin{spec}+%% Signal a = Time -> a+%% \end{spec}+%% where |Time| is some suitable representation of time.++%% %% (currently |Double| in Euterpea).++%% However, this is not how signals are actually implemented in Euterpea,+%% indeed the above is not even valid Haskell syntax. Nevertheless it is+%% helpful to think of signals in this way. Indeed, for pedagogical+%% purposes, we can go one step further and write the above as a Haskell+%% data declaration:+%% \begin{spec}+%% data Signal a = Sig (Time -> a)+%% \end{spec}+%% and then describe in more detail how signals are manipulated once this+%% concrete representation is in hand.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - The Type of a Signal Function %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{The Type of a Signal Function}+\label{sec:sigfun-type}++Polymorphically speaking, a signal function has type |SF a b|,+which should be read, ``the type of signal functions that convert+signals of type |a| into signals of type |b|.'' ++%% Keep in mind that a signal function is an \emph{abstract function},+%% meaning that its actual representation in Eutperpea is hidden. And+%% there are no values that directly represent \emph{signals} in+%% Euterpea---there are only signal \emph{functions}. So you cannot+%% simply apply a signal function to an argument like an ordinary+%% function. That, in fact, is the purpose of the arrow syntax.++For example, suppose the signal function |sigfun| used earlier has type+|SF T1 T2|, for some types |T1| and |T2|. In that case, again+using the example give earlier, |x| will have type |T1|, and |y| will+have type |T2|. Although signal functions act on signals, the arrow+notation allows us to manipulate the instantaneous values of the+signals, such as |x| and |y| above, directly.++A signal function whose type is of the form |SF () b| essentially+takes no input, but produces some output of type |b|. Because of this+we often refer to such a signal function as a \emph{signal source}.+Similarly, a signal function of type |SF a ()| is called a+\emph{signal sink}---it takes input, but produces no output. Signal+sinks are essentially a form of output to the real world.++We can also create and use signal functions that operate on signals of+tuples. For example, a signal function |exp :: SF (Double, Double)+Double| that raises the first argument in a tuple to the power of its+second, at every point in time, could be used as follows:+\begin{spec}+z <- exp -< (x,y)+\end{spec}++As mentioned earlier, a signal function is ``abstract,'' in the sense+that it cannot be applied like an ordinary function. Indeed, |SF| is+an instance of the |Arrow| type class in Haskell, which only provides+operations to \emph{compose} one signal function with another in+several ways. The |Arrow| class and how all this works for signal+functions will be described in Chapter~\ref{ch:arrows}. For+now, suffice it to say that programming in this style can be+awkward---and thus Haskell provides the arrow syntax described above+to make the programming easier and more natural.++A Euterpea MUI program expresses the composition of a possibly large+number of signal functions into a composite signal function that is+then ``run'' at the top level by a suitable interpreter. A good+analogy for this idea is a state or IO monad, where the state is+hidden, and a program consists of a linear sequencing of actions that+are eventually run by an interpreter or the operating system. But in+fact arrows are more general than monads, and in particular the+composition of signal functions does not have to be completely linear,+as will be illustrated shortly.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - |proc| Declarations %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{|proc| Declarations}++Arrows and arrow syntax will be described in more detail in+Chapter~\ref{ch:arrows}. For now, keep in mind that |<-| and |-<| are+part of the \emph{syntax}, and are not simply binary operators.+Indeed, we cannot just write the earlier code fragments anywhere. They+have to be within an enclosing |proc| construct whose result type is+that of a signal function. The |proc| construct begins with the+keyword |proc| along with a formal parameter, analogous to an+anonymous function. For example, a signal function that takes a+signal of type |Double| and adds 1 to it at every point in time, and+then applies |sigfun| to the resulting signal, can be written:+\begin{spec}+proc y -> do+ x <- sigfun -< y+1+ outA -< x+\end{spec}+|outA| is a special signal function that specifies the output of the+signal function being defined.++\syn{The |do| keyword in arrow syntax introduces layout, just as it+ does in monad syntax.}++Note the analogy of this code to the following snippet involving+an ordinary anonymous function:+\begin{spec}+\ y ->+ let x = sigfun' (y+1)+ in x+\end{spec}+The important difference, however, is that |sigfun| works on a signal,+i.e.\ a time-varying quantity. To make the analogy a little stronger,+we could imagine a signal being implemented as a stream of dicrete+values. In which case, to achieve the effect of the arrow code given+earlier, we would have to write something like this:+\begin{spec}+\ ys ->+ let xs = sigfun'' (map (+1) ys)+ in xs+\end{spec}+The arrow syntax allows us to avoid worrying about the streams+themselves.++%% It also has other important advantages that are beyond the scope of+%% the current discussion.++%% Arrow syntax is just that---syntactic sugar that is expanded into a+%% set of conventional functions that work just as well, but are more+%% cumbersome to program with (just as with monad syntax). This+%% syntactic expansion will be described in more detail in+%% Chapter~\ref{ch:arrows}. ++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - Four Useful Functions %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Four Useful Functions}+\label{sec:useful-funs}++There are four useful auxiliary functions that will make writing+signal functions a bit easier. The first two essentially ``lift''+constants and functions from the Haskell level to the arrow (signal+function) level:+\begin{spec}+arr :: (a -> b) -> SF a b+constA :: b -> SF () b+\end{spec}+For example, a signal function that adds one to every sample of its+input can be written simply as |arr (+1)|, and a signal function that+returns the constant 440 as its result can be written |constA 440|+(and is a signal source, as defined earlier).++The other two functions allow us to \emph{compose} signal functions:+\begin{spec}+(>>>) :: SF a b -> SF b c -> SF a c+(<<<) :: SF b c -> SF a b -> SF a c+\end{spec}+|(<<<)| is analogous to Haskell's standard composition operator |(.)|,+whereas |(>>>)| is like ``reverse composition.''++As an example that combines both of the ideas above, recall the very+first example given in this chapter:+\begin{spec}+proc y -> do+ x <- sigfun -< y+1+ outA -< x+\end{spec}+which essentially applies |sigfun| to one plus the input. This signal+function can be written more succinctly as either |arr (+1) >>> sigfun| or+|sigfun <<< arr (+1)|.++The functions |(>>>)|, |(<<<)|, and |arr| are actually generic+operators on arrows, and thus to use them one may import them from+the |Arrow| library. However, Euterpea reexports them automatically +so we need not do this.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - Events %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Events}+\label{sec:events}++Although signals are a nice abstraction of time-varying entities, and+the world is arguably full of such entities, there are some things+that happen at discrete points in time, like a mouse click, or a MIDI+keyboard press, and so on. We call these \emph{events}. To represent+events, and have them coexist with signals, recall the |Maybe| type+defined in the Standard Prelude:+\begin{spec}+data Maybe a = Nothing | Just a+\end{spec}+Conceptually, we define an event simply as a value of type |Maybe a|,+for some type |a|. We say that the value associated with an event is+``attached to'' or ``carried by'' that event.++However, to fit this into the signal function paradigm, we imagine+\emph{signals of events}---in other words, \emph{event streams}. So a+signal function that takes events of type |Maybe T1| as input, and+emits events of type |Maybe T2|, would have type |SF (Maybe T1) (Maybe+T2)|. When there is no event, an event stream will have the+instantaneous value |Nothing|, and when an event occurs, it will have+the value |Just x| for some value x.++For convenience Euterpea defines a type synonym for events:+\begin{spec}+type SEvent a = Maybe a+\end{spec}+The name |SEvent| is used to distinguish it from performance |Event|+as defined in Chapter~\ref{ch:performance}. ``|SEvent|'' can be read+as ``signal event.''++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - Feedback %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Feedback}++If we think about signal functions and arrows as signal processing +diagrams, then so far, we have only considered how to connect them +so that the streams all flow in the same direction. However, there +may be times that we want to feed an output of one signal function +back in as one of its inputs, thus creating a loop.++%% TODO: This might be a good place to have a diagram of a loop++How can a signal function depend on its own output? At some point +in the loop, we need to introduce a \emph{delay} function. Euterpea +has a few different delay function that we will decribe in more detail +later in this chapter (Section~\ref{ch:mui:sec:delays}), but for now, +we will casually introduce the simplest of these: |fcdelay|.+\begin{spec}+fcdelay :: b -> DeltaT -> SF b b+\end{spec}+The name |fcdelay| stands for ``fixed continuous delay'', and it +delays a continuous signal for a fixed amount of time. (Note that +|DeltaT| is a type synonym for |Double| and represents a change in +time, or $\delta t$.) Thus, the signal function |fcdelay b t| will +delay its input signal for |t| seconds, emitting the constant signal +|b| for the first |t| seconds.++With a delay at the ready, we can create a loop in a signal function +by using the |rec| keyword in the arrow syntax. This keyword behaves +much like it does in monadic |do| syntax and allows us to use a signal +before we have defined it.++For instance, we can create a signal function that will count how many +seconds have gone by since it started running:+\begin{spec}+secondCounter :: SF () Integer+secondCounter = proc () -> do+ rec count <- fcdelay 0 1 -< count + 1+ outA -< count+\end{spec}++\syn{The |rec| keyword comes from an extension to arrows called + \emph{arrow loop}. To use the same ability outside of the arrow + syntax requires the |loop| operator:+\begin{spec}+loop :: SF (b, d) (c, d) -> SF b c+\end{spec}}+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Introduction - [Advanced] Why Arrows? %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{[Advanced] Why Arrows?}++It is possible, and fairly natural, to define signal functions+directly, say as an abstract type |Signal T|, and then define+functions to add, multiply, take the sine of, and so on, signals+represented in this way. For example, |Signal Float| would be the+type of a time-varying floating-point number, |Signal AbsPitch| would+be the type of a time-varing absolute pitch, and so on. Then given+|s1,s2 :: Signal Float| we might simply write |s1 + s2|, |s1 * s2|,+and |sin s1| as examples of applying the above operations. Haskell's+numeric type class hierarchy makes this particularly easy to do.+Indeed, several domain-specific languages based on this approach have+been designed, beginning with the language \emph{Fran} \cite{Fran}+that was designed for writing computer animation programs.++But years of experience and theoretical study have revealed that such+an approach leads to a language with subtle time- and+space-leaks,\footnote{A time-leak in a real-time system occurs+ whenever a time-dependent computation falls behind the current time+ because its value or effect is not needed yet, but then requires+ ``catching up'' at a later point in time. This catching up process+ can take an arbitrarily long time, and may consume additional space+ as well. It can destroy any hope for real-time behavior if not+ managed properly.} for reasons that are beyond the scope of this+textbook \cite{Leak07}. ++Perhaps surprisingly, these problems can be avoided by using arrows.+Programming in this style gives the user access to signal functions,+and the individual values that comprise a signal, but not to the+actual signal itself. By not giving the user direct access to+signals, and providing a disciplined way to compose signal functions+(namely arrow syntax), time- and space-leaks are avoided. In fact,+the resulting framwework is highly amenable to optimization, although+this requires using special features in Haskell, as described in+Chapter \ref{ch:arrows}.++%% Although we like to think of signals as continuous, time-varying+%% quantities, in practice we know that they are sampled representations+%% of continous quantities, as discussed earlier. It is often important,+%% in a given context, to know what that sampling rate is.+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{The UISF Arrow}+\label{sec:UI}++|SF| as used in this chapter so far is an instance of the |Arrow|+class, but is not the actual type used for constructing MUIs. The+core component of Euterpea's MUI is the \emph{user interface signal+ function}, captured by the type |UISF|, which is also an instance of+the |Arrow| class. So instead of |SF|, in the remainder of this+chapter we will use |UISF|, but all of the previous discussion about+signal functions and arrows still applies.++Using |UISF|, we can create ``graphical widgets'' using a style very+similar to the way we wired signal functions earlier. However,+instead of having values of type |SF a b|, we will use values of type+|UISF a b|. Just like |SF|, the |UISF| type is fully abstract+(meaning its implementation is hidden) and, being an instance of the+|Arrow| class, can be used with arrow syntax.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow - Graphical Input and Output Widgets %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Graphical Input and Output Widgets}++Euterpea's basic widgets are shown in Figure \ref{fig:widgets}. Note+that each of them is, ultimately, a value of type |UISF a b|, for some+input type |a| and output type |b|, and therefore may be used with the+arrow syntax to help coordinate their functionality. The names and+type signatures of these functions suggest their functionality, which+we elaborate in more detail below:++\begin{figure}+\cbox{+\begin{spec}+label :: String -> UISF a a+displayStr :: UISF String ()+display :: Show a => UISF a ()+withDisplay :: Show b => UISF a b -> UISF a b+textbox :: UISF String String+textboxE :: String -> UISF (SEvent String) String+radio :: [String] -> Int -> UISF () Int+button :: String -> UISF () Bool+checkbox :: String -> Bool -> UISF () Bool+checkGroup :: [(String, a)] -> UISF () [a]+listbox :: (Eq a, Show a) => UISF ([a], Int) Int+hSlider, vSlider :: RealFrac a => (a, a) -> a -> UISF () a+hiSlider, viSlider :: Integral a => a -> (a, a) -> a -> UISF () a+\end{spec}}+\caption{Basic MUI Input/Output Widgets}+\label{fig:widgets}+\end{figure}++\begin{itemize}+\item+A simple (static) text string can be displayed using:+\begin{spec}+label :: String -> UISF () ()+\end{spec}++\item+Alternatively, a time-varying string can be be displayed using:+\begin{spec}+displayStr :: UISF String ()+\end{spec}++For convenience, Euterpea defines the following useful variations of+|displayStr|:+\begin{spec}+display :: Show a => UISF a ()+display = arr show >>> displayStr++withDisplay :: Show b => UISF a b -> UISF a b+withDisplay sf = proc a -> do+ b <- sf -< a+ display -< b+ outA -< b+\end{spec}+|display| allows us to display anything that is ``|Show|able.''+|withDisplay| is an example of a \emph{signal function transformer}:+it takes a signal function and attaches a display widget to it that+displays the value of its time-varying output.++\item+A textbox that functions for both input and output can be created+using:+\begin{spec}+textbox :: UISF String String+\end{spec}+A |textbox| in Euterpea is notable because it is ``bidirectional.''+That is, the time-varying input is displayed, and the user can+interact with it by typing or deleting, the result being the+time-varying output. In practice, the textbox is used almost+exclusively with the |rec| keyword and a |delay| operator. +For example, a code snippet from a+MUI that uses |textbox| may look like this:+\begin{spec}+rec str <- textbox <<< delay "Initial text" -< str+\end{spec}++Because of this common usage, there is a variant of the textbox:+\begin{spec}+textboxE :: String -> UISF (SEvent String) String+\end{spec}+A |textboxE| widget encapsulates the recursion and delay internally. +Thus, its initial value is given by its static argument, and its input +stream is an event stream that will update the displayed text when there +is an event and leave it unchanged otherwise.++\item+|radio|, |button|, and |checkbox| are three kinds of ``pushbuttons.''+A |button| (or |checkbox|) is pressed and unpressed (or checked+and \newline+unchecked) independently of others. In contrast, a |radio| button is+dependent upon other radio buttons---specifically, only one can be+``on'' at a time, so pressing one will turn off the others. The+string argument to these functions is the label attached to the+button. |radio| takes a list of strings, each being the label of one+of the buttons in the mutually-exclusive group; indeed the length of+the list determines how many buttons are in the group.++The |checkGroup| widget creates a group of |checkbox|es. As its static +argument, it takes a list of pairs of strings and values. For each pair, +one |checkbox| is created with the associated string as its label. Rather +than simply returning |True| or |False| for each checked box, it returns a +list of the values associated with each label as its output stream.++\item+The |listbox| widget creates a pane with selectable text entries. +The input stream is the list of entries as well as which entry is +currently selected, and the output stream is the index of the newly +selected entry. In many ways, this widget functions much like the +|radio| widget except that it is stylistically different, it is dynamic, +and, like the |textbox| widget, it is bidirectional.++\item+|hSlider|, |vSlider|, |hiSlider| and |viSlider| are four kinds of+``sliders''---a graphical widget that looks like an s slider control+as found on a hardware device. The first two yield floating-point+numbers in a given range, and are oriented horizontally and+vertically, respectively, whereas the latter two return integral+numbers. For the integral sliders, the first argument is the size of+the step taken when the slider is clicked at any point on either side+of the slider ``handle.'' In each of the four cases, the other two+arguments are the range and initial setting of the slider,+respectively.+\end{itemize}++As a simple example, here is a MUI that has a single slider+representing absolute pitch, and a display widget that displays the+pitch corresponding to the current setting of the slider:+\begin{code}+ui0 :: UISF () ()+ui0 = proc _ -> do+ ap <- hiSlider 1 (0,100) 0 -< ()+ display -< pitch ap++\end{code}+Note how the use of signal functions makes this dynamic MUI trivial to+write. But using the functions defines in+Section~\ref{sec:useful-funs} it can be defined even more succinctly+as:+\begin{spec}+ui0 = hiSlider 1 (0,100) 0 >>> arr pitch >>> display+\end{spec}++We can execute this example using the function:+\begin{spec}+runMUI' :: UI () () -> IO ()+\end{spec}+So our first running example of a MUI is:+\begin{code}+mui0 = runMUI' ui0++\end{code}+The resulting MUI, once the slider has been moved a bit, is shown in+Figure \ref{fig:simple-mui}(a).++\begin{figure}[hbtp]+\centering+\subfigure[Very Simple]{+\includegraphics[height=2.3in]{pics/mui0.eps}+}+\subfigure[With Titles and Sizing]{+\includegraphics[height=2.3in]{pics/mui1.eps} +}+\subfigure[With Alternate (left-to-right) Layout]{+\includegraphics[height=2.3in]{pics/mui2.eps} +}+\caption{Several Simple MUIs}+\label{fig:simple-mui}+\end{figure}++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow - Widget Transformers %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Widget Transformers}+\label{ch:mui:sec:wt}++Figure \ref{fig:layout-widgets} shows a set of ``widget+transformers''---functions that take UISF values as input, and return+modified UISF values as output.++\begin{figure}+\cbox{+\begin{spec}+title :: String -> UISF a b -> UISF a b+setLayout :: Layout -> UISF a b -> UISF a b+pad :: (Int, Int, Int, Int) -> UISF a b -> UISF a b+topDown, bottomUp, leftRight, rightLeft :: UISF a b -> UISF a b++makeLayout :: LayoutType -> LayoutType -> Layout+data LayoutType = Stretchy { minSize :: Int } + | Fixed { fixedSize :: Int }+\end{spec}}+\caption{MUI Layout Widget Transformers}+\label{fig:layout-widgets}+\end{figure}++\begin{itemize}+\item+|title| simply attaches a title (a string) to a UISF, and |setLayout|+establishes a new layout for a UISF. The general way to make a new+layout is to use |makeLayout|, which takes layout information for+first the horizontal dimension and then the vertical. A dimension can+be either stretchy (with a minimum size in pixels but that will expand+to fill the space it is given) or fixed (measured in pixels).++For example we can modify the previous example to both set a fixed+layout for the overall widget, and attach titles to both the slider+and display:+\begin{code}+ui1 :: UISF () ()+ui1 = setLayout (makeLayout (Fixed 150) (Fixed 150)) $ + proc _ -> do+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap++mui1 = runMUI' ui1++\end{code} %% $+This MUI is shown in Figure \ref{fig:simple-mui}(b).++\item+|pad (w,n,e,s) ui| adds |w| pixels of space to the ``west'' of the UISF+|ui|, and |n|, |e|, and |s| pixels of space to the north, east, and+south, respectively. ++\item+The remaining four functions are used to control the relative layout+of the widgets within a UISF. By default widgets are arranged+top-to-bottom, but, for example, we could modify the previous UISF+program to arrange the two widgets left-to-right:+\begin{code}+ui2 :: UISF () ()+ui2 = leftRight $+ proc _ -> do+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap++mui2 = runMUI' ui2++\end{code}+This MUI is shown in Figure \ref{fig:simple-mui}(c). +\end{itemize}++Widget transformers can be nested (as demonstrated in some later+examples), so a fair amount of flexibility is available.+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow - MIDI Input and Output %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{MIDI Input and Output}+% TODO: This (and the deviceID) section may need to be rewritten+% FIXME: Even if it stays basically the same, the following code uses +% the "unique" mediator, which hasn't been introduced yet.++An important application of events in Euterpea is real-time,+interactive MIDI. There are two UISF signal functions that handle+MIDI, one for input and the other for output, but neither of them+displays anything graphically:+\begin{spec}+midiIn :: UISF DeviceID (SEvent [MidiMessage])+midiOut :: UISF (DeviceID, SEvent [MidiMessage]) ()+\end{spec}+Except for the |DeviceID| (about which more will be said shortly),+these signal functions are fairly straightforward: |midiOut| takes a+stream of |MidiMessage| events and sends them to the MIDI output+device (thus a signal sink), whereas |midiIn| generates a stream of+|MidiMessage| events corresponding to the messages sent by the MIDI+input device (thus a signal source). In both cases, note that the+events carry \emph{lists} of MIDI messages, thus accounting for the+possibility of simultaneous events.++The |MidiMessage| data type is defined as:+\begin{spec}+data MidiMessage = ANote { channel :: Channel, key :: Key,+ velocity :: Velocity, duration :: Time }+ | Std Message+ deriving Show+\end{spec}+A |MidiMessage| is either an |ANote|, which allows us to specify a+note with duration, or is a standard MIDI |Message|. MIDI does not+have a notion of duration, but rather has separate |NoteOn| and+|NoteOff| messages. With |ANote|, the design above is a bit more+convenient, although what happens ``behind the scenes'' is that each+|ANote| is transformed into a |NoteOn| and |NoteOff| event.++The |Message| data type is described in Chapter~\ref{ch:midi}, and is+defined in the |Codec.Midi| module. Its most important functionality+is summarized here:+\begin{spec}+data Message =+ -- Channel Messages+ NoteOff { channel :: Channel, key :: Key, velocity :: Velocity }+ | NoteOn { channel :: Channel, key :: Key, velocity :: Velocity }+ | ProgramChange { channel :: Channel, preset :: Preset }+ | ...+ -- Meta Messages+ | TempoChange Tempo |+ | ...+ deriving (Show,Eq)+\end{spec}++%% data Message =+%% -- Channel Messages+%% NoteOff { channel :: !Channel, key :: !Key, velocity :: !Velocity }+%% | NoteOn { channel :: !Channel, key :: !Key, velocity :: !Velocity }+%% | ProgramChange { channel :: !Channel, preset :: !Preset }+%% | ...+%% -- Meta Messages+%% | TempoChange !Tempo |+%% | ...+%% deriving (Show,Eq)++MIDI's notion of a ``key'' is the key pressed on a MIDI instrument,+not to be confused with ``key'' as in ``key signature.'' Also, MIDI's+notion of ``velocity'' is the rate at which the key is pressed, and is+roughly equivalent to what we have been calling ``volume.'' So, for+example, a MIDI message |NoteOn c k v| plays MIDI key |k| on MIDI+channel |c| with velocity |v|.++As an example of the use of |midiOut|, let's modify our previous MUI+program to output an |ANote| message every time the absolute pitch+changes:+\begin{code}+ui3 :: UISF () ()+ui3 = proc _ -> do+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap+ uap <- unique -< ap+ midiOut -< (0, fmap (\k-> [ANote 0 k 100 0.1]) uap)++mui3 = runMUI' "Pitch Player" ui3++\end{code}+Note the use of the mediator |unique| to generate an event whenever+the absolute pitch changes. Each of those events, say |uap| above,+carries the new absolute pitch, and that pitch is used directly as the+MIDI key field in |ANote|.++To understand how the latter is done, recall that |fmap| is the+primary method in the |Functor| class as described in+Section~\ref{sec:functor-class}, and the |Maybe| type is an instance+of |Functor|. Therefore, since |EventS| is a type synonym for+|Maybe|, the use of |fmap| above is valid---and all it does is apply+the functional argument to the value ``attached to'' the event, which+in this case is an absolute pitch.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow - MIDI Device IDs %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{MIDI Device IDs}++Note in the previous example that the |DeviceID| argument to |midiOut|+is set to 0. The MIDI device ID is a system-dependent concept that+provides an operating system with a simple way to uniquely identify+various MIDI devices that may be attached to a computer. Indeed, as+devices are dynamically connected and disconnected from a computer,+the mapping of these IDs to a particular device may change. If you+try to run the above code, it may or may not work, depending on+whether the MIDI device with ID 0 corresponds to the preferred MIDI+output device on your machine.++To overcome this problem, most MIDI software programs allow the user+to select the preferred MIDI input and output devices. The user+usually has the best knowledge of which devices are connected, and+which devices to use. In Euterpea, the easiest way to do this is using+the UI widgets:+\begin{spec}+selectInput, selectOutput :: UISF () DeviceID+\end{spec}+Each of these widgets automatically queries the operating system to+obtain a list of connected MIDI devices, and then displays the list as+a set of radio buttons, allowing the user to select one of them.+This makes wiring up the+user choice very easy. For example, we can modify the previous+program to look like this:+\begin{code}+ui4 :: UISF () ()+ui4 = proc _ -> do+ devid <- selectOutput -< ()+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap+ uap <- unique -< ap+ midiOut -< (devid, fmap (\k-> [ANote 0 k 100 0.1]) uap)++mui4 = runMUI' "Pitch Player with MIDI Device Select" ui4++\end{code}++It is a good idea to always take this approach when dealing with MIDI,+even if you think you know the exact device ID.++For an example using MIDI input as well, here is a simple program that+copies each MIDI message verbatim from the selected input device to+the selected output device:++\begin{code}+ui5 :: UISF () ()+ui5 = proc _ -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ m <- midiIn -< mi+ midiOut -< (mo, m)++mui5 = runMUI' "MIDI Input / Output UI" ui5++\end{code}++Since determining device IDs for both input and ouput is common, we+define a simple signal function to do both:+\begin{code}+getDeviceIDs = topDown $+ proc () -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ outA -< (mi,mo)++\end{code} %% $+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% The UISF Arrow - Putting It All Together %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Putting It All Together}+\label{sec:runui}++Recall that a Haskell program must eventually be a value of type |IO+()|, and thus we need a function to turn a |UISF| value into a |IO|+value---i.e.\ the UISF needs to be ``run.'' We can do this using one of+the following two functions, the first of which we have already been+using:+\begin{spec}+runMUI' :: UISF () () -> IO ()+runMUI :: UIParams -> UISF () () -> IO ()+\end{spec}+Executing |runMUI' ui| or |runMUI params ui| will create a single MUI +window whose behavior is governed by the argument |ui :: UISF () ()|. +The additional |UIParams| argument of |runMUI| +contains parameters that can affect the +appearance and performance of the MUI window that is created. +There is a default value of |UIParams| that is typical for regular +MUI usage, and |runMUI'| is defined using it:+\begin{spec}+defaultMUIParams :: UIParams+runMUI' = runMUI defaultMUIParams+\end{spec}+When using |runMUI|, it is advisable to simply modify the +default value rather than building a whole new |UIParams| value. The +easiest way to do this is with Haskell's \emph{record syntax}.++There are many fields of data in a value of type |UIParams|, but we +will focus only on the |uiTitle| and |uiSize|, which will control the +value displayed in the title bar of the graphical window and the initial +size of the window respectively. Thus, the title is a |String| +value and the size is a |Dimension| value (where |Dimension| is a type +synonym for |(Int, Int)|, which in turn represents a width and height +measured in pixels). By default, the size is |(300,300)| and the title +is |"MUI"|, but we can change these like so:+\begin{code}+mui'5 = runMUI (defaultMUIParams + { uiTitle = "MIDI Input / Output UI", + uiSize = (200,200)})+ ui5+\end{code}+This version of |mui5| (from the previous subsection) will run +identically to the original except for the fact that its title +will read ``MIDI Input / Output UI'' and its initial size will +be smaller.+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Non-Widget Signal Functions %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Non-Widget Signal Functions}++All of the signal functions we have seen so far are effectful widgets. +That is, they all do something graphical or audible when they are +used. For regular computation, we have been using pure functions +(which we can insert arbitrarily in arrow syntax or lift with |arr| +otherwise). However, there are signal functions that are important +and useful which have no visible effects. We will look at a few +different types of these signal functions in this section.++\syn{Note that the mediators and folds in the next two subsections +are generic signal functions, and are not restricted to use only +in MUIs. To highlight this, we present them with the |SF| type +rather than the |UISF| type. They can be (and often are) used in +MUIs.++The timers and delay functions in Subsection~\ref{ch:mui:sec:delays} +require the MUI's internal notion of time, and so we present those +directly with the |UISF| type.}++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Non-Widget Signal Functions - Mediators %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Mediators}++In order to use event streams in the context of continuous signals,+Euterpea defines a set of functions that mediate between the+continuous and the discrete. These ``mediators,'' as well as some+functions that deal exclusively with events, are shown in+Figure~\ref{fig:mediators} along with their type signatures and brief+descriptions. Their use will be better understood through some+examples that follow.++\begin{figure}+%% in signal processing this is called an ``edge+%% detector,'' and thus the name chosen here.+\cbox{\small+\begin{spec}+unique :: Eq a => SF a (SEvent a)+ -- generates an event whenever the input changes++edge :: SF Bool (SEvent ())+ -- generates an event whenever the input changes from |False| to |True|++accum :: a -> SF (SEvent (a -> a)) a+ -- |accum x| starts with the value |x|, but then applies the function + -- attached to the first event to |x| to get the next value, and so on++mergeE :: (a -> a -> a) -> SEvent a -> SEvent a -> SEvent a+ -- |mergeE f e1 e2| merges two events, using |f| to resolve two |Just| values++hold :: b -> SF (SEvent b) b+ -- |hold x| begins as value |x|, but changes to the subsequent values+ -- attached to each of its input events++now :: SF () (SEvent ())+ -- creates a single event ``right now''++evMap :: SF b c -> UISF (SEvent b) (SEvent c)+ -- lifts a continuous signal function into one that handles events+\end{spec}}+\caption{Mediators Between the Continuous and the Discrete}+\label{fig:mediators}+\end{figure}+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Non-Widget Signal Functions - Folds %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Folds}++In traditional functional prgramming, a folding, or reducing, operation +is one that joins together a set of data. The typical case would be +an operation that operates over a list of data, such as a function that +sums all elements of a list of numbers.++There are a few different ways given in Euterpea to fold together +signal functions to create new ones:+\begin{spec}+maybeA :: SF () c -> SF b c -> SF (Maybe b) c+concatA :: [SF b c] -> SF [b] [c]+runDynamic :: SF b c -> SF [b] [c]+\end{spec}++\begin{itemize}+\item+|maybeA| is a fold over the |Maybe| (or |SEvent|) data type. The +signal function |maybeA n j| accepts as input a stream of |Maybe b| +values; at any given moment, if those values are |Nothing|, then the +signal function behaves like |n|, and if they are |Just b|, then it +behaves like |j|.++\item+The |concatA| fold takes a list of signal functions and converts them +to a single signal function whose streaming values are themselves +lists. For example, perhaps we want to display a bunch of buttons +to a user in a MUI window. Rather than coding them in one at a time, +we can use |concatA| to fold them into one operation that will return +their results altogether in a list. In essence, we are +\emph{concat}enating the signal functions together.++\item+The |runDynamic| signal function is similar to |concatA| except that +it takes a single signal function as an argument rather than a list. +What, then, does it fold over? Instead of folding over the static +signal function list, it folds over the |[b]| list that it accepts +as its input streaming argument.+\end{itemize}++|concatA| and |runDynamic| are definitely similar, but they are also +subtly different. With |concatA|, there can be many different signal +functions that are grouped together, but with |runDynamic|, there is +only one. However, |runDynamic| may have a variable number of +internally running signal functions at runtime because that number +depends on a streaming argument. |concatA| is fixed once it is +created.++++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Non-Widget Signal Functions - Timers and Delays %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Timers and Delays}+\label{ch:mui:sec:delays}++The Euterpea MUI has an implicit notion of elapsed time. The current+elapsed time can be accessed explicitly by this signal source:+\begin{spec}+getTime :: UISF () Time+\end{spec}+where |Time| is a type synonym for |Double|. ++But some MUI widgets depend on the time implicitly. For example, the+following pre-defined signal function creates a \emph{timer}:+\begin{spec}+timer :: UISF DeltaT (SEvent ())+\end{spec}+In practice, |timer -< i| takes a signal |i| that represents the timer+interval (in seconds), and generates an event stream, where each pair+of consecutive events is separated by the timer interval. Note that+the timer interval is itself a signal, so the timer output can have+varying frequency.++%% Note also that, since |timer| does not have any graphical or audio+%% representation, it is not actually of type |UISF|. Rather, it is a+%% generic |ArrowInit|. However, as |UISF| is an instance of+%% |ArrowInit|, we can use |timer| in our MUIs.++To see how a timer might be used, let's modify our previous MUI so+that, instead of playing a note every time the absolute pitch changes,+we will output a note continuously, at a rate controlled by a second+slider:+\begin{code}+ui6 :: UISF () ()+ui6 = proc _ -> do+ devid <- selectOutput -< ()+ ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()+ title "Pitch" display -< pitch ap+ f <- title "Tempo" (hSlider (1,10) 1) -< ()+ tick <- timer -< 1/f+ midiOut -< (devid, fmap (const [ANote 0 ap 100 0.1]) tick)++-- Pitch Player with Timer+mui6 = runMUI ui6++\end{code}+Note that the rate of |tick|s is controlled by the second slider---a+larger slider value causes a smaller time between ticks, and thus a+higher frequency, or tempo.++The |genEvents| signal function is very similar to |timer|, in that +it will generate specific, recurring events, but it differs in that +those events contain data based on an input list:+\begin{spec}+genEvents :: [b] -> UISF DeltaT (SEvent b)+\end{spec}+Just like |timer|, this signal function will output events +at a variable frequency, but each successive event will contain +the next value in the given list. When every value of the list +|lst| has been emitted, |genEvents lst| will never again produce +an event.++Another way in which a widget can use time implictly is in a +\emph{delay}. Euterpea comes with four different delaying widgets, +which each serve a specific role depending on whether the streams +are continuous or event-based and if the delay is a fixed length or +can be variable:+\cbox{+\begin{spec}+fcdelay :: b -> DeltaT -> UISF b b+fdelay :: DeltaT -> UISF (SEvent b) (SEvent b)+vdelay :: UISF (DeltaT, SEvent b) (SEvent b)+vcdelay :: DeltaT -> b -> UISF (DeltaT, b) b+\end{spec}}++To start, we will examine the most straightforward one: +|fcdelay b t| will emit the constant value |b| for the first |t| +seconds of the output stream and will from then on emit its input +stream delayed by |t| seconds. The name comes from ``fixed continuous +delay.''++One potential problem with |fcdelay| is that it makes no guarantees +that every instantaneous value on the input stream will be seen in the +output stream. This should not be a problem for continuous signals, +but for an event stream, it could mean that entire events are accidentally +skipped over. Therefore, there is a specialized delay for event streams:+|fdelay t| guarantees that every input event will be emitted, but in +order to achieve this, it is not as strict about timing---that is, +some events may end up being over delayed. Due to the nature of +events, we no longer need an initial value for output: for the first +|t| second, there will simply be no events emitted.++We can make both of the above delay widgets a little more complicated +by introducing the idea of a variable delay. For instance, we can +expand the capabilities of |fdelay| into |vdelay|. +Now, the delay time is part of the signal, and it can change +dynamically. Regardless, this event-based version will still +guarantee that every input event will be emitted. ``|vdelay|'' +can be read ``variable delay.''++For the variable continuous version, we must add one extra input +parameter to prevent a possible space leak. Thus, the first argument +to |vcdelay| is +the maximum amount that the widget can delay. Due to the variable +nature of |vcdelay|, some portions of the input signal may be omitted +entirely from the output signal while others may even be outputted +more than once. Thus, once again, it is higly advised to use +|vdelay| rather than |vcdelay| when dealing with event-based signals.+++++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Musical Examples %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Musical Examples}++In this section we work through three larger musical examples that use+Euterpea's MUI in interesting ways.++\subsection{Chord Builder}++This MUI will display a collection of chord types (Maj, Maj7, Maj9,+min, min7, min9, and so on), one of which is selectable via a radio+button. Then when a key is pressed on a MIDI keyboard, the selected+chord is built and played using that key as the root.++To begin, we define a ``database'' that associates chord types with+their intervals starting with the root note:+\begin{code}+chordIntervals :: [ (String, [Int]) ]+chordIntervals = [ ("Maj", [4,3,5]), ("Maj7", [4,3,4,1]),+ ("Maj9", [4,3,4,3]), ("Maj6", [4,3,2,3]),+ ("min", [3,4,5]), ("min7", [3,4,3,2]),+ ("min9", [3,4,3,4]), ("min7b5", [3,3,4,2]),+ ("mMaj7", [3,4,4,1]), ("dim", [3,3,3]),+ ("dim7", [3,3,3,3]), ("Dom7", [4,3,3,2]),+ ("Dom9", [4,3,3,4]), ("Dom7b9", [4,3,3,3]) ]++\end{code}+We will display the list of chords on the screen as radio buttons for+the user to click on.++\begin{figure}[hbtp]+\centering+\includegraphics[height=2.3in]{pics/chordBuilder.eps}+\caption{A Chord Builder MUI}+\label{fig:chordbuilder}+\end{figure}++The |toChord| function takes an input MIDI message as the root note,+and the index of the selected chord, and outputs the notes of the+selected chord. For simplicity, we only process the head of the+message list and ignore everything else.+\begin{code}+toChord :: Int -> [MidiMessage] -> [MidiMessage]+toChord i ms@(m:_) = + case m of + Std (NoteOn c k v) -> f NoteOn c k v+ Std (NoteOff c k v) -> f NoteOff c k v+ _ -> ms+ where f g c k v = map (\k' -> Std (g c k' v)) + (scanl (+) k (snd (chordIntervals !! i)))++\end{code}++\syn{|scanl :: (a->b->a) -> a -> [b] -> [a]| is a standard Haskell+ function that is like |foldl :: (a->b->a) -> a -> [b] -> a|,+ except that every intermediate result is returned, collected+ together in a list.}++The overall MUI is laid out in the following way: On the left side,+the list of input and output devices are displayed top-down. On the+right is the list of chord types. We take the name of each chord type+from the |chordIntervals| list to create the radio buttons.++When a MIDI input event occurs, the input message and the currently+selected index to the list of chords is sent to the |toChord|+function, and the resulting chord is then sent to the Midi output+device.++\begin{code}+buildChord :: UISF () ()+buildChord = leftRight $ + proc _ -> do+ (mi, mo) <- getDeviceIDs -< ()+ m <- midiIn -< mi+ i <- topDown $ title "Chord Type" $ + radio (fst (unzip chordIntervals)) 0 -< ()+ midiOut -< (mo, fmap (toChord i) m)++chordBuilder = runMUI (600,400) "Chord Builder" buildChord++\end{code} %% $+Figure \ref{fig:chordbuilder} shows this MUI in action.++\syn{|unzip :: [(a,b)] -> ([a],[b])| is a standard Haskell function+ that does the opposite of |zip :: [a] -> [b] -> [(a,b)]|.}++\subsection{Chaotic Composition}++In this section we describe a UISF that borrows some ideas from Gary+Lee Nelson's composition ``Bifurcate Me, Baby!''+\cite{nelson-bifurcate}.++The basic idea is to evaluate a formula called the \emph{logistic+ growth function}, from a branch of mathematics called chaos theory,+at different points and convert the values to musical notes. The+growth function is given by the recurrence equation:+\[ x_{n+1} = r x_n (1 - x_n) \]++Mathematically, we start with an initial population $x_0$ and+iteratively apply the growth function to it, where $r$ is the growth+rate. For certain values of $r$, the population stablizes to a+certain value, but as $r$ increases, the period doubles, quadruples,+and eventually leads to chaos. It is one of the classic examples of+chaotic behavior.++We can capture the growth rate equation above in Haskell by defining a+function that, given a rate |r| and current population |x|, generates+the next population:+\begin{code}+grow :: Double -> Double -> Double+grow r x = r * x * (1-x)++\end{code}++To generate a time-varying population, the |accum| signal function+comes in handy. |accum| takes an initial value and an event signal+carrying a modifying function, and updates the current value by+applying the function to it.+\begin{spec}+ ...+ r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()+ pop <- accum 0.1 -< fmap (const (grow r)) tick+ ...+\end{spec} %% $++The |tick| above is the ``clock tick'' that drives the simulation.+We wish to define a signal |tick| that pulsates at a given frequency+specified by a slider.+\begin{spec}+ ...+ f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()+ tick <- timer -< 1/f+ ...+\end{spec} %% $++We also need a simple function that maps a population value to a+musical note. As usual, this can be done in a variety of ways---here+is one way:+\begin{code}+popToNote :: Double -> [MidiMessage]+popToNote x = [ANote 0 n 64 0.05] + where n = truncate (x * 127)++\end{code}++Finally, to play the note at every tick, we simply apply |popToNote|+to every value in the time-varying population |pop|. |fmap| makes+this straightforward. Putting it all together, we arrive at:+\begin{code}+bifurcateUI :: UISF () ()+bifurcateUI = proc _ -> do+ mo <- selectOutput -< ()+ f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()+ tick <- timer -< 1/f+ r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()+ pop <- accum 0.1 -< fmap (const (grow r)) tick+ _ <- title "Population" $ display -< pop+ midiOut -< (mo, fmap (const (popToNote pop)) tick)++bifurcate = runMUI (300,500) "Bifurcate!" $ bifurcateUI++\end{code}++\subsection{MIDI Echo Effect}++As a final example we present a program that receives a MIDI event+stream and, in addition to playing each note received from the input+device, it also echoes the note at a given rate, while playing each+successive note more softly until the velocity reduces to 0.++The key component we need for this problem is a delay function that+can delay a given event signal for a certain amount of time. Recall+that the function |vdelay| takes a time signal, the amount of time+to delay, and an input signal, and returns a delayed version of the+input signal.++There are two signals we want to attenuate, or ``decay.'' One is the+signal coming from the input device, and the other is the delayed and+decayed signal containing the echoes. In the code shown below, they+are denoted as |m| and |s|, respectively. First we merge the two+event streams into one, and then remove events with empty MIDI+messages by replacing them with Nothing. The resulting signal |m'| is+then processed further as follows.++%% Whenever there is an event in |m'|, we take a snapshot of the current+%% decay rate specified by a slider |r|. +The MIDI messages and the+current decay rate are processed with |decay|, which softens each+note in the list of messages. Specifically, |decay| works by +reducing the velocity of each note by the given rate and removing +the note if the velocity drops to 0. The resulting signal is+then delayed by the amount of time determined by another slider |f|,+producing signal |s|. |s| is then fed back to the |mergeE| function,+closing the loop of the recursive signal. At the same time, |m'| is+sent to the output device.++\begin{code}+echoUI :: UISF () ()+echoUI = proc _ -> do+ mi <- selectInput -< ()+ mo <- selectOutput -< ()+ m <- midiIn -< mi+ r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< ()+ f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< ()++ rec let m' = removeNull $ mergeE (++) m s+ s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m')++ midiOut -< (mo, m')++echo = runMUI (500,500) "Echo" echoUI++\end{code} %% $++\begin{code}++removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]+removeNull (Just []) = Nothing+removeNull mm = mm++decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage+decay dur r m = + let f c k v d = if v > 0 + then let v' = truncate (fromIntegral v * r)+ in Just (ANote c k v' d)+ else Nothing+ in case m of+ ANote c k v d -> f c k v d+ Std (NoteOn c k v) -> f c k v dur+ _ -> Nothing+\end{code}+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Special Purpose and Custom Widgets %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Special Purpose and Custom Widgets}++Although the widgets and signal functions described so far +enable the creation of many basic MUIs, there are times when +something more specific is required. +Thus, in this section, we will look at some more special purpose +widgets as well as some functions that aid in the creation of custom +widgets.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Custom Widgets - Realtime graphs, histograms %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Realtime graphs, histograms}++So far, the only way to display the value of a stream in the MUI is +to use the |display| widget. Although this is often enough, there +may be times when another view is more enlightening. For instance, +if the stream represents a sound wave, then rather than displaying the +instantaneous values of the wave as numbers, we may wish to see them +graphed.++Euterpea provides support for a few different widgets that will graph +streaming data visually. +\begin{spec}+realtimeGraph :: RealFrac a => Layout -> Time -> Color -> UISF [(a,Time)] ()+histogram :: RealFrac a => Layout -> UISF (SEvent [a]) ()+histogramWithScale :: RealFrac a => Layout -> UISF (SEvent [(a,String)]) ()+\end{spec}+Note that each of these three functions requires a |Layout| argument +(recall the |Layout| data type from Section~\ref{ch:mui:sec:wt}); +this is because the layout of a graph is not as easily inferred as that +for, say, a button.++We will walk through the descriptions of each of these widgets:+\begin{itemize}+\item+|realtimeGraph l t c| will produce a graph widget with layout +|l|. This graph will accept as input a stream of events of pairs +of values and time\footnote{These events are represented as a list + rather than using the |SEvent| type because there may be more than + one event at the same time. The absense of any events would be + indicated by an empty list.}.+The values are plotted vertically in color |c|, and the horizontal +axis represents time, where the width of the graph represents an +amount of time |t|.++\item+The histogram widgets take as input events that each contain a complete +set of data. The data are plotted as a histogram within the given +layout. For the histogram with the scale, each value must be paired +with a |String| representing its label, and the labels are printed +under the plot.+\end{itemize}++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Custom Widgets - More MIDI Widgets %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{More MIDI Widgets}+This may be filled in later with midiOutMB and other similar stuff, +but I will refrain from writing about them until I know if they're +going to stay in Euterpea.++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Custom Widgets - Instruments %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Instruments}+Euterpea provides two special widgets that create virtual instruments +that the user can interact with: a piano and a guitar.+\begin{spec}+guitar :: GuitarKeyMap -> Midi.Channel + -> UISF (InstrumentData, SEvent [MidiMessage]) (SEvent [MidiMessage])+piano :: PianoKeyMap -> Midi.Channel + -> UISF (InstrumentData, SEvent [MidiMessage]) (SEvent [MidiMessage])+\end{spec}++There are actually a whole bunch of helper functions that go along +with these. However, all of this is in Experimental right now, so +I don't know how I should write about it here.+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Custom Widgets - A Graphical Canvas %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{A Graphical Canvas}+\label{sec:canvas}++\begin{spec}+canvas :: Dimension -> UISF (SEvent Graphic) ()+\end{spec}++|canvas| creates a graphical canvas on which images can be drawn.++Details TBD.+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Custom Widgets - [Advanced] mkWidget %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{[Advanced] mkWidget}+Even more advanced than canvas. Perhaps this need not be documented +in HSoM+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Advanced Topics %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\section{Advanced Topics}+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Advanced Topics - Banana brackets %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Banana brackets}+++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Advanced Topics - General I/O From Within a MUI %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{General I/O From Within a MUI}+\label{sec:mui-general-io}+++[This section needs further elaboration]++Euterpea has sources, sinks, and pipes for UISFs as well as a general+event buffer and a hook into it for MIDI out.++The following six functions:+\begin{spec}+uisfSource :: IO c -> UISF () c+uisfSink :: (b -> IO ()) -> UISF b ()+uisfPipe :: (b -> IO c) -> UISF b c+uisfSourceE :: IO c -> UISF (SEvent ()) (SEvent c)+uisfSinkE :: (b -> IO ()) -> UISF (SEvent b) (SEvent ())+uisfPipeE :: (b -> IO c) -> UISF (SEvent b) (SEvent c)+\end{spec}+work as expected. Without resource types, these functions are unsafe+and should be used with caution.++Here are four examples:+\begin{spec}+uisfPipeE randomRIO :: Random c => UISF (SEvent (c,c)) (SEvent c)+uisfSourceE randomIO :: Random c => UISF (SEvent ()) (SEvent c)+uisfPipeE readFile :: UISF (SEvent FilePath) (SEvent String)+uisfSinkE $ uncurry writeFile ::+ UISF (SEvent (FilePath, String)) (SEvent ())+\end{spec} %% $++Euterpea also has an event buffer:+\begin{spec}+data BufferControl b = Play | Pause | Clear | AddData [(DeltaT, b)]+eventBuffer :: UISF (SEvent (BufferControl a), Time) (SEvent [a], Bool)+\end{spec}+|Pause| and |Play| are states that determine whether time continues or+not, |Clear| empties the buffer, and |AddData| adds new data,+merging as necessary. Infinite data streams are supported. The+output includes an event of values that are ready and a |Bool|+indicating if there are values left in the buffer.++|eventBuffer| can be used directly, but it also hooks directly into+|midiOut| with:+\begin{spec}+midiOutB :: UISF (DeviceID, SEvent [(DeltaT, MidiMessage)]) Bool+midiOutB' :: UISF (DeviceID, SEvent (BufferControl MidiMessage)) Bool+\end{spec}+There is also a function that converts |Music| values into the event+structure used above:+\begin{spec}+musicToMsgs :: Bool -> [InstrumentName] -> Music1 -> [(DeltaT, MidiMessage)]+\end{spec}+in which the |Bool| argument tells whether the |Music1| value is+infinite, and the list is for instrument channels in the infinite case.++(Perhaps this should just be one argument of type |Maybe+[InstrumentName]|?)++++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Advanced Topics - Asynchrony %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\subsection{Asynchrony}+(and tying in with SigFuns -- "In Chapter 19, you will learn about SigFuns ..., we can tie them into MUIs like so")++++%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+%%%% Exercises %%%%+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+\vspace{.1in}\hrule++\begin{exercise}{\em+Define a MUI that has a text box in which the user can type a pitch+using the normal syntax |(C,4)|, |(D,5)|, etc., and a pushbutton+labeled ``Play'' that, when pushed, will play the pitch appearing in+the textbox.++Hint: use the Haskell function |reads :: Read a => String ->+[(a,String)]| to parse the input.}+\end{exercise}++\begin{exercise}{\em+Modify the previous example so that it has \emph{two} textboxes, and+plays both notes simultaneously when the pushbutton is pressed.}+\end{exercise}++\begin{exercise}{\em+Modify the previous example so that, in place of the pushbutton, the+pitches are played at a rate specified by a horizontal slider.}+\end{exercise}++\begin{exercise}{\em+Define a MUI for a pseudo-keyboard that has radio buttons to choose+one of the 12 pitches in the conventional chromatic scale. Every time+a new pitch is selected, that note is played.}+\end{exercise}++\begin{exercise}{\em+Modify the previous example so that an integral slider is used to+specify the octave in which the pitch is played.}+\end{exercise}++\begin{exercise}{\em+Leon Gruenbaum describes a ``Samchillian Tip Tip Tip Cheeepeeeee,'' a+MIDI keyboard based on intervals rather than fixed pitches. Your job+is to define a ``Cheepie Samchillian'' as a MUI that has the following+features:+\begin{itemize}+\item+A three-element radio button to choose between three scales:+chromatic, major, and whole-tone.+\item+Nine pushbuttons, corresponding to intervals (within the selected+scale) of 0, +1, +2, +3, +4, -1, -2, -3, and -4.+\end{itemize} }+\end{exercise}++\vspace{.1in}\hrule
+ HSoM/Monads.lhs view
@@ -0,0 +1,863 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\out{+\begin{code}+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.)++\end{code}+}++\chapter{Higher-Order Types and Monads}+\label{ch:monads}++\index{type!higher-order} +\index{type!constructor} ++All of the types that we have considered thus far in this text have+been \emph{first order}. For example, the type constructor |Music|+has so far always been paired with an argument, as in |Music+ Pitch|. This is because |Music| by itself is a \emph{type+ constructor}: something that takes a type as an argument and returns+a type as a result. There are no \emph{values} in Haskell that have+this type, but such ``higher-order types'' can be used in type class+declarations in useful ways, as we shall see in this chapter.++\section{The Functor Class}+\label{sec:functors}++To begin, consider the |Functor| class described previously in+Section~\ref{sec:functor-class}, and defined in the Standard+Prelude:\footnote{The term \emph{functor} (as well as the term+ \emph{monad} to be introduced shortly) comes from a branch of+ abstract mathematics known as \emph{category theory}+ \cite{pierce-ct}. This reflects the strong mathematical principles+ that underly Haskell, but otherwise does not concern us here; i.e.,+ you do not need to know anything about category theory to understand+ Haskell's functors and monads.} \indexhs{fmap}+\begin{spec}+class Functor f where+ fmap :: (a -> b) -> f a -> f b+\end{spec}++\syn{Type applications are written in the same manner as function+applications, and are also left associative: the type |T a b| is+equivalent to |((T a) b)|.}++There is something new here: the type variable |f| is applied to other+type variables, as in |f a| and |f b|. Thus we would expect |f| to be+a \emph{type constructor} such as |Music| that can be applied to an+argument. Indeed, a suitable instance of |Functor| for |Music| is:+\begin{code}+instance Functor Music where+ fmap f m = mMap f m+\end{code}+Similarly for |Primitive|:+\begin{code}+instance Functor Primitive where+ fmap f p = pMap f p+\end{code}+%% \begin{code}+%% instance Functor Tree where+%% fmap f (Leaf x) = Leaf (f x)+%% fmap f (Branch t1 t2) = Branch (fmap f t1) (fmap f t2)+%% \end{code}++Indeed, in retrospect, back in Chapter~\ref{ch:more-music} where we+defined |mMap| and |pMap|, we could have declared |Music| and+|Primitive| as instances of |Monad| directly, and avoided defining the+names |mMap| and |pMap| altogether:+\begin{spec}+instance Functor Music where+ fmap f (Prim p) = Prim (fmap f p)+ fmap f (m1 :+: m2) = fmap f m1 :+: fmap f m2+ fmap f (m1 :=: m2) = fmap f m1 :=: fmap f m2+ fmap f (Modify c m) = Modify c (fmap f m)++instance Functor Primitive where+ pMap :: (a -> b) -> Primitive a -> Primitive b+ pMap f (Note d x) = Note d (f x)+ pMap f (Rest d) = Rest d+\end{spec}++In Haskell we write |Music Pitch| for a |Music| value instantiated on+|Pitch| values; |Music| is the type constructor. Similarly, we write+|[Int]| for lists instantiated on integers; but what is the type+constructor for lists? Because of Haskell's special syntax for the+list data type, there is also a special syntax for its type+constructor, namely |[]|.++\syn{Similarly, for tuples the type constructors are |(,)|, |(,,)|,+ |(,,,)|, and so on, and the type constructor for the function type+ is |(->)|. This means that the following pairs of types are+ equivalent: |[a]| and |[] a|, |f -> g| and |(->) f g|, |(a,b)| and+ |(,) a b|, and so on.}++This allows us to create an instance of |Functor| for lists, as+follows:+\begin{spec}+instance Functor [] where+ fmap f [] = []+ fmap f (x:xs) = f x : fmap f xs+\end{spec}+Note the use of |[]| here in two ways: as a value in the list+data type, and as a type constructor as described above. ++Of course, the above declaration is equivalent to:+\begin{spec}+instance Functor [] where+ fmap = map+\end{spec}+where |map| is the familiar function that we have been using since+Chapter \ref{ch:poly}. This instance is in fact predefined in the+Standard Prelude.++One of the nice things about the |Functor| class, of course, is that+we can now use the same name, |fmap|, for lists, |Music|, and+|Primitive| values (and any other data type for which an instance of+|Functor| is declared). This could not have been done without+higher-order type constructors, and here demonstrates the ability to+handle generic ``container'' types, allowing functions such as |fmap|+to work uniformly over them.++As mentioned in Section \ref{sec:tc-laws}, type classes often imply+a set of \emph{laws} which govern the use of the operators in the+class. In the case of the |Functor| class, the following laws are+expected to hold:+\begin{spec}+fmap id = id+fmap (f . g) = fmap f . fmap g+\end{spec}++\syn{|id| is the \emph{identity function}, |\x->x|. Although+|id| is polymorphic, note that if its type on the left-hand side of+the equation above is |a->a|, then its type on the right must be+|t a -> t a|, for some type constructor |t| that is an instance+of |Functor|.}++These laws ensure that the shape of the ``container type'' is+unchanged by |fmap|, and that the contents of the container are not+re-arranged by the mapping function.++\vspace{.1in}\hrule++\begin{exercise}{\em+Verify that the instances of |Functor| for lists, |Primitive|, and+|Music| are law-abiding.}+\end{exercise}++\vspace{.1in}\hrule++\section{The |Monad| Class}+\label{sec:monadic-classes}++There are several classes in Haskell that are related to the notion of+a monad, which can be viewed as a generalization of the principles+that underly IO. Because of this, although the names of the classes+and methods may seem unusual, these ``monadic'' operations are rather+intuitive and useful for general programming.\footnote{Moggi+ \cite{moggi89} was one of the first to point out the value of monads+ in describing the semantics of programming languages, and Wadler+ first popularized their use in functional programming+ \cite{wadler-popl92,peytonjoneswadler-popl93}.}++There are three classes associated with monads: |Functor| (which we+have discussed already), |Monad| (also defined in the Standard+Prelude), and |MonadPlus| (defined in |Control.Monad|).+\indexamb{Monad}{type class} \indexamb{Monad}{library}++The |Monad| class defines four basic operators: |(>>=)| (often+pronounced ``bind''), |(>>)| (often pronounced ``sequence''),+|return|, and |fail|:+\begin{spec}+class Monad m where+ (>>=) :: m a -> (a -> m b) -> m b+ (>>) :: m a -> m b -> m b+ return :: a -> m a+ fail :: String -> m a++ m >> k = m >>= \_ -> k+ fail s = error s+\end{spec}++\syn{The two infix operators above are typeset nicely here; using a+ text editor, you will have to type \verb+>>=+ and \verb+>>++ instead.}++The default methods for |(>>)| and |fail| define behaviors that+are almost always just what is needed. Therefore most instances of+|Monad| need only define |(>>=)| and |return|. ++Before studying examples of particular instances of |Monad|, we will+first reveal another secret in Haskell, namely that the |do| syntax is+actually shorthand for use of the monadic operators! The rules for+this are a bit more involved than those for other syntax we have seen,+but are still straightforward. The first rule is this:+\begin{spec}+do e ==> e+\end{spec}+So an expression such as |do putStr "Hello World"| is equivalent +to just \linebreak+|putStr "Hello World"|. ++The next rule is:+\begin{spec}+do e1; e2; ...; en+==> e1 >> do e2 ; ...; en+\end{spec}++For example, combining this rule with the previous one means that:+\begin{spec}+do writeFile "testFile.txt" "Hello File System"+ putStr "Hello World"+\end{spec}+is equivalent to:+\begin{spec}+writeFile "testFile.txt" "Hello File System" >>+putStr "Hello World"+\end{spec}+Note now that the sequencing of two commands is just the application+of the function |(>>)| to two values of type |IO ()|. There is+no magic here---it is all just functional programming! ++\syn{What is the type of |(>>)| above? From the type class+declaration we know that its most general type is:+\begin{spec}+(>>) :: Monad m => m a -> m b -> m b+\end{spec}++However, in the case above, its two arguments both have type +|IO ()|, so the type of |(>>)| must be:+\begin{spec}+(>>) :: IO () -> IO () -> IO ()+\end{spec}+That is, |m = IO|, |a = ()|, and |b = ()|. Thus the type of+the result is |IO ()|, as expected.}++The rule for pattern matching is the most complex, because we must+deal with the situation where the pattern match fails:+\begin{spec}+do pat <- e1 ; e2 ; ...; en+==> let ok pat = do e2 ; ...; en+ ok _ = fail "..."+ in e1 >>= ok +\end{spec}+The right way to think of |(>>=)| above is simply this: it+``executes'' |e1|, and then applies |ok| to the result. What+happens after that is defined by |ok|: if the match succeeds, the+rest of the commands are executed, otherwise the operation |fail|+in the monad class is called, which in most cases (because of the+default method) results in an |error|.++\syn{The string argument to |error| is a compiler-generated error+message, preferably giving some indication of the location of the+pattern-match failure.}++A special case of the above rule is the case where the pattern |pat|+is just a name, in which case the match cannot fail, so the rule+simplifies to:+\begin{spec}+do x <- e1 ; e2 ; ...; en+==> e1 >>= \x -> do e2 ; ...; en+\end{spec}+The final rule deals with the |let| notation within a |do|+expression:+\begin{spec}+do let decllist ; e2 ; ...; en+==> let decllist in do e2 ; ...; en+\end{spec}+\indexkw{let}+\syn{Although we have not used this feature, note that a |let|+inside of a |do| can take multiple definitions, as implied by the+name |decllist|.}++As mentioned earlier, because you already understand Haskell IO, you+should have a fair amount of intuition about what the monadic+operators do. Unfortuantely, we cannot look very closely at the+instance of |Monad| for the type |IO|, since it ultimately relies on+the state of the underlying operating system, which we do not have+direct access to other than through primitive operations that+communicate with it. Even then, these operations vary from system to+system.++Nevertheless, a proper implementation of IO in Haskell is obliged to+obey the following \emph{\indexwd{monad laws}}:+\begin{spec}+return a >>= k = k a+m >>= return = m+m >>= (\x -> k x >>= h) = (m >>= k) >>= h+\end{spec}+The first of these laws expresses the fact that |return| simply+``sends'' its value to the next action. Likewise, the second law says+that if we immediately return the result of an action, we might as+well just let the action return the value itself. The third law is+the most complex, and essentially expresses an \emph{associativity}+property for the bind operator |(>>=)|. A special case of this+law applies to the sequence operator |(>>)|:+\begin{spec}+m1 >> (m2 >> m3) = (m1 >> m2) >> m3+\end{spec}+in which case the associativity is more obvious.++There is one other monad law, whose purpose is to connect the+|Monad| class to the |Functor| class, and therefore only applies+to types that are instances of both:+\begin{spec}+fmap f xs = xs >>= return . f+\end{spec}+We will see an example of this shortly.++Of course, this law can also be expressed in |do| notation:+\begin{spec}+fmap f xs = do x <- xs ; return (f x)+\end{spec}+as can the previous ones for |do|:+\begin{spec}+do x <- return a ; k x = k a+do x <- m ; return x = m+do x <- m ; y <- k x ; h y = do y <- (do x <- m ; k x) ; h y+do m1 ; m2 ; m3 = do (do m1 ; m2) ; m3+\end{spec}+So something like this:+\begin{spec}+do k <- getKey w+ return k+\end{spec}+is equivalent to just |getKey w|, according to the second law above.+As a final example, the third law above allows us to transform this:+\begin{spec}+do k <- getKey w+ n <- changeKey k+ respond n+\end{spec}+into this:+\begin{spec}+let keyStuff = do k <- getKey w+ changeKey k+in do n <- keyStuff+ respond n+\end{spec}++\vspace{.1in}\hrule++\begin{exercise}{\em+Verify the associativity law for |(>>)|, starting with the+associativity law for |(>>=)|.}+\end{exercise}++\vspace{.1in}\hrule++\subsection{Other Instances of Monad}+\label{monad-instances}++\paragraph*{|Maybe|}+\indexhs{Maybe}++In addition to |IO|, the Standard Prelude's |Maybe| data type is+a predefined instance of |Monad|:+\begin{spec}+instance Monad Maybe where+ Just x >>= k = k x+ Nothing >>= k = Nothing+ return = Just+ fail s = Nothing+\end{spec}+\syn{|Maybe| is also a predefined instance of |Functor|:+\begin{spec}+instance Functor Maybe where+ fmap f Nothing = Nothing+ fmap f (Just x) = Just (f x)+\end{spec}+}++When used with this instance, the types of the monad operators are:+\begin{spec}+(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b+return :: a -> Maybe a+\end{spec}+We leave as an exercise the task of proving that this instance is+law-abiding.++To see how this might be used, consider a computation involving+functions |f :: Int -> Int|, |g :: Int -> Int|, and +|x :: Int|:+\begin{spec}+g (f x)+\end{spec}+Now suppose that each of the calculations using |f| and |g|+could in fact be erroneous, and thus the results are encoded using the+|Maybe| data type. Unfortunately this can become rather tedious to+program, since each result that might be an error must be checked+manually, as in:+\begin{spec}+case (f x) of + Nothing -> Nothing+ Just y -> case (g y) of+ Nothing -> Nothing+ Just z -> z+\end{spec}+Alternatively, we could take advantage of |Maybe|'s membership in+the |Monad| class, and convert this into monadic form:+\begin{spec}+f x >>= \y ->+g y >>= \z ->+return z+\end{spec}+Or, using the more familiar |do| notation:+\begin{spec}+do y <- f x+ z <- g y+ return z+\end{spec}+Thus the tedium of the error check is ``hidden'' within the monad. In+this sense monads are a good example of the abstraction principle in+action (pardon the pun)!++It is also worth noting the following simplification:+\begin{spec}+f x >>= \y ->+g y >>= \z ->+return z+==> { currying simplification }+f x >>= \y ->+g y >>= return +==> { monad law for return }+f x >>= \y ->+g y+==> { currying simplification }+f x >>= g+\end{spec}+So we started with |g (f x)| and ended with |f x >>= g|; this is+not too bad considering the alternative that we started with!++For an even more pleasing result, we can define a monadic composition+operator:+\indexhs{composeM}+\begin{spec}+composeM :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)+(g `composeM` f) x = f x >>= g+\end{spec}+in which case we started with |(g . f) x| and ended with +|(g `composeM` f) x|. ++\syn{Note the type of |composeM|. It demonstrates that+higher-order type constructors are also useful in type signatures.}++%% \vspace{.1in}\hrule++%% \begin{exercise}{\em+%% Recall in Section \ref{sec:picture-interaction} the use of the+%% |Maybe| data type in the function |adjust|. Rewrite this+%% function using monadic operations.}+%% \end{exercise}++%% \vspace{.1in}\hrule++\paragraph*{Lists}++The list data type in Haskell is also a predefined instance of class+|Monad|:+\begin{spec}+instance Monad [] where+ m >>= k = concat (map k m)+ return x = [x]+ fail x = [ ]+\end{spec}+\syn{Recall that |concat| takes a list of lists and concatenates them+ all together. It is defined in the Standard Prelude as:+\begin{spec}+concat :: [[a]] -> [a]+concat xss = foldr (++) [] xss+\end{spec}+}++The types of the monadic operators in this case are:+\begin{spec}+(>>=) :: [a] -> (b -> [b]) -> [b]+return :: a -> [a]+\end{spec}+The monadic functions in this context can be thought of as dealing+with ``multiple values.'' Monadic binding takes a set (list) of+values and applies a function to each of them, collecting all+generated values together. The |return| function creates a+singleton list, and |fail| an empty one. For example,+\begin{spec}+do x <- [1,2,3]+ y <- [4,5,6]+ return (x,y)+\end{spec}+returns the list:+\begin{spec}+[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+\end{spec}+which happens to be the same list generated by:+\begin{spec}+[(x,y) | x <- [1,2,3], y <- [4,5,6]]+\end{spec}+\index{list comprehension}+So list comprehension syntax is in essence another kind of monad+syntax; indeed, they are not very different! (However, list+comprehensions can only be used with lists.)++% The existence of list comprehensions in Haskell is why the list data+% type is not predefined as an instance of |Monad|.++Note that if:+\begin{spec}+do x <- xs ; return (f x)+\end{spec}+is equivalent to:+\begin{spec}+[ f x | x <- xs ]+\end{spec}+(which is clearly just |map f xs|), then at least for the instance of+lists in |Monad|, the last monad law makes perfect sense:+\begin{spec}+fmap f xs = do x <- xs ; return (f x)+\end{spec}+Also note that the |Maybe| data type in monadic form behaves as a+sort of truncated list in monadic form: |Nothing| is the same as+|[]| and |Just x| is the same as |[x]|.)++\vspace{.1in}\hrule++\begin{exercise}{\em+Verify that all of the instance declarations in this section are+law-abiding.}+\end{exercise}++\begin{exercise}{\em+Consider the \emph{identity data type} defined by:+\begin{spec}+data Id a = Id a+\end{spec}+Create an instance of |Monad| for |Id|, and prove that it is+law-abiding.}+\end{exercise}++\vspace{.1in}\hrule++\subsection{Other Monadic Operations}+\label{sec:other-monadic-ops}++The Standard Prelude has several functions specifically designed for+use with monads; they are shown in Figure \ref{fig:monad-utilities}.+Indeed, one of these we have already used: |sequence_|. Any+mystery about how it works should be gone now; it is a very simple+fold of the sequencing operator |(>>)|, with |return ()| at the+end. Note also the definition of |sequence|, a generalization of+|sequence_| that returns a list of values of the intermediate+results.+\indexhs{sequence}+\indexhs{sequence\_}+\indexhs{mapM}+\indexhs{mapM\_}+\indexhs{(=<<)}++Finally, recall from Section \ref{sec:actions-are-value} that |putStr|+can be defined as:+\begin{spec}+putStr :: String -> IO ()+putStr s = sequence_ (map putChar s)+\end{spec}+Using |mapM_| from Figure \ref{fig:monad-utilities}, this can be+rewritten as:++\indexhs{putStr}+\begin{spec}+putStr :: String -> IO ()+putStr s = mapM_ putChar s+\end{spec}++\begin{figure}+\cbox{+\begin{spec}+sequence :: Monad m => [m a] -> m [a] +sequence = foldr mcons (return [])+ where mcons p q = do x <- p+ xs <- q+ return (x:xs)++sequence_ :: Monad m => [m a] -> m () +sequence_ = foldr (>>) (return ())++mapM :: Monad m => (a -> m b) -> [a] -> m [b]+mapM f as = sequence (map f as)++mapM_ :: Monad m => (a -> m b) -> [a] -> m ()+mapM_ f as = sequence_ (map f as)++(=<<) :: Monad m => (a -> m b) -> m a -> m b+f =<< x = x >>= f+\end{spec}}+\caption{Monadic Utility Functions}+\label{fig:monad-utilities}+\end{figure}++\section{The MonadPlus Class}+\label{sec:monad-plus}++The class |MonadPlus|, defined in the Standard Library+|Control.Monad|, is used for monads that have a \emph{zero element}+and a \emph{plus operator}: \indexhs{mzero} \indexhs{mplus}+\begin{spec}+class Monad m => MonadPlus m where+ mzero :: m a+ mplus :: m a -> m a -> m a+\end{spec}+The zero element should obey the following laws: +\begin{spec}+m >>= (\x -> mzero) = mzero+mzero >>= m = mzero+\end{spec}+and the plus operator should obey these:+\begin{spec}+m `mplus` mzero = m+mzero `mplus` m = m+\end{spec}+By analogy to arithmetic, think of |mzero| as 0, |mplus| as+addition, and |(>>=)| as multiplication. The above laws should+then make more sense.++For the |Maybe| data type, the zero and plus values are:+\begin{spec}+instance MonadPlus Maybe where+ mzero = Nothing+ Nothing `mplus` ys = ys+ xs `mplus` ys = xs+\end{spec}+and for lists they are:+\begin{spec}+instance MonadPlus [] where+ mzero = []+ mplus = (++)+\end{spec}+So you can see now that the familiar concatentation operation+|(++)| that we have been using all along for lists is just a+special case of the |mplus| operator.++It is worth pointing out that the IO monad is not an instance of the+|MonadPlus| class, since it has no zero element. For if it did+have a zero element, then the IO action |putStr "Hello" >> zero|+should \emph{not} print the string |"Hello"|, according to the first+zero law above. But this is counter-intuitive, or at least is+certainly not what the designers of Haskell had in mind for IO.++The |Monad| module in the Standard Library also includes several+other useful functions defined in terms of the monadic primitives.+You are encouraged to read these for possible use in your own+programs.++\vspace{.1in}\hrule++\begin{exercise}{\em+Verify that the instances of |MonadPlus| for the |Maybe| and+list data types are law-abiding.}+\end{exercise}++\vspace{.1in}\hrule++\section{State Monads}+\label{sec:state-monads}+\index{state monad}++Monads are commonly used to simulate stateful, or imperative,+computations, in which the details of updating and passing around the+state are hidden within the mechanics of the monad. Generally+speaking, a \emph{state monad} has a type of the form:+\begin{spec}+data SM s a = SM (s -> (s,a))+\end{spec}+where |s| is the state type, and |a| is the value type. The instance+of this type in |Monad| is given by:+\begin{spec}+instance Monad (SM s) where+ return a + = SM $ \s0 -> (s0,a)+ SM sm0 >>= fsm1+ = SM $ \s0 ->+ let (s1,a1) = sm0 s0+ SM sm1 = fsm1 a1+ (s2,a2) = sm1 s1+ in (s2,a2)+\end{spec}+The last equation in the |let| expression could obviously be+eliminated, but it is written this way to stress the symmetry in the+treatment of the two commands.++\syn{Note that |SM| is a type constructor that takes \emph{two} type+ arguments. Applyiing it to one argument (as in |SM s| above) is a+ kind of type-level currying, yielding a new type constructor that+ takes one argument, as required by the |Monad| class.}++A good example of a state monad, at least abstractly speaking, is+Haskell's |IO| type, where the state |s| can be thought of as the+``state of the world,'' such as the contents of the file system, the+image on a display, and the output of a printer.++But what about creating our own state monad? As a simple example,+consider this definition of a |Tree| data type:+\begin{spec}+data Tree a = Leaf a | Branch (Tree a) (Tree a)+ deriving Show+\end{spec}+Suppose now we wish to define a function |label :: Tree a -> Tree+Int| such that, for example, the value |test|:+\begin{spec}+test = let t = Branch (Leaf 'a') (Leaf 'b')+ in label (Branch t t)+\end{spec}+evaluates to:+\begin{spec}+Branch (Branch (Leaf 0) (Leaf 1)) + (Branch (Leaf 2) (Leaf 3))+\end{spec}+Without knowing anything about monads, this job is relatively easy:+\begin{spec}+label :: Tree a -> Tree Int+label t = snd (lab t 0)++lab :: Tree a -> Int -> (Int, Tree Int)+lab (Leaf a) n + = (n+1, Leaf n)+lab (Branch t1 t2) n+ = let (n1,t'1) = lab t1 n+ (n2,t'2) = lab t2 n1+ in (n2, Branch t'1 t'2)+\end{spec}+Although simple, there is an undeniable tedium in ``threading'' the+value of |n| from one call to |lab| to the next. To solve this+problem, note that |lab t| has type |Int -> (Int, Tree Int)|, which is+in the right form for a state monad. Of course, we need a true data+type, and so we write:+\begin{spec}+newtype Label a = Label (Int -> (Int,a))+\end{spec}++\syn{A |newtype| declaration behaves just like a |data| declaration,+ except that only one constructor is allowed on the right-hand side.+ This allows the compiler to implement the datatype more efficiently,+ since it ``knows'' that only one possibility exists. It is also+ more type-safe than a type synonym, since, like |data|, it generates+ a new type, rather than being a synonym for an existing type.}++The |Monad| instance for |Label| is just like that for |SM| above:+\begin{spec}+instance Monad Label where+ return a + = Label $ \s -> (s,a)+ Label lt0 >>= flt1+ = Label $ \s0 ->+ let (s1,a1) = lt0 s0+ Label lt1 = flt1 a1+ in lt1 s1+\end{spec}++Whereas the monad handles the threading of the state, we also need a+way to extract information from the state, as needed in a particular+application. In the case of labeling trees, we need to know what the+current value of the state (an |Int|) is, at each point that we+encounter a leaf. So we define:+\begin{spec}+getLabel :: Label Int+getLabel = Label $ \n -> (n+1,n)+\end{spec} % $++Now we can write the following monadic version of the labeling+function:+\begin{spec}+mlabel :: Tree a -> Tree Int+mlabel t = let Label lt = mlab t+ in snd (lt 0)++mlab :: Tree a -> Label (Tree Int)+mlab (Leaf a)+ = do n <- getLabel+ return (Leaf n)+mlab (Branch t1 t2)+ = do t'1 <- mlab t1+ t'2 <- mlab t2+ return (Branch t'1 t'2)+\end{spec}+Note that the threading of the state has been completely eliminated+from |mlab|, as has the incrementing of the state, which has been+isolated in the function |getLabel|.++As an example, this test case:+\begin{spec}+mtest = let t = Branch (Leaf 'a') (Leaf 'b')+ in mlabel (Branch t t)+\end{spec}+generates the same result as the non-monadic version above.++For this simple example you may decide that eliminating the threading+of state is not worth it. Indeed, in reality it has just been moved+from the definition of |lab| to the method declaration for |(>>=)|,+and the new version of the program is certainly longer than the old!+But the capture of repetitious code into one function is the whole+point of the abstraction principle, and hopefully you can imagine a+context where threading of state happens often, perhaps hundreds of+times, in which case the abstraction will surely pay off. IO is one+example of this (imagine threading the state of the world on every IO+command).++\vspace{.1in}\hrule++\begin{exercise}{\em+Recall the definition of |replFun| in Chapter~\ref{lsystems},+Section~\ref{sec:musical-lsystem}. Note how it threads the random+number source through the program. Rewrite this function using a+state monad so that this threading is eliminated. }+\end{exercise}++\vspace{.1in}\hrule++\section{Type Class Type Errors}+\label{sec:class-reasoning}++As you know, Haskell's type system detects ill-typed expressions. But+what about errors due to malformed types? The value |(+) 1 2 3|+results in a type error since |(+)| takes only two arguments.+Similarly, the type |Tree Int Int| should result in some sort of an+error since the |Tree| type constructor takes only a single argument.+So, how does Haskell detect malformed types? The answer is a second+type system which ensures the correctness of types! That is, each+type is assigned its own type---which is called its \emph{kind}---and+these \indexwd{kinds} are used to ensure that the type is used+correctly.++There are only two kinds that we need to consider:+\begin{itemize}+\item The symbol $\ast$ represents the kind of type associated with+concrete data objects. That is, if the value |v| has type |t|,+then the kind of |t| must be $\ast$.++\item If $\kappa_1$ and $\kappa_2$ are kinds, then+$\kappa_1\rightarrow\kappa_2$ is the kind of types that take a type of+kind $\kappa_1$ and return a type of kind $\kappa_2$.+\end{itemize}+The details of how kinds are used to detect malformed types are beyond+the scope of this text, but it is helpful to walk through a familiar+example:++|Int| has kind $\ast$, as does the type |Tree Int|. The type+constructor |Tree|, however, has kind $\ast\rightarrow\ast$.+Instances of the |Functor| class must all have the kind+$\ast\rightarrow\ast$. Thus a kind error would result from a+declaration such as:+\begin{spec}+instance Functor Int where ...+\end{spec}+or+\begin{spec}+instance Functor (Tree Int) where ...+\end{spec}+Kinds do not appear directly in Haskell programs; the Haskell system+infers them without any need for ``kind declarations.'' Kinds stay in+the background of a Haskell program except when a kind error occurs,+in which case an error message may refer to the kind conflict.+Fortunately, kinds are simple enough that your Haskell system should+be able to provide descriptive error messages in most cases.
+ HSoM/MoreMusic.lhs view
@@ -0,0 +1,1260 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/MoreMusic.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter{More Music} +\label{ch:more-music} + +\begin{code} +module Euterpea.Music.Note.MoreMusic where +import Euterpea.Music.Note.Music +\end{code} + +This chapter explores a number of simple musical ideas, and +contributes to a growing collection of Euterpea functions for +expressing those ideas. + +%% \section{Lines and Chords} +%% +%% Two common ideas in music are the construction of notes in a +%% horizontal fashion (a \emph{line} or \emph{melody}), and in a vertical +%% fashion (a \emph{chord}): +%% \begin{code} +%% line, chord :: [Music a] -> Music a +%% line = foldr1 (:+:) +%% chord = foldr1 (:=:) +%% \end{code} +%% From the notes in the C major triad in register 4, I can now construct +%% a C major arpeggio and chord as well: +%% \begin{code} +%% cMaj = [ n 4 qn [] | n <- [c,e,g] ] -- octave 4, quarter notes + +%% cMajArp = line cMaj +%% cMajChd = chord cMaj +%% \end{code} + +\out{ +\begin{code} +line, chord :: [Music a] -> Music a +line = foldr (:+:) (rest 0) +chord = foldr (:=:) (rest 0) + +line1, chord1 :: [Music a] -> Music a +line1 = foldr1 (:+:) +chord1 = foldr1 (:=:) +\end{code} +} + +\section{Delay and Repeat} + +%% Suppose that we wish to describe a melody |m| accompanied by +%% an identical voice a perfect 5th higher. In Euterpea we can simply write +%% |m :=: transpose 7 m|. + +We can delay the start of a music value simply by inserting a rest in +front of it, which can be packaged in a function as follows: +\begin{code} +delayM :: Dur -> Music a -> Music a +delayM d m = rest d :+: m +\end{code} +With |delayM| it is easy to write canon-like structures such as |m :=: +delayM d m|, a song written in rounds (see Exercise +\ref{ex:frere-jacques}), and so on. + +Recall from Chapter \ref{ch:interlude} the function |timesM| that +repeats a musical phrase a certain number of times: +\begin{code} + +timesM :: Int -> Music a -> Music a +timesM 0 m = rest 0 +timesM n m = m :+: timesM (n-1) m +\end{code} + +More interestingly, Haskell's non-strict semantics allows us to +define \emph{infinite} musical values. For example, a musical value +may be repeated \emph{ad nauseam} using this simple function: + +\pagebreak + +\begin{code} + +repeatM :: Music a -> Music a +repeatM m = m :+: repeatM m +\end{code} +Thus, for example, an infinite ostinato can be expressed in this way, +and then used in different contexts that automatically extract only +the portion that is actually needed. Functions that create such +contexts will be described shortly. + +\section{Inversion and Retrograde} + +The notions of inversion, retrograde, retrograde inversion, etc.\ as +used in twelve-tone theory are also easily captured in Euterpea. +These terms are usually applied only to a ``line'' of notes, i.e.\ a +melody (in twelve-tone theory it is called a ``row''). The +\emph{retrograde} of a line is simply its reverse---i.e.\ the notes +played in the reverse order. The \emph{inversion} of a line is with +respect to a given pitch (by convention usually the first pitch), +where the intervals between successive pitches are inverted, +i.e.\ negated. If the absolute pitch of the first note is |ap|, then +each pitch |p| is converted into an absolute pitch |ap - (absPitch p - +ap)|, in other words |2*ap - absPitch p|. + +To do all this in Haskell, a transformation from a line created by +|line| to a list is defined: +\begin{code} +lineToList :: Music a -> [Music a] +lineToList (Prim (Rest 0)) = [] +lineToList (n :+: ns) = n : lineToList ns +lineToList _ = + error "lineToList: argument not created by function line" +\end{code} + +Using this function it is then straightforward to define |invert|: +\begin{code} +invert :: Music Pitch -> Music Pitch +invert m = + let l@(Prim (Note _ r) : _) = lineToList m + inv (Prim (Note d p)) = + note d (pitch (2 * absPitch r - absPitch p)) + inv (Prim (Rest d)) = rest d + in line (map inv l) +\end{code} +%% invert m = line (map inv l) +%% where l@(Prim (Note _ r) : _) = lineToList m +%% inv (Prim (Note d p)) = +%% note d (pitch (2 * absPitch r - absPitch p)) +%% inv (Prim (Rest d)) = rest d + +\syn{The pattern |l@(Prim (Note _ r) : _)| is called an \emph{as + pattern}. It behaves just like the pattern |Prim (Note _ r) : _| + but additionally binds |l| to the value of a successful match to + that pattern. |l| can then be used wherever it is in scope, such as + in the last line of the function definition.} + +With |lineToList| and |invert| it is then easy to define the remaining +functions via composition: +\begin{code} +retro, retroInvert, invertRetro :: Music Pitch -> Music Pitch +retro = line . reverse . lineToList +retroInvert = retro . invert +invertRetro = invert . retro +\end{code} + +As an example of these concepts, Figure~\ref{fig:twelve-tone} shows a +simple melody (not a complete twelve-tone row) and four +transformations of it. + +\begin{figure*} +\centerline{ +\epsfysize=1in +\epsfbox{pics/TwelveToneTransformationsCropped.eps} +} +\caption{A Simple Melody and Four Transformations} +\label{fig:twelve-tone} +\end{figure*} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Show that |retro . retro|, |invert . invert|, and +|retroInvert . invertRetro| are the identity on values created by +|line|. (You may use the lemma that |reverse (reverse l) = l|.)} +\end{exercise} + +\begin{exercise}{\em +Define a function |properRow :: Music Pitch -> Bool| that determines +whether or not its argument is a ``proper'' twelve-tone row, meaning +that: (a) it must have exactly twelve notes, and (b) each unique pitch +class is used exactly once (regardless of the octave). Enharmonically +equivalent pitch classes are \emph{not} considered unique. You may +assume that the |Music Pitch| value is generated by the function +|line|, but note that rests are allowed.} +\end{exercise} + +\begin{exercise}{\em +Define a function |palin :: Music Pitch -> Bool| that determines +whether or not a given line (as generated by the |line| function) is a +palindrome or not. You should ignore rests, and disregard note +durations---the main question is whether or not the melody is a +palindrome.} +\end{exercise} + +\begin{exercise}{\em +Define a function |retroPitches :: Music Pitch -> Music Pitch| that +reverses the pitches in a line, but maintains the durations in the +same order from beginning to end. For example: +\begin{spec} +retroPitches (line [c 4 en, d 4 qn]) +===> (line [d 4 en, c 4 qn]) +\end{spec}} +\end{exercise} + +\vspace{.1in}\hrule + +\begin{figure*} +\centerline{ +\epsfysize=2.0in +\epsfbox{Pics/pr12.eps} +} +\caption{Nested Polyrhythms (top: |pr1|; bottom: |pr2|)} +\label{polyrhythms} +\end{figure*} + +\section{Polyrhythms} + +For some rhythmical ideas, first note that if |m| is a line of three +eighth notes, then |tempo (3/2) m| is a \emph{triplet} of eighth notes +(recall that this idea was used in Chapter \ref{ch:interlude}). In +fact |tempo| can be used to create quite complex rhythmical patterns. +For example, consider the ``nested polyrhythms'' shown in Figure +\ref{polyrhythms}. They can be expressed naturally in Euterpea as +follows (note the use of a |let| clause in |pr2| to capture recurring +phrases): +\begin{code} + +pr1, pr2 :: Pitch -> Music Pitch +pr1 p = tempo (5/6) + ( tempo (4/3) ( mkLn 1 p qn :+: + tempo (3/2) ( mkLn 3 p en :+: + mkLn 2 p sn :+: + mkLn 1 p qn ) :+: + mkLn 1 p qn) :+: + tempo (3/2) ( mkLn 6 p en)) +\end{code} + +\pagebreak + +\begin{code} +pr2 p = + let m1 = tempo (5/4) (tempo (3/2) m2 :+: m2) + m2 = mkLn 3 p en + in tempo (7/6) ( m1 :+: + tempo (5/4) (mkLn 5 p en) :+: + m1 :+: + tempo (3/2) m2) + +mkLn :: Int -> p -> Dur -> Music p +mkLn n p d = line $ take n $ repeat $ note d p +\end{code} % $ +\syn{|take n lst| is the first |n| elements of the list |lst|. For + example: +\begin{spec} +take 3 [C,Cs,Df,D,Ds] ===> [C,Cs,Df] +\end{spec} +|repeat x| is the infinite list of the same value |x|. For example: +\begin{spec} +take 3 (repeat 42) ===> [42,42,42] +\end{spec} +} + +To play polyrhythms |pr1| and |pr2| in parallel using middle C +and middle G, respectively, we can write: +\begin{code} + +pr12 :: Music Pitch +pr12 = pr1 (C,4) :=: pr2 (G,4) +\end{code} + +\section{Symbolic Meter Changes} + +We can implement the notion of ``symbolic meter changes'' of the form +``oldnote = newnote'' (quarter note = dotted eighth, for example) by +defining an infix function: +\begin{code} + +(=:=) :: Dur -> Dur -> Music a -> Music a +old =:= new = tempo (new/old) +\end{code} +Of course, using the new function is not much shorter than using +|tempo| directly, but it may have mnemonic value. + +\pagebreak + +\section{Computing Duration} +\label{sec:duration} + +It is often desirable to compute the \emph{duration}, in whole notes, +of a musical value; we can do so as follows: +\begin{code} +dur :: Music a -> Dur +dur (Prim (Note d _)) = d +dur (Prim (Rest d)) = d +dur (m1 :+: m2) = dur m1 + dur m2 +dur (m1 :=: m2) = dur m1 `max` dur m2 +dur (Modify (Tempo r) m) = dur m / r +dur (Modify _ m) = dur m +\end{code} +The duration of a primitive value is obvious. The duration of +|m1 :+: m2| is the sum of the two, and the duration of |m1 :=: m2| is +the maximum of the two. The only tricky case is the duration of a +music value that is modified by the |Tempo| atttribute---in this case +the duration must be scaled appropriately. + +Note that the duration of a music value that is conceptually infinite +in duration will be |bottom|, since |dur| will not terminate. +(Similary, taking the length of an infinite list is |bottom|.) For +example: +\begin{spec} +dur (repeatM (a 4 qn)) +==> dur (a 4 qn :+: repeatM (a 4 qn)) +==> dur (a 4 qn) + dur (repeatM (a 4 qn)) +==> qn + dur (repeatM (a 4 qn)) +==> qn + qn + dur (repeatM (a 4 qn)) +==> ... +==> bottom +\end{spec} + +\section{Super-retrograde} +\label{sec:reverse-music} + +Using |dur| we can define a function |revM| that reverses any |Music| +value whose duration is finite (and is thus considerably more useful +than |retro| defined earlier): + +\pagebreak + +\begin{code} +revM :: Music a -> Music a +revM n@(Prim _) = n +revM (Modify c m) = Modify c (revM m) +revM (m1 :+: m2) = revM m2 :+: revM m1 +revM (m1 :=: m2) = + let d1 = dur m1 + d2 = dur m2 + in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) + else (rest (d2-d1) :+: revM m1) :=: revM m2 +\end{code} + +The first three cases are easy, but the last case is a bit tricky. +The parallel constructor |(:=:)| implicitly begins each of its music +values at the same time. But if one is shorter than the other, then, +when reversed, a \emph{rest} must be inserted before the shorter one, +to account for the difference. + +Note that |revM| of a |Music| value whose duration is infinite is +|bottom|. (Analogously, reversing an infinite list is |bottom|.) + +\section{|takeM| and |dropM|} +\label{sec:take-and-drop} + +Two other useful operations on |Music| values is the ability to +``take'' the first so many beats (in whole notes), discarding the +rest, and conversely, the ability to ``drop'' the first so many beats, +returning what is left. We will first define a function |takeM :: Dur +-> Music a -> Music a| such that |takeM d m| is a \emph{prefix} of |m| +having duration |d|. In other words, it ``takes'' only the first |d| +beats (in whole notes) of |m|. We can define this function as +follows: +\begin{code} + +takeM :: Dur -> Music a -> Music a +takeM d m | d <= 0 = rest 0 +takeM d (Prim (Note oldD p)) = note (min oldD d) p +takeM d (Prim (Rest oldD)) = rest (min oldD d) +takeM d (m1 :=: m2) = takeM d m1 :=: takeM d m2 +takeM d (m1 :+: m2) = let m'1 = takeM d m1 + m'2 = takeM (d - dur m'1) m2 + in m'1 :+: m'2 +takeM d (Modify (Tempo r) m) = tempo r (takeM (d*r) m) +takeM d (Modify c m) = Modify c (takeM d m) +\end{code} +This definition is fairly straightforward, except for the case of +sequential composition, where two cases arise: (1) if |d| is greater +than |dur m1|, then we return \emph{all} of |m1| (i.e.\ |m'1 = m1|), +followed by |d - dur m'1| beats of |m2|, and (2) if |d| is less than +|dur m1|, then we return |d| beats of |m1| (i.e. |m'1|), followed by +nothing (since |d - dur m'1| will be zero). Note that this strategy +will work even if |m1| or |m2| is infinite. +\out{ +For backward compatibility: +\begin{code} +cut :: Dur -> Music a -> Music a +cut = takeM +\end{code} +} + +Similarly, we can define a function |dropM :: Dur -> Music a -> Music +a| such that |dropM d m| is a \emph{suffix} of |m| where the first |d| +beats (in whole notes) of |m| have been ``dropped:'' +\begin{code} +dropM :: Dur -> Music a -> Music a +dropM d m | d <= 0 = m +dropM d (Prim (Note oldD p)) = note (max (oldD-d) 0) p +dropM d (Prim (Rest oldD)) = rest (max (oldD-d) 0) +dropM d (m1 :=: m2) = dropM d m1 :=: dropM d m2 +dropM d (m1 :+: m2) = let m'1 = dropM d m1 + m'2 = dropM (d - dur m1) m2 + in m'1 :+: m'2 +dropM d (Modify (Tempo r) m) = tempo r (dropM (d*r) m) +dropM d (Modify c m) = Modify c (dropM d m) +\end{code} +This definition is also straightforward, except for the case of +sequential composition. Again, two cases arise: (1) if |d| is greater +than |dur m1|, then we drop |m1| altogether (i.e.\ |m'1| will be |rest +0|), and simply drop |d - dur m1| from |m2|, and (2) if |d| is less +than |dur m1|, then we return |m'1| followed by all of |m2| (since |d +- dur m1| will be negative). This definition too will work for +infinite values of |m1| or |m2|. + +\section{Removing Zeros} +\label{sec:zeros} + +Note that functions such as |timesM|, |line|, |revM|, |takeM| and +|dropM| occasionally insert rests of zero duration, and in the case of +|takeM| and |dropM|, may insert notes of zero duration. Doing this +makes the code simpler and more elegant, and since we cannot hear the +effect of the zero-duration events, the musical result is the same. + +On the other hand, these extraneous notes and rests (which we will +call ``zeros'') can be annoying when viewing the textual (rather than +audible) representation of the result. To alleviate this problem, we +define a function that removes them from a given |Music| value: + +\pagebreak + +\begin{code} +removeZeros :: Music a -> Music a +removeZeros (Prim p) = Prim p +removeZeros (m1 :+: m2) = + let m'1 = removeZeros m1 + m'2 = removeZeros m2 + in case (m'1,m'2) of + (Prim (Note 0 p), m) -> m + (Prim (Rest 0 ), m) -> m + (m, Prim (Note 0 p)) -> m + (m, Prim (Rest 0 )) -> m + (m1, m2) -> m1 :+: m2 +removeZeros (m1 :=: m2) = + let m'1 = removeZeros m1 + m'2 = removeZeros m2 + in case (m'1,m'2) of + (Prim (Note 0 p), m) -> m + (Prim (Rest 0 ), m) -> m + (m, Prim (Note 0 p)) -> m + (m, Prim (Rest 0 )) -> m + (m1, m2) -> m1 :=: m2 +removeZeros (Modify c m) = Modify c (removeZeros m) +\end{code} + +\syn{A |case| expression can only match against one value. To match + against more than one value, we can place them in a tuple of the + appropriate length. In the case above, |removeZeros| matches + against |m'1| and |m'2| by placing them in a pair |(m'1,m'2)|.} + +This function depends on the ``musical axioms'' that if |m1| in either +|m1 :+: m2| or |m1 :=: m2| is a zero, then the latter expressions are +equivalent to just |m2|. Similarly, if |m2| is a zero, they are +equivalent to just |m1|. Although intuitive, a formal proof of these +axioms is deferred until Chapter \ref{ch:algebra}. + +As an example of using |removeZeros|, consider the |Music| value: +\begin{spec} +m = c 4 en :+: repeatM (d 4 en) +\end{spec} + +\pagebreak + +Then note that: +\begin{spec} +takeM hn (dropM hn m) +===> +Prim (Note (0 % 1) (C,4)) :+: (Prim (Note (0 % 1) (D,4)) :+: +(Prim (Note (0 % 1) (D,4)) :+: (Prim (Note (0 % 1) (D,4)) :+: +(Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: +(Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: +Prim (Rest (0 % 1))))))))) +\end{spec} +Note the zero-duration notes and rests. But if we apply |removeZeros| +to the result we get: +\begin{spec} +removeZeros (takeM hn (dropM hn m)) +===> +Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: +(Prim (Note (1 % 8) (D,4)) :+: Prim (Note (1 % 8) (D,4)))) +\end{spec} +Both the zero-duration rests and notes have been removed. + +\section{Truncating Parallel Composition} +\label{sec:truncate} + +The duration of |m1 :=: m2| is the maximum of the durations of |m1| +and |m2| (and thus if one is infinite, so is the result). However, +sometimes it is useful to have the result be of duration equal to the +\emph{shorter} of the two. Defining a function to achieve this is not +as easy as it sounds, since it may require truncating the longer one +in the middle of a note (or notes), and it may be that one (or both) +of the |Music| values is infinite. + +The goal is to define a ``truncating parallel composition'' operator +|(/=:) :: Music a -> Music a -> Music a|. Using |takeM|, we can make +an initial attempt at a suitable definition for |(/=:)| as follows: +\begin{spec} +(/=:) :: Music a -> Music a -> Music a +m1 /=: m2 = takeM (dur m2) m1 :=: takeM (dur m1) m2 +\end{spec} +%% (min (dur m1) (dur m2)) (m1 :=: m2) + +Unfortunately, whereas |takeM| can handle infinite-duration music +values, |(/=:)| cannot. This is because |(/=:)| computes the duration +of both of its arguments, but if one of them, say |m1|, has infinite +duration, then |dur m1 ==> bottom|. If, in a particular context, we +know that only one of the two arguments is infinite, and we know which +one (say |m1|), it is always possible to write: +\begin{spec} +takeM (dur m2) m1 :=: m2 +\end{spec} +But somehow this seems unsatisfactory. + +\subsection{Lazy Evaluation to the Rescue} +\label{sec:lazy-rescue} + +The root of this problem is that |dur| uses a conventional number +type, namely the type |Rational| (which is a ratio of |Integer|s), to +compute with, which does not have a value for infinity (|bottom| is +not the same as infinity!). But what if we were to somehow compute +the duration \emph{lazily}---meaning that we only compute that much of +the duration that is needed to perform some arithmetic result of +interest. In particular, if we have one number |n| that we know is +``at least'' |x|, and another number |m| that is exactly |y|, then if +|x>y|, we know that |n>m|, even if |n|'s actual value is infinity! + +To realize this idea, let's first define a type synonym for ``lazy +durations:'' +\begin{code} +type LazyDur = [Dur] +\end{code} +The intent is that a value |d :: LazyDur| is a non-decreasing list of +durations such that the last element in the list is the actual +duration, and an infinite list implies an infinite duration. + +Now let's define a new verion of |dur| that computes the |LazyDur| of +its argument: +\begin{code} +durL :: Music a -> LazyDur +durL m@(Prim _) = [dur m] +durL (m1 :+: m2) = let d1 = durL m1 + in d1 ++ map (+(last d1)) (durL m2) +durL (m1 :=: m2) = mergeLD (durL m1) (durL m2) +durL (Modify (Tempo r) m) = map (/r) (durL m) +durL (Modify _ m) = durL m +\end{code} +where |mergeLD| merges two |LazyDur| values into one: +\begin{code} +mergeLD :: LazyDur -> LazyDur -> LazyDur +mergeLD [] ld = ld +mergeLD ld [] = ld +mergeLD ld1@(d1:ds1) ld2@(d2:ds2) = + if d1<d2 then d1 : mergeLD ds1 ld2 + else d2 : mergeLD ld1 ds2 +\end{code} + +We can then define a function |minL| to compare a |LazyDur| with +a regular |Dur|, returning the least |Dur| as a result: +\begin{code} +minL :: LazyDur -> Dur -> Dur +minL [] d' = d' +minL [d] d' = min d d' +minL (d:ds) d' = if d < d' then minL ds d' else d' +\end{code} +And with |minL| we can then define a new version of |takeM|: +\begin{code} +takeML :: LazyDur -> Music a -> Music a +takeML [] m = rest 0 +takeML (d:ds) m | d <= 0 = takeML ds m +takeML ld (Prim (Note oldD p)) = note (minL ld oldD) p +takeML ld (Prim (Rest oldD)) = rest (minL ld oldD) +takeML ld (m1 :=: m2) = takeML ld m1 :=: takeML ld m2 +takeML ld (m1 :+: m2) = + let m'1 = takeML ld m1 + m'2 = takeML (map (\d -> d - dur m'1) ld) m2 + in m'1 :+: m'2 +takeML ld (Modify (Tempo r) m) = tempo r (takeML (map (*r) ld) m) +takeML ld (Modify c m) = Modify c (takeML ld m) +\end{code} +Compare this definition with that of |takeM|---they are very similar. + +Finally, we can define a correct (meaning it works properly on +infinite |Music| values) version of |(/=:)| as follows: +\begin{code} +(/=:) :: Music a -> Music a -> Music a +m1 /=: m2 = takeML (durL m2) m1 :=: takeML (durL m1) m2 +\end{code} + +Whew! This may seem like a lot of effort, but the new code is +actually not much different from the old, and now we can freely use +|(/=:)| without worrying about which if any of its arguments are +infinite. + +\out{ +A potential generalization of these ideas: + +Let's represent numbers as a non-empty list of monotonically +increasing numbers whose last number is the limit: + +newtype ANum a = ANum [a] + deriving (Eq, Show) + +instance Num a => Num (ANum a) where + ANum xs + ANum ys = ANum (nLift (+) xs ys) +--ANum xs - ANum ys = ANum (nLift (-) xs ys) -- not valid!!! + ANum xs - ANum ys = ANum (nSub xs ys) + ANum xs * ANum ys = ANum (nLift (*) xs ys) + abs (ANum xs) = ANum (map abs xs) + signum (ANum xs) = ANum (map signum xs) + fromInteger x = ANum [fromInteger x] + +nLift op [x] ys = map (x `op`) ys +nLift op xs [y] = map (`op` y) xs +nLift op (x:xs) (y:ys) = (x `op` y) : nLift op xs ys + +nSub [x] ys = map (x-) ys +nSub xs [y] = map (subtract y) xs +nSub (x:xs) (y:ys) = nSub xs ys + +ANum [x] =* ANum [y] = x == y +ANum (x:xs) =* ANum (y:ys) = ANum xs =* ANum ys + +ANum [x] >* ANum (y:ys) = if x<=y then False else ANum [x] >* ANum ys +ANum (x:xs) >* ANum [y] = if x>y then True else ANum xs >* ANum [y] +ANum (x:xs) >* ANum (y:ys) = ANum xs >* ANum ys + +an1 >=* an2 = an1 >* an2 || an1 =* an2 +an1 <* an2 = not (an1 >=* an2) +an1 <=* an2 = not (an1 >* an2) + +The reason that subtraction cannot be handled like addition or +multiplication is that, if one number is at least x and another number +is at least y, we cannot conclude ANYTHING about the difference +between them. + +Here are the merge functions for the parallel short constructor: + +mergeS :: Performance -> Performance -> Performance + +mergeS a@(e1:es1)) b@(e2:es2)) = + if e1 < e2 then foo e1 es1 b + else foo e2 a es2 +merge [] es2 = [] +merge es1 [] = [] + +foo e es1 es2 = + let pf = mergeS es1 es2 + dft = eTime (head pf) - eTime e + d = min (eDur e) (aDur pf + dft) + in e { eDur = d } : pf + + +aDur es = Anum (foo 0 es) + where foo d [] = d + foo d (e:es) = +} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Try using |(/=:)| with some infinite |Music| values (such as created +by |repeatM|) to assure yourself that it works properly. When using +it with \emph{two} infinite values, it should return an infinite +value, which you can test by applying |takeM| to the result.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Trills} +\label{sec:trills} + +A \emph{trill} is an ornament that alternates rapidly between two +(usually adjacent) pitches. Two versions of a trill function will be +defined, both of which take the starting note and an interval for the +trill note as arguments (the interval is usually one or two, but can +actually be anything). One version will additionally have an argument +that specifies how long each trill note should be, whereas the other +will have an argument that specifies how many trills should occur. In +both cases the total duration will be the same as the duration of the +original note. + +Here is the first trill function: +\begin{code} +trill :: Int -> Dur -> Music Pitch -> Music Pitch +trill i sDur (Prim (Note tDur p)) = + if sDur >= tDur then note tDur p + else note sDur p :+: + trill (negate i) sDur + (note (tDur-sDur) (trans i p)) +trill i d (Modify (Tempo r) m) = tempo r (trill i (d*r) m) +trill i d (Modify c m) = Modify c (trill i d m) +trill _ _ _ = + error "trill: input must be a single note." +\end{code} +Using this function it is simple to define a version that starts on the +trill note rather than the start note: +\begin{code} +trill' :: Int -> Dur -> Music Pitch -> Music Pitch +trill' i sDur m = trill (negate i) sDur (transpose i m) +\end{code} + +The second way to define a trill is in terms of the number of +subdivided notes to be included in the trill. We can use the first +trill function to define this new one: +\begin{code} +trilln :: Int -> Int -> Music Pitch -> Music Pitch +trilln i nTimes m = trill i (dur m / fromIntegral nTimes) m +\end{code} +This, too, can be made to start on the other note. +\begin{code} +trilln' :: Int -> Int -> Music Pitch -> Music Pitch +trilln' i nTimes m = trilln (negate i) nTimes (transpose i m) +\end{code} + +Finally, a |roll| can be implemented as a trill whose interval is +zero. This feature is particularly useful for percussion. +\begin{code} +roll :: Dur -> Music Pitch -> Music Pitch +rolln :: Int -> Music Pitch -> Music Pitch + +roll dur m = trill 0 dur m +rolln nTimes m = trilln 0 nTimes m +\end{code} + +Figure \ref{fig:ssf} shows a nice use of the trill functions in +encoding the opening lines of John Philip Sousa's \emph{Stars and + Stripes Forever}. + +\begin{figure} +\cbox{ +\begin{code} +ssfMel :: Music Pitch +ssfMel = line (l1 ++ l2 ++ l3 ++ l4) + where l1 = [ trilln 2 5 (bf 6 en), ef 7 en, ef 6 en, ef 7 en ] + l2 = [ bf 6 sn, c 7 sn, bf 6 sn, g 6 sn, ef 6 en, bf 5 en ] + l3 = [ ef 6 sn, f 6 sn, g 6 sn, af 6 sn, bf 6 en, ef 7 en ] + l4 = [ trill 2 tn (bf 6 qn), bf 6 sn, denr ] + +starsAndStripes :: Music Pitch +starsAndStripes = instrument Flute ssfMel + +\end{code}} +\caption{Trills in \emph{Stars and Stripes Forever}} +\label{fig:ssf} +\end{figure} + +\syn{|ssfMel| uses a |where| clause, which is similar to a |let| + expression, except that the equations appear after the result, + rather than before.} + +\section{Grace Notes} +\label{sec:grace-notes} + +Recall from Chapter \ref{ch:interlude} the function |graceNote| to +generate grace notes. A more general version is defined below, which +takes a |Rational| argument that specifies that fraction of the +principal note's duration to be used for the grace note's duration: +\begin{code} +grace :: Int -> Rational -> Music Pitch -> Music Pitch +grace n r (Prim (Note d p)) = + note (r*d) (trans n p) :+: note ((1-r)*d) p +grace n r _ = + error "grace: can only add a grace note to a note" +\end{code} +Thus |grace n r (note d p)| is a |Music| value consisting of two +notes, the first being the grace note whose duration is |r*d| and +whose pitch is |n| semitones higher (or lower if |n| is negative) than +|p|, and the second being the principal note at pitch |p| but now with +duration |(1-r)*d|. + +Note that |grace| places the downbeat of the grace note at the point +written for the principal note. Sometimes the interpretation of a +grace note is such that the downbeat of the principal note is to be +unchanged. In that case, the grace note reduces the duration of the +\emph{previous} note. We can define a function |grace2| that takes +two notes as arguments, and places the grace note appropriately: +\begin{code} +grace2 :: Int -> Rational -> + Music Pitch -> Music Pitch -> Music Pitch +grace2 n r (Prim (Note d1 p1)) (Prim (Note d2 p2)) = + note (d1-r*d2) p1 :+: note (r*d2) (trans n p2) :+: note d2 p2 +grace2 _ _ _ _ = + error "grace2: can only add a grace note to a note" +\end{code} + +\vspace{.1in}\hrule +\begin{exercise}{\em +Related to trills and grace notes in Western classical music are the +notions of \emph{mordent}, \emph{turn}, and \emph{appoggiatura}. +Define functions to realize these musical ornamentations.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Percussion} +\label{sec:percussion} + +Percussion is a difficult notion to represent in the abstract. On one +hand, a percussion instrument is just another instrument, so why +should it be treated differently? On the other hand, even common +practice notation treats it specially, although it has much in common +with non-percussive notation. The MIDI standard is equally ambiguous +about the treatment of percussion: on one hand, percussion sounds are +chosen by specifying an octave and pitch, just like any other +instrument; on the other hand, these pitches have no tonal meaning +whatsoever: they are just a convenient way to select from a large +number of percussion sounds. Indeed, part of the General MIDI +Standard is a set of names for commonly used percussion sounds. + +\begin{figure} +\cbox{\small +\begin{spec} +data PercussionSound = + AcousticBassDrum -- MIDI Key 35 + | BassDrum1 -- MIDI Key 36 + | SideStick -- ... + | AcousticSnare | HandClap | ElectricSnare | LowFloorTom + | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom + | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 + | HighTom | RideCymbal1 | ChineseCymbal | RideBell + | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 + | Vibraslap | RideCymbal2 | HiBongo | LowBongo + | MuteHiConga | OpenHiConga | LowConga | HighTimbale + | LowTimbale | HighAgogo | LowAgogo | Cabasa + | Maracas | ShortWhistle | LongWhistle | ShortGuiro + | LongGuiro | Claves | HiWoodBlock | LowWoodBlock + | MuteCuica | OpenCuica | MuteTriangle + | OpenTriangle -- MIDI Key 82 +\end{spec}} +\caption{General MIDI Percussion Names} +\label{fig:percussion} +\end{figure} +\out{ +\begin{code} +data PercussionSound = + AcousticBassDrum -- MIDI Key 35 + | BassDrum1 -- MIDI Key 36 + | SideStick -- ... + | AcousticSnare | HandClap | ElectricSnare | LowFloorTom + | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom + | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 + | HighTom | RideCymbal1 | ChineseCymbal | RideBell + | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 + | Vibraslap | RideCymbal2 | HiBongo | LowBongo + | MuteHiConga | OpenHiConga | LowConga | HighTimbale + | LowTimbale | HighAgogo | LowAgogo | Cabasa + | Maracas | ShortWhistle | LongWhistle | ShortGuiro + | LongGuiro | Claves | HiWoodBlock | LowWoodBlock + | MuteCuica | OpenCuica | MuteTriangle + | OpenTriangle -- MIDI Key 82 + deriving (Show,Eq,Ord,Enum) +\end{code} +} + +Since MIDI is such a popular platform, it is worth defining some handy +functions for using the General MIDI Standard. In Figure +\ref{fig:percussion} a data type is defined that borrows its +constructor names from the General MIDI standard. The comments +reflecting the ``MIDI Key'' numbers will be explained later, but +basically a MIDI Key is the equivalent of an absolute pitch in +Euterpea terminology. So all that remains to be done is a way to +convert these percussion sound names into a |Music| value; i.e.\ a +|Note|: +\begin{code} + +perc :: PercussionSound -> Dur -> Music Pitch +perc ps dur = note dur (pitch (fromEnum ps + 35)) +\end{code} + +\syn{|fromEnum| is an operator in the |Enum| class, which is all about + enumerations, and will be discussed in more detail in + Chapter~\ref{ch:qualified-types}. A data type that is a member of + this class can be \emph{enumerated}---i.e.\ the elements of the data + type can be listed in order. |fromEnum| maps each value to its + index in this enumeration. Thus |fromEnum AcousticBassDrum| is 0, + |fromEnum BassDrum1| is 1, and so on.} + +If a |Music| value returned from |perc| is played using a piano sound, +then you will get a piano sound. But if you specify the instrument +|Percussion|, MIDI knows to play the apppropriate |PercussionSound|. + +Recall the |InstrumentName| data type from Chapter~\ref{ch:music}. +If a |Music| value returned from |perc| is played using, say, the +|AcousticGrandPiano| instrument, then you will hear an acounstic grand +piano sound at the appropriate pitch. But if you specify the +|Percussion| instrument, then you will hear the percussion sound that +was specified as an argument to |perc|. + +For example, here are eight bars of a simple rock or ``funk groove'' +that uses |perc| and |roll|: +\begin{code} +funkGroove :: Music Pitch +funkGroove + = let p1 = perc LowTom qn + p2 = perc AcousticSnare en + in tempo 3 $ instrument Percussion $ takeM 8 $ repeatM + ( ( p1 :+: qnr :+: p2 :+: qnr :+: p2 :+: + p1 :+: p1 :+: qnr :+: p2 :+: enr) + :=: roll en (perc ClosedHiHat 2) ) +\end{code} % $ + +\out{ We can go one step further by defining a ``percussion + datatype:'' +\begin{spec} + data Percussion = Perc Dur [NoteAttribute] -- percussion + | Pause Dur -- rest + | Roll Dur Dur [NoteAttribute] -- roll w/duration + | Rolln Int Dur [NoteAttribute] -- roll w/number of strokes +\end{spec} +whose interpretation is given by: +\begin{spec} + percLine :: PercussionSound -> [Percussion] -> Music a + percLine dsnd l = Instr "Drums" (foldr (dlAux dsnd) (Rest 0) l) where + dlAux dsnd (N dur na) = perc dsnd dur na :+: xs + dlAux dsnd (R dur) = Rest dur :+: xs + dlAux dsnd (Roll sDur dur na) = roll sDur (perc dsnd dur na) :+: xs + dlAux dsnd (Rolln nTimes dur na) = rolln nTimes (perc dsnd dur na) + :+: dlAux dsnd xs +\end{spec} +} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Write a program that generates all of the General MIDI percussion +sounds, playing through each of them one at a time.} +\end{exercise} + +\begin{exercise}{\em +Find a drum beat that you like, and express it in Euterpea. Then use +|repeatM|, |takeM|, and |(:=:)| to add a simple melody to it.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{A Map for Music} +\label{sec:music-map} + +Recall from Chapter \ref{ch:poly} the definition of |map|: +\begin{spec} +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs +\end{spec} +This function is defined on the list data type. Is there something +analogous for |Music|? I.e.\ a function:\footnote{The name |mapM| + would perhaps have been a better choice here, to be consistent with + previous names. However, |mapM| is a predefined function in Haskell, + and thus |mMap| is used instead. Similarly, Haskell's |Monad| + library defines a function |foldM|, and thus in the next section + the name |mFold| is used instead.} +\begin{spec} +mMap :: (a -> b) -> Music a -> Music b +\end{spec} +Such a function is indeed straightforward to define, but it helps to +first define a map-like function for the |Primitive| type: +\begin{code} + +pMap :: (a -> b) -> Primitive a -> Primitive b +pMap f (Note d x) = Note d (f x) +pMap f (Rest d) = Rest d +\end{code} +With |pMap| in hand we can now define |mMap|: +\begin{code} +mMap :: (a -> b) -> Music a -> Music b +mMap f (Prim p) = Prim (pMap f p) +mMap f (m1 :+: m2) = mMap f m1 :+: mMap f m2 +mMap f (m1 :=: m2) = mMap f m1 :=: mMap f m2 +mMap f (Modify c m) = Modify c (mMap f m) +\end{code} +Just as |map f xs| for lists replaces each polymorphic element |x| in +|xs| with |f x|, |mMap f m| for |Music| replaces each polymorphic +element |p| in |m| with |f p|. + +As an example of how |mMap| can be used, let's introduces a |Volume| +type for a note: +\begin{code} +type Volume = Int +\end{code} +The goal is to convert a value of type |Music Pitch| into a value of +type |Music (Pitch,Volume)|---that is, to pair each pitch with a +volume attribute. We can define a function to do so as follows: +\begin{code} +addVolume :: Volume -> Music Pitch -> Music (Pitch,Volume) +addVolume v = mMap (\p -> (p,v)) +\end{code} +For MIDI, the variable |v| can range from 0 (softest) to 127 (loudest). + +For example, compare the loudness of these two phrases: +\begin{spec} +m1, m2 :: Music (Pitch,Volume) +m1 = addVolume 100 (c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn) +m2 = addVolume 30 (c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn) +\end{spec} +using the |play| function. (Recall from Section~\ref{auxiliaries} +that the type of the argument to |play| must be made clear, as is done +here with the type signature.) + +%% Currently the |play| function in Euterpea does not know how to play a +%% value of type |Music (Pitch,Volume)|, but it does know how to play a +%% value of type |Music (Pitch, [NoteAttribute])|. The |NoteAtttribute| +%% data type is not defined until Chapter~\ref{ch:performance}, but for +%% now it suffices to know that one of its constructors is |Volume|, and +%% thus we can define a function +%% \begin{code} +%% addVol :: Volume -> Music Pitch -> Music (Pitch, [NoteAttribute]) +%% addVol v = mMap (\p -> (p, [Volume v])) +%% \end{code} +%% So if you wish to hear the effect of adding volume to a |Music| value, +%% use |addVol|, not |addVolume|.) + +\syn{Note that the name |Volume| is used both as a type synonym and as + a constructor---Haskell allows this, since they can always be + distinguished by context.} + +\out{ +\begin{code} +data NoteAttribute = + Volume Int -- MIDI convention: 0=min, 127=max + | Fingering Integer + | Dynamics String + | Params [Double] + deriving (Eq, Show) +\end{code} +} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Using |mMap|, define a function: +\begin{spec} +scaleVolume :: Rational -> Music (Pitch,Volume) + -> Music (Pitch,Volume) +\end{spec} +such that |scaleVolume s m| scales the volume of each note in |m| by +the factor |s|. + +(This problem requires multiplying a |Rational| number by an |Int| +(i.e.\ |Volume|). To do this, some coercions between number types are +needed, which in Haskell is done using \emph{qualified types}, which +are discussed in Chapter~\ref{ch:qualified-types}. For now, you can +simply do the following: If |v| is the volume of a note, then +|round (s * fromIntegral v)| is the desired scaled volume.)} +\end{exercise} + +\vspace{.1in}\hrule + +\pagebreak + +\section{A Fold for Music} +\label{sec:music-fold} + +We can also define a fold-like operator for |Music|. But whereas the +list data type has only two constructors (the nullary constructor |[]| +and the binary constructor |(:)|), |Music| has \emph{four} +constructors (|Prim|, (:+:), (:=:), and |Modify|). Thus the following +function takes four arguments in addition to the |Music| value it is +transforming, instead of two: +\begin{code} +mFold :: (Primitive a -> b) -> (b->b->b) -> (b->b->b) -> + (Control -> b -> b) -> Music a -> b +mFold f (+:) (=:) g m = + let rec = mFold f (+:) (=:) g + in case m of + Prim p -> f p + m1 :+: m2 -> rec m1 +: rec m2 + m1 :=: m2 -> rec m1 =: rec m2 + Modify c m -> g c (rec m) +\end{code} +This somewhat unwieldy function basically takes apart a |Music| value +and puts it back together with different constructors. Indeed, note +that: +\begin{spec} +mFold Prim (:+:) (:=:) Modify m == m +\end{spec} +Although intuitive, proving this property requires induction, a proof +technique discussed in Chapter \ref{ch:induction}. + +To see how |mFold| might be used, note first of all that it is more +general than |mMap|---indeed, |mMap| can be defined in terms of +|mFold| like this: +\begin{spec} +mMap :: (a -> b) -> Music a -> Music b +mMap f = mFold g (:+:) (:=:) Modify where + g (Note d x) = note d (f x) + g (Rest d) = rest d +\end{spec} + +More interestingly, we can use |mFold| to more succinctly define +functions such as |dur| from Section \ref{sec:duration}: +\begin{spec} +dur :: Music a -> Dur +dur = mFold getDur (+) max modDur where + getDur (Note d _) = d + getDur (Rest d) = d + modDur (Tempo r) d = d/r + modDur _ d = d +\end{spec} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Redefine |revM| from Section \ref{sec:reverse-music} using |mFold|.} +\end{exercise} + +\begin{exercise}{\em +Define a function |insideOut| that inverts the role of serial and +parallel composition in a |Music| value. Using |insideOut|, see if +you can (a) find a non-trivial value |m :: Music Pitch| such that |m| +is ``musically equivalent'' to (i.e. sounds the same as) |insideOut m| +and (b) find a value |m :: Music Pitch| such that |m :+: insideOut m +:+: m| sounds interesting. (You are free to define what ``sounds +interesting'' means.)} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Crazy Recursion} + +With all the functions and data types that have been defined, and the +power of recursion and higher-order functions well understood, we can +start to do some wild and crazy things with music. Here is just one +such idea. + +The goal is to define a function to recursively apply transformations +|f| (to elements in a sequence) and |g| (to accumulated phrases) some +specified number of times: +\begin{code} +rep :: (Music a -> Music a) -> (Music a -> Music a) -> Int + -> Music a -> Music a +rep f g 0 m = rest 0 +rep f g n m = m :=: g (rep f g (n-1) (f m)) +\end{code} +With this simple function we can create some interesting phrases of +music with very little code. For example, |rep| can be used three +times, nested together, to create a ``cascade'' of sounds: + +\out{ +\begin{code} +run, cascade, cascades, final :: Music Pitch +run', cascade', cascades', final' :: Music Pitch +\end{code} +} +\begin{code} +run = rep (transpose 5) (delayM tn) 8 (c 4 tn) +cascade = rep (transpose 4) (delayM en) 8 run +cascades = rep id (delayM sn) 2 cascade +\end{code} +We can then make the cascade run up, and then down: +\begin{code} +final = cascades :+: revM cascades +\end{code} +What happens if the |f| and |g| arguments are reversed? +\begin{code} +run' = rep (delayM tn) (transpose 5) 8 (c 4 tn) +cascade' = rep (delayM en) (transpose 4) 8 run' +cascades' = rep (delayM sn) id 2 cascade' +final' = cascades' :+: revM cascades' +\end{code} + +\vspace{.1in}\hrule + +\pagebreak + +\begin{exercise}{\em +Consider this sequence of 8 numbers: +\begin{spec} +s1 = [ 1, 5, 3, 6, 5, 0, 1, 1 ] +\end{spec} +We might interpret this as a sequence of pitches, i.e.\ a melody. +Another way to represent this sequence is as a sequence of 7 intervals: +\begin{spec} +s2 = [ 4, -2, 3, -1, -5, 1, 0 ] +\end{spec} +Together with the starting pitch (i.e.\ 1), this sequence of intervals +can be used to reconstruct the original melody. But, with a suitable +transposition to eliminate negative numbers, it can also be viewed as +another melody. Indeed, we can repeat the process: |s2| can be +represented by this sequence of 6 intervals: +\begin{spec} +s3 = [ -6, 5, -4, -4, 6, -1 ] +\end{spec} +Together with the starting number (i.e.\ 4), |s3| can be used to +reconstruct |s2|. Continuing the process: +\begin{spec} +s4 = [ 11, -9, 0, 10, -7 ] +s5 = [ -20, 9, 10, -17 ] +s6 = [ 29, 1, -27 ] +s7 = [ -28, -28 ] +s8 = [ 0 ] +\end{spec} +Now, if we take the first element of each of these sequences to form +this 8-number sequence: +\begin{spec} +ic = [ 0, -28, 29, -20, 11, -6, 4, 1 ] +\end{spec} +then it alone can be used to re-create the original 8-number sequence +in its entirety. Of course, it can also be used as the original +melody was used, and we could derive another 8-note sequence from +it---and so on. The list |ic| will be referred to as the ``interval +closure'' of the original list |s1|. + +Your job is to: +\begin{enumerate}[a)] +\item +Define a function |toIntervals| that takes a list of |n| numbers, and +generates a list of |n| lists, such that the $i^{th}$ list is the sequence +$s_i$ as defined above. + +\item +Define a function |getHeads| that takes a list of |n| lists and +returns a list of |n| numbers such that the $i^{th}$ element is the +head of the $i^{th}$ list. + +\item +Compose the above two functions in a suitable way to define a function +|intervalClosure| that takes an |n|-element list and returns its +interval closure. + +\item +Define a function |intervalClosures| that takes an |n|-element list and +returns an infinite sequence of interval closures. + +\item +Now for the open-ended part of this exercise: Interpret the outputs of +any of the functions above to create some ``interesting'' music. +\end{enumerate} +} +\end{exercise} + +\begin{exercise}{\em +Write a Euterpea program that sounds like an infinitely descending (in +pitch) sequence of musical lines. Each descending line should fade +into the audible range as it begins its descent, and then fade out as +it descends further. So the beginning and end of each line will be +difficult to hear. And there will be many such lines, each starting +at a different time, some perhaps descending a little faster than +others, or perhaps using different instrument sounds, and so on. The +effect will be that as the music is listened to, everything will seem +to be falling, falling, falling with no end, but no beginning either. +(This illusion is called the \emph{Shepard Tone}, or \emph{Shepard + Scale}, first introduced by Roger Shepard in 1964 \cite{shepard}.) + +Use high-order functions, recursion, and whatever other abstraction +techniques you have learned to write an elegant solution to this +problem. Try to parameterize things in such a way that, for example, +with a simple change, you could generate an infinite \emph{ascension} +as well. The |Volume| constructor in the |NoteAttribute| type, as +used in the definition of |addVol|, should be used to set the volumes.} +\end{exercise} + +\begin{exercise}{\em +Do something wild and crazy with Euterpea.} +\end{exercise} + +\vspace{.1in}\hrule
+ HSoM/Music.lhs view
@@ -0,0 +1,958 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Music.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +%% ToDo: +%% Introduce "play" and the Performable class soon after introducing +%% the Music type. +%% +%% Also reformat data decls so that the constructors line up vertically. + +\chapter{Simple Music} +\label{ch:music} + +\out{ +\begin{code} +module Euterpea.Music.Note.Music where +infixr 5 :+:, :=: +\end{code} +} +\begin{spec} +module Euterpea.Music.Note.Music where +infixr 5 !:+:, :=: +\end{spec} + +The previous chapters introduced some of the fundamental ideas of +functional programming in Haskell. Also introduced were several of +Euterpea's functions and operators, such as |note|, |rest|, |(:+:)|, +|(:=:)|, and |trans|. This chapter will reveal the actual definitions +of these functions and operators, thus exposing Euterpea's underlying +structure and overall design at the note level. In addition, a number +of other musical ideas will be developed, and in the process more +Haskell features will be introduced as well. + +\section{Preliminaries} + +Sometimes it is convenient to use a built-in Haskell data type to +directly represent some concept of interest. For example, we may +wish to use |Int| to represent \emph{octaves}, where by convention +octave 4 corresponds to the octave containing middle C on the piano. +We can express this in Haskell using a \emph{type synonym}: +\begin{code} + +type Octave = Int +\end{code} +A type synonym does not create a new data type---it just gives a new +name to an existing type. Type synonyms can be defined not just for +atomic types such as |Int|, but also for structured types such as +pairs. For example, as discussed in the last chapter, in music theory +a pitch is defined as a pair, consisting of a \emph{pitch class} and +an \emph{octave}. Assuming the existence of a data type called +|PitchClass| (which we will return to shortly), we can write the +following type synonym: +\begin{code} +type Pitch = (PitchClass, Octave) +\end{code} +For example, concert A (i.e.\ A440) corresponds to the pitch |(A,4) :: +Pitch|, and the lowest and highest notes on a piano correspond to +|(A,0) :: Pitch| and |(C,8) :: Pitch|, respectively. + +%% For convenience we could define a Haskell variable with that value as +%% follows: +%% \begin{spec} +%% a4 :: Pitch +%% a4 = (A,4) -- concert A +%% \end{spec} + +Another important musical concept is \emph{duration}. Rather than use +either integers or floating-point numbers, Euterpea uses \emph{rational} +numbers to denote duration: +\begin{code} +type Dur = Rational +\end{code} +|Rational| is the data type of rational numbers expressed as ratios of +|Integer|s in Haskell. The choice of |Rational| is somewhat +subjective, but is justified by three observations: (1) many durations +are expressed as ratios in music theory (5:4 rhythm, quarter notes, +dotted notes, and so on), (2) |Rational| numbers are exact (unlike +floating point numbers), which is important in many computer music +applications, and (3) irrational durations are rarely needed. + +%% (Alternatively, we could have used |Ratio Int|.) + +Rational numbers in Haskell are printed by GHC in the form |n%d|, +where |n| is the numerator, and |d| is the denominator. Even a whole +number, say the number 42, will print as |42%1| if it is a |Rational| +number. To create a |Rational| number in a program, however, once it +is given the proper type, we can use the normal division operator, as +in the following definition of a quarter note: +\begin{spec} +qn :: Dur +qn = 1/4 -- quarter note +\end{spec} + +So far so good. But what about |PitchClass|? We might try to use +integers to represent pitch classes as well, but this is not very +elegant---ideally we would like to write something that looks more +like the conventional pitch class names C, C$\sharp$, D$\flat$, D, +etc.\ The solution is to use an \emph{algebraic data type} in Haskell: +\begin{spec} +data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs + | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss +\end{spec} +\out{ +\begin{code} +data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs + | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss + deriving (Show, Eq, Ord, Read, Enum, Bounded) +\end{code} +} + +\syn{All of the names to the right of the equal sign in a |data| + declaration are called \emph{constructors}, and must be capitalized. + In this way they are syntactically distinguished from ordinary + values. This distinction is useful since only constructors can be + used in the pattern matching that is part of a function definition, + as will be described shortly. + + %% The last line, |deriving (Eq,Ord,Show,Read,Enum)|, tells Haskell to + %% make |PitchClass| an instance of these five type classes, and to + %% automatically derive definitions of the operators associated with + %% those type classes. (Recall the discussion of qualified types and + %% type classes in Section \ref{sec:qualified-types}.) +} + +%% However, we will not discuss type classes in detail until Chapter +%% \ref{ch:qualified-types}. For now, here are just two examples of the +%% capabilities this provides: +%% \begin{enumerate} +%% \item The |Eq| class has an operator |(==)| that allows us to test +%% for the equality of two pitch classes. For example, |Cf == Gs| +%% returns |False|. +%% \item The |Ord| class has an operator |(>)| that allows us to +%% compare values acording to the order that they appear in the data +%% type declaration. For example, |D > C| returns |True|. +%% \end{enumerate} + + +The |PitchClass| data type declaration essentially enumerates 35 pitch +class names (five for each of the note names A through G). Note that +both double-sharps and double-flats are included, resulting in many +enharmonics (i.e., two notes that ``sound the same,'' such as +G$\sharp$ and A$\flat$). + +(The order of the pitch classes may seem a bit odd, but the idea is +that if a pitch class |pc1| is to the left of a pitch class |pc2|, +then |pc1|'s pitch is ``lower than'' that of |pc2|. This idea will be +formalized and exploited in Chapter~\ref{sec:qualified-types}.) + +%% which may be important in certain applications. + +Keep in mind that |PitchClass| is a completely new, user-defined data +type that is not equal to any other. This is what distinguishes a +|data| declaration from a |type| declaration. As another example of +the use of a |data| declaration to define a simple enumerated type, +Haskell's Boolean data type, called |Bool|, is predefined in Haskell +simply as: +\begin{spec} +data Bool = False | True +\end{spec} + +\section{Notes, Music, and Polymorphism} +\label{sec:music} + +We can of course define other data types for other purposes. For +example, we will want to define the notion of a \emph{note} and a +\emph{rest}. Both of these can be thought of as ``primitive'' musical +values, and thus as a first attempt we might write: +\begin{spec} +data Primitive = Note Dur Pitch + | Rest Dur +\end{spec} +%% deriving (Show, Eq, Ord) +Analogously to our previous data type declarations, the above +declaration says that a |Primitive| is either a |Note| or a |Rest|. +However, it is different in that the constructors |Note| and |Rest| +take arguments, like functions do. In the case of |Note|, it takes two +arguments, whose types are |Dur| and |Pitch|, respectively, whereas +|Rest| takes one argument, a value of type |Dur|. In other words, +the types of |Note| and |Rest| are: +\begin{spec} +Note :: Dur -> Pitch -> Primitive +Rest :: Dur -> Primitive +\end{spec} +For example, |Note qn a440| is concert A played as a quarter note, and +|Rest 1| is a whole-note rest. + +This definition is not completely satisfactory, however, because we +may wish to attach other information to a note, such as its loudness, +or some other annotation or articulation. Furthermore, the pitch +itself may actually be a percussive sound, having no true pitch at +all. To resolve this, Euterpea uses an important concept in Haskell, +namely \emph{polymorphism}---the ability to parameterize, or abstract, +over types (\emph{poly} means \emph{many} and \emph{morphism} refers +to the structure, or \emph{form}, of objects). + +|Primitive| can be redefined as a \emph{polymorphic data type} as +follows. Instead of fixing the type of the pitch of a note, it is +left unspecified through the use of a \emph{type variable}: +\begin{spec} +data Primitive a = Note Dur a + | Rest Dur +\end{spec} +\out{ +\begin{code} +data Primitive a = Note Dur a + | Rest Dur + deriving (Show, Eq, Ord) +\end{code} +} +Note that the type variable |a| is used as an argument to |Primitive|, +and then used in the body of the declaration---just like a variable in +a function. This version of |Primitive| is more general than the +previous version---indeed, note that |Primitive Pitch| is the same as +(or, technically, is \emph{isomorphic to}) the previous version of +|Primitive|. But additionally, |Primitive| is now more flexible than +the previous version, since, for example, we can add loudness by +pairing loudness with pitch, as in |Primitive (Pitch, Loudness)|. +Other concrete instances of this idea will be introduced later. + +\syn{Type variables such as |a| above must begin with a lower-case + letter, to distinguish them from concrete types such as |Dur| or + |Pitch|. Since |Primitive| takes an argument, it is called a + \emph{type constructor}, wherease |Note| and |Rest| are just called + constructors (or value constructors).} + +Another way to interpret this data declaration is to say that for any +type |a|, this declaration declares the types of its constructors to +be: +\begin{spec} +Note :: Dur -> a -> Primitive a +Rest :: Dur -> Primitive a +\end{spec} +Even though |Note| and |Rest| are called data constructors, they are +still functions, and they have a type. Since they both have type +variables in their type signatures, they are examples of +\emph{polymorphic functions}. + +It is helpful to think of polymorphism as applying the abstraction +principle at the type level---indeed it is often called \emph{type + abstraction}. Many more examples of both polymorphic functions and +polymorphic data types will be explored in detail in +Chapter~\ref{ch:poly}. + +So far Euterpea's primitive notes and rests have been introduced---but +how do we combine many notes and rests into a larger composition? To +achieve this, Euterpea defines another polymorphic data type, perhaps +the most important data type used in this textbook, which defines the +fundamental structure of a note-level musical entity: +\begin{spec} +data Music a = + Prim (Primitive a) -- primitive value + | Music a :+: Music a -- sequential composition + | Music a :=: Music a -- parallel composition + | Modify Control (Music a) -- modifier + \end{spec} +\out{ +\begin{code} +data Music a = + Prim (Primitive a) -- primitive value + | Music a :+: Music a -- sequential composition + | Music a :=: Music a -- parallel composition + | Modify Control (Music a) -- modifier + deriving (Show, Eq, Ord) +\end{code} +} +Following the reasoning above, the types of these constructors are: +\begin{spec} +Prim :: Primitive a -> Music a +(:+:) :: Music a -> Music a -> Music a +(:=:) :: Music a -> Music a -> Music a +Modify :: Control -> Music a -> Music a +\end{spec} +These four constructors then are also polymorphic functions. + +%% | Music a :=/ Music a -- parallel composition +%% (short) + +%% The first line here looks odd: the name |Primitive| appears +%% twice. The first occurence, however, is the name of a new +%% \emph{constructor} in the |Music| data type, whereas the second is +%% the name of the existing \emph{data type} defined above. Haskell +%% allows using the same name to define a constructor and a data type, +%% since they can never be confused: the context in which they are used +%% will always be sufficient to distinguish them. + +\syn{ + \index{infix constructors} + Note the use of the \emph{infix constructors} |(:+:)| and |(:=:)|. + Infix constructors are just like infix operators in Haskell, but + they must begin with a colon. This syntactic distinction makes it + clear when pattern matching is intended, and is analogous to the + distinction between ordinary names (which must begin with a + lower-case character) and constructor names (which must begin with + an upper-case character). + + The observant reader will also recall that at the very beginning of + this chapter---corresponding to the module containing all the code in + this chapter---the following line appeared: + \begin{spec} + infixr 5 !:+:, :=: + \end{spec} + This is called a \emph{fixity declaration}. The ``|r|'' after the + word ``|infix|'' means that the specified operators---in this case + |(:+:)| and |(:=:)|---are to have \emph{right} associativity, and the + ``5'' specifies their \emph{precedence level} (these operators will + bind more tightly than an operator with a lower precedence). +} + +\newpage +The |Music| data type declaration essentially says that a value of type +|Music a| has one of four possible forms: +\begin{itemize} +\item |Prim p|, where |p| is a primitive value of type |Primitive a|, + for some type |a|. For example: +\begin{spec} +a440m :: Music Pitch +a440m = Prim (Note qn a440) +\end{spec} +is the musical value corresponding to a quarter-note rendition of +concert A. + +\item |m1 :+: m2| is the \emph{sequential composition} of |m1| and +|m2|; i.e.\ |m1| and |m2| are played in sequence. + +\item |m1 :=: m2| is the \emph{parallel composition} of |m1| and |m2|; + i.e.\ |m1| and |m2| are played simultaneously. The duration of the + result is the duration of the longer of |m1| and |m2|. + + (Recall that these last two operators were introduced in the last + chapter. You can see now that they are actually constructors of an + algebraic data type.) + +%% \item |m1 :=/ m2| is also a parallel composition of |m1| and |m2|, but +%% its duration is that of the shorter of |m1| and |m2|. + +\item |Modify cntrl m| is an ``annotated'' version of |m| in which the + control parameter |cntrl| specifies some way in which |m| is to be + modified. +\end{itemize} + +\index{type!recursive} \syn{Note that |Music a| is defined in terms of + |Music a|, and thus the data type is said to be \emph{recursive} + (analogous to a recursive function). It is also often called an + \emph{inductive} data type, since it is, in essence, an inductive + definition of an infinite number of values, each of which can be + arbitrarily complex.} + +It is convenient to represent these musical ideas as a recursive +datatype because it allows us to not only \emph{construct} musical +values, but also take them apart, analyze their structure, print them +in a structure-preserving way, transform them, interpret them for +performance purposes, and so on. Many examples of these kinds of +processes will be seen in this textbook. + +The |Control| data type is used by the |Modify| constructor to +annotate a |Music| value with a \emph{tempo change}, a +\emph{transposition}, a \emph{phrase attribute}, a \emph{player name}, +or an \emph{instrument}. This data type is unimportant at the moment, +but for completeness here is its full definition: + +\pagebreak + +\begin{spec} +data Control = + Tempo Rational -- scale the tempo + | Transpose AbsPitch -- transposition + | Instrument InstrumentName -- instrument label + | Phrase [PhraseAttribute] -- phrase attributes + | Player PlayerName -- player label + | KeySig PitchClass Mode -- key signature and mode + +type PlayerName = String +data Mode = Major | Minor +\end{spec} +\out{ +\begin{code} +data Control = + Tempo Rational -- scale the tempo + | Transpose AbsPitch -- transposition + | Instrument InstrumentName -- instrument label + | Phrase [PhraseAttribute] -- phrase attributes + | Player PlayerName -- player label + | KeySig PitchClass Mode -- key signature and mode + deriving (Show, Eq, Ord) + +type PlayerName = String +data Mode = Major | Minor + deriving (Show, Eq, Ord) +\end{code} +} + +|AbsPitch| (``absolute pitch,'' to be defined in Section +\ref{sec:abspitch}) is just a type synonym for |Int|. Instrument +names are borrowed from the General MIDI standard +\cite{MIDI,General-MIDI}, and are captured as an algebraic data type +in Figure \ref{fig:instrument-names}. Phrase attributes and the +concept of a ``player'' are closely related, but a full explanation is +deferred until Chapter \ref{ch:performance}. The |KeySig| constructor +attaches a key signature to a |Music| value, and is different +conceptually from transposition. + +%% are defined in Figure \ref{fig:phase-attributes}. The + +\begin{figure}{\small +\indexhs{InstrumentName} +\begin{code} +data InstrumentName = + AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano + | HonkyTonkPiano | RhodesPiano | ChorusedPiano + | Harpsichord | Clavinet | Celesta + | Glockenspiel | MusicBox | Vibraphone + | Marimba | Xylophone | TubularBells + | Dulcimer | HammondOrgan | PercussiveOrgan + | RockOrgan | ChurchOrgan | ReedOrgan + | Accordion | Harmonica | TangoAccordion + | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz + | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar + | DistortionGuitar | GuitarHarmonics | AcousticBass + | ElectricBassFingered | ElectricBassPicked | FretlessBass + | SlapBass1 | SlapBass2 | SynthBass1 + | SynthBass2 | Violin | Viola + | Cello | Contrabass | TremoloStrings + | PizzicatoStrings | OrchestralHarp | Timpani + | StringEnsemble1 | StringEnsemble2 | SynthStrings1 + | SynthStrings2 | ChoirAahs | VoiceOohs + | SynthVoice | OrchestraHit | Trumpet + | Trombone | Tuba | MutedTrumpet + | FrenchHorn | BrassSection | SynthBrass1 + | SynthBrass2 | SopranoSax | AltoSax + | TenorSax | BaritoneSax | Oboe + | Bassoon | EnglishHorn | Clarinet + | Piccolo | Flute | Recorder + | PanFlute | BlownBottle | Shakuhachi + | Whistle | Ocarina | Lead1Square + | Lead2Sawtooth | Lead3Calliope | Lead4Chiff + | Lead5Charang | Lead6Voice | Lead7Fifths + | Lead8BassLead | Pad1NewAge | Pad2Warm + | Pad3Polysynth | Pad4Choir | Pad5Bowed + | Pad6Metallic | Pad7Halo | Pad8Sweep + | FX1Train | FX2Soundtrack | FX3Crystal + | FX4Atmosphere | FX5Brightness | FX6Goblins + | FX7Echoes | FX8SciFi | Sitar + | Banjo | Shamisen | Koto + | Kalimba | Bagpipe | Fiddle + | Shanai | TinkleBell | Agogo + | SteelDrums | Woodblock | TaikoDrum + | MelodicDrum | SynthDrum | ReverseCymbal + | GuitarFretNoise | BreathNoise | Seashore + | BirdTweet | TelephoneRing | Helicopter + | Applause | Gunshot | Percussion + | Custom String +\end{code} +} +\out{ +\begin{code} + deriving (Show, Eq, Ord) +\end{code} +} +\caption{General MIDI Instrument Names} +\label{fig:instrument-names} +\end{figure} + +\out{ +\begin{figure}{\small +\begin{code} +data PhraseAttribute = Dyn Dynamic + | Tmp Tempo + | Art Articulation + | Orn Ornament + deriving (Show, Eq, Ord) + +data Dynamic = Accent Rational | Crescendo Rational | Diminuendo Rational + | StdLoudness StdLoudness | Loudness Rational + deriving (Show, Eq, Ord) + +data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF + deriving (Show, Eq, Ord, Enum) + +data Tempo = Ritardando Rational | Accelerando Rational + deriving (Show, Eq, Ord) + +data Articulation = Staccato Rational | Legato Rational | Slurred Rational + | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath + | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz + | BartokPizz | Swell | Wedge | Thumb | Stopped + deriving (Show, Eq, Ord) + +data Ornament = Trill | Mordent | InvMordent | DoubleMordent + | Turn | TrilledTurn | ShortTrill + | Arpeggio | ArpeggioUp | ArpeggioDown + | Instruction String | Head NoteHead + | DiatonicTrans Int + deriving (Show, Eq, Ord) + +data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead + | TremoloHead | SlashHead | ArtHarmonic | NoHead + deriving (Show, Eq, Ord) + +\end{code}} +\caption{Phrase Attributes} +\label{fig:phase-attributes} +\end{figure} +} + +\section{Convenient Auxiliary Functions} +\label{auxiliaries} + +%% In anticipation of the need to translate between different number +%% types, we define the following coercion function: +%% \begin{code} +%% rtof :: Ratio Int -> Float +%% rtof r = float (numerator r) / float (denominator r) + +%% float :: Int -> Float +%% float = fromInteger . toInteger +%% \end{code} + +For convenience, and in anticipation of their frequent use, a number +of functions are defined in Euterpea to make it easier to write +certain kinds of musical values. For starters: +\begin{code} + +note :: Dur -> a -> Music a +note d p = Prim (Note d p) + +rest :: Dur -> Music a +rest d = Prim (Rest d) + +tempo :: Dur -> Music a -> Music a +tempo r m = Modify (Tempo r) m + +transpose :: AbsPitch -> Music a -> Music a +transpose i m = Modify (Transpose i) m + +instrument :: InstrumentName -> Music a -> Music a +instrument i m = Modify (Instrument i) m + +phrase :: [PhraseAttribute] -> Music a -> Music a +phrase pa m = Modify (Phrase pa) m + +player :: PlayerName -> Music a -> Music a +player pn m = Modify (Player pn) m + +keysig :: PitchClass -> Mode -> Music a -> Music a +keysig pc mo m = Modify (KeySig pc mo) m +\end{code} +Note that each of these functions is polymorphic, a trait inherited +from the data types that it uses. Also recall that the first two of +these functions were used in an example in the last chapter. + +We can also create simple names for familiar notes, durations, and +rests, as shown in Figures \ref{fig:note-names} and +\ref{fig:rest-names}. Despite the large number of them, these names +are sufficiently ``unusual'' that name clashes are unlikely. + +\syn{Figures \ref{fig:note-names} and \ref{fig:rest-names} demonstrate + that at the top level of a program, more than one equation can be + placed on one line, as long as they are separated by a semicolon. + This allows us to save vertical space on the page, and is useful + whenever each line is relatively short. The semicolon is not needed + at the end of a single equation, or at the end of the last equation + on a line. This convenient feature is part of Haskell's + \emph{layout} rule, and will be explained in more detail later. + +More than one equation can also be placed on one line in a |let| +expression, as demonstrated below: +\begin{spec} +let x = 1; y = 2 +in x + y +\end{spec} +} + +%% In fact this same rule may be used to override layout in any context, +%% how the layout rule can be overridden through the use of a semicolon. + +\begin{figure} +\cbox{\small +\begin{code} +cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f, + fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss :: + Octave -> Dur -> Music Pitch + +cff o d = note d (Cff, o); cf o d = note d (Cf, o) +c o d = note d (C, o); cs o d = note d (Cs, o) +css o d = note d (Css, o); dff o d = note d (Dff, o) +df o d = note d (Df, o); d o d = note d (D, o) +ds o d = note d (Ds, o); dss o d = note d (Dss, o) +eff o d = note d (Eff, o); ef o d = note d (Ef, o) +e o d = note d (E, o); es o d = note d (Es, o) +ess o d = note d (Ess, o); fff o d = note d (Fff, o) +ff o d = note d (Ff, o); f o d = note d (F, o) +fs o d = note d (Fs, o); fss o d = note d (Fss, o) +gff o d = note d (Gff, o); gf o d = note d (Gf, o) +g o d = note d (G, o); gs o d = note d (Gs, o) +gss o d = note d (Gss, o); aff o d = note d (Aff, o) +af o d = note d (Af, o); a o d = note d (A, o) +as o d = note d (As, o); ass o d = note d (Ass, o) +bff o d = note d (Bff, o); bf o d = note d (Bf, o) +b o d = note d (B, o); bs o d = note d (Bs, o) +bss o d = note d (Bss, o) +\end{code}} +\caption{Convenient Note Names} +\label{fig:note-names} +\end{figure} + +\begin{figure} +\cbox{\small +\begin{code} + +bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn, + dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur + +bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr, + dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch + +bn = 2; bnr = rest bn -- brevis rest +wn = 1; wnr = rest wn -- whole note rest +hn = 1/2; hnr = rest hn -- half note rest +qn = 1/4; qnr = rest qn -- quarter note rest +en = 1/8; enr = rest en -- eighth note rest +sn = 1/16; snr = rest sn -- sixteenth note rest +tn = 1/32; tnr = rest tn -- thirty-second note rest +sfn = 1/64; sfnr = rest sfn -- sixty-fourth note rest + +dwn = 3/2; dwnr = rest dwn -- dotted whole note rest +dhn = 3/4; dhnr = rest dhn -- dotted half note rest +dqn = 3/8; dqnr = rest dqn -- dotted quarter note rest +den = 3/16; denr = rest den -- dotted eighth note rest +dsn = 3/32; dsnr = rest dsn -- dotted sixteenth note rest +dtn = 3/64; dtnr = rest dtn -- dotted thirty-second note rest + +ddhn = 7/8; ddhnr = rest ddhn -- double-dotted half note rest +ddqn = 7/16; ddqnr = rest ddqn -- double-dotted quarter note rest +dden = 7/32; ddenr = rest dden -- double-dotted eighth note rest +\end{code}} +\caption{Convenient Duration and Rest Names} +\label{fig:rest-names} +\end{figure} + +\subsection{A Simple Example} + +As a simple example, suppose we wish to generate a ii-V-I chord +progression in a particular major key. In music theory, such a chord +progression begins with a minor chord on the second degree of the major +scale, followed by a major chord on the fifth degree, and ending in a +major chord on the first degree. We can write this in Euterpea, using +triads in the key of C major, as follows: +\begin{code} +t251 :: Music Pitch +t251 = let dMinor = d 4 wn :=: f 4 wn :=: a 4 wn + gMajor = g 4 wn :=: b 4 wn :=: d 5 wn + cMajor = c 4 bn :=: e 4 bn :=: g 4 bn + in dMinor :+: gMajor :+: cMajor +\end{code} + +\syn{Note that more than one equation is allowed in a \indexwdkw{let} + expression, just like at the top level of a program. The first + characters of each equation, however, must line up vertically, and + if an equation takes more than one line then the subsequent lines + must be to the right of the first characters. For example, this is + legal: +\begin{spec} +let a = aLongName + + anEvenLongerName + b = 56 +in ... +\end{spec} +but neither of these are: +\begin{spec} +let a = aLongName + + anEvenLongerName + b = 56 +in ... + +let a = aLongName + + anEvenLongerName + b = 56 +in ... +\end{spec} +(The second line in the first example is too far to the left, as is +the third line in the second example.) + +Although this rule, called the {\em \indexwd{layout rule}}, may seem a +bit {\em ad hoc}, it avoids having to use special syntax (such as a +semicolon) to denote the end of one equation and the beginning of the +next, thus enhancing readability. In practice, use of layout is +rather intuitive. Just remember two things: + +First, the first character following |let| (and a few other keywords +that will be introduced later) is what determines the starting column +for the set of equations being written. Thus we can begin the +equations on the same line as the keyword, the next line, or whatever. + +Second, be sure that the starting column is further to the right +than the starting column associated with any immediately surrounding +|let| clause (otherwise it would be ambiguous). The ``termination'' of an +equation happens when something appears at or to the left of the +starting column associated with that equation.} + +We can play this simple example using Euterpea's |play| function +by simply typing: +\begin{spec} +play t251 +\end{spec} +at the GHCi command line. Default instruments and tempos are used to +convert |t251| into MIDI and then play the result through your +computer's standard sound card. + +\syn{It is important when using |play| that the type of its argument +is made clear. In the case of |t251|, it is clear from the type +signature in its definition. But for reasons to be explained in +Chapter~\ref{ch:qualified-types}, if we write even something very +simple such as |play (note qn (C,4))|, Haskell cannot infer exactly +what kind of number 4 is, and therefore cannot infer that |(C,4)| is +intended to be a |Pitch|. We can get around this either by writing: +\begin{spec} +m :: Pitch +m = note qn (C,4) +\end{spec} +in which case |play m| will work just fine, or we can include the type +signature ``in-line'' with the expression, as in |play (note qn +((C,4)::Pitch))|.} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +The above example is fairly concrete, in that, for one, it is rooted +in C major, and furthermore it has a fixed tempo. Define a function +|twoFiveOne :: Pitch -> Dur -> Music Pitch| such that |twoFiveOne p d| +constructs a ii-V-I chord progression in the key whose major scale +begins on the pitch |p| (i.e.\ the first degree of the major scale on +which the progression is being constructed), where the duration of the +first two chords is each |d|, and the duration of the last chord is +|2*d|. + +To verify your code, prove by calculation that |twoFiveOne (C,4) wn = +t251|.} +\end{exercise} + +\begin{exercise}{\em +The |PitchClass| data type implies the use of standard Western +harmony, in particular the use of a \emph{twelve-tone equal temperament + scale}. But there are many other scale possibilities. For example, +the \emph{pentatonic blues scale} consists of five notes (thus +``pentatonic'') and, in the key of C, approximately corresponds to the +notes C, E$\flat$, F, G, and B$\flat$. More abstractly, let's call +these the root, minor third, fourth, fifth, and minor seventh, +respectively. Your job is to: +\begin{enumerate} +\item +Define a new algebraic data type called |BluesPitchClass| that +captures this scale (for example, you may wish to use the constructor +names |Ro|, |MT|, |Fo|, |Fi|, and |MS|). +\item +Define a type synonym |BluesPitch|, akin to |Pitch|. +\item +Define auxiliary functions |ro|, |mt|, |fo|, |fi|, and |ms|, akin to +those in Figure \ref{fig:note-names}, that make it easy to construct +notes of type |Music BluesPitch|. +\item +In order to play a value of type |Music BluesPitch| using MIDI, it +will have to be converted into a |Music Pitch| value. Define a +function |fromBlues :: Music BluesPitch -> Music Pitch| to do this, +using the ``approximate'' translation described at the beginning of +this exercise. + +Hint: To do this properly, you will have to pattern match against the +|Music| value, something like this: +\begin{spec} +fromBlues (Prim (Note d p)) = ... +fromBlues (Prim (Rest d)) = ... +fromBlues (m1 :+: m2) = ... +fromBlues (m1 :=: m2) = ... +fromBlues (Modify ...) = ... +\end{spec} +\item +Write out a few melodies of type |Music BluesPitch|, and play them +using |fromBlues| and |play|. +\end{enumerate} } +\end{exercise} + +\vspace{.1in}\hrule + +\section{Absolute Pitches} +\label{sec:abspitch} + +Treating pitches simply as integers is useful in many settings, so +Euterpea uses a type synonym to define the concept of an ``absolute +pitch:'' +\begin{code} +type AbsPitch = Int +\end{code} +The absolute pitch of a (relative) pitch can be defined mathematically +as 12 times the octave, plus the index of the pitch class. We can +express this in Haskell as follows: +\begin{code} +absPitch :: Pitch -> AbsPitch +absPitch (pc,oct) = 12*oct + pcToInt pc +\end{code} + +\syn{Note the use of pattern matching to match the argument of + |absPitch| to a pair.} + +|pcToInt| is a function that converts a particular pitch class to an +index, easily but tediously expressed as shown in Figure +\ref{fig:pcToInt}. But there is a subtlety: according to music theory +convention, pitches are assigned integers in the range 0 to 11, +i.e.\ modulo 12, starting on pitch class C. In other words, the index +of C is 0, C$\flat$ is 11, and B$\sharp$ is 0. However, that would +mean the absolute pitch of |(C,4)|, say, would be 48, whereas |(Cf,4)| +would be 59. Somehow the latter does not seem right---47 would be a +more logical choice. Therefore the definition in +Figure~\ref{fig:pcToInt} is written in such a way that the wrap-round +does not happen, i.e.\ numbers outside the range 0 to 11 are used. +With this definition, |absPitch (Cf,4)| yields 47, as desired. + +%% Should |Cf| be interpreted as 11 instead of -1, and |Bs| as 0 +%% instead of 12? I do not know. In most cases it will not matter, but +%% it is an interesting question. + +\begin{figure} +\cbox{\small +\begin{spec} +pcToInt :: PitchClass -> Int + +pcToInt Cff = -2; pcToInt Dff = 0; pcToInt Eff = 2 +pcToInt Cf = -1; pcToInt Df = 1; pcToInt Ef = 3 +pcToInt C = 0; pcToInt D = 2; pcToInt E = 4 +pcToInt Cs = 1; pcToInt Ds = 3; pcToInt Es = 5 +pcToInt Css = 2; pcToInt Dss = 4; pcToInt Ess = 6 + +pcToInt Fff = 3; pcToInt Gff = 5; pcToInt Aff = 7 +pcToInt Ff = 4; pcToInt Gf = 6; pcToInt Af = 8 +pcToInt F = 5; pcToInt G = 7; pcToInt A = 9 +pcToInt Fs = 6; pcToInt Gs = 8; pcToInt As = 10 +pcToInt Fss = 7; pcToInt Gss = 9; pcToInt Ass = 11 + +pcToInt Bff = 9 +pcToInt Bf = 10 +pcToInt B = 11 +pcToInt Bs = 12 +pcToInt Bss = 13 +\end{spec}} +\caption{Converting Pitch Classes to Integers} +\label{fig:pcToInt} +\end{figure} + +\syn{The repetition of ``|pcToInt|'' above can be avoided by using a + Haskell |case| expression, resulting in a more compact definition: +\begin{code} +pcToInt :: PitchClass -> Int +pcToInt pc = case pc of + Cff -> -2; Cf -> -1; C -> 0; Cs -> 1; Css -> 2; + Dff -> 0; Df -> 1; D -> 2; Ds -> 3; Dss -> 4; + Eff -> 2; Ef -> 3; E -> 4; Es -> 5; Ess -> 6; + Fff -> 3; Ff -> 4; F -> 5; Fs -> 6; Fss -> 7; + Gff -> 5; Gf -> 6; G -> 7; Gs -> 8; Gss -> 9; + Aff -> 7; Af -> 8; A -> 9; As -> 10; Ass -> 11; + Bff -> 9; Bf -> 10; B -> 11; Bs -> 12; Bss -> 13 +\end{code} +As you can see, a |case| expression allows multiple pattern-matches on +an expression without using equations. Note that layout applies to +the body of a case expression, and can be overriden as before using a +semicolon. (As in a function type signature, the right-pointing arrow +in a |case| expression must be typed as ``{\tt ->}'' on your +computer keyboard.) + +The body of a |case| expression observes layout just as a |let| +expression, including the fact that semicolons can be used, as above, +to place more than one pattern match on the same line.} + +Converting an absolute pitch to a pitch is a bit more tricky, because +of enharmonic equivalences. For example, the absolute pitch 15 might +correspond to either |(Ds,1)| or |(Ef,1)|. Euterpea takes the +approach of always returning a sharp in such ambiguous cases: +%%\begin{code} +%%pitch :: AbsPitch -> Pitch +%%pitch ap = ( [C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! mod ap 12, +%% quot ap 12 ) +%%\end{code} +\begin{code} +pitch :: AbsPitch -> Pitch +pitch ap = + let (oct, n) = divMod ap 12 + in ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct) +\end{code} + +\index{list!indexing} +\syn{|(!!)| is Haskell's zero-based list-indexing function; +|list !! n| returns the |(n+1)|th element in |list|. +|divMod x n| returns a pair |(q,r)|, where |q| is +the integer quotient of |x| divided by |n|, and |r| is the +value of |x| modulo |n|.} +%% |(!!)| behaves as follows: +%% \begin{spec} +%% infixl 9 !! +%% (!!) :: [a] -> Int -> a +%% (x:_) !! 0 = x +%% (_:xs) !! n | n > 0 = xs !! (n-1) +%% \end{spec} +Given |pitch| and |absPitch|, it is now easy to define a function +|trans| that transposes pitches: +%% (analogous to |Trans|, which transposes values of type |Music|) +\begin{code} +trans :: Int -> Pitch -> Pitch +trans i p = pitch (absPitch p + i) +\end{code} +With this definition, all of the operators and functions introduced in +the previous chapter have been covered. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Show that |abspitch (pitch ap) = ap|, and, up to enharmonic +equivalences, |pitch (abspitch p) = p|.} +\end{exercise} + +\begin{exercise}{\em +Show that |trans i (trans j p) = trans (i+j) p|.} +\end{exercise} + +\begin{exercise}{\em +|Transpose| is part of the |Control| data type, which in turn is part +of the |Music| data type. Its use in transposing a |Music| value is +thus a kind of ``annotation''---it doesn't really change the |Music| +value, it just annotates it as something that is transposed. + +Define instead a recursive function |transM :: AbsPitch -> Music Pitch +-> Music Pitch| that actually changes each note in a |Music Pitch| +value by transposing it by the interval represented by the first +argument. + +Hint: To do this properly, you will have to pattern match against the +|Music| value, something like this: +\begin{spec} +transM ap (Prim (Note d p)) = ... +transM ap (Prim (Rest d)) = ... +transM ap (m1 :+: m2) = ... +transM ap (m1 :=: m2) = ... +transM ap (Modify ...) = ... +\end{spec} +} +\end{exercise} + +\vspace{.1in}\hrule
+ HSoM/Patterns.lhs view
@@ -0,0 +1,197 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{Pattern-Matching Details} +\label{ch:patterns} + +\index{pattern!matching||(} +In this chapter we will look at Haskell's pattern-matching process in +greater detail. + +Haskell defines a fixed set of patterns for use in case expressions +and function definitions. Pattern matching is permitted using the +constructors of any type, whether user-defined or pre-defined in +Haskell. This includes tuples, strings, numbers, characters, etc. +For example, here's a contrived function that matches against a tuple +of ``constants:'' +\begin{spec} +contrived :: ([a], Char, (Int, Float), String, Bool) -> Bool +contrived ([], 'b', (1, 2.0), "hi", True) = False +\end{spec} +This example also demonstrates that {\em nesting} of patterns is +permitted (to arbitrary depth). + +Technically speaking, {\em formal parameters} to functions are also +patterns---it's just that they {\em never fail to match a value}. As +a ``side effect'' of a successful match, the formal parameter is bound +to the value it is being matched against. For this reason patterns in +any one equation are not allowed to have more than one occurrence of +the same formal parameter. +\index{pattern!refutable} +\index{pattern!irrefutable} + +A pattern that may fail to match is said to be {\em refutable}; for +example, the empty list \hs{[]} is refutable. Patterns such as formal +parameters that never fail to match are said to be {\em irrefutable}. +There are three other kinds of irrefutable patterns, which are +summarized below. + +\index{pattern!as-pattern} +\paragraph*{As-Patterns} Sometimes it is convenient to name a +pattern for use on the right-hand side of an equation. For example, a +function that duplicates the first element in a list might be written +as: +\begin{spec} +f (x:xs) = x:x:xs +\end{spec} +Note that \hs{x:xs} appears both as a pattern on the left-hand side, +and as an expression on the right-hand side. To improve readability, +we might prefer to write \hs{x:xs} just once, which we can achieve +using an {\em as-pattern} as follows:\footnote{Another advantage to +doing this is that a naive implementation might otherwise completely +reconstruct \hs{x:xs} rather than re-use the value being matched +against.} +\begin{spec} +f s@(x:xs) = x:s +\end{spec} +Technically speaking, as-patterns always result in a successful match, +although the sub-pattern (in this case \hs{x:xs}) could, of course, +fail. + +\index{pattern!wildcard} +\paragraph*{Wildcards} Another common situation is matching against +a value we really care nothing about. For example, the functions +\hs{head} and \hs{tail} can be written as: +\begin{spec} +head (x:_) = x +tail (_:xs) = xs +\end{spec} +in which we have ``advertised'' the fact that we don't care what a +certain part of the input is. Each wildcard will independently match +anything, but in contrast to a formal parameter, each will bind +nothing; for this reason more than one are allowed in an equation. + +\index{pattern!lazy} +\paragraph*{Lazy Patterns} +There is one other kind of pattern allowed in Haskell. It is called a +{\em lazy pattern}, and has the form \hs{~pat}. Lazy patterns are +{\em irrefutable}: matching a value $v$ against \hs{~pat} always +succeeds, regardless of \hs{pat}. Operationally speaking, if an +identifier in \hs{pat} is later ``used'' on the right-hand-side, it +will be bound to that portion of the value that would result if \hs{v} +were to successfully match \hs{pat}, and $\bot$ otherwise. + +Lazy patterns are useful in contexts where infinite data structures +are being defined recursively. For example, infinite lists are an +excellent vehicle for writing {\em simulation} programs, and in this +context the infinite lists are often called {\em streams}. +%% Streams were discussed at length in Chapter \ref{ch:streams}. + +\section*{Pattern-Matching Semantics} + +So far we have discussed how individual patterns are matched, how some +are refutable, some are irrefutable, etc. But what drives the overall +process? In what order are the matches attempted? What if none +succeed? This section addresses these questions. + +Pattern matching can either {\em fail}, {\em succeed} or {\em +diverge}. A successful match binds the formal parameters in the +pattern. Divergence occurs when a value needed by the pattern +diverges (i.e.\ is non-terminating) or results in an error ($\bot$). +The matching process itself occurs ``top-down, left-to-right.'' +Failure of a pattern anywhere in one equation results in failure of +the whole equation, and the next equation is then tried. If all +equations fail, the value of the function application is $\bot$, and +results in a run-time error. + +For example, if \hs{bot} is a divergent or erroneous computation, and +if \hs{[1,2]} is matched against \hs{[0,bot]}, then \hs{1} fails to +match \hs{0}, so the result is a failed match. But if \hs{[1,2]} is +matched against \hs{[bot,0]}, then matching \hs{1} against \hs{bot} +causes divergence (i.e.~$\bot$). + +\index{pattern!guard} + +The only other twist to this set of rules is that top-level patterns +may also have a boolean {\em guard}, as in this definition of a +function that forms an abstract version of a number's sign: +\begin{spec} +sign x | x > 0 = 1 + | x == 0 = 0 + | x < 0 = -1 +\end{spec} +Note here that a sequence of guards is given for a single pattern; as +with patterns, these guards are evaluated top-down, and the first that +evaluates to \hs{True} results in a successful match. + +\paragraph*{An Example} + +The pattern-matching rules can have subtle effects on the meaning of +functions. For example, consider this definition of \hs{take}: +\begin{spec} +take 0 _ = [] +take _ [] = [] +take n (x:xs) = x : take (n-1) xs +\end{spec} +and this slightly different version (the first 2 equations have been +reversed): +\begin{spec} +take1 _ [] = [] +take1 0 _ = [] +take1 n (x:xs) = x : take1 (n-1) xs +\end{spec} +Now note the following: +\[\begin{array}{lcl} + \hs{take 0 bot} &\ \ \ \red\ \ \ & \hs{[]} \\ + \hs{take1 0 bot} &\ \ \ \red\ \ \ & \bot \\[.1in] + \hs{take bot []} &\ \ \ \red\ \ \ & \bot \\ + \hs{take1 bot []} &\ \ \ \red\ \ \ & \hs{[]} +\end{array}\] +We see that \hs{take} is ``more defined'' with respect to its second +argument, whereas \hs{take1} is more defined with respect to its first. +It is difficult to say in this case which definition is better. Just +remember that in certain applications, it may make a difference. (The +Standard Prelude includes a definition corresponding to \hs{take}.) + +\section*{Case Expressions} +\indexkw{case} + +Pattern matching provides a way to ``dispatch control'' based on +structural properties of a value. However, in many circumstances we +don't wish to define a {\em function} every time we need to do this. +Haskell's {\em case expression} provides a way to solve this problem. +Indeed, the meaning of pattern matching in function definitions is +specified in the Haskell Report in terms of case expressions, which +are considered more primitive. In particular, a function definition +of the form: +\[\begin{array}{l} +\hs{f} p_{11} ... p_{1k} \hs{=} e_{1} \\ +... \\ +\hs{f} p_{n1} ... p_{nk} \hs{=} e_{n} +\end{array}\] +where each $p_{ij}$ is a pattern, is semantically equivalent to: +\[ \hs{f x1 x2 ... xk = case (x1, ..., xk) of} + \begin{array}[t]{l} + (p_{11}, ..., p_{1k}) \rightarrow e_{1} \\ + ... \\ + (p_{n1}, ..., p_{nk}) \rightarrow e_{n} + \end{array} +\] +where the \hs{xi} are new identifiers. For example, the +definition of \hs{take} given earlier is equivalent to: +\begin{spec} +take m ys = case (m,ys) of + (0,_) -> [] + (_,[]) -> [] + (n,x:xs) -> x : take (n-1) xs +\end{spec} +For type correctness, the types of the right-hand sides of a case +expression or set of equations comprising a function definition must +all be the same; more precisely, they must all share a common +principal type. + +The pattern-matching rules for case expressions are the same as we +have given for function definitions. +\index{pattern!matching||)}
+ HSoM/Performance.lhs view
@@ -0,0 +1,905 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\out{+\begin{code}+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/Performance.lhs. (See HSoM/MakeCode.bat.)++\end{code}+}++\chapter{Interpretation and Performance}+\label{ch:performance}++\begin{code}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++module Euterpea.Music.Note.Performance where++import Euterpea.Music.Note.Music+import Euterpea.Music.Note.MoreMusic+\end{code} ++\syn{The first line above is a GHC \emph{pragma} that, in this case,+ relaxes certain constraints on instance declarations. Specifically,+ instances cannot normally be declared for type synonyms---but the+ above pragma overrides that constraint.}++So far, our presentation of musical values in Haskell has been mostly+structural, i.e.\ \emph{syntactic}. Although we have given an+interpretation of the duration of |Music| values (as manifested in+|dur|, |takeM|, |dropM|, and so on), we have not given any deeper+musical interpretation. What do these musical values actually+\emph{mean}, i.e.\ what is their \emph{semantics}, or+\emph{interpretation}? The formal process of giving a semantic+interpretation to syntactic constructs is very common in computer+science, especially in programming language theory. But it is+obviously also common in music: the interpretation of music is the+very essence of musical performance. However, in conventional music+this process is usually informal, appealing to aesthetic judgments and+values. What we would like to do is make the process formal in+Euterpea---but still flexible, so that more than one interpretation is+possible, just as in the human performance of music.++\section{Abstract Performance}+\label{sec:performance}++To begin, we need to say exactly what an abstract \emph{performance}+is. Our approach is to consider a performance to be a time-ordered+sequence of musical \emph{events}, where each event captures the+playing of one individual note. In Haskell:+\begin{code}++type Performance = [Event]++data Event = Event { eTime :: PTime, + eInst :: InstrumentName, + ePitch :: AbsPitch,+ eDur :: DurT, + eVol :: Volume, + eParams :: [Double]}+ deriving (Show,Eq,Ord)+\end{code}+\begin{spec}+type PTime = Rational+type DurT = Rational+type Volume = Integer+\end{spec}+\out{+\begin{code}+type PTime = Rational+type DurT = Rational+\end{code}}++\index{field labels} +\syn{The data declaration for |Event| uses Haskell's \emph{field+ label} syntax, also called \emph{record} syntax, and is equivalent to:+\begin{spec}+data Event = Event PTime InstrumentName + AbsPitch DurT Volume [Double]+ deriving (Show,Eq,Ord)+\end{spec}+except that the former also defines ``field labels'' |eTime|, |eInst|, +|ePitch|, |eDur|, |eVol|, and |eParams|, which can be used to+create, update, and select from |Event| values.}++\syn{For example, this equation:+\begin{spec}+e = Event 0 Cello 27 (1/4) 50 []+\end{spec}+is equivalent to:+\begin{spec}+e = Event { eTime = 0, ePitch = 27, eDur = 1/4, + eInst = Cello, eVol = 50, eParams = [] }+\end{spec}+Although more verbose, the latter is also more descriptive, and the+order of the fields does not matter (indeed the order here is not the+same as above).++Field labels can be used to \emph{select} fields from an |Event|+value; for example, using the value of |e| above, |eInst e => Cello|,+|eDur e => 1/4|, and so on. They can also be used to selectively+\emph{update} fields of an existing |Event| value. For example:+\begin{spec}+e { eInst = Flute } ==> Event 0 Flute 27 (1/4) 50 []+\end{spec}+Finally, they can be used selectively in pattern matching:+\begin{spec}+f (Event { eDur = d, ePitch = p }) = ... d ... p ...+\end{spec}+Field labels do not change the basic nature of a data type; they are+simply a convenient syntax for referring to the components of a data+type by name rather than by position.}++An event |Event {eTime = s, eInst = i, ePitch = p, eDur = d, eVol =+ v}| captures the fact that at start time |s|, instrument |i| sounds+pitch |p| with volume |v| for a duration |d| (where now duration is+measured in seconds, rather than beats). (The |eParams| of an event+is for instruments other than MIDI, in particular instruments that we+might design on our using the techniques described in+Chapter~\ref{ch:sigfuns}.++An abstract performance is the lowest of our music representations not+yet committed to MIDI or some other low-level computer music+representation. In Chapter~\ref{ch:midi} we will discuss how to map a+performance into MIDI.++\subsection{Context}+\label{sec:context}++To generate a complete performance of, i.e.\ give an interpretation+to, a musical value, we must know the time to begin the performance,+and the proper instrument, volume, starting pitch offset, and tempo.+We can think of this as the ``context'' in which a musical value is+interpreted. This context can be captured formally in Haskell as a+data type:++\pagebreak++\begin{code}++data Context a = Context { cTime :: PTime, + cPlayer :: Player a, + cInst :: InstrumentName, + cDur :: DurT, + cPch :: AbsPitch,+ cVol :: Volume,+ cKey :: (PitchClass, Mode) }+ deriving Show+\end{code}+When a |Music| value is interpreted, it will be given an inital+context, but as the |Music| value is recursively interpreted, the+context will be updated to reflect things like tempo change,+transposition, and so on. This will be made clear shortly.++The |DurT| component of the context is the duration, in seconds,+of one whole note. To make it easier to compute, we can define a+``metronome'' function that, given a standard metronome marking (in+beats per minute) and the note type associated with one beat (quarter+note, eighth note, etc.) generates the duration of one whole note:+\begin{code}+metro :: Int -> Dur -> DurT+metro setting dur = 60 / (fromIntegral setting * dur)+\end{code} +Thus, for example, |metro 96 qn| creates a tempo of 96 quarter+notes per minute.++\syn{|fromIntegral :: (Integral a, Num b) => a -> b| coerces a value+ whose type is a member of the |Integral| class to a value whose type+ is a member of the |Num| class. As used here, it is effectively+ converting the |Int| value |setting| to a |Rational| value, because+ |dur| is a |Rational| value, |Rational| is a member of the |Num|+ class, and multiplication has type |(*) :: Num a => a->a->a|.}++\subsection{Player Map}+\label{sec:player-map}++In addition to the context, we also need to know what {\em player} to+use; that is, we need a mapping from each |PlayerName| (a string) in a+|Music| value to the actual player to be used.\footnote{We do not need+ a mapping from |InstrumentName|s to instruments, since that is+ handled in the translation from a performance into MIDI, which is+ discussed in Chapter \ref{ch:midi}.} The details of what a player+is, and how it gives great flexibility to Euterpea, will be explained+later in this chapter (Section~\ref{sec:players}). For now, we simply+define a type synonym to capture the mapping of |PlayerName| to+|Player|:+\begin{code}++type PMap a = PlayerName -> Player a+\end{code}++\subsection{Interpretation}+\label{sec:perform}++Finally, we are ready to give an interpretation to a piece of music,+which we do by defining a function |perform|, whose type is:+\begin{spec}+perform :: PMap a -> Context a -> Music a -> Performance+\end{spec}+So |perform pm c m| is the |Performance| that results from+interpreting |m| using player map |pm| in the initial context |c|.+Conceptually, |perform| is perhaps the most important function defined+in this textbook, and is shown in Figure \ref{fig:perform}. To help+in understanding the definition of |perform|, let's step through the+equations one at a time.++\begin{figure}+\cbox{\small+\begin{spec}+perform :: PMap a -> Context a -> Music a -> Performance+perform pm + c@Context {cTime = t, cPlayer = pl, cDur = dt, cPch = k} m =+ case m of+ Prim (Note d p) -> playNote pl c d p+ Prim (Rest d) -> []+ m1 :+: m2 -> + let c' = c {cTime = t + dur m1 * dt}+ in perform pm c m1 ++ perform pm c' m2+ m1 :=: m2 -> merge (perform pm c m1) + (perform pm c m2)+ Modify (Tempo r) m -> perform pm (c {cDur = dt / r}) m+ Modify (Transpose p) m -> perform pm (c {cPch = k + p}) m+ Modify (Instrument i) m -> perform pm (c {cInst = i}) m+ Modify (KeySig pc mo) m -> perform pm (c {cKey = (pc,mo)}) m+ Modify (Player pn) m -> perform pm (c {cPlayer = pm pn}) m+ Modify (Phrase pa) m -> interpPhrase pl pm c pa m+\end{spec}}+\caption{An abstract |perform| function}+\label{fig:perform}+\end{figure}++\begin{enumerate} +\item+The interpretation of a note is player dependent. This is handled in+|perform| using the |playNote| function, which takes the player as an+argument. Precisely how the |playNote| function works is described in+Section~\ref{sec:players}, but for now you can think of it as+returning a |Performance| (a list of events) with just one event: the+note being played.+\item+In the interpretation of |(:+:)|, note that the |Performance|s of the+two arguments are appended together, with the start time of the second+|Performance| delayed by the duration of the first (as captured in the+context |c'|). The function |dur| (defined in Section+\ref{sec:duration}) is used to compute this duration. Note that the+interpretation of |(:+:)| is well-defined even for infinite |Music|+values.+\item+In the interpretation of |(:=:)|, the |Performance|s derived from the+two arguments are merged into a time-ordered stream. The definition+of |merge| is given below:+\begin{spec}+merge :: Performance -> Performance -> Performance++merge [] es2 = es2+merge es1 [] = es1+merge a@(e1:es1) b@(e2:es2) = + if e1 < e2 then e1 : merge es1 b+ else e2 : merge a es2+\end{spec} +Note that |merge| is esssentially the same as the |mergeLD| function+defined in Section~\ref{sec:lazy-rescue}.+\item+In the interpretation of |Modify|, first recall the definition of+|Control| from Chapter~\ref{sec:music}:+\begin{spec}+data Control =+ Tempo Rational -- scale the tempo+ | Transpose AbsPitch -- transposition+ | Instrument InstrumentName -- instrument label+ | Phrase [PhraseAttribute] -- phrase attributes+ | Player PlayerName -- player label+ | KeySig PitchClass Mode -- key signature and mode+ deriving (Show, Eq, Ord)++type PlayerName = String+data Mode = Major | Minor+ deriving (Show, Eq, Ord)+\end{spec}+Each of these six constructors is handled by a separate equation in+the definition of |perform|. Note how the context is updated in each+case---the |Context|, in general, is the running ``state'' of the+performance, and gets updated in several different ways.++Also of note is the treatment of |Phrase|. Like the playing of a+note, the playing of a phrase is player dependent. This is captured+through the function |interpPhrase|, which takes the player as an+argument. Like |playNote|, this too, along with the |PhraseAttribute|+data type, will be described in full detail in+Section~\ref{sec:players}.+\end{enumerate}++Figure~\ref{fig:PerformBD} is a block diagram showing how |perform|+fits into the ``big picture'' of Euterpea. |Music| values are most+abstract, |Performance| values are less abstract, and MIDI or audio+streams are the least abstract. This chapter focuses on converting a+|Music| value into a |Performance|; subsequent chapters will focus on+translating a |Performance| into either MIDI (still at the ``note''+level, and fairly straightforward) or audio (at the ``signal'' level,+and more complex).++\begin{figure}[hbtp]+\centering+\includegraphics[height=4in]{pics/PerformBD.eps} +\caption{Block Diagram of Performance Concepts}+\label{fig:PerformBD}+\end{figure}++%% For example, the interpretation of the |Tempo| constructor involves+%% scaling |dt| appropriately and updating the |DurT| field of the+%% context.++\subsection{Efficiency Concerns}++The use of |dur| in the treatment of |(:+:)| can, in the worst case,+result in a quadratic time complexity for |perform|. (Why?) A more+efficient solution is to have |perform| compute the duration directly,+returning it as part of its result. This version of |perform| is+shown in Figure \ref{fig:real-perform}.++Aside from efficiency, there is a more abstract reason for including+duration in the result of |perform|. Namely, the performance of a+rest is not just nothing---it is a period of ``silence'' equal in+duration to that of the rest. Indeed, John Cage's famous composition+\emph{4' 33"}, in which the performer is instructed to play nothing,+would otherwise be meaningless.\footnote{In reality this piece is+ meant to capture extemporaneously the sound of the environment+ during that period of ``silence.'' \cite{Cage433}}++Also note that |merge| compares entire events rather than just start+times. This is to ensure that it is commutative, a desirable+condition for some of the proofs used later in the text. Here is a+more efficient version of |merge| that will work just as well in+practice:+\begin{code}++merge :: Performance -> Performance -> Performance+merge [] es2 = es2+merge es1 [] = es1+merge a@(e1:es1) b@(e2:es2) = + if eTime e1 < eTime e2 then e1 : merge es1 b+ else e2 : merge a es2+\end{code} ++\begin{figure}+\cbox{\small+\begin{code}++perform :: PMap a -> Context a -> Music a -> Performance+perform pm c m = fst (perf pm c m)++perf :: PMap a -> Context a -> Music a -> (Performance, DurT)+perf pm + c@Context {cTime = t, cPlayer = pl, cDur = dt, cPch = k} m =+ case m of+ Prim (Note d p) -> (playNote pl c d p, d*dt)+ Prim (Rest d) -> ([], d*dt)+ m1 :+: m2 -> + let (pf1,d1) = perf pm c m1+ (pf2,d2) = perf pm (c {cTime = t+d1}) m2+ in (pf1++pf2, d1+d2)+ m1 :=: m2 -> + let (pf1,d1) = perf pm c m1+ (pf2,d2) = perf pm c m2+ in (merge pf1 pf2, max d1 d2)+ Modify (Tempo r) m -> perf pm (c {cDur = dt / r}) m+ Modify (Transpose p) m -> perf pm (c {cPch = k + p}) m+ Modify (Instrument i) m -> perf pm (c {cInst = i}) m+ Modify (KeySig pc mo) m -> perf pm (c {cKey = (pc,mo)}) m+ Modify (Player pn) m -> perf pm (c {cPlayer = pm pn}) m+ Modify (Phrase pas) m -> interpPhrase pl pm c pas m++\end{code}}+\caption{A more efficient |perform| function}+\label{fig:real-perform}+\end{figure}++%% m1 :=/ m2 -> +%% let (pf1,d1) = perf pm c m1+%% (pf2,d2) = perf pm c m2+%% in (merge pf1 pf2, max d1 d2)++\section{Players}+\label{sec:players}++%% \begin{spec}+%% module Players (module Players, module Music, module Performance)+%% where+%% import Music+%% import Performance+%% \end{spec} ++Recall from Section~\ref{sec:music} that the |Phrase| constructor in+the |Control| data type takes a list of |PhraseAttribute|s as an+argument:+\begin{spec}+data Control = ...+ | Phrase [PhraseAttribute] -- phrase attributes+ ...+\end{spec}+It is now time to unveil the definition of |PhraseAttribute|! Shown+fully in Figure \ref{fig:phrase-attributes}, these attributes give us+great flexibility in the interpretation process, because they can be+interpreted by different players in different ways. For example, how+should ``legato'' be interpreted in a performance? Or ``diminuendo?''+Different human players interpret things in different ways, of course,+but even more fundamental is the fact that a pianist, for example,+realizes legato in a way fundamentally different from the way a+violinist does, because of differences in their instruments.+Similarly, diminuendo on a piano and diminuendo on a harpsichord are+very different concepts.++\begin{figure}+\cbox{\small+\begin{spec}+data PhraseAttribute = Dyn Dynamic+ | Tmp Tempo+ | Art Articulation+ | Orn Ornament+ deriving (Show, Eq, Ord)++data Dynamic = Accent Rational | Crescendo Rational+ | Diminuendo Rational | StdLoudness StdLoudness + | Loudness Rational+ deriving (Show, Eq, Ord)++data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF+ deriving (Show, Eq, Ord, Enum)++data Tempo = Ritardando Rational | Accelerando Rational+ deriving (Show, Eq, Ord)++data Articulation = Staccato Rational | Legato Rational + | Slurred Rational | Tenuto | Marcato | Pedal + | Fermata | FermataDown | Breath | DownBow + | UpBow | Harmonic | Pizzicato | LeftPizz + | BartokPizz | Swell | Wedge | Thumb | Stopped+ deriving (Show, Eq, Ord)++data Ornament = Trill | Mordent | InvMordent | DoubleMordent+ | Turn | TrilledTurn | ShortTrill+ | Arpeggio | ArpeggioUp | ArpeggioDown+ | Instruction String | Head NoteHead+ | DiatonicTrans Int+ deriving (Show, Eq, Ord)++data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead+ | TremoloHead | SlashHead | ArtHarmonic | NoHead+ deriving (Show, Eq, Ord)+\end{spec}}+\caption{Phrase Attributes}+\label{fig:phrase-attributes}+\end{figure}++In addition to phrase attributes, Euterpea has a notion of \emph{note+ attributes} that can similarly be interpreted in different ways by+different players. This is done by exploiting polymorphism to define+a version of |Music| that in addition to pitch, carries a list of note+attributes for each individual note:++\begin{spec}+data NoteAttribute = + Volume Int -- MIDI convention: 0=min, 127=max+ | Fingering Integer+ | Dynamics String+ | Params [Double]+ deriving (Show, Eq)+\end{spec}+Our goal then is to define a player for music values of type:+\begin{code}+type Note1 = (Pitch, [NoteAttribute])+type Music1 = Music Note1+\end{code}+To facilitate the use of |Music1| values, Euterpea defines the+following simple coercion functions:+\begin{code}++toMusic1 :: Music Pitch -> Music1+toMusic1 = mMap (\p -> (p, []))++toMusic1' :: Music (Pitch, Volume) -> Music1+toMusic1' = mMap (\(p, v) -> (p, [Volume v]))+\end{code}++Finally, with a slight stretch of the imagination, we can even+consider the generation of a \emph{score} as a kind of player: exactly+how the music is notated on the written page may be a personal,+stylized process. For example, how many, and which staves should be+used to notate a particular instrument? ++%% As another example, the |Key| phrase attribute is needed to implement+%% a proper trill or turn, and also how to notate accidentals in a score.++To handle these three different kinds of interpretation, Euterpea has+a notion of a \emph{player} that ``knows'' about differences with+respect to performance and notation. An Euterpean |Player| is a+four-tuple consisting of a name and three functions: one for+interpreting notes, one for phrases, and one for producing a properly+notated score:++\pagebreak++\begin{code}+data Player a = MkPlayer { pName :: PlayerName, + playNote :: NoteFun a,+ interpPhrase :: PhraseFun a, + notatePlayer :: NotateFun a }++type NoteFun a = Context a -> Dur -> a -> Performance+type PhraseFun a = PMap a -> Context a -> [PhraseAttribute]+ -> Music a -> (Performance, DurT)+type NotateFun a = ()++instance Show a => Show (Player a) where+ show p = "Player " ++ pName p+\end{code}+Note that |NotateFun| is just the unit type; this is because notation+is currently not implemented in Euterpea. Also note the instance+declaration for a |Player|---since its components are mostly+functions, which are not default instances of |Show|, we define a+simple way to return the |PlayerName|.++\subsection{Example of Player Construction}++In this section we define a ``default player'' called |defPlayer| (not+to be confused with a ``deaf player''!) for use when none other is+specified in a score; it also functions as a basis from which other+players can be derived.++At the upper-most level, |defPlayer| is defined as a four-tuple:+\begin{code}+defPlayer :: Player Note1+defPlayer = MkPlayer + { pName = "Default",+ playNote = defPlayNote defNasHandler,+ interpPhrase = defInterpPhrase defPasHandler,+ notatePlayer = () }+\end{code}++The remaining functions are defined in Figure+\ref{fig:default-Player}. Before reading this code, first review how+players are invoked by the |perform| function defined in the last+section; in particular, note the calls to |playNote| and+|interpPhrase|. We will define |defPlayer| to respond only to the+|Volume| note attribute and to the |Accent|, |Staccato|, and |Legato|+phrase attributes.++\begin{figure}+\cbox{\small+\begin{code}+defPlayNote :: (Context (Pitch,[a]) -> a -> Event-> Event)+ -> NoteFun (Pitch, [a])+defPlayNote nasHandler + c@(Context cTime cPlayer cInst cDur cPch cVol cKey) d (p,nas) =+ let initEv = Event { eTime = cTime, eInst = cInst,+ eDur = d * cDur, eVol = cVol,+ ePitch = absPitch p + cPch,+ eParams = [] }+ in [ foldr (nasHandler c) initEv nas ]++defNasHandler :: Context a -> NoteAttribute -> Event -> Event+defNasHandler c (Volume v) ev = ev {eVol = v}+defNasHandler c (Params pms) ev = ev {eParams = pms}+defNasHandler _ _ ev = ev++defInterpPhrase :: + (PhraseAttribute -> Performance -> Performance) -> + ( PMap a -> Context a -> [PhraseAttribute] -> --PhraseFun+ Music a -> (Performance, DurT) )+defInterpPhrase pasHandler pm context pas m =+ let (pf,dur) = perf pm context m+ in (foldr pasHandler pf pas, dur)++defPasHandler :: PhraseAttribute -> Performance -> Performance+defPasHandler (Dyn (Accent x)) = + map (\e -> e {eVol = round (x * fromIntegral (eVol e))})+defPasHandler (Art (Staccato x)) = + map (\e -> e {eDur = x * eDur e})+defPasHandler (Art (Legato x)) = + map (\e -> e {eDur = x * eDur e})+defPasHandler _ = id+\end{code}}+\caption{Definition of default player |defPlayer|.}+\label{fig:default-Player}+\end{figure}++% defNotatePlayer :: a -> ()+% defNotatePlayer _ = ()++Then note:+\begin{enumerate} +\item |defPlayNote| is the only function (even in the definition+of |perform|) that actually generates an event. It also modifies+that event based on an interpretation of each note attribute by the+function |defNasHandler|.++\item |defNasHandler| only recognizes the |Volume| attribute,+which it uses to set the event volume accordingly.++\item |defInterpPhrase| calls (mutually recursively)+|perform| to interpret a phrase, and then modifies the result based on+an interpretation of each phrase attribute by the function+|defPasHandler|.++\item |defPasHandler| only recognizes the |Accent|,+|Staccato|, and |Legato| phrase attributes. For each of these it+uses the numeric argument as a ``scaling'' factor of the volume (for+|Accent|) and duration (for |Staccato| and |Legato|). Thus +|Modify (Phrase [Legato (5/4)]) m| effectively increases the duration+of each note in |m| by 25\% (without changing the tempo).+\end{enumerate} ++\subsection{Deriving New Players From Old Ones}+\label{sec:new-player}++It should be clear that much of the code in Figure+\ref{fig:default-Player} can be re-used in defining a new player.+For example, to define a player |newPlayer| that interprets note+attributes just like |defPlayer| but behaves differently with+respect to certain phrase attributes, we could write:+\begin{spec}+newPlayer :: Player (Pitch, [NoteAttribute])+newPlayer = MkPlayer + { pName = "NewPlayer",+ playNote = defPlayNote defNasHandler,+ interpPhrase = defInterpPhrase myPasHandler,+ notatePlayer = () }+\end{spec} +and then supply a suitable definition of |myPasHandler|. Better yet,+we could just do this:+\begin{spec}+newPlayer :: Player (Pitch, [NoteAttribute])+newPlayer = defPlayer+ { pName = "NewPlayer",+ interpPhrase = defInterpPhrase myPasHandler }+\end{spec} +This version uses the ``record update'' syntax to directly derive the+new player from |defPlayer|.++The definition of |myPasHandler| can also re-use code, in the+following sense: suppose we wish to add an interpretation for+|Crescendo|, but otherwise have |myPasHandler| behave just like+|defPasHandler|.+\begin{spec}+myPasHandler :: PhraseAttribute -> Performance -> Performance+myPasHandler (Dyn (Crescendo x)) pf = ...+myPasHandler pa pf = defPasHandler pa pf+\end{spec} ++\todo{Explain more... in particular, how ``inheritance'' works.}++\subsection{A Fancy Player}+\label{sec:fancy-player}++Figure \ref{fancy-Player} defines a more sophisticated player called+|fancyPlayer| that knows all that |defPlayer| knows, and more. Note+that |Slurred| is different from |Legato| in that it does not extend+the duration of the {\em last} note(s). The behavior of |Ritardando+x| can be explained as follows. We would like to ``stretch'' the time+of each event by a factor from $0$ to $x$, linearly interpolated based+on how far along the musical phrase the event occurs. I.e., given a+start time $t_0$ for the first event in the phrase, total phrase+duration $D$, and event time $t$, the new event time $t'$ is given by:+\[ t' = (1 + \frac{t-t_0}{D}x)(t-t_0) + t_0 \]+Further, if $d$ is the duration of the event, then the end of+the event $t+d$ gets stretched to a new time $t_d'$ given by:+\[ t_d' = (1 + \frac{t+d-t_0}{D}x)(t+d-t_0) + t_0 \]+The difference $t_d' - t'$ gives us the new, stretched duration $d'$,+which after simplification is:+\[ d' = (1 + \frac{2(t-t_0)+d}{D}x)\ d \]+|Accelerando| behaves in exactly the same way, except that it+shortens event times rather than lengthening them. And a similar but+simpler strategy explains the behaviors of |Crescendo| and+|Diminuendo|.++\pagebreak++\section{Putting it all Together}++The |play| function in Euterpea ueses a default player map and a+default context that are defined as follows:+\begin{code}++defPMap :: PMap Note1+defPMap "Fancy" = fancyPlayer+defPMap "Default" = defPlayer+defPMap n = defPlayer { pName = n }++defCon :: Context Note1+defCon = Context { cTime = 0,+ cPlayer = fancyPlayer,+ cInst = AcousticGrandPiano,+ cDur = metro 120 qn,+ cPch = 0,+ cKey = (C, Major),+ cVol = 127 }+\end{code}+Note that if anything other than a |"Fancy"| or |"Default"| player is+specified in the |Music| value, such as |player "Strange" m|, then the+default player |defPlayer| is used, and given the name |"Strange"|.++If instead we wish to use our own player, say |newPlayer| defined+in Section \ref{sec:new-player}, then a new player map can be defined,+such as:+\begin{spec}+myPMap :: PlayerName -> Player Note1+myPMap "NewPlayer" = newPlayer+myPMap p = defPMap p+\end{spec}++Similarly, different versions of the context can be defined based on a+user's needs.++We could, then, use these versions of player maps and contexts to+invoke the |perform| function to generate an abstract |Performance|.+Of course, we ultimately want to hear our music, not just see an+abstract |Performance| displayed on our computer screen. Recall+that |play|'s type signature is:+\begin{spec}+play :: Performable a => Music a -> IO ()+\end{spec}+To allow using different player maps and contexts, Euterpea also has+a version of |play| called |playA| whose type signature is:+\begin{spec}+playA :: Performable a => + PMap Note1 -> Context Note1 -> Music a -> IO ()+\end{spec}+For example, to play a |Music| value |m| using |myPMap| defined above+and the default context |defCon|, we can do:+\begin{spec}+playA myPMap defCon m+\end{spec}++In later chapters we will learn more about |play|, and how it converts+a |Performance| into MIDI events that eventually are heard through+your computer's sound card.++\vspace{.1in}\hrule++\begin{exercise}{\em+Fill in the |...| in the definition of |myPasHandler| according to the+following strategy: Gradually scale the volume of each event in the+performance by a factor of |1| through |1+x|, using linear+interpolation.}+\end{exercise}++\begin{exercise}{\em+Choose some of the other phrase attributes and provide interpretations+for them. ++(Hint: As in |fancyPlayer|, you may not be able to use the+``|pasHandler|'' approach to implement some of the phrase attributes.+For example, for a proper treatment of |Trill| (and similar ornaments)+you will need to access the |cKey| field in the context.)}+\end{exercise}++\begin{exercise}{\em+Define a player |myPlayer| that appropriately handles the+|Pedal| articulation and both the |ArpeggioUp| and |ArpeggioDown|+ornamentations. You should define |myPlayer| as a derivative+of |defPlayer| or |newPlayer|.}+\end{exercise}++\begin{exercise}{\em+Define a player |jazzMan| (or |jazzWoman| if you prefer) that plays a+melody using a jazz ``swing'' feel. Since there are different kinds+and degrees of swing, we can be more specific as follows: whenever+there is a sequence of two eighth notes, they should be interpreted+instead as a quarter note followed by an eighth note, but with tempo+3/2. So in essence, the first note is lengthened, and the second note+is shortened, so that the first note is twice as long as the second,+but they still take up the same amount of overall time. ++(Hint: There are several ways to solve this problem. One surprisingly+effective and straightforward solution is to implement |jazzMan| as a+|NoteFun|, not a |PhraseFun|. In jazz, if an eighth note falls on a+quarter-note beat it is said to fall on the ``downbeat,'' and the+eighth notes that are in between are said to fall on the ``upbeat.''+For example, in the phrase |c 4 en :+: d 4 en :+: e 4 en :+: f 4 en|,+the C and E fall on the downbeat, and the D and F fall on the upbeat.+So to get a ``swing feel,'' the notes on the down beat need to be+lengthened, and ones on the upbeat need to be delayed and shortened.+Whether an event falls on a downbeat or upbeat can be determined from+the |cTime| and |cDur| of the context.)}+\end{exercise}++\begin{exercise}{\em+Implement the ornamentation |DiatonicTrans|, which is intended to be a+``diatonic tranposition'' of a phrase within a particular key. The+argument to |DiatonicTrans| is an integer representing the number of+\emph{scale degrees} to do the transposition. For example, the+diatonic transposition of |c 4 en :+: d 4 en :+: e 4 en| in C major by+2 scale degrees should yield |e 4 en :+: f 4 en :+: g 4 en|, whereas+in G major should yield |e 4 en :+: fs 4 en :+: g 4 en|.++(Hint: You will need to access the key from the context (using+|cKey|). Thus, as with |fancyPlayer|, you may not be able to use the+``|pasHandler|'' approach to solve this problem.)}+\end{exercise}++%% but the trickier part is how to treat the |cPch| field. Once a+%% |Performance| is generated, you can think of each abolute pitch as+%% being relative to a zero offset.}++\vspace{.1in}\hrule+\vspace{.1in}++\begin{figure}+\todo{This code has errors and needs to be fixed.}+\cbox{\small+\begin{code}++fancyPlayer :: Player (Pitch, [NoteAttribute])+fancyPlayer = MkPlayer { pName = "Fancy",+ playNote = defPlayNote defNasHandler,+ interpPhrase = fancyInterpPhrase,+ notatePlayer = () }++fancyInterpPhrase :: PhraseFun a+fancyInterpPhrase pm c [] m = perf pm c m+fancyInterpPhrase pm + c@Context { cTime = t, cPlayer = pl, cInst = i, + cDur = dt, cPch = k, cVol = v}+ (pa:pas) m =+ let pfd@(pf,dur) = fancyInterpPhrase pm c pas m+ loud x = fancyInterpPhrase pm c (Dyn (Loudness x) : pas) m+ stretch x = let t0 = eTime (head pf); r = x/dur+ upd (e@Event {eTime = t, eDur = d}) = + let dt = t-t0+ t' = (1+dt*r)*dt + t0+ d' = (1+(2*dt+d)*r)*d+ in e {eTime = t', eDur = d'}+ in (map upd pf, (1+x)*dur)+ inflate x = let t0 = eTime (head pf); + r = x/dur+ upd (e@Event {eTime = t, eVol = v}) = + e {eVol = round ( (1+(t-t0)*r) * + fromIntegral v)}+ in (map upd pf, dur)+ in case pa of+ Dyn (Accent x) ->+ ( map (\e-> e {eVol = round (x * fromIntegral (eVol e))}) pf, dur)+ Dyn (StdLoudness l) -> + case l of + PPP -> loud 40; PP -> loud 50; P -> loud 60+ MP -> loud 70; SF -> loud 80; MF -> loud 90+ NF -> loud 100; FF -> loud 110; FFF -> loud 120+ Dyn (Loudness x) -> fancyInterpPhrase pm+ c{cVol = round x} pas m+ Dyn (Crescendo x) -> inflate x ; Dyn (Diminuendo x) -> inflate (-x)+ Tmp (Ritardando x) -> stretch x ; Tmp (Accelerando x) -> stretch (-x)+ Art (Staccato x) -> (map (\e-> e {eDur = x * eDur e}) pf, dur)+ Art (Legato x) -> (map (\e-> e {eDur = x * eDur e}) pf, dur)+ Art (Slurred x) -> + let lastStartTime = foldr (\e t -> max (eTime e) t) 0 pf+ setDur e = if eTime e < lastStartTime+ then e {eDur = x * eDur e}+ else e+ in (map setDur pf, dur) + Art _ -> pfd+ Orn _ -> pfd+\end{code}}+\caption{Definition of Player |fancyPlayer|.}+\label{fancy-Player}+\end{figure}++\out{++Generating Performances+-----------------------++Make the default translation to Performance as a class in order to deal+with both Music Pitch and Music Note1:++\begin{code}++class Performable a where+ perfDur :: PMap Note1 -> Context Note1 -> Music a -> (Performance, DurT)+\end{code}++Using the defaults below, from a Music value we can generate a+Performance:++\begin{code}++instance Performable Note1 where+ perfDur pm c m = perf pm c m++instance Performable Pitch where+ perfDur pm c = perfDur pm c . toMusic1++instance Performable (Pitch, Volume) where+ perfDur pm c = perfDur pm c . toMusic1'++defToPerf :: Performable a => Music a -> Performance+defToPerf = fst . perfDur defPMap defCon++toPerf :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Performance+toPerf pm con = fst . perfDur pm con+\end{code}++}
+ HSoM/Poly.lhs view
@@ -0,0 +1,1187 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter[Polymorphic \& Higher-Order Functions] +{Polymorphic and Higher-Order Functions} +\label{ch:poly} + +Several examples of polymorphic data types were introduced in the last +couple of chapters. In this chapter the focus is on {\em polymorphic + functions}, which are most commonly defined over polymorphic data +types. + +The already familiar {\em list} is the protoypical example of a +polymorphic data type, and it will be studied in depth in this +chapter. Although lists have no direct musical connection, they are +perhaps the most commonly used data type in Haskell, and have many +applications in computer music programming. But in addition the +|Music| data type is polymorphic, and several new functions that +operate on it polymorphiccally will also be defined, + +(A more detailed discussion of predefined polymorphic functions that +operate on lists can be found in Appendix \ref{ch:list-tour}.) + +This chapter also introduces {\em higher-order functions}, which are +functions that take one or more functions as arguments or return a +function as a result (functions can also be placed in data +structures). Higher-order functions permit the elegant and concise +expression of many musical concepts. Together with polymorphism, +higher-order functions substantially increase the programmer's +expressive power and ability to reuse code. + +Both of these new ideas follow naturally the foundations that have +already been established. + +\section{Polymorphic Types} +\label{sec:poly-types} + +\index{polymorphism||(} \index{type!polymorphic||(} + +In previous chapters, examples of lists containing several different +kinds of elements---integers, characters, pitch classes, and so +on---were introduced, and we can well imagine situations requiring +lists of other element types. Sometimes, however, it is not necessary +to be so particular about the type of the elements. For example, +suppose we wish to define a function |length| that determines the +number of elements in a list. It does not really matter whether the +list contains integers, pitch classes, or even other lists---we can +imagine computing the length in exactly the same way in each case. +The obvious definition is: \indexhs{length} +\begin{spec} +length [] = 0 +length (x:xs) = 1 + length xs +\end{spec} +This recursive definition is self-explanatory. Indeed, we can read +the equations as saying: ``The length of the empty list is 0, and the +length of a list whose first element is |x| and remainder is |xs| is 1 +plus the length of |xs|.'' + +But what should the type of |length| be? Intuitively, we would like +to say that, for {\em any} type |a|, the type of |length| is |[a] -> +Integer|. In mathematics we might write this as: +\begin{spec} +length :: (forall a) [a] -> Integer +\end{spec} +But in Haskell this is written simply as: +\begin{spec} +length :: [a] -> Integer +\end{spec} +In other words, the universal quantification of the type variable |a| +is implicit. +\index{type!variable} +\syn{Generic names for types, such as |a| above, are called {\em +type variables}, and are uncapitalized to distinguish them from +concrete types such as |Integer|.} + +So |length| can be applied to a list containing elements of {\em +any} type. For example: +\begin{code} +length [1,2,3] ===> 3 +length [C,D,Ef ] ===> 3 +length [[1],[],[2,3,4]] ===> 3 +\end{code} +%% length "def" ===> 3 + +Note that the type of the argument to |length| in the last example +is |[[Integer]]|; that is, a list of lists of integers. + +Here are two other examples of polymorphic list functions, which +happen to be predefined in Haskell: +\indexhs{head} +\indexhs{tail} +\begin{spec} +head :: [a] -> a +head (x:_) = x + +tail :: [a] -> [a] +tail (_:xs) = xs +\end{spec} +\syn{The |_| on the left-hand side of these equations is called a + \emph{wildcard} pattern. It matches any value, and binds no + variables. It is useful as a way of documenting the fact that we + do not care about the value in that part of the pattern. Note + that we could (perhaps should) have used a wildcard in place of the + variable |x| in the definition of |length|. } + +These two functions take the ``head'' and ``tail,'' respectively, of +any non-empty list. For example: +\begin{spec} +head [ 1, 2, 3 ] ==> 1 +head [ C, D, Ef ] ==> C +tail [ 1, 2, 3 ] ==> [ 2, 3 ] +tail [ C, D, Ef ] ==> [ D, Ef ] +\end{spec} +Note that, for any non-empty list |xs|, |head| and |tail| obey the +following law: +\begin{spec} +head xs : tail xs = xs +\end{spec} + +Functions such as |length|, |head|, and |tail| are said to be +{\em polymorphic}. Polymorphic functions arise naturally when +defining functions on lists and other polymorphic data types, +including the |Music| data type defined in the last chapter. + +%% In the remainder of this chapter we will continue studying polymorphic +%% lists, but in Chapter \ref{ch:trees}, for example, we will look at +%% another polymorphic data structure, namely a {\em tree}. + +\index{type!polymorphic||)} +\index{polymorphism||)} + +\section{Abstraction Over Recursive Definitions} +\label{sec:rec-abstraction} + +Given a list of pitches, suppose we wish to convert each pitch into +an absolute pitch. We could define a function: +\begin{code} +toAbsPitches :: [Pitch] -> [AbsPitch] +toAbsPitches [] = [] +toAbsPitches (p:ps) = absPitch p : toAbsPitches ps +\end{code} + +We might also want to convert a list of absolute pitches to a list of +pitches: +\begin{code} +toPitches :: [AbsPitch] -> [Pitch] +toPitches [] = [] +toPitches (a:as) = pitch a : toPitches as +\end{code} + +These two functions are different, but share something in common: +there is a repeating pattern of operations. But the pattern is not +quite like any of the examples studied earlier, and therefore it is +unclear how to apply the abstraction principle. What distinguishes +this situation is that there is a repeating pattern of {\em + recursion}. + +In discerning the nature of a repeating pattern, recall that it is +sometimes helpful to first identify those things that {\em are not} +repeating---i.e.\ those things that are {\em changing}---since these +will be the sources of {\em parameterization}: those values that must +be passed as arguments to the abstracted function. In the case above, +these changing values are the functions |absPitch| and |pitch|; +consider them instances of a new name, |f|. Rewriting either of the +above functions as a new function---call it |map|---that takes an +extra argument |f|, yields: +\begin{spec} +map f [] = [] +map f (x:xs) = f x : map f xs +\end{spec} +This recursive pattern of operations is so common that |map| is +predefined in Haskell (and is why the name |map| was chosen in the +first place). + +With |map|, we can now redefine |toAbsPitches| and |toPitches| as: +\indexhs{map} +\begin{spec} +toAbsPitches :: [Pitch] -> [AbsPitch] +toAbsPitches ps = map absPitch ps + +toPitches :: [AbsPitch] -> [Pitch] +toPitches as = map pitch as +\end{spec} +Note that these definitions are non-recursive; the common pattern of +recursion has been abstracted away and isolated in the definition of +|map|. They are also very succinct; so much so, that it seems +unnecessary to create new names for these functions at all! One of +the powers of higher-order functions is that they permit concise yet +easy-to-understand definitions such as this, and you will see many +similar examples throughout the remainder of the text. + +A proof that the new versions of these two functions are equivalent to +the old ones can be done via calculation, but requires a proof +technique called {\em induction}, because of the recursive nature of +the original function definitions. Inductive proofs are discussed in +detail, including for these two examples, in Chapter +\ref{ch:induction}. + +\subsection{Map is Polymorphic} + +What should the type of |map| be? Looking first at its use in +|toAbsPitches|, note that it takes the function |absPitch :: Pitch -> +AbsPitch| as its first argument and a list of |Pitch|s as its second +argument, returning a list of |AbsPitch|s as its result. So its type +must be: +\begin{spec} +map :: (Pitch -> AbsPitch) -> [Pitch] -> [AbsPitch] +\end{spec} +Yet a similar analysis of its use in |toPitches| reveals that +|map|'s type should be: +\begin{spec} +map :: (AbsPitch -> Pitch) -> [AbsPitch] -> [Pitch] +\end{spec} +This apparent anomaly can be resolved by noting that |map|, like +|length|, |head|, and |tail|, does not really care what its +list element types are, {\em as long as its functional argument can be +applied to them}. Indeed, |map| is {\em polymorphic}, and its most +general type is: +\begin{spec} +map :: (a -> b) -> [a] -> [b] +\end{spec} +This can be read: ``|map| is a function that takes a function from +any type |a| to any type |b|, and a list of |a|'s, and +returns a list of |b|'s.'' The correspondence between the two +|a|'s and between the two |b|'s is important: a function that +converts |Int|'s to |Char|'s, for example, cannot be mapped over +a list of |Char|'s. It is easy to see that in the case of +|toAbsPitches|, |a| is instantiated as |Pitch| and |b| as +|AbsPitch|, whereas in |toPitches|, |a| and |b| are +instantiated as |AbsPitch| and |Pitch|, respectively. + +Note, as we did in Section \ref{sec:music}, that the above reasoning +can be viewed as the abstraction principle at work at the type level. + +\syn{In Chapter \ref{ch:intro} it was mentioned that every expression + in Haskell has an associated type. But with polymorphism, we might + wonder if there is just one type for every expression. For example, + |map| could have any of these types: +\begin{spec} +(a->b) -> [a] -> [b] +(Integer->b) -> [Integer] -> [b] +(a->Float) -> [a] -> [Float] +(Char->Char) -> [Char] -> [Char] +\end{spec} +and so on, depending on how it will be used. However, notice that the +first of these types is in some fundamental sense more general than +the other three. In fact, every expression in Haskell has a unique +type known as its \index{type!principal}{\em principal type}: the +least general type that captures all valid uses of the expression. +The first type above is the principal type of |map|, since it captures +all valid uses of |map|, yet is less general than, for example, the +type |a->b->c|. As another example, the principal type of |head| is +|[a]->a|; the types |[b]->a|, |b->a|, or even |a| are too general, +whereas something like |[Integer]->Integer| is too specific. (The +existence of unique principal types is the hallmark feature of the +{\em Hindley-Milner type system} \cite{hindley69,milner78} that forms +the basis of the type systems of Haskell, ML \cite{ML-definition} and +several other functional languages \cite{huda89a}.)} +\index{Hindley-Milner type system} + +\subsection{Using map} + +%% Now that we can picture |map| as a polymorphic function, it is +%% useful to look back on some of the examples we have worked through to +%% see if there are any situations where |map| might have been useful. +%% For example, recall from Section \ref{sec:basic-list-abstraction} the +%% definition of |totalArea|: +%% \begin{spec} +%% totalArea = listSum [circleArea r1, circleArea r2, circleArea r3] +%% \end{spec} +%% It should be clear that this can be rewritten as: +%% \begin{spec} +%% totalArea = listSum (map circleArea [r1,r2,r3]) +%% \end{spec} +%% A simple calculation is all that is needed to show that these are the +%% same: +%% \begin{spec} +%% map circleArea [r1, r2, r3] +%% ==> circleArea r1 : map circleArea [r2, r3] +%% ==> circleArea r1 : circleArea r2 : map circleArea [r3] +%% ==> circleArea r1 : circleArea r2 : circleArea r3 : map circleArea [] +%% ==> circleArea r1 : circleArea r2 : circleArea r3 : [] +%% ==> [circleArea r1, circleArea r2, circleArea r3] +%% \end{spec} + +For a musical example involving |map|, consider the task of generating +a six-note whole-tone scale starting at a given pitch:\footnote{A + whole-tone scale is a sequence of six ascending notes, with each + adjacent pair of notes separated by two semitones, i.e.\ a whole + note.} +\begin{code} +wts :: Pitch -> [Music Pitch] +wts p = let f ap = note qn (pitch (absPitch p + ap)) + in map f [0,2,4,6,8] +\end{code} +For example: +\begin{spec} +wts a440 +===> [ note qn (A,4), note qn (B,4), note qn (C#,4), + note qn (D#,4), note qn (F,4), note qn (G,4) ] +\end{spec} + +%% \syn{A list |[a,b..c]| is called an +%% {\em \indexwd{arithmetic sequence}}, and is special syntax for the +%% list |[a, a+d, a+2*d, ..., c]| where |d = b-a|.} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Using |map|, define: +\begin{enumerate} +\item A function |f1 :: Int -> [Pitch] -> [Pitch]| that transposes + each pitch in its second argument by the amount specified in its + first argument. +\item A function |f2 :: [Dur] -> [Music a]| that turns a list + of durations into a list of rests, each having the corresponding + duration. +\item A function |f3 :: [Music Pitch] -> [Music Pitch]| that + takes a list of music values (that are assumed to be single notes), + and for each such note, halves its duration and places a rest of + that same duration after it. For example: +\begin{spec} +f3 [c 4 qn, d 4 en, e 4 hn] +===> [c 4 en :+: rest en, d 4 sn :+: rest sn, e 4 qn :+: rest qn] +\end{spec} + You can think of this as giving a staccato interpretation of the + notes. +\end{enumerate} } +\end{exercise} + +\vspace{.1in}\hrule + +\section{Append} +\label{sec:append} + +Consider now the problem of {\em concatenating} or {\em + appending} two lists together; that is, creating a third list that +consists of all of the elements from the first list followed by all of +the elements of the second. Once again the type of list elements does +not matter, so we can define this as a polymorphic infix operator +|(++)|: \indexhs{(++)} +\begin{spec} +(++) :: [a] -> [a] -> [a] +\end{spec} +For example, here are two uses of |(++)| on different types: +\begin{spec} +[1,2,3] ++ [4,5,6] ===> [1,2,3,4,5,6] +[C,E,G] ++ [D,F,A] ===> [C,E,G,D,F,A] +\end{spec} + +As usual, we can approach this problem by considering the various +possibilities that could arise as input. But in the case of |(++)| +there are {\em two} inputs---so which should be considered first? In +general this is not an easy question to answer, so we could just try +the first list first: it could be empty, or non-empty. If it is empty +the answer is easy: +\begin{spec} +[] ++ ys = ys +\end{spec} +and if it is not empty the answer is also straightforward: +\begin{spec} +(x:xs) ++ ys = x : (xs++ys) +\end{spec} +Note the recursive use of |(++)|. The full definition is thus: +\begin{spec} +(++) :: [a] -> [a] -> [a] +[] ++ ys = ys +(x:xs) ++ ys = x : (xs++ys) +\end{spec} + +\syn{Note that an infix operator can be defined just as any other + function, including pattern-matching, except that on the + left-hand-side it is written using its infix syntax. + +Also be aware that this textbook takes liberty in typesetting by +displaying the append operator as |++|. When you type your code, +however, you will need to write {\tt ++}. Recall that infix operators +in Haskell must not contain any numbers or letters of the alphabet, +and also must not begin with a colon (because those are reserved to be +infix constructors).} + +If we were to consider instead the second list first, then the +first equation would still be easy: +\begin{spec} +xs ++ [] = xs +\end{spec} +but the second is not so obvious: +\begin{spec} +xs ++ (y:ys) = ?? +\end{spec} +So it seems that the right choice was made to begin with. + +Like |map|, the concatenation operator |(++)| is used so often that it +is predefined in Haskell. + +\subsection{[Advanced] The Efficiency and Fixity of Append} + +In Chapter \ref{ch:induction} the following simple property about +|(++)| will be proved: +\begin{spec} +(xs ++ ys) ++ zs = xs ++ (ys ++ zs) +\end{spec} +That is, |(++)| is {\em associative}. + +\index{efficiency} +But what about the efficiency of the left-hand and right-hand sides of +this equation? It is easy to see via calculation that appending two +lists together takes a number of steps proportional to the length of +the first list (indeed the second list is not evaluated at all). For +example: +\begin{spec} +[1,2,3] ++ xs +==> 1 : ([2,3] ++ xs) +==> 1 : 2 : ([3] ++ xs) +==> 1 : 2 : 3 : ([] ++ xs) +==> 1 : 2 : 3 : xs +\end{spec} +Therefore the evaluation of |xs ++ (ys ++ zs)| takes a number of +steps proportional to the length of |xs| plus the length of +|ys|. But what about |(xs ++ ys) ++ zs|? The leftmost append +will take a number of steps proportional to the length of |xs|, but +then the rightmost append will require a number of steps proportional +to the length of |xs| plus the length of |ys|, for a total cost +of: +\begin{spec} +2 * length xs + length ys +\end{spec} +Thus |xs ++ (ys ++ zs)| is more efficient than |(xs ++ ys) ++ zs|. +This is why the Standard Prelude defines the fixity of |(++)| as: +\begin{spec} +infixr 5 !++ +\end{spec} +In other words, if you just write |xs ++ ys ++ zs|, you will get the +most efficient association, namely the right association |xs ++ (ys ++ +zs)|. In the next section a more dramatic example of this property +will be introduced. + +\section{Fold} +\label{sec:fold} +\indexhs{fold} + +Suppose we wish to take a list of notes (each of type |Music a|) and +convert them into a \emph{line}, or \emph{melody}. We can define a +recursive function to do this as follows: +\begin{spec} +line :: [Music a] -> Music a +line [] = rest 0 +line (m:ms) = m :+: line ms +\end{spec} +Note that this function is polymorphic---the first example so far, in +fact, of a polymorphic function involving the |Music| data type. + +We might also wish to have a function |chord| that operates in an +analogous way, but using |(:=:)| instead of |(:+:)|: +\begin{spec} +chord :: [Music a] -> Music a +chord [] = rest 0 +chord (m:ms) = m :=: chord ms +\end{spec} +This function is also polymorphic. + +In a completely different context we might wish to compute the highest +pitch in a list of pitches, which we might capture in the following +way: +\begin{code} +maxPitch :: [Pitch] -> Pitch +maxPitch [] = pitch 0 +maxPitch (p:ps) = p !!! maxPitch ps +\end{code} +where |(!!!)| is defined as: +\begin{code} +p1 !!! p2 = if absPitch p1 > absPitch p2 then p1 else p2 +\end{code} + +\indexkw{if then else} +\index{conditional expression} +\syn{An expression |if pred then cons else alt| is called a {\em +conditional expression}. If |pred| (called the {\em predicate}) is +true, then |cons| (called the {\em consequence}) is the result; if +|pred| is false, then |alt| (called the {\em alternative}) is +the result.} + +Once again we have a situation where several definitions share +something in common: a repeating recursive pattern. Using the process +used earlier to discover |map|, we first identify those things that +are changing. There are two situations: the |rest 0| and |pitch 0| +values (for which the generic name |init|, for ``initial value,'' will +be used), and the |(:+:)|, |(:=:)|, and |(!!!)| operators (for which +the generic name |op|, for ``operator,'' will be used). Now rewriting +any of the above three functions as a new function---call it +|fold|---that takes extra arguments |op| and |init|, we arrive +at:\footnote{The use of the name ``|fold|'' for this function is + historical (within the functional programming community), and has + nothing to do with the use of ``fold'' and ``unfold'' in + Chapter~\ref{ch:intro} to describe steps in a calculation.} +\begin{spec} +fold op init [] = init +fold op init (x:xs) = x `op` fold op init xs +\end{spec} +\syn{Any normal binary function name can be used as an infix operator + by enclosing it in backquotes; |x `f` y| is equivalent to |f x y|. + Using infix application here for |op| better reflects the + structure of the repeating pattern that is being abstracted, but + could also have been written |op x (fold op init xs)|.} + +With this definition of |fold| we can now rewrite the definitions of +\indexwdhs{line}, \indexwdhs{chord}, and \indexwdhs{maxPitch} as: +\begin{code} +line, chord :: [Music a] -> Music a +line ms = fold (:+:) (rest 0) ms +chord ms = fold (:=:) (rest 0) ms +\end{code} + +\begin{spec} +maxPitch :: [Pitch] -> Pitch +maxPitch ps = fold (!!!) (pitch 0) ps +\end{spec} + +\syn{Just as we can turn a function into an operator by enclosing it + in backquotes, we can turn an operator into a function by enclosing + it in parentheses. This is required in order to pass an operator as + a value to another function, as in the examples above. (If we wrote + |fold !!! 0 ps| instead of |fold (!!!) 0 ps| it would look like we + were trying to apply |(!!!)| to |fold| and |0 ps|, which is + nonsensical and ill-typed.)} + +In Chapter \ref{ch:induction} we will use induction to prove that +these new definitions are equivalent to the old. + +|fold|, like |map|, is a highly useful---reusable---function, as will +be seen through several other examples later in the text. Indeed, it +too is polymorphic, for note that it does not depend on the type of +the list elements. Its most general type---somewhat trickier than +that for |map|---is: +\begin{spec} +fold :: (a->b->b) -> b -> [a] -> b +\end{spec} +This allows us to use |fold| whenever we need to ``collapse'' a +list of elements using a binary (i.e.\ two-argument) operator. + +As a final example, recall the definition of |hList| from Chapter +\ref{ch:intro}: +\begin{spec} +hList :: Dur -> [Pitch] -> Music Pitch +hList d [] = rest 0 +hList d (p:ps) = hNote d p :+: hList d ps +\end{spec} +A little thought should convince the reader that this can be rewritten as: +\begin{spec} +hList d ps = let f p = hNote d p + in line (map f ps) +\end{spec} +This version is more modular, in that it avoids explicit recursion, +and is instead built up from smaller building blocks, namely |line| +(which uses |fold|) and |map|. + +\subsection{Haskell's Folds} + +Haskell actually defines two versions of |fold| in the Standard +Prelude. The first is called \indexwdhs{foldr} +(``fold-from-the-right'') whose definition is the same as that of +|fold| given earlier: +\begin{spec} +foldr :: (a->b->b) -> b -> [a] -> b +foldr op init [] = init +foldr op init (x:xs) = x `op` foldr op init xs +\end{spec} +A good way to think about |foldr| is that it replaces all +occurrences of the list operator |(:)| with its first argument (a +function), and replaces |[]| with its second argument. In other +words: +\begin{spec} +foldr op init (x1 : x2 : ... : xn : []) +===> x1 `op` (x2 `op` (...(xn `op` init)...)) +\end{spec} +This might help in better understanding the type of |foldr|, and also +explains its name: the list is ``folded from the right.'' Stated +another way, for any list |xs|, the following always +holds:\footnote{This will be formally proved in Chapter + \ref{ch:induction}.} +\begin{spec} +foldr (:) [] xs ===> xs +\end{spec} +Haskell's second version of |fold| is called \indexwdhs{foldl}: +\begin{spec} +foldl :: (b->a->b) -> b -> [a] -> b +foldl op init [] = init +foldl op init (x:xs) = foldl op (init `op` x) xs +\end{spec} +A good way to think about |foldl| is to imagine ``folding the list +from the left:'' +\begin{spec} +foldl op init (x1 : x2 : ... : xn : []) +===> (...((init `op` x1) `op` x2)...) `op` xn +\end{spec} + +\subsection{[Advanced] Why Two Folds?} + +Note that if we had used |foldl| instead of |foldr| in the +definitions given earlier then not much would change; |foldr| and +|foldl| would give the same result. Indeed, judging from their types, it +looks like the only difference between |foldr| and |foldl| is +that the operator takes its arguments in a different order. + +So why does Haskell have two versions of |fold|? It turns out that +there are situations where using one is more efficient, and possibly +``more defined'' (that is, the function terminates on more values of +its input domain) than the other. \index{efficiency} + +Probably the simplest example of this is a generalization of the +associativity of |(++)| discussed in the last section. Suppose +we wish to collapse a list of lists into one list. The Standard +Prelude defines the polymorphic function \indexwdhs{concat} for this +purpose: +\begin{spec} +concat :: [[a]] -> [a] +concat xss = foldr (++) [] xss +\end{spec} +For example: +\begin{spec} +concat [[1],[3,4],[],[5,6]] +===> [1]++([3,4]++([]++([5,6]++[]))) +===> [1,3,4,5,6] +\end{spec} +More generally, we have that: +\begin{spec} +concat [xs1,xs2,...,xsn] +==> foldr (++) [] [xs1,xs2,...,xsn] +===> xs1 ++ (xs2 ++ ( ... (xn ++ [])) ... ) +\end{spec} +The total cost of this computation is proportional to the sum of the +lengths of all of the lists. If each list has the same length +|len|, and there are |n| lists, then this cost is |(n-1)*len|. + +On the other hand, if we had defined |concat| this way: +\begin{spec} +slowConcat xss = foldl (++) [] xss +\end{spec} +then: +\begin{spec} +slowConcat [xs1,xs2,...,xsn] +==> foldl (++) [] [xs1,xs2,...,xsn] +===> ( ... (([] ++ x1) ++ x2) ... ) ++ xn +\end{spec} +If each list has the same length |len|, then the cost of this +computation will be: +\begin{spec} +len + (len+len) + (len+len+len) + ... + (n-1)*len += n*(n-1)*len/2 +\end{spec} +which is considerably worse than |(n-1)*len|. Thus the choice of +|foldr| in the definition of |concat| is quite important. + +Similar examples can be given to demonstrate that |foldl| is +sometimes more efficient than |foldr|. On the other hand, in many +cases the choice does not matter at all (consider, for example, +|(+)|). The moral of all this is that care must be taken in the +choice between |foldr| and |foldl| if efficiency is a concern. + +% (consider, for example, |flip (++)|!) + +\subsection{Fold for Non-empty Lists} + +In certain contexts it may be understood that the functions |line| and +|chord| should not be applied to an empty list. For such situations +the Standard Prelude provides functions |foldr1| and |foldl1|, which +return an error if applied to an empty list. And thus we may also +desire to define versions of |line| and |chord| that adopt this +behavior: + +\pagebreak + +\begin{code} +line1, chord1 :: [Music a] -> Music a +line1 ms = foldr1 (:+:) ms +chord1 ms = foldr1 (:=:) ms +\end{code} +Note that |foldr1| and |foldl1| do not take an |init| argument. + +In the case of |maxPitch| we could go a step further and say that the +previous definition is in fact flawed, for who is to say what the +maximum pitch of an empty list is? The choice of 0 was indeed +arbitrary, and in a way it is nonsensical---how can 0 be the maximum +if it is not even in the list? In such situations we might wish to +define only one function, and to have that function return an error +when presented with an empty list. For consistency with |line| and +|chord|, however, that function is defined here with a new name: +\begin{code} +maxPitch1 :: [Pitch] -> Pitch +maxPitch1 ps = foldr1 (!!!) ps +\end{code} + +\section{[Advanced] A Final Example: Reverse} +\label{sec:reverse} + +As a final example of a useful list function, consider the problem of +{\em reversing} a list, which will be captured in a function called +\indexwdhs{reverse}. This could be useful, for example, when +constructing the \emph{retrograde} of a musical passage, i.e.\ the +music as if it were played backwards. For example, |reverse +[C,D,Ef]| is |[Ef,D,C]|. + +Thus |reverse| takes a single list argument, whose possibilities +are the normal ones for a list: it is either empty, or it is not. And +thus: +\begin{spec} +reverse :: [a] -> [a] +reverse [] = [] +reverse (x:xs) = reverse xs ++ [x] +\end{spec} +This, in fact, is a perfectly good definition for |reverse|---it is +certainly clear---except for one small problem: it is terribly +inefficient! To see why, first recall that the number of steps needed +to compute |xs ++ ys| is proportional to the length of |xs|. +Now suppose that the list argument to |reverse| has length $n$. +The recursive call to |reverse| will return a list of length $n-1$, +which is the first argument to |(++)|. Thus the cost to reverse a +list of length of $n$ will be proportional to $n-1$ plus the cost to +reverse a list of length $n-1$. So the total cost is proportional to +$(n-1)+(n-2)+\cdots+1 = n(n-1)/2$, which in turn is proportional to +the square of $n$. + +Can we do better than this? In fact, yes. + +There is another algorithm for reversing a list, which can be +described intuitively as follows: take the first element, and put it +at the front of an empty auxiliary list; then take the next element +and add it to the front of the auxiliary list (thus the auxiliary list +now consists of the first two elements in the original list, but in +reverse order); then do this again and again until the end of the +original list is reached. At that point the auxiliary list will be +the reverse of the original one. + +This algorithm can be expressed recursively, but the auxiliary list +implies the need for a function that takes {\em two} arguments---the +original list and the auxiliary one---yet |reverse| only takes one. +This can be solved by creating an auxiliary function |rev|: +\begin{spec} +reverse xs = let rev acc [] = acc + rev acc (x:xs) = rev (x:acc) xs + in rev [] xs +\end{spec} +The auxiliary list is the first argument to |rev|, and is called +|acc| since it behaves as an ``accumulator'' of the intermediate +results. Note how it is returned as the final result once the end of +the original list is reached. +\index{accumulator} + +A little thought should convince the reader that this function does +not have the quadratic ($n^2$) behavior of the first algorithm, and +indeed can be shown to execute a number of steps that is directly +proportional to the length of the list, which we can hardly expect to +improve upon. + +But now, compare the definition of |rev| with the definition of +|foldl|: +\begin{spec} +foldl op init [] = init +foldl op init (x:xs) = foldl op (init `op` x) xs +\end{spec} +They are somewhat similar. In fact, suppose we were to slightly +revise the definition of |rev| as follows: +\begin{spec} +rev op acc [] = acc +rev op acc (x:xs) = rev op (acc `op` x) xs +\end{spec} +Now |rev| looks strongly like |foldl|, and the question becomes +whether or not there is a function that can be substituted for |op| +that would make the latter definition of |rev| equivalent to the +former one. Indeed there is: +\begin{spec} +revOp a b = b : a +\end{spec} +For note that: +\begin{spec} +acc `revOp` x +==> revOp acc x +==> x : acc +\end{spec} +So |reverse| can be rewritten as: +\begin{spec} +reverse xs = let rev op acc [] = acc + rev op acc (x:xs) = rev op (acc `op` x) xs + in rev revOp [] xs +\end{spec} +which is the same as: +\begin{spec} +reverse xs = foldl revOp [] xs +\end{spec} + +If all of this seems like magic, well, you are starting to see the +beauty of functional programming! + +\section{Currying} +\label{sec:currying} + +\index{function!currying||(} +We can improve further upon some of the definitions given in this +chapter using a technique called \emph{currying simplification}. To +understand this idea, first look closer at the notation used to write +function applications, such as |simple x y z|. Although, as noted +earlier, this is similar to the mathematical notation +$\mathit{simple}(x,y,z)$, in fact there is an important difference, +namely that |simple x y z| is actually shorthand for |(((simple x) y) +z)|. In other words, function application is {\em left associative}, +taking one argument at a time. + +\index{function!application} +Now look at the expression |(((simple x) y) z)| a bit closer: there is +an application of |simple| to |x|, the result of which is applied to +|y|; so |(simple x)| must be a function! The result of this +application, |((simple x) y)|, is then applied to |z|, so |((simple x) +y)| must also be a function! + +Since each of these intermediate applications yields a function, it +seems perfectly reasonable to define a function such as: +\begin{spec} +multSumByFive = simple 5 +\end{spec} +What is |simple 5|? From the above argument it is clear that it must +be a function. And from the definition of |simple| in Section +\ref{ch:intro} we might guess that this function takes two arguments, +and returns 5 times their sum. Indeed, we can {\em calculate} this +result as follows: +\begin{spec} +multSumByFive a b +==> (simple 5) a b +==> simple 5 a b +==> 5*(a+b) +\end{spec} +\index{Curry, Haskell B.} +The intermediate step with parentheses is included just for clarity. +This method of applying functions to one argument at a time, yielding +intermediate functions along the way, is called {\em currying}, after +the logician Haskell B.\ Curry who popularized the idea.\footnote{It +was actually Sch\"{o}nfinkel who first called attention to this idea +\cite{scho24}, but the word ``sch\"{o}nfinkelling'' is rather a +mouthful!} It is helpful to look at the types of the intermediate +functions as arguments are applied: +\begin{spec} +simple :: Float -> Float -> Float -> Float +simple 5 :: Float -> Float -> Float +simple 5 a :: Float -> Float +simple 5 a b :: Float +\end{spec} + +For a musical example of this idea, recall the function |note :: Dur +-> Pitch -> Music Pitch|. So |note qn| is a function that, given a +pitch, yields a quarter note rendition of that pitch. A common use of +this idea is simplifying something like: +\begin{spec} +note qn p1 :+: note qn p2 :+: ... :+: note qn pn +\end{spec} +to: +\begin{spec} +line (map (note qn) [ p1, p2, ..., pn ]) +\end{spec} +Indeed, this idea is used extentively in the larger example in the +next chapter. + +\subsection{Currying Simplification} +\label{sec:currying-simplification} + +We can also use currying to improve some of the previous function +definitions as follows. Suppose that the values of |f x| and |g x| +are the same, for all values of |x|. Then it seems clear that the +functions |f| and |g| are equivalent.\footnote{In mathematics, we + would say that the two functions are \emph{extensionally + equivalent}.} So, if we wish to define |f| in terms of |g|, +instead of writing: +\begin{spec} +f x = g x +\end{spec} +We could instead simply write: +\begin{spec} +f = g +\end{spec} + +We can apply this reasoning to the definitions of |line| and |chord| +from Section \ref{sec:fold}: +\begin{spec} +line ms = fold (:+:) (rest 0) ms +chord ms = fold (:=:) (rest 0) ms +\end{spec} +Since function application is left associative, we can rewrite these as: +\begin{spec} +line ms = (fold (:+:) (rest 0)) ms +chord ms = (fold (:=:) (rest 0)) ms +\end{spec} +But now applying the same reasoning here as was used for |f| and |g| +above means that we can write these simply as: +\begin{spec} +line = fold (:+:) (rest 0) +chord = fold (:=:) (rest 0) +\end{spec} + +Similarly, the definitions of |toAbsPitches| and |toPitches| from +Section \ref{sec:rec-abstraction}: +\begin{spec} +toAbsPitches ps = map absPitch ps +toPitches as = map pitch as +\end{spec} +can be rewritten as: +\begin{spec} +toAbsPitches = map absPitch +toPitches = map pitch +\end{spec} + +Furthermore, the definition |hList|, most recently defined as: +\begin{spec} +hList d ps = let f p = hNote d p + in line (map f ps) +\end{spec} +can be rewritten as: +\begin{spec} +hList d ps = let f = hNote d + in line (map f ps) +\end{spec} +and since the definition of |f| is now so simple, we might as well +``in-line'' it: +\begin{spec} +hList d ps = line (map (hNote d) ps) +\end{spec} + +This kind of simplification will be referred to as ``currying +simplification'' or just ``currying.''\footnote{In the Lambda Calculus + this is called ``eta contraction.''} + +\syn{Some care should be taken when using this simplification idea. + In particular, note that an equation such as |f x = g x y x| + cannot be simplified to |f = g x y|, since then the remaining + |x| on the right-hand side would become undefined!} + +\subsection{[Advanced] Simplification of |reverse|} + +Here is a more interesting example, in which currying simplification +is used three times. Recall from Section \ref{sec:reverse} the +definition of |reverse| using |foldl|: +\begin{spec} +reverse xs = let revOp acc x = x : acc + in foldl revOp [] xs +\end{spec} +Using the polymorphic function \indexwdhs{flip} which is defined in the +Standard Prelude as: +\begin{spec} +flip :: (a -> b -> c) -> (b -> a -> c) +flip f x y = f y x +\end{spec} +it should be clear that |revOp| can be rewritten as: +\begin{spec} +revOp acc x = flip (:) acc x +\end{spec} +But now currying simplification can be used twice to reveal that: +\begin{spec} +revOp = flip (:) +\end{spec} +This, along with a third use of currying, allows us to rewrite the +definition of \indexwdhs{reverse} simply as: +\begin{spec} +reverse = foldl (flip (:)) [] +\end{spec} +This is in fact the way |reverse| is defined in the Standard Prelude. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Show that |flip (flip f)| is the same as |f|.} +\end{exercise} + +\begin{exercise}{\em +What is the type of |ys| in: +\begin{spec} +xs = [1,2,3] :: [Integer] +ys = map (+) xs +\end{spec} +} +\end{exercise} + +\begin{exercise}{\em +Define a function |applyEach| that, given a list of functions, +applies each to some given value. For example: +\begin{spec} +applyEach [simple 2 2, (+3)] 5 ===> [14, 8] +\end{spec} +where |simple| is as defined in Chapter \ref{ch:intro}.} +\end{exercise} + +\begin{exercise}{\em +Define a function |applyAll| that, given a list of functions +|[f1, f2, ..., fn]| and a value |v|, returns the result +|f1 (f2 (...(fn v)...))|. For example: +\begin{spec} +applyAll [simple 2 2, (+3)] 5 ===> 20 +\end{spec} +} +\end{exercise} + +\begin{exercise}{\em +Recall the discussion about the efficiency of |(++)| and +|concat| in Chapter \ref{ch:poly}. Which of the following +functions is more efficient, and why? +\begin{spec} +appendr, appendl :: [[a]] -> [a] +appendr = foldr (flip (++)) [] +appendl = foldl (flip (++)) [] +\end{spec} +} +\end{exercise} + +\vspace{.1in}\hrule + +\index{function!currying||)} + +\section{Errors} +\label{sec:errors} + +The last section suggested the idea of ``returning an error'' when the +argument to |foldr1| is the empty list. As you might imagine, there +are other situations where an error result is also warranted. + +\index{errors}\index{bottom} +There are many ways to deal with such situations, depending on the +application, but sometimes all we want to do is stop the program, +signalling to the user that some kind of an error has occurred. +In Haskell this is done with the Standard Prelude function +\indexhs{error}|error :: String -> a|. Note that |error| is +polymorphic, meaning that it can be used with any data type. The +value of the expression |error s| is |bottom|, the completely +undefined, or ``bottom'' value that was discussed in Section +\ref{sec:expressions}. As an example of its use, here is the +definition of |foldr1| from the Standard Prelude: +\begin{spec} +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) +foldr1 f [] = error "Prelude.foldr1: empty list" +\end{spec} +Thus if the anomalous situation arises, the program will terminate +immediately, and the string |"Prelude.foldr1: empty list"| will be +printed. + +%% \syn{Strings, i.e.\ sequences of characters, were briefly introduced +%% in Chapter \ref{ch:intro}. They are written between double quotes, +%% as in |"Hello World"|. +%% %% When typed on your computer, however, it will look a little +%% %% differently, as in {\tt "Hello World"} (the double-quote +%% %% character is the same at both ends of the string). +%% Strings have type \indexwdhs{String}. The |"\n"| at the end of +%% the string above is a ``newline'' character; that is, if another +%% string were printed just after this one, it would appear beginning +%% on the next line, rather than just after ``Hello World.''} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Rewrite the definition of |length| non-recursively.} +\end{exercise} + +\begin{exercise}{\em +Define a function that behaves as each of the following: +\begin{enumerate}[a)] +\item Doubles each number in a list. For example: +\begin{spec} +doubleEach [1,2,3] ===> [2,4,6] +\end{spec} +\item Pairs each element in a list with that number and one plus +that number. For example: +\begin{spec} +pairAndOne [1,2,3] ===> [(1,2),(2,3),(3,4)] +\end{spec} +\item Adds together each pair of numbers in a list. For example: +\begin{spec} +addEachPair [(1,2),(3,4),(5,6)] ===> [3,7,11] +\end{spec} +\item Adds ``pointwise'' the elements of a list of pairs. For example: +\begin{spec} +addPairsPointwise [(1,2),(3,4),(5,6)] ===> (9,12) +\end{spec} +\end{enumerate} +} +\end{exercise} + +\begin{exercise}{\em +Define a polymorphic function |fuse :: [Dur] -> [Dur -> Music a] -> +[Music a]| that combines a list of durations with a list of notes +lacking a duration, to create a list of complete notes. For example: +\begin{spec} +fuse [qn, hn, sn] [c 4, d 4, e 4] +===> [c 4 qn, d 4 hn, e 4 sn] +\end{spec} +You may signal an error if the lists have unequal lengths. } +\label{ex:fuse} +\end{exercise} + +In the next two exercises, give both recursive and (if possible) +non-recursive definitions, and be sure to include type signatures. + +\begin{exercise}{\em +Define a function |maxAbsPitch| that determines the maximum absolute +pitch of a list of absolute pitches. Define |minAbsPitch| +analogously. Both functions should return an error if applied to the +empty list.} +\end{exercise} + +\begin{exercise} +\label{ex:chrom}{\em +Define a function |chrom :: Pitch -> Pitch -> Music Pitch| such that +|chrom p1 p2| is a chromatic scale of quarter-notes whose first pitch +is |p1| and last pitch is |p2|. If |p1 > p2|, the scale should be +descending, otherwise it should be ascending. If |p1 == p2|, then the +scale should contain just one note. (A chromatic scale is one whose +successive pitches are separated by one absolute pitch (i.e.\ one +semitone)).} +\end{exercise} + +\begin{exercise} +\label{ex:mkscale}{\em +Abstractly, a scale can be described by the intervals between +successive notes. For example, the 7-note major scale can be defined +as the sequence of 6 intervals |[2,2,1,2,2,2]|, and the 12-note +chromatic scale by the 11 intervals |[1,1,1,1,1,1,1,1,1,1,1]|. Define +a function |mkScale :: Pitch -> [Int] -> Music Pitch| such that +|mkScale p ints| is the scale beginning at pitch |p| and having the +intervallic structure |ints|.} +\end{exercise} + +\begin{exercise}{\em +Define an enumerated data type that captures each of the standard +major scale modes: Ionian, Dorian, Phrygian, Lydian, Mixolydian, +Aeolian, and Locrian. Then define a function |genScale| that, given +one of these contructors, generates a scale in the intervalic form +described in Exercise \ref{ex:mkscale}.} +\end{exercise} + +\begin{exercise}{\em +Write the melody of ``Fr\`{e}re Jacques'' (or, ``Are You Sleeping'') +in Euterpea. Try to make it as succinct as possible. Then, using +functions already defined, generate a traditional four-part round, +i.e.\ four identical voices, each delayed successively by two +measures. Use a different instrument to realize each voice.} +\label{ex:frere-jacques} +\end{exercise} + +\begin{exercise}{\em +Freddie the Frog wants to communicate privately with his girlfriend +Francine by {\em encrypting} messages sent to her. Frog brains are +not that large, so they agree on this simple strategy: each character +in the text shall be converted to the character ``one greater'' than +it, based on the representation described below (with wrap-around from +255 to 0). Define functions |encrypt| and |decrypt| that will +allow Freddie and Francine to communicate using this strategy.} +\end{exercise} + +\syn{Characters are often represented inside a computer as some kind + of an integer; in the case of Haskell, a 16-bit unicode + representation is used. However, the standard keyboard is + adequately represented by a standard byte (eight bits), and thus we + only need to consider the first 256 codes in the unicode + representation. For the above exercise, you will want to use two + Haskell functions, |toEnum| and |fromEnum|. The first will convert + an integer into a character, the second will convert a character + into an integer.} + +\out{ +\begin{exercise}{\em +Suppose you are given a non-negative integer |amt| representing a +sum of money, and a list of coin denominations |[v1, v2, ..., vn]|, +each being a positive integer. Your job is to make change for +|amt| using the coins in the coin supply. Define a function +|makeChange| to solve this problem. For example, your function may +behave like this: +\begin{spec} +makeChange 99 [5,1] ==> [19,4] +\end{spec} +where |99| is the amount and |[5,1]| represents the types of coins +(say, nickels and pennies in US currency) that are available. The +answer |[19,4]| means that we can make the exact change with |19| +|5|-unit coins and |4| single-unit coins; this is the best possible +solution (in terms of the total number of coins). + +To make things slightly easier, you may assume that the list +representing the coin denominations is given in descending order, and +that the single-unit coin is always one of the coin types.} +\end{exercise} +}
+ HSoM/Preface.lhs view
@@ -0,0 +1,217 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +\chapter{Preface} + +In 2000 I wrote a book called \emph{The Haskell School of + Expression -- Learning Functional Programming through Multimedia} +\cite{soe}. In that book I used graphics, animation, music, and +robotics as a way to motivate learning how to program, and +specifically how to learn \emph{functional programming} using Haskell, +a purely functional programming language. Haskell \cite{haskell98} is +quite a bit different from conventional imperative or object-oriented +languages such as C, C$++$, Java, C\#, and so on. It takes a different +mind-set to program in such a language, and appeals to the +mathematically inclined and to those who seek purity and elegance in +their programs. Although Haskell was designed over twenty years ago, +it has only recently begun to catch on in a significant way, not just +because of its purity and elegance, but because with it you can solve +real-world problems quickly and efficiently, and with great economy of +code. + +I have also had a long, informal, yet passionate interest in music, +being an amateur jazz pianist and having played in several bands over +the years. About fifteen years ago, in an effort to combine work with +play, I and my students wrote a Haskell library called \emph{Haskore} +for expressing high-level computer music concepts in a purely +functional way \cite{haskore,haskore-tutorial,haskore-fop}. Indeed, +three of the chapters in \emph{The Haskell School of Expression} +summarize the basic ideas of this work. Soon after that, with the +help of another student, I designed a Haskell library called +\emph{HasSound} that was, essentially, a Haskell interface to +\emph{csound} \cite{csound} for doing sound synthesis and instrument +design. + +Thus, when I recently became responsible for the Music Track in the +new \emph{Computing and the Arts} major at Yale, and became +responsible for teaching not one, but two computer music courses in +the new curriculum, it was natural to base the course material on +Haskell. This current book is a rewrite of \emph{The Haskell School + of Expression} with a focus on computer music, based on, and greatly +improving upon, the ideas in Haskore and HasSound. The new Haskell +library that incorporates all of this is called \emph{Euterpea}. + +\index{Curry, Haskell B.} Haskell was named after the logician +Haskell B.\ Curry who, along with Alonzo Church, helped establish +the theoretical foundations of functional programming in the 1940's, +when digital computers were mostly just a gleam in researchers' eyes. +A curious historical fact is that Haskell Curry's father, Samuel Silas +Curry, helped found and direct a school in Boston called the {\em + School of Expression}. (This school eventually evolved into what is +now {\em Curry College}.) Since pure functional programming is +centered around the notion of an {\em expression}, I thought that {\em + The Haskell School of Expression} would be a good title for my first +book. And it was thus quite natural to choose \emph{The Haskell + School of Music} for my second! + +\section*{How To Read This Book} + +As mentioned earlier, there is a certain mind-set, a certain viewpoint +of the world, and a certain approach to problem solving that +collectively work best when programming in Haskell (this is true for +any programming paradigm). If you teach only Haskell language details +to a C programmer, he or she is likely to write ugly, incomprehensible +functional programs. But if you teach how to think differently, how +to see problems in a different light, functional solutions will come +easily, and elegant Haskell programs will result. As Samuel Silas +Curry once said: +\begin{quote} +All expression comes {\em from within outward}, from the center to the +surface, from a hidden source to outward manifestation. The study of +expression as a natural process brings you into contact with cause and +makes you feel the source of reality. +\end{quote} +What is especially beautiful about this quote is that music is also a +form of expression, although Curry was more likely talking about +writing and speaking. In addition, as has been noted by many, music +has many ties to mathematics. So for me, combining the elegant +mathematical nature of Haskell with that of music is as natural as +singing a nursery tune. + +Using a high-level language to express musical ideas is, of course, +not new. But Haskell is unique in its insistence on purity (no side +effects), and this alone makes it particularly suitable for expressing +musical ideas. By focusing on \emph{what} a musical entity is rather +than on \emph{how} to create it, we allow musical ideas to take their +natural form as Haskell expressions. Haskell's many abstraction +mechanisms allow us to write computer music programs that are elegant, +concise, yet powerful. We will consistently attempt to let the music +express itself as naturally as possible, without encoding it in terms +of irrelevant language details. + +Of course, my ultimate goal is not just to teach computer music +concepts. Along the way you will also learn Haskell. There is no +limit to what one might wish to do with computer music, and therefore +the better you are at programming, the more success you will have. +This is why I think that many languages designed specifically for +computer music---although fun to work with, easy to use, and cute in +concept---face the danger of being too limited in expressiveness. + +You do not need to know much, if any, music theory to read this book, +and you do not need to play an instrument. Of course, the more you +know about music, the more you will be able to apply the concepts +learned in this text in musically creative ways. + +My general approach to introducing computer music concepts is to first +provide an intuitive explanation, then a mathematically rigorous +definition, and finally fully executable Haskell code. +% It will often be the case that there is a close correspondence +% between the mathematical definition and the Haskell code. +In the process I introduce Haskell features as they are needed, rather +than all at once. I believe that this interleaving of concepts and +applications makes the material easier to digest. + +Another characteristic of my approach is that I do not hide any +details---I want Euterpea to be as transparent as possible! There are +no magical built-in operations, no special computer music commands or +values. This works out well for several reasons. First, there is in +fact nothing ugly or difficult to hide---so why hide anything at all? +Second, by reading the code, you will better and more quickly +understand Haskell. Finally, by stepping through the design process +with me, you may decide that you prefer a different approach---there +is, after all, no One True Way to express computer music ideas. I +expect that this process will position you well to write rich, +creative musical applications on your own. + +I encourage the seasoned programmer having experience only with +conventional imperative and/or object-oriented languages to read this +text with an open mind. Many things will be different, and will +likely feel awkward. There will be a tendency to rely on old habits +when writing new programs, and to ignore suggestions about how to +approach things differently. If you can manage to resist those +tendencies I am confident that you will have an enjoyable learning +experience. Those who succeed in this process often find that many +ideas about functional programming can be applied to imperative and +object-oriented languages as well, and that their imperative coding +style changes for the better. + +I also ask the experienced programmer to be patient while in the +earlier chapters I explain things like ``syntax,'' ``operator +precedence,'' etc., since it is my goal that this text should be +readable by someone having only modest prior programming experience. +With patience the more advanced ideas will appear soon enough. + +If you are a novice programmer, I suggest taking your time with the +book; work through the exercises, and don't rush things. If, however, +you don't fully grasp an idea, feel free to move on, but try to +re-read difficult material at a later time when you have seen more +examples of the concepts in action. For the most part this is a +``show by example'' textbook, and you should try to execute as many of +the programs in this text as you can, as well as every program that +you write. Learn-by-doing is the corollary to show-by-example. + +Finally, I note that some section titles are prefaced with the +parenthetical phrase, ``{\bf [Advanced]}''. These sections may be +skipped upon first reading, especially if the focus is on learning +computer music concepts, as opposed to programming concepts. + +\section*{Haskell Implementations} + +There are several implementations of Haskell, all available free on +the Internet through the Haskell users' website at +\url{http://haskell.org}. However, the one that has dominated all +others, and on which Euterpea is based, is \emph{\indexwd{GHC}}, an +easy-to-use and easy-to-install Haskell compiler and interpreter (see +\url{http://haskell.org/ghc}). GHC runs on a variety of platforms, +including PC's, various flavors of Unix, and Macs. The preferred way +to install GHC is through the \emph{Haskell Platform} +(\url{http://hackage.haskell.org/platform/}). Any text editor can be +used to create source files, but I prefer to use emacs (see +\url{http://www.gnu.org/software/emacs}), along with its Haskell mode +(see \url{http://projects.haskell.org/haskellmode-emacs/}). The +entire Euterpea library, including the source code from this textbook, +and installation instructions, can be found at +\url{http://haskell.cs.yale.edu}. + +\newpage + +\section*{Acknowledgements} + +I wish to thank my funding agencies---the National Science Foundation, +the Defense Advanced Research Projects Agency, and Microsoft +Research---for their generous support of research that contributed to +the foundations of Euterpea. Yale University has provided me a +stimulating and flexible environment to pursue my dreams for over +thirty years, and I am especially thankful for its recent support of +the Computing and the Arts initiative. + +Tom Makucevich, a talented computer music practitioner and composer in +New Haven, was the original motivator, and first user, of Haskore, +which preceded Euterpea. Watching him toil endlessly with low-level +csound programs was simply too much for me to bear! Several +undergraduate students at Yale contributed to the original design and +implementation of Haskore. I would like to thank in particular the +contributions of Syam Gadde and Bo Whong, who co-authored the original +paper on Haskore. Additionally, Matt Zamec helped me greatly in the +creation of HasSound. + +I wish to thank my more recent graduate students, in particular Hai +(Paul) Liu, Eric Cheng, Donya Quick, and Daniel Winograd-Cort for +their help in writing much of the code that constitutes the current +Euterpea library. In addition, many students in my computer music +classes at Yale provided valuable feedback through earlier drafts of +the manuscript. + +% Also thanks to Serge Lehuitouze and ... for their comments on the +% text. + +Finally, I wish to thank my wife, Cathy Van Dyke, my best friend and +ardent supporter, whose love, patience, and understanding have helped +me get through some bad times, and enjoy the good. + +\vspace{0.1in} +{\noindent}Happy Haskell Music Making! + +\vspace{0.1in} +{\noindent}Paul Hudak\newline +New Haven\newline +January 2012
+ HSoM/QualifiedTypes.lhs view
@@ -0,0 +1,1069 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\chapter{Qualified Types and Type Classes}+\label{ch:qualified-types}++This chapter introduces the notions of \emph{qualified types} and+\emph{type classes}. These concepts can be viewed as a refinement of+the notion of polymorphism, and increase the ability to write modular+programs.++\section{Motivation}+\label{sec:qualified-types}++A polymorphic type such as |(a->a)| can be viewed as shorthand for+$\forall($|a|$)|a->a|$, which can be read ``\emph{for all} types |a|,+functions mapping elements of type |a| to elements of type |a|.''+Note the emphasis on ``\emph{for all}.''++In practice, however, there are times when we would prefer to limit a+polymorphic type to a smaller number of possibilities. A good example+is a function such as |(+)|. It is probably not a good idea to limit+|(+)| to a \emph{single} (that is, \emph{monomorphic}) type such as+|Integer->Integer->Integer|, since there are other kinds of+numbers---such as rational and floating-point numbers---that we would+like to perform addition on as well. Nor is it a good idea to have a+different addition function for each number type, since that would+require giving each a different name, such as |addInteger|,+|addRational|, |addFloat|, etc. And, unfortunately, giving |(+)| a+type such as |a->a->a| will not work, since this would imply that we+could add things other than numbers, such as characters, pitch+classes, lists, tuples, functions, and any type that we might define+on our own!++\index{type!qualified} \index{class} ++Haskell provides a solution to this problem through the use of {\em+ qualified types}. Conceptually, it is helpful to think of a+qualified type just as a polymorphic type, except that in place of+``\emph{for all} types |a|'' it will be possible to say ``for all+types |a| \emph{that are members of the type class} |C|,'' where the+type class |C| can be thought of as a set of types. For example,+suppose there is a type class \indexwdhs{Num} with members |Integer|,+|Rational|, and |Float|. Then an accurate type for |(+)| would be+$\forall($|a|$\in$|Num|$)$|a -> a -> a|. But in Haskell, instead of+writing $\forall(|a|\in|Num|)\cdots$, the notation |Num a =>|$\cdots$+is used. So the proper type signature for |(+)| is:+\begin{spec}+(+) :: Num a => a -> a -> a+\end{spec}+which should be read: ``for all types |a| that are members of the type+class |Num|, |(+)| has type |a -> a -> a|.'' Members of a type class+are also called \emph{instances} of the class, and these two terms+will be used interchangeably in the remainder of the text. The |Num a+=>|$\cdots$ part of the type signature is often called a+\emph{context}, or \emph{constraint}.++\index{class}+\syn{It is important not to confuse |Num| with a data type or a+constructor within a data type, even though the same syntax +(``|Num a|'') is used. |Num| is a \emph{type class}, and the+context of its use (namely, to the left of a |=>|) is always+sufficient to determine this fact.}++Recall now the type signature given for the function |simple| in+Chapter~\ref{ch:intro}:+\begin{spec}+simple :: Integer -> Integer -> Integer -> Integer+simple x y z = x*(y+z)+\end{spec}+Note that |simple| uses the operator |(+)| discussed above. It also+uses |(*)|, whose type is the same as that for |(+)|:+\begin{spec}+(*) :: Num a => a -> a -> a+\end{spec}+This suggests that a more general type for |simple| is:+\begin{spec}+simple :: Num a => a -> a -> a -> a+simple x y z = x*(y+z)+\end{spec}+Indeed, this is the preferred, most general type that can be given for+|simple|. It can now be used with any type that is a member of the+|Num| class, which includes |Integer|, |Int|, |Rational|, |Float| and+|Double|, among others.++The ability to qualify polymorphic types is a unique feature of+Haskell, and, as we will soon see, provides great expressiveness. In+the following sections the idea is explored much more thoroughly, and+in particular it is shown how a programmer can define his or her own+type classes and their instances. To begin, let's take a closer look+at one of the pre-defined type classes in Haskell, having to do with+equality.++\section{Equality}+\label{sec:equality}++\index{equality} \emph{Equality} between two expressions |e1| and |e2|+in Haskell means that the value of |e1| is the same as the value of+|e2|. Another way to view equality is that we should be able to+substitute |e1| for |e2|, or vice versa, wherever they appear in a+program, without affecting the result of that program.++In general, however, it is not possible for a program to determine the+equality of two expressions---consider, for example, determining the+equality of two infinite lists, two infinite |Music| values, or two+functions of type |Integer -> Integer|.\footnote{This is the same as+ determining \emph{program equivalence}, a well-known example of an+ \emph{undecideable problem} in the theory of computation.} The+ability to compute the equality of two values is called+\emph{computational equality}. Even though by the above simple+examples it is clear that computational equality is strictly weaker+than full equality, it is still an operation that we would like to+use in many ordinary programs.++\indexhs{(==)} ++Haskell's operator for computational equality is |(==)|. Partly+because of the problem mentioned above, there are many types for which+we would like equality defined, but some for which it might not make+sense. For example, it is common to compare two characters, two+integers, two floating-point numbers, etc.\ On the other hand,+comparing the equality of infinite data structures, or functions, is+difficult, and in general not possible. Thus Haskell has a type class+called |Eq|, so that the equality operator |(==)| can be given the+qualified type: \indexhs{Eq}+\begin{spec}+(==) :: Eq a => a -> a -> Bool+\end{spec}++In other words, |(==)| is a function that, for any type |a| in+the class |Eq|, tests two values of type |a| for equality,+returning a Boolean (|Bool|) value as a result. Amongst |Eq|'s+instances are the types \indexwdhs{Char} and \indexwdhs{Integer}, so+that the following calculations hold:+\begin{spec}+42 == 42 ==> True+42 == 43 ==> False+'a' == 'a' ==> True+'a' == 'b' ==> False+\end{spec}+Furthermore, the expression |42 ==| |'a'| is {\em+\indexwd{ill-typed}}; Haskell is clever enough to know when qualified+types are ill-formed.++One of the nice things about qualified types is that they work in the+presence of ordinary polymorphism. In particular, the type+constraints can be made to propagate through polymorphic data types.+For example, because |Integer| and |Float| are members of+|Eq|, so are the types |(Integer,Char)|, |[Integer]|,+|[Float]|, etc. Thus:+\begin{spec}+[42,43] == [42,43] ==> True+[4.2,4.3] == [4.3,4.2] ==> False+(42,'a') == (42,'a') ==> True+\end{spec}+This will be elaborated upon in a later section.++Type constraints also propagate through function definitions. For+example, consider this definition of the function |`elem`| that+tests for membership in a list:+\begin{spec}+x `elem` [] = False+x `elem` (y:ys) = x==y || x `elem` ys+\end{spec}++\syn{|(`elem`)| is actually written |elem| in Haskell; i.e.\ it is a+ normal function, not an infix operator. Of course it can be used+ in an infix manner (and it often is) by enclosing it in backquotes.}++Note the use of |(==)| on the right-hand side of the second+equation. The principal type for |(`elem`)| is thus:+\begin{spec}+`elem` :: Eq a => a -> [a] -> Bool+\end{spec}+This should be read, ``For every type |a| that is an instance of the+class |Eq|, |(`elem`)| has type |a->[a]->Bool|.'' This is exactly what+we would hope for---it expresses the fact that |(`elem`)| is not defined+on all types, just those for which computational equality is defined.++The above type for |(`elem`)| is also its principal type, and Haskell+will infer this type if no signature is given. Indeed, if we were to+write the type signature:+\begin{spec}+(`elem`) :: a -> [a] -> Bool+\end{spec}+a type error would result, because this type is fundamentally+\emph{too general}, and the Haskell type system will complain.++\syn{On the other hand, we could write:+\begin{spec}+(`elem`) :: Integer -> [Integer] -> Bool+\end{spec}+if we expect to use |(`elem`)| only on lists of integers. In other+words, using a type signature to constrain a value to be less general+than its principal type is Ok.}++As another example of this idea, a function that squares its argument:+\begin{spec}+square x = x*x+\end{spec}+has principal type |Num a => a -> a|, since |(*)|, like+|(+)|, has type \newline+|Num a => a -> a -> a|. Thus:+\begin{spec}+square 42 ==> 1764+square 4.2 ==> 17.64+\end{spec}+The |Num| class will be discusssed in greater detail shortly.++\section{Defining Our Own Type Classes}+\label{sec:type-class-decls}++Haskell provides a mechanism whereby we can create our own qualified+types, by defining a new type class and specifying which types are+members, or ``instances'' of it. Indeed, the type classes |Num|+and |Eq| are not built-in as primitives in Haskell, but rather are+simply predefined in the Standard Prelude.++To see how this is done, consider the |Eq| class. It is created by+the following \emph{type class declaration}: +\index{class!\hkw{class}}+\index{class!declaration}+\begin{spec}+class Eq a where + (==) :: a -> a -> Bool+\end{spec}+\index{class!operation} +The connection between |(==)| and |Eq| is important: the above+declaration should be read, ``a type |a| is an instance of the class+|Eq| only if there is an operation |(==)::a->a->Bool| defined on it.''+|(==)| is called an \emph{operation} in the class |Eq|, and in general+more than one operation is allowed in a class. More examples of this+will be introduced shortly.++\index{class!instance}+So far so good. But how do we specify which types are instances of+the class |Eq|, and the actual behavior of |(==)| on each of those+types? This is done with an \emph{instance declaration}. For example:+\begin{spec}+instance Eq Integer where + x == y = integerEq x y+\end{spec}+\index{class!method}++The definition of |(==)| is called a \emph{method}. The function+|integerEq| happens to be the primitive function that compares+integers for equality, but in general any valid expression is allowed+on the right-hand side, just as for any other function definition.+The overall instance declaration is essentially saying: ``The type+|Integer| is an instance of the class |Eq|, and here is the method+corresponding to the operation |(==)|.'' Given this declaration, we+can now compare fixed-precision integers for equality using |(==)|.+Similarly:+\begin{spec}+instance Eq Float where+ x == y = floatEq x y+\end{spec}+allows us to compare floating-point numbers using |(==)|.++More importantly, datatypes that we have defined on our own can also+be made instances of the class |Eq|. Consider, for example, the+|PitchClass| data type defined in Chapter \ref{ch:music}:+\begin{spec}+data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs+ | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss+\end{spec} +We can declare |PitchClass| to be an instance of |Eq| as follows:+\begin{spec}+instance Eq PitchClass where+ Cff == Cff = True+ Cf == Cf = True+ C == C = True+ ...+ Bs == Bs = True+ Bss == Bss = True+ _ == _ = False+\end{spec}+where |...| refers to the other thirty equations needed to make this+definition complete. Indeed, this is rather tedious! It is not only+tedious, it is also dead obvious how |(==)| should be defined.++\subsection{Derived Instances}+\label{sec:derived-instances}++To alleviate the burden of defining instances such as above, Haskell+provides a convenient way to \emph{automatically derive} such instance+declarations from data type declarations, for certain predefined type+classes. This is done using a |deriving| clause. For example, in the+case of |PitchClass| we can simply write:+\begin{spec}++data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs+ | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss+ deriving Eq+\end{spec}+With this declaration, Haskell will automatically derive the instance+declaration given above, so that |(==)| behaves in the way we would+expect it to.++Consider now a polymorphic type, such as the |Primitive| type from+Chapter \ref{ch:music}:+\begin{spec}+data Primitive a = Note Dur a+ | Rest Dur+\end{spec}+What should an instance for this type in the class |Eq| look like?+Here is a first attempt:+\begin{spec}+instance Eq (Primitive a) where+ Note d1 x1 == Note d2 x2 = (d1==d2) && (x1==x2)+ Rest d1 == Rest d2 = d1==d2+ _ == _ = False+\end{spec}+Note the use of |(==)| on the right-hand side, in several places. Two+of those places involve |Dur|, which a type synonym for |Rational|.+The |Rational| type is in fact a predefined instance of |Eq|, so all+is well there. (If it were not an instance of |Eq|, a type error+would result.)++But what about the term |x1==x2|? |x1| and |x2| are values of the+polymorphic type |a|, but how do we know that equality is defined+on |a|, i.e.\ that the type |a| is an instance of |Eq|? In fact this+is not known in general. The simple fix is to add a constraint to the+instance declaration, as follows:+\begin{spec}+instance Eq a ==> Eq (Primitive a) where+ Note d1 x1 == Note d2 x2 = (d1==d2) && (x1==x2)+ Rest d1 == Rest d2 = d1==d2+ _ == _ = False+\end{spec}+This can be read, ``For any type |a| in the class |Eq|, the type+|Primitive a| is also in the class |Eq|, and here is the definition of+|(==)| for that type.'' Indeed, if we had written the original type+declaration like this:+\begin{spec}+data Primitive a = Note Dur a + | Rest Dur + deriving Eq+\end{spec}+then Haskell would have derived the above correct instance declaration+automatically. ++So, for example, |(==)| is defined on the type |Primitive Pitch|,+because |Pitch| is a type synonym for |(PitchClass, Octave)|, and (a)+|PitchClass| is an instance of |Eq| by the effort above, (b) |Octave|+is a synonym for |Int|, which is a predefined instance of |Eq|, and+(c) as mentioned earlier the pair type is a predefined instance of+|Eq|. Indeed, now that an instance for a polymorphic type has been+seen, we can understand what the predefined instance for polymorphic+pairs must look like, namely:+\begin{spec}+instance (Eq a, Eq b) => Eq (a,b) where+ (x1,y1) == (x2,y2) = (x1==x2) && (y1==y2)+\end{spec}++About the only thing not considered is a \emph{recursive} data type.+For example, recall the |Music| data type, also from Chapter+\ref{ch:music}:+\begin{spec}+data Music a = Prim (Primitive a)+ | Music a :+: Music a+ | Music a :=: Music a+ | Modify Control (Music a)+\end{spec}+Its instance declaration for |Eq| seems obvious:+\begin{spec}+instance Eq a => Eq (Music a) where+ Prim p1 == Prim p2 = p1==p2+ (m1 :+: m2) == (m3 :+: m4) = (m1 == m3) && (m2 == m4)+ (m1 :=: m2) == (m3 :=: m4) = (m1 == m3) && (m2 == m4)+ Modify c1 m1 == Modify c2 m2 = (c1 == c2) && (m1 == m2)+\end{spec}+Indeed, assuming that |Control| is an instance of |Eq|, this is just+what is expected, and can be automatically derived by adding a+|deriving| clause to the data type declaration for |Music|.++\subsection{Default Methods}+\label{sec:default-methods}++In reality, the class \indexwdhs{Eq} as defined in Haskell's Standard+Prelude is slightly richer than what is defined above. Here it is+in its exact form: \indexhs{(/=)}+\begin{spec}+class Eq a where+ (==), (/=) :: a -> a -> Bool+ x /= y = not (x == y)+ x == y = not (x /= y)+\end{spec}+\index{class!default method}++This is an example of a class with two operations, one for equality,+the other for inequality. It also demonstrates the use of a+\emph{default method}, one for each operator. If a method for a+particular operation is omitted in an instance declaration, then the+default one defined in the class declaration, if it exists, is used+instead. For example, all of the instances of |Eq| defined earlier+will work perfectly well with the above class declaration, yielding+just the right definition of inequality that we would expect: the+logical negation of equality.++\syn{Both the inequality and the logical negation operators are shown+ here using the mathematical notation, |/=| and |not|, respectively.+ When writing your Haskell programs, you instead will have to use the+ operator {\tt /=} and the function name {\tt not}, respectively.}++A useful slogan that helps to distinguish type classes from ordinary+polymorphism is this: ``polymorphism captures similar structure over+different values, while type classes capture similar operations over+different structures.'' For example, a sequences of integers,+sequence of characters, etc.\ can be captured as a polymorphic |List|,+whereas equality of integers, equality of trees, etc.\ can be captured+by a type class such as |Eq|.++\subsection{Inheritance}+\label{sec:inheritance}++\index{class!inheritance}++Haskell also supports a notion called \emph{inheritance}. For+example, we may wish to define a class \indexwdhs{Ord} that+``inherits'' all of the operations in |Eq|, but in addition has a set+of comparison operations and minimum and maximum functions (a fuller+definition of |Ord|, as taken from the Standard Prelude, is given in+Appendix \ref{ch:class-tour}):+\begin{spec}+class Eq a => Ord a where+ (<), (<=), (>=), (>) :: a -> a -> Bool+ max, min :: a -> a -> a+\end{spec}+\index{class!superclass}+\index{class!subclass} ++Note the constraint |Eq a =>| in the |class| declaration. |Eq| is a+\emph{superclass} of |Ord| (conversely, |Ord| is a \emph{subclass} of+|Eq|), and any type that is an instance of |Ord| must also be an+instance of |Eq|. The reason that this extra constraint makes sense+is that to perform comparisons such as |a<=b| and |a>=b| implies that+we know how to compute |a==b|.++For example, following the strategy used for |Eq|, we could declare+|Music| an instance of |Ord| as follows (note the constraint |Ord a =>+...|):+\begin{spec}+instance Ord a => Ord (Music a) where+ Prim p1 < Prim p2 = p1 < p2+ (m1 :+: m2) < (m3 :+: m4) = (m1<m3) && (m2<m4)+ (m1 :=: m2) < (m3 :=: m4) = (m1<m3) && (m2<m4)+ Modify c1 m1 < Modify c2 m2 = (c1<c2) && (m1<m2)+ ...+\end{spec}+Although this is a perfectly well-defined definition for |<|, it is+not clear that it exhibits the desired behavior, an issue that will be+returned to in Section \ref{sec:tc-laws}.++Another benefit of inheritance is shorter constraints. For example,+the type of a function that uses operations from both the |Eq| and+|Ord| classes can use just the constraint |(Ord a)| rather than+|(Eq a, Ord a)|, since |Ord| ``implies'' |Eq|.++\indexhs{sort}+\index{class!multiple inheritance}++As an example of the use of |Ord|, a generic \emph{sort} function+should be able to sort lists of any type that is an instance of+|Ord|, and thus its most general type should be:+\begin{spec}+sort :: Ord a => [a] -> [a]+\end{spec}+This typing for |sort| would naturally arise through the use of+comparison operators such as |<| and |>=| in its definition.++\syn{Haskell also permits \emph{multiple inheritance}, since classes+may have more than one superclass. Name conflicts are avoided by the+constraint that a particular operation can be a member of at most one+class in any given scope. For example, the declaration+\begin{spec}+class (Eq a, Show a) => C a where ...+\end{spec}+creates a class |C| that inherits operations from both |Eq| and+|Show|.++% Contexts are also allowed in |data| declarations; see+% Section \ref{datatype-decls}.++Finally, class methods may have additional class constraints on any+type variable except the one defining the current class. For example,+in this class:+\begin{spec}+class C a where+ m :: Eq b => a -> b+\end{spec}+the method |m| requires that type |b| is in class |Eq|.+However, additional class constraints on type |a| are not allowed+in the method |m|; these would instead have to be part of the+overall constraint in the class declaration.}++\section{Haskell's Standard Type Classes}+\label{sec:standard-type-classes}++The Standard Prelude defines many useful type classes, including |Eq|+and |Ord|. They are described in detail in Appendix+\ref{ch:class-tour}. In addition, the Haskell Report and the Library+Report contain useful examples and discussions of type classes; you+are encouraged to read through them.++Most of the standard type classes in Haskell are shown in+Figure~\ref{fig:common-type-classes}, along with their key instances.+Since each of these has various default mthods defined, also shown is+the minimal set of methods that must defined---the rest are taken care+of by the default methods. For example, for |Ord|, all we have to+provide is a definition for |(<=)|.++The \indexwdhs{Num} class, which has been used implicitly throughout+much of the text, is described in more detail below. With this+explanation a few more of Haskell's secrets will be revealed.++\begin{figure}+\begin{tabular}{||||l||l||l||||} \hline+{\bf Type} & {\bf Key} & {\bf Key} \\+{\bf Class} & {\bf functions} & {\bf instances} \\+\hline+|Num| & |(+),(-),(*) :: Num a => a->a->a| & |Integer, Int, Float, Double,| \\ + & |negate :: Num a => a->a| & |Rational| \\+ & minimal set: all but |(-)| or |negate| & \\+\hline+|Eq| & |(==),(/=) :: Eq a => a->a->Bool| & |Integer, Int, Float, Double,| \\+ & & |Rational, Char, Bool, ... | \\+ & minimal set: either |(==)| or |(/=)| & \\+\hline+|Ord| & |(>),(<),(>=),(<=) ::| & |Integer, Int, Float, Double,| \\+ & \ \ \ \ |Ord a => a->a->Bool| & |Rational, Char, Bool, ... | \\+ & |max,min :: Ord a => a->a->a | & \\+ & minimal set: |(<=)| & \\+\hline+|Enum| & |succ,pred :: Enum a => a->a| & |Integer, Int, Float, Double,| \\+ & |fromEnum :: Enum a => a -> Int| & |Rational, Char, Bool, ... | \\+ & |toEnum :: Enum a => Int -> a | & \\+ & also enables arithmetic sequences & \\+ & minimal set: |toEnum| \& |fromEnum| & \\+\hline+|Bounded| & |minBound,maxBound :: a| & |Int, Char, Bool| \\+\hline+|Show| & |show :: Show a => a -> String| & Almost every type except \\+ & & for functions \\+\hline+|Read| & |read :: Read a => String -> a| & Almost every type except \\+ & & for functions \\+\hline+\end{tabular}+\caption{Common Type Classes and Their Instances}+\label{fig:common-type-classes}+\end{figure}++\subsection{The |Num| Class}+\label{sec:num-class}++As we already know, Haskell provides several kinds of numbers, some of+which have already been introduced: |Int|, |Integer|, |Rational|, and+|Float|. These numbers are instances of various type classes arranged+in a rather complicated hierarchy. The reason for this is that there+are many operations, such as |(+)|, |abs|, and |sin|, that are common+amongst some of these number types. For example, we would expect+|(+)| to be defined on every kind of number, whereas |sin| might only+be applicable to either single precision (|Float|) or double-precision+(|Double|) floating-point numbers.++Control over which numerical operations are allowed and which are not+is the purpose of the numeric type class hierarchy. At the top of the+hierarchy, and therefore containing operations that are valid for all+numbers, is the class |Num|. It is defined as:+\begin{spec}+class (Eq a, Show a) => Num a where+ (+), (-), (*) :: a -> a -> a+ negate :: a -> a+ abs, signum :: a -> a+ fromInteger :: Integer -> a+\end{spec}+Note that |(/)| is \emph{not} an operation in this class.+|negate| is the negation function; \indexwdhs{abs} is the absolute+value function; and \indexwdhs{signum} is the sign function, which+returns |-1| if its argument is negative, |0| if it is |0|,+and |1| if it is positive. |fromInteger| converts an+|Integer| into a value of type |Num a => a|, which is useful for+certain coercion tasks.++\indexamb{(-)}{negation}+\indexhs{negate}+\syn{Haskell also has a negation operator, which is Haskell's only+prefix operator. However, it is just shorthand for |negate|. That+is, |-e| in Haskell is shorthand for |negate e|.++The operation \indexwdhs{fromInteger} also has a special purpose. How+is it that we can write the constant |42|, say, both in a context+requiring an |Int| and in one requiring a |Float| (say). Somehow+Haskell ``knows'' which version of |42| is required in a given+context. But, what is the type of |42| itself? The answer is that it+has type |Num a ==> a|, for some |a| to be determined by its context.+(If this seems strange, remember that |[]| by itself is also somewhat+ambiguous; it is a list, but a list of what? The most we can say+about its type is that it is |[a]| for some |a| yet to be determined.)++The way this is achieved in Haskell is that literal numbers such as+|42| are actually considered to be shorthand for |fromInteger 42|.+Since |fromInteger| has type |Num a => Integer -> a|, then+|fromInteger 42| has type |Num a => a|.}++The complete hierarchy of numeric classes is shown in Figure+\ref{fig:tc-hierarchy}; note that some of the classes are subclasses+of certain non-numeric classes, such as |Eq| and |Show|. The comments+below each class name refer to the Standard Prelude types that are+instances of that class. See Appendix \ref{ch:class-tour} for more+detail.++\begin{figure}+\centerline{+\epsfysize=7in +\epsfbox{Pics/classes.eps}+}+\caption{Numeric Class Hierarchy}+\label{fig:tc-hierarchy}+\end{figure}++The Standard Prelude actually defines only the most basic numeric+types: |Int|, |Integer|, |Float| and |Double|. Other+numeric types such as rational numbers (|Ratio a|) and complex+numbers (|Complex a|) are defined in libraries. The connection+between these types and the numeric classes is given in Figure+\ref{fig:standard-numeric-types}. The instance declarations implied+by this table can be found in the Haskell Report.++\begin{figure}+\begin{tabular}{lll}+{\bf Numeric Type} & {\bf Type Class} & {\bf Description} \\+\hline \\+|Int| & |Integral| & Fixed-precision integers \\+|Integer| & |Integral| & Arbitrary-precision integers \\+|Integral a =>| \\+\ \ \ |Ratio a| & |RealFrac| & Rational numbers \\+|Float| & |RealFloat|& Real floating-point, single precision\\+|Double| & |RealFloat|& Real floating-point, double precision\\+|RealFloat a =>| \\+\ \ \ |Complex a| & |Floating| & Complex floating-point +\end{tabular}+\caption{Standard Numeric Types}+\label{fig:standard-numeric-types}+\end{figure}++\subsection{The |Show| Class}++It is very common to want to convert a data type value into a string.+In fact, it happens all the time when we interact with GHCi at the+command prompt, and GHCi will complain if it does not ``know'' how to+``show'' a value. The type of anything that GHCi prints must be an+instance of the |Show| class.++\pagebreak++Not all of the operations in the |Show| class will be discussed here,+in fact the only one of interest is |show|:+\begin{spec}+class Show a where+ show :: a -> String+ ...+\end{spec}+Instances of |Show| can be derived, so normally we do not have to worry+about the details of the definition of |show|. ++%% For example, the actual definition of the |Primitive| type that we+%% gave in Chapter \ref{ch:music} is:+%% \begin{spec}+%% data Primitive = Note Dur Pitch +%% | Rest Dur +%% deriving (Show, Eq, Ord)+%% \end{spec}++Lists also have a |Show| instance, but it is not derived, since,+after all, lists have special syntax. Also, when |show| is applied to+a string such as |"Hello"|, it should generate a string that, when+printed, will look like |"Hello"|. This means that it must include+characters for the quotation marks themselves, which in Haskell is+achieved by prefixing the quotation mark with the ``escape'' character+$\backslash$. Given the following data declaration:+\begin{spec}+data Hello = Hello+ deriving Show+\end{spec}+it is then instructive to ponder over the following calculations:+\begin{spec}+show Hello ===> "Hello"+show (show Hello) ===> show "Hello" ===> "\"Hello\""+show (show (show Hello)) ===> "\"\\\"Hello\\\"\""+\end{spec}+\syn{To refer to the escape character itself, it must also be escaped;+thus |"\\"| prints as $\backslash$.}++For further pondering, consider the following program. See if you can+figure out what it does, and why!\footnote{The essence of this idea is+due to Willard Van Orman Quine \cite{Quine}, and its use in a computer+program is discussed by Hofstadter \cite{Hofstadter}. It was adapted+to Haskell by J\'{o}n Fairbairn.}+\begin{spec}+main = putStr (quine q)+quine s = s ++ show s+q = "main = putStr (quine q)\nquine s = s ++ show s\nq = "+\end{spec}++\syn{The |"\n"| that appears twice in the string |q| is a ``newline''+ character; that is, when |q| is printed (or displayed on a console)+ the string starting to the right of |"\n"| will appear on a new line.}++Derived |Show| instances are possible for all types whose component+types also have |Show| instances. |Show| instances for most of+the standard types are provided in the Standard Prelude.++%% Some types, such as the function type |(->)|, have a |Show|+%% instance that simply generates the string |"<<function>>"|, but not+%% a corresponding |Read| instance.++\subsection{The Functor Class}+\label{sec:functor-class}++[Define |Functor| class, and show instances for lists, |Maybe|,+ |Primitive|, |Music|, ...]++TBD++\section{Other Derived Instances}+\label{sec:other-derived-instances}++\index{class!derived instance}+\index{class!\hkw{deriving}}+\indexkw{deriving}++In addition to |Eq| and |Ord|, instances of \indexwdhs{Enum},+\indexwdhs{Bounded}, \indexwdhs{Ix}, \indexwdhs{Read}, and+\indexwdhs{Show} (see Appendix \ref{ch:class-tour}) can also be+generated by the |deriving| clause. These type classes are widely+used in Haskell programming, making the deriving mechanism very+useful.++The textual representation defined by a derived |Show| instance is+consistent with the appearance of constant Haskell expressions+(i.e.\ values) of the type involved. For example, from:+\begin{spec}+data Color = Black+ | Blue+ | Green+ | Cyan+ | Red+ | Magenta+ | Yellow+ | White+ deriving (Show, Eq, Ord, Enum, Bounded)+\end{spec}+we can expect that:+\begin{spec}+show [Red ..] +===> "[Black,Blue,Green,Cyan,Red,Magenta,Yellow,White]"+\end{spec}++We can also expect that:+\begin{spec}+minBound :: Color ===> Black+maxBound :: Color ===> White+\end{spec}+Note that the type signature ``|:: Color|'' is given explicitly in+this case, because, out of any context, at least, Haskell does not+know the type for which you are trying to determine the minimum and+maximum bounds.++Further details about derived instances can be found in the Haskell+Report.++Many of the predefined data types in Haskell have |deriving| clauses,+even ones with special syntax. For example, if we could write a data+type declaration for lists (the reason we cannot do this is that+lists have special syntax, both at the value and type level) it would+look something like this:+\begin{spec}+data [a] = [] + | a : [a] + deriving (Eq, Ord)+\end{spec}+The derived |Eq| and |Ord| instances for lists are the usual+ones; in particular, character strings, as lists of characters, are+ordered as determined by the underlying |Char| type, with an+initial sub-string being less than a longer string; for example,+|"cat" < "catalog"| is |True|.++In practice, |Eq| and |Ord| instances are almost always derived,+rather than user-defined. In fact, you should provide your own+definitions of equality and ordering predicates only with some+trepidation, being careful to maintain the expected algebraic+properties of equivalence relations and total orders, respectively+(more on this later). An intransitive |(==)| predicate, for example,+would be problematic, confusing readers of the program who expect+|(==)| to be transitive. Nevertheless, it is sometimes necessary to+provide |Eq| or |Ord| instances different from those that would be+derived.++The data type declarations for |PitchClass|, |Primitive|, |Music| and+|Control| given in Chapter~\ref{ch:intro} are not the ones actually+used in Eutperpea. The actual definitions each use a |deriving|+clause, and are shown in Figure~\ref{fig:actual-datatypes}. The+|InstrumentName| data type from Chapter~\ref{ch:intro} also has a+deriving clause for |Show|, |Eq|, and |Ord| (but is ommitted here to+save space).++\syn{When instances of more than one type class are derived for the+ same data type, they appear grouped in parentheses as in+ Figure~\ref{fig:actual-datatypes}. Also, in this case |Eq|+ \emph{must} appear if |Ord| does (unless an explicit instance for+ |Eq| is given), since |Eq| is a superclass of |Ord|.}++\begin{figure}+\cbox{\small+\begin{spec}+data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds + | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs+ | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As + | Bf | Ass | B | Bs | Bss+ deriving (Eq, Ord, Show, Read, Enum, Bounded)++data Primitive a = Note Dur a + | Rest Dur + deriving (Show, Eq, Ord)++data Music a = + Prim (Primitive a) -- primitive value + | Music a :+: Music a -- sequential composition+ | Music a :=: Music a -- parallel composition+ | Modify Control (Music a) -- modifier+ deriving (Show, Eq, Ord)++data Control =+ Tempo Rational -- scale the tempo+ | Transpose AbsPitch -- transposition+ | Instrument InstrumentName -- instrument label+ | Phrase [PhraseAttribute] -- phrase attributes+ | Player PlayerName -- player label+ deriving (Show, Eq, Ord)+\end{spec}}+\caption{Euterpea's Data Types with Deriving Clauses}+\label{fig:actual-datatypes}+\end{figure}++Note that with single and double sharps and flats, there are many+enharmonic equivalences. Thus in the data declaration for+|PitchClass|, the constructors are ordered such that, if |pc1 < pc2|,+then |pcToInt pc1 <= pcToInt pc2|.++For some examples, the |Show| class allows us to convert values to+strings:+\begin{spec}+show Cs ===> "Cs"+show concertA ===> "(A,4)"+\end{spec}+The |Read| class allows us to go the other way around:+\begin{spec}+read "Cs" ===> Cs+read "(A,4)" ===> (A,4)+\end{spec}+The |Eq| class allows testing values for equality:+\begin{spec}+concertA == a440 ===> True+concertA == (A,5) ===> False+\end{spec}+And the |Ord| class has relational operators for types whose values+can be ordered:+\begin{spec}+C < G ===> True+max C G ===> G+\end{spec}+The |Enum| class is for ``enummerable types.'' For example:+\begin{spec}+succ C ===> Dff+pred 1 ===> 0+fromEnum C ===> 2+toEnum 3 ===> Dff+\end{spec}+The |Enum| class is also the basis on which \emph{arithmetic+ sequences} (defined earlier in Section+\ref{sec:arithmetic-sequences}) are defined.++\section{The type of |play|}+\label{sec:play-type}++Ever since the |play| function was introduced in+Chapter~\ref{ch:music}, we have been using it to ``play'' the results+of our |Music| values, i.e.\ to listen to their rendering through+MIDI. However, it is just a function like any other function in+Haskell, but we never discussed what its type is. In fact, here it+is:+\begin{spec}+play :: Performable a => Music a -> IO ()+\end{spec}+The type of the result, |IO ()|, is the type of a \emph{command} in+Haskell, i.e.\ something that ``does I/O.'' We will have more to say+about this in a later chapter.++But of more relevance to this chapter, note the constraint+|Performable a|. You might guess that |Performable| is a type class,+indeed it is the type class of ``performable values.'' If a type is a+member of (i.e.\ instance of) |Performable|, then it can be+``performed,'' i.e.\ rendered as sound. The point is, some things we+would not expect to be performable, for example a list or a character+or a function. So the type signature for |play| can be read, ``For+any type |T| that is a member of the class |Performable|, |play| has+type |Music T -> IO ()|.''++Currently the types |Pitch|, |(Pitch,Volume)|, and+|(Pitch,[NoteAttribute])| are members of the class |Performable|.+(The |NoteAttribute| data type will be introduced in+Chapter~\ref{ch:performance}.) Indeed, we have used |play| on the+first two of these types, i.e.\ on values of type |Music Pitch| and+|Music (Pitch,Volume)| in previous examples, and you might have+wondered how both could possibly be properly typed---hopefully now it+is clear.++\section{Reasoning With Type Classes}+\label{sec:tc-laws}++\index{class!laws}++Type classes often imply a set of \emph{laws} that govern the use of+the operators in the class. For example, for the |Eq| class, we can+expect the following laws to hold for every instance of the class:+\begin{spec}+x == x+x == y =:> y == x+(x==y) && (y==z) =:> x == z+(x /= y) =:> not (x == y)+\end{spec}+where $\supseteq$ should be read ``implies+that.''\footnote{Mathematically, the first three of these laws are the+ same as those for an \emph{equivalence relation}.}++However, there is no way to guarantee these laws. A user may create+an instance of |Eq| that violates them, and in general Haskell has no+way to enforce them. Nevertheless, it is useful to state the laws of+interest for a particular class, and to state the expectation that all+instances of the class be ``law-abiding.'' Then as diligent+functional programmers, we should ensure that every instance that is+defined, whether for our own type class or someone else's, is in fact+law-abiding. \index{type!qualified}++As another example, consider the |Ord| class, whose instances are+intended to be \emph{totally ordered}, which means that the following+laws should hold, for all |a|, |b|, and |c|:+\begin{spec}+a <= a+(a <= b) && (b <= c) =:> (a <= c)+(a <= b) && (b <= a) =:> (a == b)+(a /= b) =:> (a < b) || (b < a)+\end{spec}+Similar laws should hold for |(>)|.++But alas, the instance of |Music| in the class |Ord| given in Section+\ref{sec:inheritance} does not satisfy all of these laws! To see why,+consider two |Primitive| values |p1| and |p2| such that |p1 < p2|.+Now consider these two |Music| values:+\begin{spec}+m1 = Prim p1 :+: Prim p2+m2 = Prim p2 :+: Prim p1+\end{spec}+Clearly |m1 == m2| is false, but the problem is, so are |m1 < m2|+and |m2 < m1|, thus violating the last law above. ++\index{lexicographic ordering}++To fix the problem, a \emph{lexicographic ordering} should be used on+the |Music| type, such as used in a dictionary. For example,+``polygon'' comes before ``polymorphic,'' using a left-to-right+comparison of the letters. The new instance declaration looks like+this:+\begin{spec}+instance Ord a => Ord (Music a) where+ Prim p1 < Prim p2 = p1 < p2+ Prim p1 < _ = True+ (m1 :+: m2) < Prim _ = False+ (m1 :+: m2) < (m3 :+: m4) = (m1<m3) || + (m1==m3) && (m2<m4)+ (m1 :+: m2) < _ = True+ (m1 :=: m2) < Prim _ = False+ (m1 :=: m2) < (m3 :+: m4) = False+ (m1 :=: m2) < (m3 :=: m4) = (m1<m3) || + (m1==m3) && (m2<m4)+ (m1 :=: m2) < _ = True+ Modify c1 m1 < Modify c2 m2 = (c1<c2) || + (c1==c2) && (m1<m2)+ Modify c1 m1 < _ = False+\end{spec}+This example shows the value of checking to be sure that each instance+obeys the laws of its class. Of course, that check should come in the+way of a proof. This example also highlights the utility of derived+instances, since the derived instance of |Music| for the class |Ord|+is equivalent to that above, yet is done automatically.++\vspace{.1in}\hrule++\begin{exercise}{\em+Prove that the instance of |Music| in the class |Eq| satisfies+the laws of its class. Also prove that the modified instance of+|Music| in the class |Ord| satisfies the laws of its class.}+\end{exercise}++\begin{exercise}{\em+Write out appropriate instance declarations for the |Color| type in+the classes |Eq|, |Ord|, and |Enum|. (For simplicity you may define+|Color| to have fewer constructors, say just |Red|, |Green| and+|Blue|.)}+\end{exercise}++\begin{exercise}{\em+Define a type class called |Temporal| whose members are types that can be+interpreted as having a temporal duration. |Temporal| should have+three operations, namely:+\begin{spec}+durT :: Temporal a => a -> Dur+takeT :: Temporal a => Dur -> a -> a+dropT :: Temporal a => Dur -> a -> a+\end{spec}+Then define instances of |Temporal| for the types |Music| and+|Primitive|. (Hint: this is not as hard as it sounds, because you can+\emph{reuse} some function names previously defined to do these sorts+of operations.)++Can you think of other types that are temporal?}+\end{exercise}++\begin{exercise}{\em+Functions are not members of the |Eq| class, because, in general,+determining whether two functions are equal is undecideable. But+functions whose domains are finite, and can be completely enumerated,+\emph{can} be tested for equality. We just need to test that each+function, when applied to each element in the domain, returns the same+result.++Define an instance of |Eq| for functions. For this to be possible,+note that, if the function type is |a->b|, then:+\begin{itemize}+\item+the type |a| must be \emph{enumerable} (i.e.\ a member of the |Enum| class), +\item+the type |a| must be \emph{bounded} (i.e.\ a member of |Bounded| class), and+\item+the type |b| must admit \emph{equality} (i.e.\ be a member of the |Eq|+class).+\end{itemize}+These constraints must therefore be part of the instance declaration.++Hint: using the minimum and maximum bounds of a type, enumerate all+the elements of that type using an arithmetic sequence (recall Section+\ref{sec:arithmetic-sequences}), which, despite its name, works for+any enumerable type.++Test your implementation by defining some functions on existing+Euterpea types that are finite and bounded (such as |PitchClass|+and |Color|), or by defining some functions on your own data type(s).}+\end{exercise}++\vspace{.1in}\hrule+
+ HSoM/RandomMusic.lhs view
@@ -0,0 +1,601 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/RandomMusic.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter[Random Numbers ... and Markov Chains] +{Random Numbers, Probability Distributions, and Markov Chains} +\label{ch:random} + +\begin{code} +module Euterpea.Examples.RandomMusic where + +import Euterpea + +import System.Random +import System.Random.Distributions +import qualified Data.MarkovChain as M +\end{code} + +The use of randomness in composition can be justified by the somewhat +random, exploratory nature of the creative mind, and indeed it has +been used in computer music composition for many years. In this +chapter we will explore several sources of random numbers and how to +use them in generating simple melodies. With this foundation you will +hopefully be able to use randomness in more sophisticated ways in your +compositions. Music relying at least to some degree on randomness is +said to be \emph{stochastic}, or \emph{aleatoric}. + +\section{Random Numbers} +\label{sec:random} + +This section describes the basic functionality of Haskell's +|System.Random| module, which is a library for random numbers. The +library presents a fairly abstract interface that is structured in two +layers of type classes: one that captures the notion of a \emph{random + generator}, and one for using a random generator to create +\emph{random sequences}. + +We can create a random number generator using the built-in |mkStdGen| +function: +\begin{spec} +mkStdGen :: Int -> StdGen +\end{spec} +which takes an |Int| seed as argument, and returns a ``standard +generator'' of type |StdGen|. For example, we can define: +\begin{code} +sGen :: StdGen +sGen = mkStdGen 42 +\end{code} +We will use this single random generator quite extensively in the +remainder of this chapter. + +|StdGen| is an instance of |Show|, and thus its values can be +printed---but they appear in a rather strange way, basically as two +integers. Try typing |sGen| to the GHCi prompt. + +More importantly, |StdGen| is an instance of the |RandomGen| class: +\begin{spec} +class RandomGen g where + genRange :: g -> (Int, Int) + next :: g -> (Int, g) + split :: g -> (g, g) +\end{spec} +The reason that |Int|s are used here is that essentially all +pseudo-random number generator algorithms are based on a +fixed-precision binary number, such as |Int|. We will see later how +this can be coerced into other number types. + +For now, try applying the operators in the above class to the |sGen| +value above. The |next| function is particularly important, as it +generates the next random number in a sequence as well as a new random +number generator, which in turn can be used to generate the next +number, and so on. It should be clear that we can then create an +infinite list of random |Int|s like this: +\begin{code} +randInts :: StdGen -> [Int] +randInts g = let (x,g') = next g + in x : randInts g' +\end{code} +Look at the value |take 10 (randInts sGen)| to see a sample output. + +To support other number types, the |Random| library defines this type +class: +\begin{spec} +class Random a where + randomR :: RandomGen g => (a, a) -> g -> (a, g) + random :: RandomGen g => g -> (a, g) + + randomRs :: RandomGen g => (a, a) -> g -> [a] + randoms :: RandomGen g => g -> [a] + + randomRIO :: (a,a) -> IO a + randomIO :: IO a +\end{spec} +Built-in instances of |Random| are provided for |Int|, |Integer|, +|Float|, |Double|, |Bool|, and |Char|. + +The set of operators in the |Random| class is rather daunting, so +let's focus on just one of them for now, namely the third one, +|RandomRs|, which is also perhaps the most useful one. This function +takes a random number generator (such as |sGen|), along with a range +of values, and generates an infinite list of random numbers within the +given range (the pair representing the range is treated as a closed +interval). Here are several examples of this idea: +\begin{code} +randFloats :: [Float] +randFloats = randomRs (-1,1) sGen + +randIntegers :: [Integer] +randIntegers = randomRs (0,100) sGen + +randString :: String +randString = randomRs ('a','z') sGen +\end{code} +Recall that a string is a list of characters, so we choose here to use +the name |randString| for our infinite list of characters. If you +believe the story about a monkey typing a novel, then you might +believe that |randString| contains something interesting to read. + +So far we have used a seed to initialize our random number generators, +and this is good in the sense that it allows us to generate +repeatable, and therefore more easily testable, results. If instead +you prefer a non-repeatable result, in which you can think of the seed +as being the time of day when the program is executed, then you need +to use a function that is in the IO monad. The last two operators in +the |Random| class serve this purpose. For example, consider: +\begin{code} +randIO :: IO Float +randIO = randomRIO (0,1) +\end{code} +If you repeatedly type |randIO| at the GHCi prompt, it will return a +different random number every time. This is clearly not purely +``functional,'' and is why it is in the IO monad. As another example: +\begin{code} +randIO' :: IO () +randIO' = do r1 <- randomRIO (0,1) :: IO Float + r2 <- randomRIO (0,1) :: IO Float + print (r1 == r2) +\end{code} +will almost always return |False|, because the chance of two randomly +generated floating point numbers being the same is exceedingly small. +(The type signature is needed +to ensure that the value generated has an unambigous type.) + +\syn{|print :: Show a => a -> IO ()| converts any showable value into +a string, and displays the result in the standard output area.} + +\section{Probability Distributions} + +The random number generators described in the previous section are +assumed to be \emph{uniform}, meaning that the probability of +generating a number within a given interval is the same everywhere in +the range of the generator. For example, in the case of |Float| (that +purportedly represents \emph{continuous} real numbers), suppose we are +generating numbers in the range $0$ to $10$. Then we would expect the +probability of a number appearing in the range $2.3$-$2.4$ to be the +same as the probability of a number appearing in the range +$7.6$-$7.7$, namely $0.01$, or $1\%$ (i.e.\ $0.1/10$). In the case of +|Int| (a \emph{discrete} or \emph{integral} number type), we would +expect the probability of generating a 5 to be the same as generating +an 8. In both cases, we say that we have a \emph{uniform + distribution}. + +But we don't always want a uniform distribution. In generating music, +in fact, it's often the case that we want some kind of a non-uniform +distribution. Mathematically, the best way to describe a distribution +is by plotting how the probability changes over the range of values +that it produces. In the case of continuous numbers, this is called +the \emph{probability density function}, which has the property that +its integral over the full range of values is equal to $1$. + +The |System.Random.Distributions| library provides a number of +different probability distributions, which are described below. +Figure \ref{fig:distributions} shows the probability density functions +for each of othem. + +\begin{figure} +\centering +\subfigure[Linear]{ +\includegraphics[scale=0.9]{Pics/linear.eps} +} +\subfigure[Exponential]{ +\includegraphics[scale=0.9]{Pics/exponential.eps} +} +\subfigure[Bilateral exponential]{ +\includegraphics[scale=0.9]{Pics/bilexp.eps} +} +\subfigure[Gaussian]{ +\includegraphics[scale=0.9]{Pics/gaussian.eps} +} +\subfigure[Cauchy]{ +\includegraphics[scale=0.9]{Pics/cauchy.eps} +} +\subfigure[Poisson]{ +\includegraphics[scale=0.9]{Pics/poisson.eps} +} +\caption{Various Probability Density Functions} +\label{fig:distributions} +\end{figure} + +Here is a list and brief description of each random number generator: +\begin{description} +\item[linear] Generates a \emph{linearly} distributed random variable + between 0 and 1. The probability density function is given by: +\[ f(x) = \left\{ \begin{array}{ll} + 2(1-x) & \mbox{if $0 \leq x \leq 1$} \\ + 0 & \mbox{otherwise} + \end{array} + \right. +\] +The type signature is: +\begin{spec} +linear :: (RandomGen g, Floating a, Random a, Ord a) => + g -> (a,g) +\end{spec} +The mean value of the linear distribution is $1/3$. + +\item[exponential] Generates an \emph{exponentially} distributed + random variable given a spread parameter $\lambda$. A larger spread + increases the probability of generating a small number. The mean of + the distribution is $1/\lambda$. The range of the generated + number is conceptually $0$ to $\infty$, although the chance of + getting a very large number is very small. The probability density + function is given by: +\[ f(x) = \lambda e^{-\lambda x} \] +The type signature is: +\begin{spec} +exponential :: (RandomGen g, Floating a, Random a) => + a -> g -> (a,g) +\end{spec} +The first argument is the parameter $\lambda$. + +\item[bilateral exponential] Generates a random number with a + \emph{bilateral exponential} distribution. It is similar to + exponential, + but the mean of the distribution is 0 and 50\% of the results fall + between $-1/\lambda$ and $1/\lambda$. The probability density + function is given by: +\[ f(x) = \frac{1}{2}\lambda e^{-\lambda ||x||} \] +The type signature is: +\begin{spec} +bilExp :: (Floating a, Ord a, Random a, RandomGen g) => + a -> g -> (a,g) +\end{spec} + +\item[Gaussian] Generates a random number with a \emph{Gaussian}, also + called \emph{normal}, distribution, given mathematically by: +\[ f(x) = \frac{1}{\sigma\sqrt{2\pi}} + e^{-\frac{(x-\mu)^2}{2\sigma^2}} +\] +where $\sigma$ is the \emph{standard deviation}, and $\mu$ is the +\emph{mean}. The type signature is: +\begin{spec} +gaussian :: (Floating a, Random a, RandomGen g) => + a -> a -> g -> (a,g) +\end{spec} +The first argument is the standard deviation $\sigma$ and the second +is the mean $\mu$. Probabilistically, about 68.27\% of the numbers in +a Gaussian distribution fall within $\pm\sigma$ of the mean; about +$95.45\%$ are within $\pm 2\sigma$, and $99.73\%$ are within +$\pm 3\sigma$. + +\item[Cauchy] Generates a \emph{Cauchy}-distributed random variable. + The distribution is symmetric with a mean of 0. The density + function is given by: +\[ f(x) = \frac{\alpha}{\pi(\alpha^2 + x^2)} \] +As with the Gaussian distribution, it is unbounded both above and +below the mean, but at its extremes it approaches 0 more slowly than +the Gaussian. The type signature is: +\begin{spec} +cauchy :: (Floating a, Random a, RandomGen g) => + a -> g -> (a,g) +\end{spec} +The first argument corresponds to $\alpha$ above, and is called the +\emph{density}. + +\item[Poisson] Generates a \emph{Poisson}-distributed random variable. + The Poisson distribution is discrete, and generates only + non-negative numbers. $\lambda$ is the mean of the distribution. + If $\lambda$ is an integer, the probability that the result is + $j = \lambda-1$ is the same as that of $j = \lambda$. The + probability of generating the number $j$ is given by: +\[ P\{X=j\} = \frac{\lambda^j}{j!} e^{-\lambda} \] +The type signature is: +\begin{spec} +poisson :: ( Num t, Ord a, Floating a, Random a + RandomGen g ) => + a -> g -> (t, g) +\end{spec} + +\item[Custom] Sometimes it is useful to define one's own discrete + probability distribution function, and to generate random numbers + based on it. The function |frequency| does this---given a list of + weight-value pairs, it generates a value randomly picked from the + list, weighting the probability of choosing each value by the given + weight. +\begin{spec} +frequency :: (Floating w, Ord w, Random w, RandomGen g) => + [(w, a)] -> g -> (a,g) +\end{spec} +\end{description} + +\subsection{Random Melodies and Random Walks} + +Note that each of the non-uniform distribution random number +generators described in the last section takes zero or more parameters +as arguments, along with a uniform random number generator, and +returns a pair consisting of the next random number and a new +generator. In other words, the tail end of each type signature has +the form: +\begin{spec} +... -> g -> (a,g) +\end{spec} +where |g| is the type of the random number generator, and |a| is the +type of the next value generated. + +Given such a function, we can generate an infinite sequence of random +numbers with the given distribution in a way similar to what we did +earlier for |randInts|. In fact the following function is defined in +the |Distributions| library to make this easy: +\begin{spec} +rands :: (RandomGen g, Random a) => + (g -> (a,g)) -> g -> [a] +rands f g = x : rands f g' where (x,g') = f g +\end{spec} + +Let's work through a few musical examples. One thing we will need to +do is convert a floating point number to an absolute pitch: +\begin{code} +toAbsP1 :: Float -> AbsPitch +toAbsP1 x = round (40*x + 30) +\end{code} +This function converts a number in the range $0$ to $1$ into an +absolute pitch in the range $30$ to $70$. + +And as we have often done, we will also need to convert an absolute +pitch into a note, and a sequence of absolute pitches into a melody: +\begin{code} +mkNote1 :: AbsPitch -> Music Pitch +mkNote1 = note tn . pitch + +mkLine1 :: [AbsPitch] -> Music Pitch +mkLine1 rands = line (take 32 (map mkNote1 rands)) +\end{code} + +With these functions in hand, we can now generate sequences of random +numbers with a variety of distributions, and convert each of them into +a melody. For example: + +\pagebreak + +\begin{code} +-- uniform distribution +m1 :: Music Pitch +m1 = mkLine1 (randomRs (30,70) sGen) + +-- linear distribution +m2 :: Music Pitch +m2 = let rs1 = rands linear sGen + in mkLine1 (map toAbsP1 rs1) + +-- exponential distribution +m3 :: Float -> Music Pitch +m3 lam = let rs1 = rands (exponential lam) sGen + in mkLine1 (map toAbsP1 rs1) + +-- Gaussian distribution +m4 :: Float -> Float -> Music Pitch +m4 sig mu = let rs1 = rands (gaussian sig mu) sGen + in mkLine1 (map toAbsP1 rs1) +\end{code} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Try playing each of the above melodies, and listen to the musical +differences. For |lam|, try values of $0.1$, $1$, $5$, and $10$. For +|mu|, a value of $0.5$ will put the melody in the central part of the +scale range---then try values of $0.01$, $0.05$, and $0.1$ for |sig|.} +\end{exercise} + +\begin{exercise}{\em +Do the following: +\begin{itemize} +\item +Try using some of the other probability distributions to generate a +melody. +\item +Instead of using a chromatic scale, try using a diatonic or pentatonic +scale. +\item +Try using randomness to control parameters other than pitch---in +particular, duration and/or volume. +\end{itemize} +} +\end{exercise} + +\vspace{.1in}\hrule +\vspace{.1in} + +Another approach to generating a melody is sometimes called a +\emph{random walk}. The idea is to start on a particular note, and +treat the sequence of random numbers as \emph{intervals}, rather than +as pitches. To prevent the melody from wandering too far from the +starting pitch, one should use a probability distribution whose mean +is zero. This comes for free with something like the bilateral +exponential, and is easily obtained with a distribution that takes the +mean as a parameter (such as the Gaussian), but is also easily +achieved for other distributions by simply subtracting the mean. To +see these two situations, here are random melodic walks using first +a Gaussian and then an exponential distribution: +\begin{code} +-- Gaussian distribution with mean set to 0 +m5 :: Float -> Music Pitch +m5 sig = let rs1 = rands (gaussian sig 0) sGen + in mkLine2 50 (map toAbsP2 rs1) + +-- exponential distribution with mean adjusted to 0 +m6 :: Float -> Music Pitch +m6 lam = let rs1 = rands (exponential lam) sGen + in mkLine2 50 (map (toAbsP2 . subtract (1/lam)) rs1) + +toAbsP2 :: Float -> AbsPitch +toAbsP2 x = round (5*x) + +mkLine2 :: AbsPitch -> [AbsPitch] -> Music Pitch +mkLine2 start rands = + line (take 64 (map mkNote1 (scanl (+) start rands))) +\end{code} +Note that |toAbsP2| does something reasonable to interpret a +floating-point number as an interval, and |mkLine2| uses |scanl| to +generate a ``running sum'' that represents the melody line. + +\out{ +-- Test code to see how accurate the mean is: +\begin{code} +m2' = let rs1 = rands linear sGen + in sum (take 1000 rs1) / 1000 :: Float + +m5' sig = let rs1 = rands (gaussian sig 0) sGen + in sum (take 1000 rs1) + +m6' lam = let rs1 = rands (exponential lam) sGen + rs2 = map (subtract (1/lam)) rs1 + in sum (take 1000 rs2) +\end{code} +} + +%% \begin{exercise}{\em +%% Instead of ...} +%% \end{exercise} + +\section{Markov Chains} + +Each number in the random number sequences that we have described thus +far is \emph{independent} of any previous values in the sequence. +This is like flipping a coin---each flip has a 50\% chance of being +heads or tails, i.e.\ it is independent of any previous flips, even if +the last ten flips were all heads. + +Sometimes, however, we would like the probability of a new choice to +depend upon some number of previous choices. This is called a +\emph{conditional probability}. In a discrete system, if we look only +at the previous value to help determine the next value, then these +conditional probabilities can be conveniently represented in a matrix. +For example, if we are choosing between the pitches $C$, $D$, $E$, and +$F$, then Table \ref{fig:markov-table} might represent the conditional +probabilities of each possible outcome. The previous pitch is found +in the left column---thus note that the sum of each row is $1.0$. So, +for example, the probability of choosing a $D$ given that the previous +pitch was an $E$ is $0.6$, and the probability of an $F$ occurring +twice in succession is $0.2$. The resulting stochastic system is +called a \emph{Markov Chain}. + +\begin{table} +\begin{center} +\begin{tabular}{||l||l||l||l||l||} \hline + & |C| & |D| & |E| & |F| \\ \hline +|C| & 0.4 & 0.2 & 0.2 & 0.2 \\ \hline +|D| & 0.3 & 0.2 & 0.0 & 0.5 \\ \hline +|E| & 0.1 & 0.6 & 0.1 & 0.2 \\ \hline +|F| & 0.2 & 0.3 & 0.3 & 0.2 \\ \hline +\end{tabular} +\end{center} +\caption{Second-Order Markov Chain} +\label{fig:markov-table} +\end{table} + +This idea can of course be generalized to arbitrary numbers of +previous events, and in general an $(n+1)$-dimensional array can be +used to store the various conditional probabilities. The number of +previous values observed is called the \emph{order} of the Markov +Chain. + +[TO DO: write the Haskell code to implement this] + +\subsection{Training Data} + +Instead of generating the conditional probability table ourselves, +another approach is to use \emph{training data} from which the +conditional probabilities can be \emph{inferred}. This is handy for +music, because it means that we can feed in a bunch of melodies that +we like, including melodies written by the masters, and use that as a +stochastic basis for generating new melodies. + +[TO DO: Give some pointers to the literatue, in particular David + Cope's work.] + +The |Data.MarkovChain| library provides this functionality through a +function called |run|, whose type signature is: +\begin{spec} +run :: (Ord a, RandomGen g) => + Int -- order of Markov Chain + -> [a] -- training sequence (treated as circular list) + -> Int -- index to start within the training sequence + -> g -- random number generator + -> [a] +\end{spec} +The |runMulti| function is similar, except that it takes a list of +training sequences as input, and returns a list of lists as its +result, each being an independent random walk whose probabilities are +based on the training data. The following examples demonstrate how to +use these functions. + +\begin{code} +-- some sample training sequences +ps0,ps1,ps2 :: [Pitch] +ps0 = [(C,4), (D,4), (E,4)] +ps1 = [(C,4), (D,4), (E,4), (F,4), (G,4), (A,4), (B,4)] +ps2 = [ (C,4), (E,4), (G,4), (E,4), (F,4), (A,4), (G,4), (E,4), + (C,4), (E,4), (G,4), (E,4), (F,4), (D,4), (C,4)] + +-- functions to package up |run| and |runMulti| +mc ps n = mkLine3 (M.run n ps 0 (mkStdGen 42)) +mcm pss n = mkLine3 (concat (M.runMulti n pss 0 + (mkStdGen 42))) + +-- music-making functions +mkNote3 :: Pitch -> Music Pitch +mkNote3 = note tn + +mkLine3 :: [Pitch] -> Music Pitch +mkLine3 ps = line (take 64 (map mkNote3 ps)) +\end{code} + +\out{ +\begin{code} +-- testing the Markov output directly +lc ps n = take 1000 (M.run n ps 0 (mkStdGen 42)) +lcl pss n m = take 1000 (M.runMulti n pss 0 (mkStdGen 42) !! m) +\end{code} +} + +Here are some things to try with the above definitions: +\begin{itemize} +\item +|mc ps0 0| will generate a completely random sequence, since it is a +``zeroth-order'' Markov Chain that does not look at any previous +output. +\item +|mc ps0 1| looks back one value, which is enough in the case of this +simple training sequence to generate an endless sequence of notes that +sounds just like the training data. Using any order higher than 1 +generates the same result. +\item +|mc ps1 1| also generates a result that sounds just like its training +data. +\item +|mc ps2 1|, on the other hand, has some (random) variety to it, +because the training data has more than one occurrence of most of the +notes. If we increase the order, however, the output will sound more +and more like the training data. +\item +|mcm [ps0,ps2] 1| and |mcm [ps1,ps2] 1| generate perhaps the most +interesting results yet, in which you can hear aspects of both the +ascending melodic nature of |ps0| and |ps1|, and the harmonic +structure of |ps2|. +\item +|mcm [ps1,reverse ps1] 1| has, not suprisingly, both ascending and +descending lines in it, as reflected in the training data. +\end{itemize} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Play with Markov Chains. Use them to generate more melodies, or to +control other aspects of the music, such as rhythm. Also consider +other kinds of training data rather than simply sequences of pitches.} +\end{exercise} + +\vspace{.1in}\hrule + +
+ HSoM/SelfSimilar.lhs view
@@ -0,0 +1,398 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SelfSimilar.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter{Self-Similar Music} +\label{ch:self-similar} + +\begin{code} +module Euterpea.Examples.SelfSimilar where +import Euterpea +\end{code} + +\index{self-similar music} +\index{fractal music} + +In this chapter we will explore the notion of \emph{self-similar} +music---i.e.\ musical structures that have patterns that repeat +themselves recursively in interesting ways. There are many approaches +to generating self-similar structures, the most well-known being +\emph{fractals}, which have been used to generate not just music, but +also graphical images. We will delay a general treatment of fractals, +however, and will instead focus on more specialized notions of +self-similarity, notions that we conceive of musically, and then +manifest as Haskell programs. + +\section{Self-Similar Melody} +\label{sec:self-sim-melody} + +Here is the first notion of self-similar music that we will consider: +Begin with a very simple melody of |n| notes. Now duplicate this +melody |n| times, playing each in succession, but first perform the +following transformations: transpose the |i|th melody by an amount +proportional to the pitch of the |i|th note in the original melody, +and scale its tempo by a factor proportional to the duration of the +|i|th note. For example, Figure \ref{fig:self-similar} shows the +result of applying this process once to a four-note melody (the first +four notes form the original melody). Now imagine that this process +is repeated infinitely often. For a melody whose notes are all +shorter than a whole note, it yields an infinitely dense melody of +infinitesimally shorter notes. To make the result playable, however, +we will stop the process at some pre-determined level. + +\begin{figure*} +\centerline{ +\epsfysize=2in +\epsfbox{pics/self-sim.eps} +} +\caption{An Example of Self-Similar Music} +\label{fig:self-similar} +\end{figure*} + +How can this be represented in Haskell? A {\em tree} seems like it +would be a logical choice; let's call it a |Cluster|: +\begin{code} + +data Cluster = Cluster SNote [Cluster] +type SNote = (Dur,AbsPitch) +\end{code} +This particular kind of tree happens to be called a {\em rose tree} +\cite{}. An |SNote| is just a ``simple note,'' a duration paired +with an absolute pitch. We prefer to stick with absolute pitches in +creating the self-similar structure, and will convert the result into +a normal |Music| value only after we are done. + +The sequence of |SNote|s at each level of the cluster is the +melodic fragment for that level. The very top cluster will contain a +``dummy'' note, whereas the next level will contain the original +melody, the next level will contain one iteration of the process +described above (e.g.\ the melody in Figure \ref{fig:self-similar}), +and so forth. + +To achieve this we will define a function |selfSim| that takes the +initial melody as argument and generates an infinitely deep cluster: +\indexhs{selfSim} +\begin{code} +selfSim :: [SNote] -> Cluster +selfSim pat = Cluster (0,0) (map mkCluster pat) + where mkCluster note = + Cluster note (map (mkCluster . addMult note) pat) + +addMult :: SNote -> SNote -> SNote +addMult (d0,p0) (d1,p1) = (d0*d1,p0+p1) +\end{code} +Note that |selfSim| itself is not recursive, but |mkCluster| is. This +code should be studied carefully. In particualr, the recursion in +|mkCluster| is different from what we have seen before, as it is not a +direct invocation of |mkCluster|, but rather it is a high-order +argument to |map| (which in turn invokes |mkCluster| an aribtrary +number of times). + +Next, we define a function to skim off the notes at the $n^{th}$ level, +or $n^{th}$ ``fringe,'' of a cluster: +\begin{code} +fringe :: Int -> Cluster -> [SNote] +fringe 0 (Cluster note cls) = [note] +fringe n (Cluster note cls) = concatMap (fringe (n-1)) cls +\end{code} + +\syn{|concatMap| is defined in the Standard Prelude as: +\begin{spec} +concatMap :: (a -> [b]) -> [a] -> [b] +concatMap f = concat . map f +\end{spec} +Recall that |concat| appends together a list of lists, and is +defined in the Prelude as: +\begin{spec} +concat :: [[a]] -> [a] +concat = foldr (++) [] +\end{spec} +} + +All that is left to do is convert this into a |Music| value that we +can play: +\begin{spec} +simToMusic :: [SNote] -> Music Pitch +simToMusic ss = let mkNote (d,ap) = note d (pitch ap) + in line (map mkNote ss) +\end{spec} +We can define this with a bit more elegance as follows: +\begin{code} +simToMusic :: [SNote] -> Music Pitch +simToMusic = line . map mkNote + +mkNote :: (Dur,AbsPitch) -> Music Pitch +mkNote (d,ap) = note d (pitch ap) +\end{code} +The increased modularity will allow us to reuse |mkNote| later in the +chapter. + +Putting it all together, we can define a function that takes an +initial pattern, a level, a number of pitches to transpose the result, +and a tempo scaling factor, to yield a final result: +\begin{code} +ss pat n tr te = + transpose tr $ tempo te $ simToMusic $ fringe n $ selfSim pat +\end{code} + +\subsection{Sample Compositions} + +Let's start with a melody with no rhythmic variation. +\begin{code} +m0 :: [SNote] +m0 = [(1,2),(1,0),(1,5),(1,7)] + +tm0 = instrument Vibraphone (ss m0 4 50 20) +\end{code} +One fun thing to do with music like this is to combine it with +variations of itself. For example: +\begin{code} +ttm0 = tm0 :=: transpose (12) (revM tm0) +\end{code} + +We could also try the opposite: a simple percussion instrument with no +melodic variation, i.e.\ all rhythm: +\begin{code} +m1 :: [SNote] +m1 = [(1,0),(0.5,0),(0.5,0)] + +tm1 = instrument Percussion (ss m1 4 43 2) +\end{code} +Note that the pitch is transposed by 43, which is the MIDI Key number +for a ``high floor tom'' (i.e.\ percussion sound +|HighFloorTom|---recall the discussion in Section +\ref{sec:percussion}). + +Here is a very simple melody, two different pitches and two different +durations: +\begin{code} +m2 :: [SNote] +m2 = [(dqn,0),(qn,4)] + +tm2 = ss m2 6 50 (1/50) +\end{code} + +Here are some more exotic compositions, combining both melody and +rhythm: +\begin{code} +m3 :: [SNote] +m3 = [(hn,3),(qn,4),(qn,0),(hn,6)] + +tm3 = ss m3 4 50 (1/4) + +ttm3 = let l1 = instrument Flute tm3 + l2 = instrument AcousticBass $ + transpose (-9) (revM tm3) + in l1 :=: l2 + +m4 :: [SNote] +m4 = [ (hn,3),(hn,8),(hn,22),(qn,4),(qn,7),(qn,21), + (qn,0),(qn,5),(qn,15),(wn,6),(wn,9),(wn,19) ] + +tm4 = ss m4 3 50 8 +\end{code} % $ + +%% p3 = [(6/10,2),(13/10,5),(wn,0),(9/10,7)] +%% ss3 = ss p3 4 50 20 + +\newpage + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Experiment with this idea futher, using other melodic seeds, exploring +different depths of the clusters, and so on.} +\end{exercise} + +\begin{exercise}{\em +Note that |concat| is defined as |foldr (++) []|, which means that it +takes a number of steps proportional to the sum of the lengths of the +lists being concatenated; we cannot do any better than this. (If +|foldl| were used instead, the number of steps would be proportional +to the number of lists times their average length.) + +However, |fringe| is not very efficient, for the following reason: +|concat| is being used over and over again, like this: +\begin{spec} +concat [ concat [ ... ], concat [ ... ], concat [ ... ] ] +\end{spec} +This causes a number of steps proportional to the depth of the tree +times the length of the sub-lists; clearly not optimal. + +Define a version of |fringe| that is linear in the total length of +the final list.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Self-Similar Harmony} +\label{sec:self-sim-harmony} + +In the last section we used a melody as a seed, and created longer +melodies from it. Another idea is to stack the melodies vertically. +Specifically, suppose we redefine |fringe| in such a way that it does +not concatenate the sub-clusters together: +\begin{code} + +fringe' :: Int -> Cluster -> [[SNote]] +fringe' 0 (Cluster note cls) = [[note]] +fringe' n (Cluster note cls) = map (fringe (n-1)) cls +\end{code} +Note that this strategy is only applied to the top level---below that +we use fringe. Thus the type of the result is |[[SNote]]|, i.e.\ a +list of lists of notes. + +We can convert the individual lists into melodies, and play the +melodies all together, like this: +\begin{code} +simToMusic' :: [[SNote]] -> Music Pitch +simToMusic' = chord . map (line . map mkNote) +\end{code} + +Finally, we can define a function akin to |ss| defined earlier: +\begin{code} +ss' pat n tr te = + transpose tr $ tempo te $ simToMusic' $ fringe' n $ selfSim pat +\end{code} + +Using some of the same patterns used earlier, here are some sample +compositions (with not necessarily a great outcome...): +\begin{code} +ss1 = ss' m2 4 50 (1/8) +ss2 = ss' m3 4 50 (1/2) +ss3 = ss' m4 3 50 2 +\end{code} +\out{ +p1 = [(hn,3),(qn,4),(qn,0),(wn,6)] +p2 = [(hn,0),(wn,4),(hn,7),(wn,5)] +p3 = [(6/10,2),(13/10,5),(wn,0),(9/10,7)] +p4 = [(hn,3),(hn,8),(hn,22),(qn,4),(qn,7),(qn,21), + (qn,0),(qn,5),(qn,15),(wn,6),(wn,9),(wn,19)] +} + +Here is a new one, based on a major triad: +\begin{code} +m5 = [(en,4),(sn,7),(en,0)] +ss5 = ss m5 4 45 (1/500) +ss6 = ss' m5 4 45 (1/1000) +\end{code} +Note the need to scale the tempo back drastically, due to the short +durations of the starting notes. + +\section{Other Self-Similar Structures} + +The reader will observe that our notion of ``self-similar harmony'' +does not involve changing the structure of the |Cluster| data +type, nor the algorithm for computing the sub-structures (as captured +in |selfSim|). All that we do is interpret the result differently. +This is a common characteristic of algorithmic music composition---the +same mathematical or computational structure is interpreted in +different ways to yield musically different results. + +For example, instead of the above strategy for playing melodies in +parallel, we could play entire levels of the |Cluster| in parallel, +where the number of levels that we choose is given as a parameter. If +alligned properly in time there will be a harmonic relationship +between the levels, which could yield pleasing results. + +The |Cluster| data type is conceptually useful in that is represents +the infinite solution space of self-simlar melodies. And it is +computationally useful in that it is computed to a desired depth only +once, and thus can be inspected and reused without recomputing each +level of the tree. This idea might be useful in the application +mentioned above, namely combining two or more levels of the result in +interesting ways. + +However, the |Cluster| data type is strictly unnecessary, in that, for +example, if we are interested in computing a specific level, we could +define a function that recursed to that level and gave the result +directly, without saving the intermediate levels. + +A final point about the notion of self-similarity captured in this +chapter is that the initial pattern is used as the basis with which to +transform each successive level. Another strategy would be to use the +entirety of each new level as the seed for transforming itself into +the next level. This will result in an exponential blow-up in the +size of each level, but may be worth pursuing---in some sense it is a +simpler notion of self-similarity than what we have used in this +chapter. + +All of the ideas in this section, and others, we leave as exercises for +the reader. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Experiment with the self-similar programs in this chapter. Compose an +interesting piece of music through a judicious choice of starting +melody, depth of recursion, instrumentation, etc.} +\end{exercise} + +\begin{exercise}{\em +Devise an interpretation of a |Cluster| that plays multiple levels of +the |Cluster| in parallel. Try to get the levels to align properly in +time so that each level has the same duration. You may choose to play +all the levels up to a certain depth in parallel, or levels within a +certain range, say levels 3 through 5.} +\end{exercise} + +\begin{exercise}{\em +Define an alternative version of |simToMusic| that interprets the music +differently. For example: +\begin{itemize} +\item Interpret the pitch as an index into a scale---e.g., as an index + into the C major scale, so that 0 corresponds to C, 1 to D, 2 to E, + 3 to F, ..., 6 to B, 7 to C in the next octave, and so on. + +\item Interpret the pitch as duration, and the duration as pitch. +\end{itemize} +} +\end{exercise} + +\begin{exercise}{\em +Modify the self-similar code in the following ways: +\begin{itemize} +\item +Add a Volume component to |SNote| (in other words, define it as a triple +instead of a pair), and redefine |addMult| so that it takes two of these +triples and combines them in a suitable way. Then modify the rest of +the code so that the result is a |Music1| value. With these +modifications, compose something interesting that highlights the +changes in volume. + +\item +Change the |AbsPitch| field in |SNote| to be a list of |AbsPitch|s, to +be interpreted ultimately as a chord. Figure out some way to combine +them in |addMult|, and compose something interesting. +\end{itemize} +} +\end{exercise} + +\begin{exercise}{\em +Devise some other variant of self-similar music, and encode it in +Haskell. In particular, consider structures that are different from +those generated by the |selfSim| function.} +\end{exercise} + +\begin{exercise}{\em +Define a function that gives the same result as |ss|, but without +using a data type such as |Cluster|.} +\end{exercise} + +\begin{exercise}{\em +Define a version of self-similarity similar to that defined in this +chapter, but that uses the entire melody generated at one level to +transform itself into the next level (rather than using the original +seed pattern).} +\end{exercise} + +\vspace{.1in}\hrule
+ HSoM/SigFuns.lhs view
@@ -0,0 +1,1086 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +\out{ +\begin{code} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SigFuns.lhs. (See HSoM/MakeCode.bat.) + +\end{code} +} + +\chapter{Euterpea's Signal Functions} +\label{ch:sigfuns} + +\begin{code} +{-# LANGUAGE Arrows #-} + +module Euterpea.Examples.SigFuns where + +import Euterpea +import Control.Arrow ((>>>),(<<<),arr) +\end{code} + +\syn{The first line in the module header above is a \emph{compiler + pragma}, amd in this case is telling GHC to accept \emph{arrow + syntax}, which will be explained in Section~\ref{sec:sigfuns}.} + +In this chapter we show how the theoretical concepts involving +sound and signals studied in the last chapter are manifested in +Euterpea. The techniques learned will lay the groundwork for doing +two broad kinds of activities: \emph{sound synthesis} and \emph{audio + processing}. Sound synthesis might include creating the sound of a +footstep on dry leaves, simulating a conventional musical instrument, +creating an entirely new instrument sound, or composing a single +``soundscape'' that stands alone as a musical composition. Audio +processing includes such things as equalization, filtering, reverb, +special effects, and so on. In future chapters we will study various +techniques for achieving these goals. + +%% apply these concepts to particular computer music applications. + +\section{Signals and Signal Functions} +\label{sec:sigfuns} + +%% Conceptually, one could think of a signal as a value of type |Signal +%% T| that represents time-varying values of type |T|. For example, +%% |Signal Float| would be a time-varying floating-point number, |Signal +%% AbsPitch| would be a time-varing absolute pitch, and so on. +%% Abstractly, one could therefore think of a signal as a function: +%% \begin{spec} +%% Signal a ==== Time -> a +%% \end{spec} +%% where |Time| is some suitable representation of time. + +As we saw in Chapter \ref{ch:MUI}, it would seem natural to represent +a signal as an abstract type, say |Signal T| in Haskell, and then +define functions to add, multiply, take the sine of, and so on, +signals represented in this way. For example, |Signal Float| would be +the type of a time-varying floating-point number, |Signal AbsPitch| +would be the type of a time-varing absolute pitch, and so on. Then +given |s1,s2 :: Signal Float| we might simply write |s1 + s2|, |s1 * +s2|, and |sin s1| as examples of applying the above operations. +Haskell's numeric type class hierarchy would make this particularly +easy to do. Indeed, several domain-specific languages based on this +approach have been defined before, beginning with the language +\emph{Fran} \cite{Fran} that was designed for writing computer +animation programs. + +But years of experience and theoretical study have revealed that such +an approach leads to a language with subtle time- and +space-leaks,\footnote{A time-leak in a real-time system occurs + whenever a time-dependent computation falls behind the current time + because its value or effect is not needed yet, but then requires + ``catching up'' at a later point in time. This catching up process + can take an arbitrarily long time, and may consume additional space + as well. It can destroy any hope for real-time behavior if not + managed properly.} for reasons that are beyond the scope of this +textbook \cite{Leak07}. Therefore Euterpea takes a somewhat different +approach, as described below. + +%% Earlier versions of Fran, FAL \cite{SOE}, and FRP \cite{Yale-FRP} used +%% various methods to make this performance problem less of an issue, but +%% ultimately they all either suffered from the problem in one way or +%% another, or introduced other problems as a result of fixing it. + +Perhaps the simplest way to understand Euterpea's approach to +programming with signals is to think of it as a language for +expressing \emph{signal processing diagrams} (or equivalently, +electrical circuits). We refer to the lines in a typical signal +processing diagram as \emph{signals}, and the boxes that convert one +signal into another as \emph{signal functions}. For example, this +very simple diagram has two signals, |x| and |y|, and one signal +function, |sigfun|: +\begin{center} + \includegraphics[scale=0.70]{pics/frp-circuit} +\end{center} +Using Haskell's \emph{arrow syntax} \cite{Hughes2000,Paterson2001}, +this diagram can be expressed as a code fragment in Euterpea simply +as: +\begin{spec} +y <- sigfun -< x +\end{spec} +\syn{The syntax |<-| and |-<| is typeset here in an attractive way, + but the user will have to type \verb+<-+ and \verb+-<+, + respectively, in her source file.} + +Arrows and arrow syntax will be described in much more detail in +Chapter~\ref{ch:implementing-sigfuns}. For now, keep in mind that +|<-| and |-<| are part of the \emph{syntax}, and are not simply binary +operators. Indeed, we can't just write the above code fragment +anywhere. It has to be within an enclosing |proc| construct whose +result type is that of a signal function. The |proc| construct begins +with the keyword |proc| along with an argument, analogous to an +anonymous function. For example, a signal function that takes a +signal of type |Double| and adds 1 to every signal sample, and then +applies |sigfun| to the resulting signal, can be written: +\begin{spec} +proc y -> do + x <- sigfun -< y+1 + outA -< x +\end{spec} +\syn{The |do| keyword in arrow syntax introduces layout, just as it + does in monad syntax.} + +%% Also, modules that use the arrow syntax should have a +%% ``.as'' or ``.lhs'' (instead of ``.hs'') extension.} + +Note the analogy of this code to the following snippet involving +an ordinary anonymous function: +\begin{spec} +\ y -> + let x = sigfun (y+1) + in x +\end{spec} +The important difference, however, is that |sigfun| works on a signal, +which we can think of as a stream of values, whose representative +values at the ``point'' level are the variables |x| and |y| above. So +in reality we would have to write something like this: +\begin{spec} +\ ys -> + let xs = sigfun (map (+1) ys) + in xs +\end{spec} +to achieve the effect of the arrow code above. The arrow syntax +allows us to avoid worrying about the streams themselves. It also has +other important advantages that are beyond the scope of the current +discussion. + +Arrow syntax is just that-–-syntactic sugar that is expanded into a +set of conventional functions that work just as well, but are more +cumbersome to program with (just as with monad syntax). This +syntactic expansion will be described in more detail in +Chapter~\ref{ch:implementing-sigfuns}. To use the arrow syntax within +a ``.lhs'' file, one must declare a compiler flag in GHC at the very +beginning of the file, as follows: +\begin{spec} +{-# LANGUAGE Arrows #-} +\end{spec} + +%% We can also create and use signal functions that operate on tuples of +%% signals. For example, a signal function |exp :: SigFun (Double, +%% Double) Double| that raises its first argument to the power of its +%% second, at every point in time, could be used as follows: + +%% \begin{code} +%% z <- exp -< (x,y) +%% \end{code} + +\subsection{The Type of a Signal Function} +\label{sec:sigfun-type} + +Polymorphically speaking, a signal function has type: +\begin{spec} +Clock c => SigFun c a b +\end{spec} +which should be read, ``for some clock type (i.e.\ sampling rate) |c|, +this is the type of signal functions that convert signals of type |a| +into signals of type |b|.'' + +\out{ +\syn{|Signal| is actually not a good name for the type---it should + be something like |SignalFunction| or |SF| and will probably be + renamed in a soon-to-be-released version of Euterpea.} +} + +The type variable |c| indicates what clock rate is being used, and for +our purposes will always be one of two types: |AudRate| or |CtrRate| +(for \emph{audio rate} and \emph{control rate}, respectively). Being +able to express the sampling rate of a signal function is what we call +\emph{clock polymorphism}. Although we like to think of signals as +continuous, time-varying quantities, in practice we know that they are +sampled representations of continous quantities, as discussed in the +last chapter. However, some signals need to be sampled at a very high +rate---say, an audio signal---whereas other signals need not be +sampled at such a high rate---say, a signal representing the setting +of a slider. The problem is, we often want to mix signals sampled at +different rates; for example, the slider might control the volume of +the audio signal. + +One solution to this problem would be to simply sample everything at +the very highest rate, but this is computationally inefficient. A +better approach is to sample signals at their most appropriate rate, +and to perform coercions to ``up sample'' or ``down sample'' a signal +when it needs to be combined with a signal sampled at a different +rate. This is the approach used in Euterpea. + +More specifically, the base type of each signal into and out of a +signal function must satisfy the type class constraint |Clock c|, +where |c| is a \emph{clock type}. The |Clocked| class is defined as: +\begin{spec} +class Clock c where + rate :: c -> Double +\end{spec} +The single method |rate| allows the user to extract the sampling rate +from the type. In Euterpea, the |AudRate| is pre-defined to be 44.1 +kHz, and the |CtrRate| is set at 4.41 kHz. Here are the definitions +of |AudRate| and |CtrRate|, along with their instance declarations in +the |Clock| class, to achieve this: +\begin{spec} +data AudRate +data CtrRate + +instance Clock AudRate where + rate _ = 44100 + +instance Clock CtrRate where + rate _ = 4410 +\end{spec} +Because these two clock types are so often used, it is helpful to +define a couple of type synonyms: +\begin{spec} +type AudSF a b = SigFun AudRate a b +type CtrSF a b = SigFun CtrRate a b +\end{spec} + +From these definitions it should be clear how to define your own clock type. + +\syn{Note that |AudRate| and |CtrRate| have no constructors---they are + called \emph{empty} data types. More precisely, they are each + inhabited by exactly one value, namely |bottom|.} + +The sampling rate can be determined from a given clock type. +In this way, a coercion function can be written to change a signal +sampled at one rate to a signal sampled at some other rate. In +Euterpea, there are two such functions that are pre-defined: +\begin{spec} +coerce, upsample :: (Clock c1, Clock c2) => + SigFun c1 a b -> SigFun c2 a b +\end{spec} +The function |coerce| looks up the sampling rates of the input and +output signals from the type variables |c1| and |c2|. It then either +stretches the input stream by duplicating the same element or +contracts it by skipping elements. (It is also possible to define a +more accurate coercion function that performs interpolation, at the +expense of performance.) + +For simpler programs, the overhead of calling |coerce| might not be +worth the time saved by generating signals with lower resolution. +(Haskell’s fractional number implementation is relatively slow.) The +specialized coercion function |upsample| avoids this overhead, but +only works properly when the output rate is an integral multiple of +the input rate (which is true in the case of |AudRate| and |CtrRate|). + +Keep in mind that one does not have to commit a signal function to a +particular clock rate---it can be left \emph{polymorphic}. Then that +signal function will adapt its sampling rate to whatever is needed in +the context in which it is used. + +%% From a typing perspective, signal functions such as |sigfun| will have +%% a type of the form |SigFun T1 T2|, for some types |T1| and |T2|, in which +%% case |x| will have type |T1|, and |y| will have type |T2|. Although +%% signal functions act on signals, the arrow notation allows one to +%% manipulate the instantaneous values of the signals, such as |x| and +%% |y| above. Not suprisingly, the actual representation of the type SigFun +%% is hidden (i.e.\ |SigFun| is abstract), + +Also keep in mind that a signal function is an abstract function. You +cannot just apply it to an argument like an ordinary function---that +is the purpose of the arrow syntax. There are no values that directly +represent \emph{signals} in Euterpea---there are only signal +\emph{functions}. + +The arrow syntax provides a convenient way to compose signal functions +together---i.e.\ to wire together the boxes that make up a signal +processing diagram. By not giving the user direct access to signals, +and providing a disciplined way to compose signal functions (namely +arrow syntax), time- and space-leaks are avoided. In fact, the +resulting framwework is highly amenable to optimization, although this +requires using special features in Haskell, as described in Chapter +\ref{ch:implementing-sigfuns}. + +A signal function whose type is of the form |Clock c => SigFun c () b| +essentially takes no input, but produces some output of type |b|. +Because of this we often refer to such a signal function as a +\emph{signal source}. + +%% A Euterpea program program expresses the composition of a +%% possibly large number of signal functions into a composite signal +%% function that is then ``run'' at the top level by a suitable +%% interpreter. A good analogy for this idea is a state or IO monad, +%% where the state is hidden, and a program consists of a linear +%% sequencing of actions that are eventually run by an interpreter or the +%% operating system. But in fact arrows are more general than monads, +%% and in particular the composition of signal functions does not have to +%% be completely linear, as will be illustrated shortly. + +\subsection{Four Useful Functions} +\label{sec:useful-funs} + +There are four useful auxiliary functions that will make writing +signal functions a bit easier. The first two essentially ``lift'' +constants and functions from the Haskell level to the arrow (signal +function) level: +\begin{spec} +arr :: Clock c => (a -> b) -> SigFun c a b +constA :: Clock c => b -> SigFun c () b +\end{spec} +For example, a signal function that adds one to every sample of its +input can be written simply as |arr (+1)|, and a signal function that +returns the constant 440 as its result can be written |constA 440| +(and is a signal source, as defined earlier). + +\out{ +\begin{spec} +constA :: Clock c => b -> SigFun c a b +constA y = arr (\_ -> y) +\end{spec} +} + +The other two functions allow us to \emph{compose} signal functions: +\begin{spec} +(>>>) :: Clock clk => + SigFun clk a b -> SigFun clk b c -> SigFun clk a c +(<<<) :: Clock clk => + SigFun clk b c -> SigFun clk a b -> SigFun clk a c +\end{spec} +|(<<<)| is analogous to Haskell's standard composition operator |(.)|, +whereas |(>>>)| is like ``reverse composition.'' + +As an example that combines both of the ideas above, recall the very +first example given in this chapter: +\begin{spec} +proc y -> do + x <- sigfun -< y+1 + outA -< x +\end{spec} +which essentially applies |sigfun| to one plus the input. This signal +function can be written more succinctly as either |arr (+1) >>> sigfun| or +|sigfun <<< arr (+1)|. + +The functions |(>>>)|, |(<<<)|, and |arr| are actually generic +operators on arrows, and are defined in Haskell's |Arrow| library. +Euterpea imports them from there and adds them to the Euterpea +namespace, so they do not have to be explicitly imported by the user. + +\subsection{Some Simple Examples} +\label{sec:sigfun-examples} + +Let's now work through a few examples that focus on the behavior of +signal functions, so that we can get a feel for how they are used in +practice. Euterpea has many pre-defined signal functions, including +ones for sine waves, numeric computations, transcendental functions, +delay lines, filtering, noise generation, integration, and so on. +Many of these signal functions are inspired by csound \cite{csound}, +where they are called \emph{unit generators}. Some of them are not +signal functions \emph{per se}, but take a few fixed arguments to +yield a signal function, and it is important to understand this +distinction. + +For example, there are several pre-defined functions for generating +sine waves and periodic waveforms in Euterpea. Collectively these are +called \emph{oscillators}, a name taken from electronic circuit +design. They are summarized in Figure \ref{fig:oscillators}. + +\begin{figure} +\cbox{ +\begin{spec} +osc, oscI :: Clock c => + Table -> Double -> SigFun c Double Double +\end{spec} + +|osc tab ph| is a signal function whose input is a frequency, and +output is a signal having that frequency. The output is generated +using fixed-waveform table-lookup, using the table |tab|, starting +with initial offset (phase angle) |ph| expressed as a fraction of a +cycle (0 to 1). |oscI| is the same, but uses linear interpolation +between points. +\vspace{0.15in} + +\begin{spec} +oscFixed :: Clock c => + Double -> SigFun c () Double +\end{spec} + +|oscFixed freq| is a signal source whose sinusoidal output frequency +is |freq|. It uses a recurrence relation that requires only one multiply +and two add operations for each sample of output. +\vspace{0.15in} + +\begin{spec} +oscDur, oscDurI :: Clock c => + Table -> Double -> Double -> SigFun () Double +\end{spec} + +|oscDur tab del dur| samples just once through the table |tab| at a +rate determined by |dur|. For the first |del| seconds, the point of +scan will reside at the first location of the table; it will then move +through the table at a constant rate, reaching the end in another +|dur| seconds; from that time on (i.e.\ after |del + dur| seconds) it +will remain pointing at the last location. |oscDurI| is similar but +uses linear interpolation between points. +\vspace{0.15in} + +\begin{spec} +oscPartials :: Clock c => + Table -> Double -> SigFun c (Double,Int) Double +\end{spec} + +|oscPartials tab ph| is a signal function whose pair of inputs +determines the frequency (as with |osc|), as well as the number of +harmonics of that frequency, of the output. |tab| is the table that +is cycled through, and |ph| is the phase angle (as with |osc|). +} +\caption{Euterpea's Oscillators} +\label{fig:oscillators} +\end{figure} + +The two most common oscillators in Euterpea are: +\begin{spec} +osc :: Clock c => + Table -> Double -> SigFun c Double Double +oscFixed :: Clock c => + Double -> SigFun c () Double +\end{spec} +|osc| uses fixed-waveform table-lookup synthesis as described in +Section \ref{sec:wavetable}. The first argument is the fixed +wavetable; we will see shortly how such a table can be generated. The +second argument is the initial phase angle, represented as a fraction +between 0 and 1. The resulting signal function then converts a signal +representing the desired output frequency to a signal that has that +output frequency. + +|oscFixed| uses an efficient recurrence relation to compute a pure +sinusoidal wave; the mathematics of this are described in Section +\ref{sec:sine-recurrence}. In contrast with |osc|, its single +argument is the desired output frequency. The resulting signal +function is therefore a signal source (i.e.\ its input type is |()|). + +\todo{Discuss recurrence relations here or perhaps in the last chapter + where the fixed-waveform table-lookup method is described.} + +The key point here is that the frequency that is output by |osc| is an +\emph{input to the signal function}, and therefore can vary with time, +whereas the frequency output by |oscFixed| is a \emph{fixed argument}, +and cannot vary with time. To see this concretely, let's define a +signal source that generates a pure sine wave using |oscFixed| at a +fixed frequency, say 440 Hz: +\begin{code} +s1 :: Clock c => SigFun c () Double +s1 = proc () -> do + s <- oscFixed 440 -< () + outA -< s +\end{code} +Since the resulting signal |s| is directly returned through |outA|, +this example can also be written: +\begin{spec} +s1 = proc () -> do + oscFixed 440 -< () +\end{spec} +Alternatively, we could simply write |oscFixed 440|. + +To use |osc| instead, we first need to generate a wavetable that +represents one full cycle of a sine wave. We can do this using one of +Eutperpea's table generating functions, which are summarized in +Figure~\ref{fig:table-generators}. For example, using Euterpea's +|tableSinesN| function, we can define: +\begin{code} +tab1 :: Table +tab1 = tableSinesN 4096 [1] +\end{code} +This will generate a table of 4096 elements, consisting of one sine +wave whose peak amplitude is 1.0. Then we can define the following +signal source: +\begin{code} +s2 :: Clock c => SigFun c () Double +s2 = proc () -> do + osc tab1 0 -< 440 +\end{code} +Alternatively, we could use the |const| and composition operators to +write either |constA 440 >>> osc tab1 0| or |osc tab2 0 <<< constA +440|. |s1| and |s2| should be compared closely. + +\begin{figure} +\cbox{\small +\begin{spec} +type TableSize = Int +type PartialNum = Double +type PartialStrength = Double +type PhaseOffset = Double +type StartPt = Double +type SegLength = Double +type EndPt = Double +\end{spec} +\vspace{0.05in} + +\begin{spec} +tableLinear, tableLinearN :: + TableSize -> StartPt -> [(SegLength, EndPt)] -> Table +\end{spec} +|tableLinear size sp pts| is a table of size |size| whose starting +point is |(0,sp)| and that uses straight lines to move from that point +to, successively, each of the points in |pts|, which are +segment-length/endpoint pairs (segment lengths are projections along +the x-axis). |tableLinearN| is a normalized version of the result. +\vspace{0.15in} + +\begin{spec} +tableExpon, tableExponN :: + TableSize -> StartPt -> [(SegLength, EndPt)] -> Table +\end{spec} + +Just like |tableLinear| and |tableLinearN|, respectively, except that +exponential curves are used to connect the points. +\vspace{0.15in} + +\begin{spec} +tableSines3, tableSines3N :: + TableSize -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table +\end{spec} + +|tableSines3 size triples| is a table of size |size| that represents a +sinusoidal wave and an arbitrary number of partials, whose +relationship to the fundamental frequency, amplitude, and phase are +determined by each of the triples in |triples|. |tableSines3N| is a +normalized version of the result. +\vspace{0.15in} + +\begin{spec} +tableSines, tableSinesN :: + TableSize -> [PartialStrength] -> Table +\end{spec} + +Like |tableSines3| and |tableSines3N|, respectively, except that the +second argument is an ordered list of the strengths of each partial, +starting with the fundamental. +\vspace{0.15in} + +\begin{spec} +tableBesselN :: + TableSize -> Double -> Table +\end{spec} + +|tableBesselN size x| is a table representing the log of a modified +Bessel function of the second kind, order 0, suitable for use in +amplitude-modulated FM. |x| is the x-interval (0 to |x|) over which +the function is defined. +} +\caption{Table Generating Functions} +\label{fig:table-generators} +\end{figure} + +Keep in mind that |oscFixed| only generates a sine wave, whereas |osc| +generates whatever is stored in the wavetable. Indeed, |tableSinesN| +actually creates a table that is the sum of a series of overtones, +i.e.\ multiples of the fundmental frequency (recall the discussion in +Section~\ref{sec:spectrum}). For example: +\begin{code} +tab2 = tableSinesN 4096 [1.0,0.5,0.33] +\end{code} +generates a waveform consisting of the fundamental frequency with +amplitude 1.0, the first overtone at amplitude 0.5, and the second +overtone at amplitude 0.33. So a more complex sound can be +synthesized just by changing the wavetable: +\begin{code} +s3 :: Clock c => SigFun c () Double +s3 = proc () -> do + osc tab2 0 -< 440 +\end{code} +To get the same effect using |oscFixed| we would have to write: +\begin{code} +s4 :: Clock c => SigFun c () Double +s4 = proc () -> do + f0 <- oscFixed 440 -< () + f1 <- oscFixed 880 -< () + f2 <- oscFixed 1320 -< () + outA -< (f0 + 0.5*f1 + 0.33*f2) / 1.83 +\end{code} +Not only is this more complex, it is less efficient. (The division by +1.83 is to normalize the result---if the peaks of the three signals +|f0|, |f1|, and |f2| align properly, the peak amplitude will be 1.83 +(or -1.83), which is outside the range $\pm 1.0$ and may cause +clipping (see discussion in Section~\ref{sec:generating-sound}). + +So far in these examples we have generated a signal whose fundamental +frequency is 440 Hz. But as mentioned, in the case of |osc|, the +input to the oscillator is a signal, and can therefore itself be +time-varying. As an example of this idea, let's implement +\emph{vibrato}---the performance effect whereby a musician slightly +varies the frequency of a note in a pulsating rhythm. On a string +instrument this is typically achieved by wiggling the finger on the +fingerboard, on a reed instrument by an adjustment of the breath and +emboucher to compress and relax the reed in a suitable way, and so on. + +Specifically, let's define a function: +\begin{spec} +vibrato :: Clock c => + Double -> Double -> SigFun c Double Double +\end{spec} +such that |vibrato f d| is a signal function that takes a frequency +argument (this is not a signal of a given frequency, it is the +frequency itself), and generates a signal at that frequency, but with +vibrato added, where |f| is the vibrato frequency, and |d| is the +vibrato depth. We will consider ``depth'' to be a measure of how many +Hz the input frequency is modulated. + +Intuitively, it seems as if we need \emph{two} oscillators, one to +generate the fundamental frequency of interest, and the other to +generate the vibrato (much lower in frequency). Here is a solution: +\begin{code} +vibrato :: Clock c => + Double -> Double -> SigFun c Double Double +vibrato vfrq dep = proc afrq -> do + vib <- osc tab1 0 -< vfrq + aud <- osc tab2 0 -< afrq + vib * dep + outA -< aud +\end{code} +Note that a pure sine wave is used for the vibrato signal, whereas +|tab2|, a sum of three sine waves, is chosen for the signal itself. + +For example, to play a 1000 Hz tone with a vibrato frequency of 5 Hz +and a depth of 20 Hz, we could write: +\begin{code} +s5 :: AudSF () Double +s5 = constA 1000 >>> vibrato 5 20 +\end{code} + +Vibrato is actually an example of a more general sound synthesis +technique called \emph{frequency modulation} (since one signal is +being used to vary, or modulate, the frequency of another signal), and +will be explained in more detail in Chapter~\ref{ch:fm}. Other +chapters include synthesis techniques such as additive and subtractive +synthesis, plucked instruments using waveguides, physical modeling, +granular synthesis, as well as audio processing techniques such as +filter design, reverb, and other effects. Now that we have a basic +understanding of signal functions, these techniques will be +straighforward to express in Euterpea. + +\section{Generating Sound} +\label{sec:generating-sound} + +Euterpea can execute some programs in real-time, but sufficiently +complex programs require writing the result to a file. The function +for achieving this is: +\begin{spec} +outFile :: (AudioSample a, Clock c) => + String -> Double -> SigFun c () a -> IO () +\end{spec} +%% outFile :: forall a p. (AudioSample a, Clock p) => +%% String -- ^ Filename to write to. +%% -> Double -- ^ Duration of the wav in seconds. +%% -> SigFun p () a -- ^ Signal representing the sound. +%% -> IO () +The first argument is the name of the WAV file to which the result is +written. The second argument is the duration of the result, in +seconds (remember that signals are conceptually infinite). The third +argument is a signal function that takes no input and generates a +signal of type |a| as output (i.e.\ a signal source), where |a| is +required to be an instance of the |AudioSample| type class, which +allows one to choose between mono, stereo, etc. + +For convenience, Euterpea defines these type synonyms: +\begin{spec} +type Mono p = SigFun p () Double +type Stereo p = SigFun p () (Double,Double) +\end{spec} + +For example, the IO command |outfile "test.wav" 5 sf| generates 5 +seconds of output from the signal function |sf|, and writes the result +to the file |"test.wav"|. If |sf| has type |Mono AudRate| +(i.e.\ |SigFun AudRate () Double| then the result will be monophonic; +if the type is |Stereo AudRate| (i.e.\ |SigFun AudRate () +(Double,Double)| the result will be stereophonic. + +%% |SigFun AudRate () (Double,Double,Double,Double)| yields +%% quadraphonic sound, and so on. + +One might think that |outFile| should be restricted to |AudRate|. +However, by allowing a signal of any clock rate to be written to a +file, one can use external tools to analyze the result of control +signals or other signals of interest as well. + +An important detail in writing WAV files with |outFile| is that care +must be taken to ensure that each sample falls in the range $\pm 1.0$. +If this range is exceeded, the output sound will be harshly distorted, +a phenomenon known as \emph{clipping}. The reason that clipping +sounds especially bad is that once the maximum limit is exceeded, the +subsequent samples are interpreted as the \emph{negation} of their +intended value---and thus the signal swings abruptly from its largest +possible value to its smallest possible value. Of course, signals +within your program may be well outside this range---it is only when +you are ready to write the result to a file that clipping needs to be +avoided. + +One can easily write signal functions that deal with clipping in one +way or another. For example here's one that simply returns the +maximum (positive) or mininum (negative) value if they are exceeded, +thus avoiding the abrupt change in magnitude described above, and +degenerating in the worst case to a square wave: +\begin{code} +simpleClip :: Clock c => SigFun c Double Double +simpleClip = arr f where + f x = if abs x <= 1.0 then x else signum x +\end{code} +\syn{|abs| is the absolute value function in Haskell, and |signum| + returns -1 for negative numbers, 0 for zero, and 1 for positive + numbers.} + +\todo{Define some signal functions to deal with time---for example + one that ``takes'' the first |t| seconds of a signal function, + returning zero for all times beyond that. We could write a special + function to do this, but using Occam's Razor suppose we have a signal + function |time :: Clock c => SigFun c () Double| that returns the + current time. Then we could write: +\begin{spec} +takeSF :: Clock c => Double -> SigFun c Double Double +takeSF t = proc x do + now <- time -< () + outA -< if now < t then x else 0 +\end{spec} +Indeed, time can be defined by: +\begin{code} +time :: Clock c => SigFun c () Double +time = integral <<< constA 1 +\end{code} + +Or, we could take a Yampa-like approach and use a ``switcher,'' but +then we'd need some switcher signal functions. There is a +collection-based switcher defined in |Euterpea.Audio.Render| called +|pSwitch|, but we might want something simpler. + +Even with all this, it seems desirable to have a ``debug'' function +that takes a time and a signal function, and returns a Boolean +indicating whether or not the signal function clipped or not during +that period of time. Again using Occam's razor, it seems best to +define a function |sfToList| that returns the infinite list underlying +a signal source. If we know the clock rate, then ``take''ing a +suitable prefix of this list will return the desired result. Then, +for example, |max (take 44100 (sfToList ss))| yields the maximum value +of the first 44100 samples of the signal source |ss|. One could then +use this to normalize the |ss|. + +Note that |sfToList| is not something that can be defined using +Euterpea as a library---it would have to be defined within +Euterpea's implementation of signal functions. +} + +\section{Instruments} +\label{sec:euterp-instruments} + +So far we have only considered signal functions as stand-alone values +whose output we can write to a WAV file. But how do we connect the +ideas in previous chapters about |Music| values, |Performance|s, and +so on, to the ideas presented in this chapter? This section presents +a bridge between the two worlds. + +\subsection{Turning a Signal Function into an Instrument} + +Suppose that we have a |Music| value that, previously, we would have +played using a MIDI instrument, and now we want to play using an +instrument that we have designed using signal functions. To do this, +first recall from Chapter~\ref{ch:music} that the |InstrumentName| +data type has a special constructor called |Custom|: +\begin{spec} +data InstrumentName = + AcousticGrandPiano + | BrightAcousticPiano + | ... + | Custom String + deriving (Show, Eq, Ord) +\end{spec} +With this constructor, names (represented as strings) can be given to +instruments that we have designed using signal functions. For +example: +\begin{code} +simpleInstr :: InstrumentName +simpleInstr = Custom "Simple Instrument" +\end{code} + +Now we need to define the instrument itself. Euterpea defines the +following type synonym: +\begin{spec} +type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a +\end{spec} +Although |Instr| is polymorphic, by far its most common instantiation +is the type |Instr (AufSF () Double)|. An instrument of this type is +a function that takes a duration, absolute pitch, volume, and a list +of parameters, and returns a signal source that generates the +resulting sound. + +The list of parameters (similar to the ``pfields'' in csound) are not +used by MIDI instruments, and thus have not been discussed until now. +They afford us unlimited expressiveness in controlling the sound of +our signal-function based instruments. Recall from +Chapter~\ref{ch:performance} the types: +\begin{spec} +type Music1 = Music Note1 +type Note1 = (Pitch, [NoteAttribute]) + +data NoteAttribute = + Volume Int + | Fingering Integer + | Dynamics String + | Params [Double] + deriving (Eq, Show) +\end{spec} +Using the |Params| constructor, each individual note in a |Music1| +value can be given a different list of parameters. It is up to the +instrument designer to decide how these parameters are used. + +There are three steps to playing a |Music| value using a user-defined +instrument. First, we must coerce our signal function into an +instrument having the proper type |Instr| as described above. For +example, let's turn the |vibrato| function from the last section into +a (rather primitive) instrument: +\begin{code} +myInstr :: Instr (AudSF () Double) + -- |Dur -> AbsPitch -> Volume -> [Double] -> (AudSF () Double)| +myInstr dur ap vol [vfrq,dep] = + proc () -> do + vib <- osc tab1 0 -< vfrq + aud <- osc tab2 0 -< apToHz ap + vib * dep + outA -< aud +\end{code} +Aside from the re-shuffling of arguments, note the use of the function +|apToHz|, which converts an absolute pitch into its corresponding +frequency: +\begin{spec} +apToHz :: Floating a => AbsPitch -> a +\end{spec} + +Next, we must connect our instrument name (used in the |Music| value) +to the instrument itself (such as defined above). This is achieved +using a simple association list, or \emph{instrument map}: +\begin{spec} +type InstrMap a = [(InstrumentName, Instr a)] +\end{spec} +Continuing the example started above: +\begin{code} +myInstrMap :: InstrMap (AudSF () Double) +myInstrMap = [(simpleInstr, myInstr)] +\end{code} + +Finally, we need a function that is analogous to |perform| from +Chapter~\ref{ch:performance}, except that instead of generating a +|Performance|, it creates a single signal function that will ``play'' +our |Music| value for us. In Euterpea that function is called +|renderSF|: +\begin{spec} +renderSF :: (Performable a, AudioSample b, Clock c) => + Music a -> + InstrMap (SigFun p () b) -> + (Double, SigFun p () b) +\end{spec} +The first element of the pair that is returned is the duration of the +|Music| value, just as is returned by |perform|. That way we know how +much of the signal function to render in order to hear the entire +composition. + +Using the simple melody |mel| in Figure~\ref{fig:reflections}, and the +simple vibrato instrument defined above, we can generate our result +and write it to a file, as follows: +\begin{code} +(dr, sf) = renderSF mel myInstrMap +main = outFile "simple.wav" dr sf +\end{code} +For clarity we show in Figure~\ref{fig:sf-instrument} all of the +pieces of this running example as one program. + +\begin{figure} +\cbox{ +\begin{code} +mel :: Music1 +mel = + let m = Euterpea.line [ na1 (c 4 en), na1 (ef 4 en), na1 (f 4 en), + na2 (af 4 qn), na1 (f 4 en), na1 (af 4 en), + na2 (bf 4 qn), na1 (af 4 en), na1 (bf 4 en), + na1 (c 5 en), na1 (ef 5 en), na1 (f 5 en), + na3 (af 5 wn) ] + na1 (Prim (Note d p)) = Prim (Note d (p,[Params [0, 0]])) + na2 (Prim (Note d p)) = Prim (Note d (p,[Params [5,10]])) + na3 (Prim (Note d p)) = Prim (Note d (p,[Params [5,20]])) + in instrument simpleInstr m +\end{code}} +\caption{A Simple Melody} +\label{fig:reflections} +\end{figure} + +\begin{figure} +\cbox{ +\begin{spec} +simpleInstr :: InstrumentName +simpleInstr = Custom "Simple Instrument" + +myInstr :: Instr (AudSF () Double) +myInstr dur ap vol [vfrq,dep] = + proc () -> do + vib <- osc tab1 0 -< vfrq + aud <- osc tab2 0 -< apToHz ap + vib * dep + outA -< aud + +myInstrMap :: InstrMap (AudSF () Double) +myInstrMap = [(simpleInstr, myInstr)] + +(d, sf) = renderSF mel myInstrMap +main = outFile "simple.wav" d sf +\end{spec}} +\caption{A Complete Example of a Signal-Function Based Instrument} +\label{fig:sf-instrument} +\end{figure} + +\subsection{Envelopes} +\label{sec:envelopes} + +Most instruments played by humans have a distinctive sound that is +partially dependent on how the performer plays a particular note. For +example, when a wind instrument is played (whether it be a flute, +saxophone, or trumpet), the note does not begin instantaneously---it +depends on how quickly and forcibly the performer blows into the +instrument. This is called the ``attack.'' Indeed, it is not +uncommon for the initial pulse of energy to generate a sound that is +louder than the ``sustained'' portion of the sound. And when the note +ends, the airflow does not stop instantaneously, so there is +variability in the ``release'' of the note. + +The overall variability in the loudness of a note can be simulated by +multiplying the output of a signal function by an \emph{envelope}, +which is a time-varying signal that captures the desired behavior. +Indeed, the \emph{ADSR envelope} (attack, decay, sustain, release) +introduced above is one of the most common envelopes used in practice. +It is shown pictorially in Figure \ref{fig:ADSR}. Before defining it +in Euterpea, however, we first describe a collection of simpler +envelopes. + +\begin{figure} +... +\caption{ADSR Envelope} +\label{fig:ADSR} +\end{figure} + +Figure~\ref{fig:line-envelopes} shows six pre-defined +envelope-generating functions. Read the code comments carefully to +understand what they do. + +\begin{figure} +\cbox{\small +\begin{spec} +-- a linear envelope +envLine :: Clock p => + Double -> -- starting value + Double -> -- duration in seconds + Double -> -- value after dur seconds + SigFun p () Double + +-- an exponential envelope +envExpon :: Clock p => + Double -> -- starting value; zero is illegal for exponentials + Double -> -- duration in seconds + Double -> -- value after dur seconds (must be non-zero + -- and agree in sign with first argument) + SigFun p () Double + +-- a series of linear envelopes +envLineSeg :: Clock p => + [Double] -> -- list of points to trace through + [Double] -> -- list of durations for each line segment + -- (one element fewer than previous argument) + SigFun p () Double + +-- a series of exponential envelopes +envExponSeg :: Clock p => + [Double] -> -- list of points to trace through + [Double] -> -- list of durations for each line segment + -- (one element fewer than previous argument) + SigFun p () Double + +-- an ``attack/decay/release'' envelope; each segment is linear +envASR :: Clock p => + Double -> -- rise time in seconds + Double -> -- overall duration in seconds + Double -> -- decay time in seconds + SigFun p () Double + +-- a more sophisticated ASR +envCSEnvlpx :: Clock p => + Double -> -- rise time in seconds + Double -> -- overall duration in seconds + Double -> -- decay time in seconds + Table -> -- table representing rise shape + Double -> -- attenuation factor, by which the last value + -- of the envlpx rise is modified during the + -- note's pseudo steady state + Double -> -- attenuation factor by which the closing + -- steady state value is reduced exponentially + -- over the decay period + SigFun p () Double +\end{spec}} +\caption{Envelopes} +\label{fig:line-envelopes} +\end{figure} + +Here are some additional comments regarding |envCSEnvplx|, easily the +most sophisticated of the envelope generators: +\begin{enumerate} +\item +The fifth argument to |envCSEnvplx|: A value greater than 1 causes +exponential growth; a value less than 1 causes exponential decay; a +value = 1 will maintain a true steady state at the last rise +value. The attenuation is not by a fixed rate (as in a piano), but is +sensitive to a note's duration. However, if this argument is less than +0 (or if steady state is less than 4 k-periods) a fixed attenuation +rate of |abs atss| per second is used. A value of 0 is illegal. +\item +The sixth arg to |envCSEnvplx|: Must be positive and is normally of the +order of 0.01. A large or excessively small value is apt to produce a +cutoff that is not audible. Values less than or equal to 0 are +disallowed. +\end{enumerate} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Using the Euterpea function |osc|, create a simple sinusoidal wave, +but using different table sizes, and different frequencies, and see if +you can hear the differences (report on what you hear). Use |outFile| +to write your results to a file, and be sure to use a decent set of +speakers or headphones.} +\end{exercise} + +\begin{exercise}{\em +The |vibrato| function varies a signal’s frequency at a given rate and +depth. Define an analogous function |tremolo| that varies the volume +at a given rate and depth. However, in a sense, |tremolo| is a kind +of envelope (infinite in duration), so define it as a signal source, +with which you can then shape whatever signal you wish. Consider the +``depth'' to be the fractional change to the volume; that is, a value +of 0 would result in no tremolo, a value of 0.1 would vary the +amplitude from 0.9 to 1.1, and so on. Test your result.} +\label{ex:tremolo} +\end{exercise} + +\begin{exercise}{\em +Define an ADSR (``attack/decay/sustain/release'') envelope generator +(i.e. a signal source) called |envADSR|, with type: +\begin{spec} +type DPair = (Double, Double) -- pair of duration and amplitude +envADSR :: DPair -> DPair -> DPair -> Double -> AudSF () Double +\end{spec} +The three |DPair| arguments are the duration and amplitude of the +attack, decay, and release ``phases,'' respectively, of the envelope. +The sustain phase should hold the last value of the decay phase. The +fourth argument is the duration of the entire envelope, and thus the +duration of the sustain phase should be that value minus the sum of +the durations of the other three phases. (Hint: use Euterpea’s +|envLineSeg| function.) Test your result. } +\end{exercise} + +\begin{exercise}{\em +Generate a signal that causes clipping, and listen to the result. +Then use |simpleClip| to ``clean it up'' somewhat---can you hear the +difference? Now write a more ambitious clipping function. In +particular, one that uses some kind of non-linear reduction in the +signal amplitude as it approaches plus or minus one (rather than +abruptly ``sticking'' at plus or minus one, as in |simpleClip|).} +\end{exercise} + +\begin{exercise}{\em +Define two instruments, each of type |Instr (AudSF () Double)|. These +can be as simple as you like, but each must take at least two +|Params|. Define an |InstrMap| that uses these, and then use +|renderSF| to ``drive'' your instruments from a |Music1| value. Test +your result.} +\end{exercise} + +\vspace{.1in}\hrule
+ HSoM/Signals.lhs view
@@ -0,0 +1,804 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +% ToDo: +% add remaining figures + +%include lhs2TeX.fmt +%include myFormat.fmt + +\chapter{Sound and Signals} +\label{ch:signals} + +In this chapter we study the fundamental nature of sound and its basic +mathematical representation as a signal. We also discuss discrete +digital representations of a signal, which form the basis of modern +sound synthesis and audio processing. + +% Taken from Chapter 2 of the text, and +% Blair School of Music (BSoM) http://www.computermusicresource.com/ + +\section{The Nature of Sound} +\label{sec:sound} + +Before studying digital audio, it's important that we first know what +\emph{sound} is. In essence, sound is the rapid compression and +relaxation of air, which travels as a \emph{wave} through the air from +the physical source of the sound to, ultimately, our ears. The +physical source of the sound could be the vibration of our vocal +chords (resulting in speech or singing), the vibration of a speaker +cone, the vibration of a car engine, the vibration of a string in a +piano or violin, the vibration of the reed in a saxophone or of +the lips when playing a trumpet, or even the (brief and chaotic) +vibrations that result when our hands come together as we clap. +The ``compression and relaxation'' of the air (or of a coiled spring) +is called a \emph{longitudinal} wave, in which the vibrations occur +parallel to the direction of travel of the wave. In contrast, a rope +that is fixed at one end and being shaken at the other, and a wave in +the ocean, are examples of a \emph{transverse} wave, in which the +rope's and water's movement is perpendicular to the direction the wave +is traveling. + +[Note: There are some great animations of these two kinds of waves at: +\newline + \verb|http://www.computermusicresource.com/what.is.sound.html|.] + +If the rate and amplitude of the sound are within a suitable range, we +can \emph{hear} the sound---i.e.\ it is \emph{audible sound}. +``Hearing'' results when the vibrating air waves cause our ear drum to +vibrate, in turn stimulating nerves that enter our brain. Sound above +our hearing range (i.e.\ vibration that is too quick to induce any +nerve impulses) is called \emph{ultrasonic sound}, and sound below our +hearing range is said to be \emph{infrasonic}. + +Staying within the analog world, sound can also be turned into an +\emph{electrical} signal using a \emph{microphone} (or ``mic'' for +short). Several common kinds of microphones are: +\begin{enumerate} +\item Carbon microphone. Based on the resistance of a pocket of + carbon particles that are compressed and relaxed by the sound waves + hitting a diaphram. +\item Condenser microphone. Based on the capacitance between two + diaphrams, one being vibrated by the sound. +\item Dynamic microphone. Based on the inductance of a coil of wire + suspended in a magnetic field (the inverse of a speaker). +\item Piezoelectric microphone. Based on the property of certain + crystals to induce current when they are bent. +\end{enumerate} + +\begin{figure}[hbtp] +\centering +\includegraphics[height=4in,angle=270]{pics/sinewave.eps} +\caption{A Sine Wave} +\label{fig:sine-wave} +\end{figure} + +Perhaps the most common and natural way to represent a wave +diagrammatically, whether it be a sound wave or electrical wave, +longitudinal or transverse, is as a \emph{graph} of its amplitude +vs.\ time. For example, Figure \ref{fig:sine-wave} shows a +\emph{sinusiodal wave} of 1000 cycles per second, with an amplitude +that varies beween +1 and -1. A sinusoidal wave follows precisely the +definition of the mathematical sine function, but also relates +strongly, as we shall soon see, to the vibration of sound produced by +most musical instruments. In the remainder of this text, we will +refer to a sinusoidal wave simply as a sine wave. + +%% \begin{figure*} +%% \centerline{ +%% \epsfysize=2in +%% \epsfbox{pics/sinewave.eps} +%% } +%% \caption{A Sine Wave} +%% \label{fig:sine-wave} +%% \end{figure*} + +%% Perhaps the most natural way to draw sound is the same as for an +%% electrical signal---that is, as a \emph{graph} of its amplitude +%% vs.\ time. For example, see Figure \ref{fig:signal-graph}. This same +%% representation can be used to represent both logitudinal and +%% transverse waves. + +\emph{Acoustics} is the study of the properties, in particular the +propagation and reflection, of sound. \emph{Psychoacoustics} is the +study of the mind's interpretation of sound, which is not always as +tidy as the physical properties that are manifest in acoustics. +Obviously both of these are important areas of study for music in +general, and therefore play an important role in generating or +simulating music with a computer. + +The speed of sound can vary considerably, depending on the material, +the temperature, the humidity, and so on. For example, in dry air at +room temperature (68 degrees Farenheit), sound travels at a rate of +1,125 feet (343 meters) per second, or 768 miles (1,236 kilometers) +per hour. Perhaps surprisingly, the speed of sound varies little with +respect to air pressure, although it does vary with temperature. + +The reflection and absorbtion of sound is a much more difficult topic, +since it depends so much on the material, the shape and thickness of +the material, and the frequency of the sound. Modeling well the +acoustics of a concert hall, for example, is quite challenging. To +understand how much such reflections can affect the overall sound that +we hear, consider a concert hall that is 200 feet long and 100 feet +wide. Based on the speed of sound given above, it will take a sound +wave $\nicefrac{2\times200}{1125} = 0.355$ seconds to travel from the +front of the room to the back of the room and back to the front again. +That $\nicefrac{1}{3}$ of a second, if loud enough, would result in a +significant distortion of the music, and corresponds to about one beat +with a metronome set at 168. + +With respect to our interpretation of music, sound has (at least) +three key properties: +\begin{enumerate} +\item \emph{Frequency} (perceived as \emph{pitch}). +\item \emph{Amplitude} (perceived as \emph{loudness}). +\item \emph{Spectrum} (perceived as \emph{timbre}). +\end{enumerate} +We discuss each of these in the sections that follow. + +%% \subsection{Review of Trigonometric Identities} + +%% In preparation for what follows, we quickly review some basic +%% properties of trigonometric functions that are useful for audio +%% processing. In general, all of the transcendental functions have a +%% use in audio processing and computer music applications, but our focus +%% here is on sine and cosine. + +\subsection{Frequency and Period} +\label{sec:frequency} + +The \emph{frequency} $f$ is simply the rate of the vibrations (or +repetitions, or cycles) of the sound, and is the inverse of the +\emph{period} (or duration, or wavelength) $p$ of each of the +vibrations: +\[ f = \frac{1}{p} \] +Frequency is measured in \emph{Hertz} (abbreviated Hz), where 1 Hz is +defined as one cycle per second. For example, the sound wave in +Figure \ref{fig:sine-wave} has a frequency of 1000 Hz (i.e.\ 1 kHz) +and a period of $\nicefrac{1}{1000}$ second (i.e.\ 1 ms). + +In trigonometry, functions like sine and cosine are typically applied +to angles that range from 0 to 360 degrees. In audio processing (and +signal processing in general) angles are instead usually measured in +\emph{radians}, where $2\pi$ radians is equal to $360^\circ$. Since +the sine function has a period of $2\pi$ and a frequency of +$\nicefrac{1}{2\pi}$, it repeats itself every $2\pi$ radians: +\[ \sin (2\pi k + \theta) = \sin \theta \] +for any integer $k$. + +But for our purposes it is better to parameterize these functions over +frequency as follows. Since $\sin(2\pi t)$ covers one full cycle in +one second, i.e.\ has a frequency of 1 Hz, it makes sense that +$\sin(2\pi f t)$ covers $f$ cycles in one second, i.e.\ has a frequency +of $f$. Indeed, in signal processing the quantity $\omega$ is defined +as: +\[ \omega = 2 \pi f \] +That is, a pure sine wave as a function of time behaves as +$\sin(\omega t)$. + +Finally, it is convenient to add a \emph{phase} (or \emph{phase + angle}) to our formula, which effectively shifts the sine wave in +time. The phase is usually represented by $\phi$. Adding a +multiplicative factor $A$ for amplitude (see next section), we arrive +at our final formula for a sine wave as a function of time: +\[ s(t) = A\sin(\omega t + \phi) \] +A negative value for $\phi$ has the effect of ``delaying'' the sine +wave, whereas a positive value has the effect of ``starting early.'' +Note also that this equation holds for negative values of $t$. + +All of the above can be related to cosine by recalling the following +identity: +\[ \sin(\omega t + \dfrac{\pi}{2}) = \cos(\omega t) \] +More generally: +\[ A \sin(\omega t + \phi) = a\cos(\omega t) + b\sin(\omega t) \] +Given $a$ and $b$ we can solve for $A$ and $\phi$: +\[\begin{array}{lcl} +A &=& \sqrt{a^2 + b^2} \\[.05in] +\phi &=& \tan^{-1} \dfrac{b}{a} +\end{array}\] +Given $A$ and $\phi$ we can also solve for $a$ and $b$: +\[\begin{array}{lcl} +a &=& A\cos(\phi) \\ +b &=& A\sin(\phi) +\end{array}\] + +\subsection{Amplitude and Loudness} +\label{sec:amplitude} + +Amplitude can be measured in several ways. The \emph{peak amplitude} +of a signal is its maximum deviation from zero; for example our sine +wave in Figure \ref{fig:sine-wave} has a peak amplitude of 1. But +different signals having the same peak amplitude have more or less +``energy,'' depending on their ``shape.'' For example, Figure +\ref{fig:rms} shows four kinds of signals: a sine wave, a square wave, +a sawtooth wave, and a triangular wave (whose names are suitably +descriptive). Each of them has a peak amplitude of 1. But, +intuitively, one would expect the square wave, for example, to have +more ``energy,'' or ``power,'' than a sine wave, because it is +``fatter.'' In fact, it's value is everywhere either +1 or -1. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=3in,angle=270]{pics/sine_rms.eps} +\includegraphics[height=3in,angle=270]{pics/square_rms.eps} +\includegraphics[height=3in,angle=270]{pics/sawtooth_rms.eps} +\includegraphics[height=3in,angle=270]{pics/triangle_rms.eps} +\caption{RMS Amplitude for Different Signals} +\label{fig:rms} +\end{figure} + +To measure this characteristic of a signal, scientists and engineers +often refer to the \emph{root-mean-square} amplitude, or RMS. +Mathematically, the root-mean-square is the square root of the mean of +the squared values of a given quantity. If $x$ is a discrete quantity +given by the values $x_1, x_2, ..., x_n$, the formula for RMS is: + +\[ x_{\rm RMS} = \sqrt{\frac{x_1^2 + x_2^2 + ... + x_n^2}{n}} \] + +And if $f$ is continuous function, its RMS value over the interval $T_1 +\leq t \leq T_2$ is given by: + +\[ \sqrt{{\frac{1}{T_2-T_1}}\int_{-T_1}^{T_2}f(t)^2dt} \] + +For a sine wave, it can be shown that the RMS value is approximately +0.707 of the peak value. For a square wave, it is 1.0. And for both +a sawtooth wave and a triangular wave, it is approximately 0.577. +Figure \ref{fig:rms} shows these RMS values superimposed on each of +the four signals. + +Another way to measure amplitude is to use a relative logarithmic +scale that more aptly reflects how we hear sound. This is usually +done by measuring the sound level (usually in RMS) with respect to +some reference level. The number of \emph{decibels} (dB) of sound +is given by: +\[ S_{dB} = 10 \log_{10}\frac{S}{R} \] +where $S$ is the RMS sound level, and $R$ is the RMS reference +level. The accepted reference level for the human ear is $10^{-12}$ +watts per square meter, which is roughly the threshold of hearing. + +A related concept is the measure of how much useful information is in +a signal relative to the ``noise.'' The \emph{signal-to-noise ratio}, +or $\mathit{SNR}$, is defined as the ratio of the \emph{power} of each +of these signals, which is the square of the RMS value: +\[ \mathit{SNR} = \left(\frac{S}{N}\right)^2 \] +where $S$ and $N$ are the RMS values of the signal and noise, +respectively. As is often the case, it is better to express this on a +logarithmic scale, as follows: +\[\begin{array}{lcl} +\mathit{SNR}_{dB} &=& 10 \log_{10}\left(\dfrac{S}{N}\right)^2 \\[0.12in] + &=& 20 \log_{10}\dfrac{S}{N} +\end{array}\] + +The \emph{dynamic range} of a system is the difference between the +smallest and largest values that it can process. Because this range +is often very large, it is usually measured in decibels, which is a +logarithmic quantity. The ear, for example, has a truly remarkable +dynamic range---about 130 dB. To get some feel for this, silence +should be considered 0 dB, a whisper 30 dB, normal conversation about +60 dB, loud music 80 dB, a subway train 90 dB, and a jet plane taking +off or a very loud rock concert 120 dB or higher. + +Note that if you double the sound level, the decibels increase by +about 3 dB, whereas a million-fold increase corresponds to 60 dB: +\[\begin{array}{lclcl} +10 \log_{10}2 &=& 10 \times 0.301029996 &\cong& 3 \\ +10 \log_{10}10^6 &=& 10 \times 6 &=& 60 \\ +\end{array}\] +So the ear is truly adaptive! (The eye also has a large dynamic range +with respect to light intensity, but not quite as much as the ear, and +its response time is much slower.) + +\begin{figure}[hbtp] +\centering +\includegraphics[height=4in]{pics/equal_loudness_contour.eps} +\caption{Fletcher-Munson Equal Loudness Contour} +\label{fig:fletcher-munson} +\end{figure} + +Loudness is the perceived measure of amplitude, or volume, of sound, +and is thus subjective. It is most closely aligned with RMS +amplitude, with one important exception: loudness depends somewhat on +frequency! Of course that's obvious for really high and really low +frequencies (since at some point we can't hear them at all), but in +between things aren't constant either. Furthermore, no two humans are +the same. Figure \ref{fig:fletcher-munson} shows the +\emph{Fletcher-Munson Equal-Loudness Contour}, which reflects the +perceived equality of sound intensity by the average human ear with +respect to frequency. Note from this figure that: +\begin{itemize} +\item The human ear is less sensitive to low frequencies. +\item The maximum sensitivity is around 3-4 kHz, which roughly + corresponds to the resonance of the auditory canal. +\end{itemize} + +%% [See: \newline +%% \verb|http://hyperphysics.phy-astr.gsu.edu/Hbase/sound/earsens.html| +%% and +%% \verb|http://hyperphysics.phy-astr.gsu.edu/Hbase/hframe.html|] +%% \verb|http://www2.sfu.ca/sonic-studio/handbook/Equal_Loudness_Contours.html|.] + +Another important psychoacoustical property is captured in the +\emph{Weber\-Fechner Law}, which states that the \emph{just noticeable + difference} (jnd) in a quantity---i.e.\ the minimal change necessary +for humans to notice something in a cognitive sense---is a relative +constant, independent of the absolute level. That is, the ratio of +the change to the absolute measure of that quantity is constant: + +\[ \frac{\Delta q}{q} = k \] + +The jnd for loudness happens to be about 1 db, which is another +reason why the decibel scale is so convenient. 1 db corresponds to a +sound level ratio of 1.25892541. So, in order for a person to ``just +notice'' an increase in loudness, one has to increase the sound level +by about 25\%. If that seems high to you, it's because your ear is so +adaptive that you are not even aware of it. + +\subsection{Frequency Spectrum} +\label{sec:spectrum} + +Humans can hear sound approximately in the range 20 Hz to 20,000 Hz = +20 kHz. This is a dynamic range in frequency of a factor of 1000, or +30 dB. Different people can hear different degrees of this range (I +can hear very low tones well, but not very high ones). On a piano, +the fundamental frequency of the lowest note is 27.5 Hz, middle +(concert) A is 440 hz, and the top-most note is about 4 kHz. Later we +will learn that these notes also contain \emph{overtones}---multiples +of the fundamental frequency---that contribute to the \emph{timbre}, +or sound quality, that distinguishes one instrument from another. +(Overtones are also called \emph{harmonics} or \emph{partials}.) + +The \emph{phase}, or time delay, of a signal is important too, and +comes into play when we start mixing signals together, which can +happen naturally, deliberately, from reverberations (room acoustics), +and so on. Recall that a pure sine wave can be expressed as +$\sin(\omega t + \phi)$, where $\phi$ is the \emph{phase angle}. +Manipulating the phase angle is common in additive synthesis and +amplitude modulation, topics to be covered in later chapters. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=3in,angle=270]{pics/sine_spect1.eps} +\begin{center} +(a) Spectral plot of pure sine wave +\end{center} +\includegraphics[height=3in,angle=270]{pics/sine_spect2.eps} +\begin{center} +(b) Spectral plot of a noisy sine wave +\end{center} +\includegraphics[height=3in,angle=270]{pics/sine_spect3.eps} +\begin{center} +(c) Spectral plot of a musical tone +\end{center} +\caption{Spectral Plots of Different Signals} +\label{fig:frequency-spectrum} +\end{figure} + +A key point is that most sounds do not consist of a single, pure sine +wave---rather, they are a combination of many frequencies, and at +varying phases relative to one another. Thus it is helpful to talk of +a signal's \emph{frequency spectrum}, or spectral content. If we have +a regular repetitive sound (called a \emph{periodic signal}) we can +plot its spectral content instead of its time-varying graph. For a +pure sine wave, this looks like an impulse function, as shown in +Figure \ref{fig:frequency-spectrum}a. + +But for a richer sound, it gets more complicated. First, the +distribution of the energy is not typically a pure impulse, meaning +that the signal might vary slightly above and below a particular +frequency, and thus its frequency spectrum typically looks more like +Figure \ref{fig:frequency-spectrum}b. + +In addition, a typical sound has many different frequencies associated +with it, not just one. Even for an instrument playing a single note, +this will include not just the perceived pitch, which is called the +\emph{fundamental frequency}, but also many \emph{overtones} (or +harmonics) which are multiples of the fundamental, as shown in Figure +\ref{fig:frequency-spectrum}c. The \emph{natural harmonic series} is +one that is approximated often in nature, and has a harmonically +decaying series of overtones. + +What's more, the articulation of a note by a performer on an +instrument causes these overtones to vary in relative size over time. +There are several ways to visualize this graphically, and Figure +\ref{fig:time-varying-spectrum} shows two of them. In +\ref{fig:time-varying-spectrum}a, shading is used to show the varying +amplitude over time. And in \ref{fig:time-varying-spectrum}b, a 3D +projection is used. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=4in,angle=270]{pics/spectrum_map.eps} +\begin{center} +(a) Using shading +\end{center} +\includegraphics[height=4in,angle=270]{pics/spectrum_mesh.eps} +\begin{center} +(b) Using 3D projection +\end{center} +\caption{Time-Varying Spectral Plots} +\label{fig:time-varying-spectrum} +\end{figure} + +The precise blend of the overtones, their phases, and how they vary +over time, is primarily what distinguishes a particular note, say +concert A, on a piano from the same note on a guitar, a violin, a +saxophone, and so on. We will have much more to say about these +issues in later chapters. + +[See pictures at: +\newline + \verb|http://www.computermusicresource.com/spectrum.html|.] + +% This also relates to the envelope that “shapes” a sound. [see BSoM +% for more ideas on this] + +\section{Digital Audio} +\label{sec:digital-audio} + +The preceding discussion has assumed that sound is a continuous +quantity, which of course it is, and thus we represent it using +continuous mathematical functions. If we were using an analog +computer, we could continue with this representation, and create +electronic music accordingly. Indeed, the earliest electronic +synthesizers, such as the \emph{Moog synthesizer} of the 1960's, were +completely analog. + +However, most computers today are \emph{digital}, which require +representing sound (or signals in general) using digital values. The +simplest way to do this is to represent a continuous signal as a +\emph{sequence of discrete samples} of the signal of interest. An +\emph{analog-to-digital converter}, or ADC, is a device that converts +an instantaneous sample of a continuous signal into a binary value. +The microphone input on a computer, for example, connects to an ADC. + +Normally the discrete samples are taken at a fixed \emph{sampling + rate}. Choosing a proper sampling rate is quite important. If it +is too low, we will not acquire sufficient samples to adequately +represent the signal of interest. And if the rate is too high, it may +be an overkill, thus wasting precious computing resources (in both +time and memory consumption). Intuitively, it seems that the highest +frequency signal that we could represent using a sampling rate $r$ +would have a frequency of $\nicefrac{r}{2}$, in which case the result +would have the appearance of a square wave, as shown in Figure +\ref{fig:sample-rate}a. Indeed, it is easy to see that problems could +arise if we sampled at a rate significantly lower than the frequency +of the signal, as shown in Figures \ref{fig:sample-rate}b and +\ref{fig:sample-rate}c for sampling rates equal to, and one-half, of +the frequency of the signal of interest---in both cases the result is +a sampled signal of 0 Hz! + +\begin{figure}[hbtp] +\centering +\includegraphics[height=3.1in,angle=270]{pics/aliasing_2f.eps} +\begin{center} +(a) +\end{center} +\includegraphics[height=3.1in,angle=270]{pics/aliasing_f.eps} +\begin{center} +(b) +\end{center} +\includegraphics[height=3.1in,angle=270]{pics/aliasing_half-f.eps} +\begin{center} +(c) +\end{center} +\caption{Choice of Sampling Rate} +\label{fig:sample-rate} +\end{figure} + +Indeed, this observation is captured in what is known as the +\emph{Nyquist-Shannon Sampling Theorm} that, stated informally, says +that the accurate reproduction of an analog signal (no matter how +complicated) requires a sampling rate that is at least twice the +highest frequency of the signal of interest. + +For example, for audio signals, if the highest frequency humans can +hear is 20 kHz, then we need to sample at a rate of at least 40 kHz +for a faithful reproduction of sound. In fact, CD's are recorded at +44.1 kHz. But many people feel that this rate is too low, as some +people can hear beyond 20 kHz. Another recording studio standard is +48 kHz. Interestingly, a good analog tape recorder from generations +ago was able to record signals with frequency content even higher than +this---perhaps digital is not always better! + +\subsection{From Continuous to Discrete} +\label{sec:discrete} + +Recall the definition of a sine wave from Section \ref{sec:frequency}: +\[ s(t) = A\sin(\omega t + \phi) \] +We can easily and intuitively convert this to the discrete domain by +replacing the time $t$ with the quantity $\nicefrac{n}{r}$, where $n$ +is the integer index into the sequence of discrete samples, and $r$ is +the sampling rate discussed above. If we use $s[n]$ to denote the +$(n+1)^{\rm th}$ sample of the signal, we have: +\[ s[n] = A\sin\left(\frac{\omega n}{r} + \phi\right),\ \ \ \ \ \ \ \ + n = 0, 1, ..., \infty \] +Thus $s[n]$ corresponds to the signal's value at time $\nicefrac{n}{r}$. + +\subsection{Fixed-Waveform Table-Lookup Synthesis} +\label{sec:wavetable} + +One of the most fundamental questions in digital audio is how to +generate a sine wave as efficiently as possible, or, in general, how +to generate a fixed periodic signal of any form (sine wave, square +wave, sawtooth wave, even a sampled sound bite). A common and +efficient way to generate a periodic signal is through +\emph{fixed-waveform table-lookup synthesis}. The idea is very +simple: store in a table the samples of a desired periodic signal, and +then index through the table at a suitable rate to reproduce that +signal at some desired frequency. The table is often called a +\emph{wavetable}. + +In general, if we let: +\[\begin{array}{lcl} +L &=& {\rm table\ length} \\ +f &=& {\rm resulting\ frequency} \\ +i &=& {\rm indexing\ increment} \\ +r &=& {\rm sample\ rate} +\end{array}\] +then we have: +\[ f = \frac{i r}{L} \] + +For example, suppose the table contains 8196 samples. If the sample +rate is 44.1 kHz, how do we generate a tone of, say, 440 Hz? Plugging +in the numbers and solving the above equation for $i$, we get: +\[\begin{array}{lcl} +440 &=& \dfrac{i \times 44.1 {\rm kHz}}{8196} \\[.1in] +i &=& \dfrac{440 \times 8196}{44.1 {\rm kHz}} \\[.1in] + &=& 81.77 +\end{array}\] +So, if we were to sample approximately every 81.77$^{\rm th}$ value in +the table, we would generate a signal of 440 Hz. + +Now suppose the table $T$ is a vector, and $T[n]$ is the $n$th +element. Let's call the exact index increment $i$ into a continuous +signal the \emph{phase}, and the actual index into the corresponding +table the \emph{phase index} $p$. The computation of successive +values of the phase index and output signal $s$ is then captured by +these equations: +\[\begin{array}{lcl} +p_o &=& \lfloor \phi_0 + 0.5 \rfloor \\ +p_{n+1} &=& (p_n + i) \bmod L \\ +s_n &=& T [\ \lfloor p_n + 0.5 \rfloor\ ] +\end{array}\] +$\lfloor a+0.5 \rfloor$ denotes the floor of $a+0.5$, which effectively +rounds $a$ to the nearest integer. $\phi_0$ is the initial phase +angle (recall earlier discussion), so $p_0$ is the initial index into +the table that specifies where the fixed waveform should begin. + +Instead of rounding the index, one could do better by +\emph{interpolating} between values in the table, at the expense of +efficiency. In practice, rounding the index is often good enough. +Another way to increase accuracy is to simply increase the size of the +table. + +\subsection{Aliasing} +\label{sec:aliasing} + +Earlier we saw examples of problems that can arise if the sampling +rate is not high enough. We saw that if we sample a sine wave at +twice its frequency, we can suitably capture that frequency. If we +sample at exactly its frequency, we get 0 Hz. But what happens in +between? Consider a sampling rate ever-so-slightly higher or lower +than the sine wave's fundamental frequency-–-in both cases, this will +result in a frequency much lower than the original signal, as shown in +Figures \ref{fig:aliasing1} and \ref{fig:aliasing2}. This is +analogous to the effect of seeing spinning objects under fluorescent +or LED light, or old motion pictures of the spokes in the wheels of +horse-drawn carriages. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=4in,angle=270]{pics/aliasing_lowf1.eps} +\includegraphics[height=4in,angle=270]{pics/aliasing_lowf2.eps} +\caption{Aliasing 1} +\label{fig:aliasing1} +\end{figure} + +\begin{figure}[hbtp] +\centering +\includegraphics[height=4in,angle=270]{pics/aliasing_lowf5.eps} +\includegraphics[height=4in,angle=270]{pics/aliasing_lowf6.eps} +\caption{Aliasing 2} +\label{fig:aliasing2} +\end{figure} + +These figures suggest the following. Suppose that $m$ is one-half the +sampling rate. Then: +\[\begin{array}{lll} +\hline \\ +{\rm Original\ signal} && {\rm Reproduced\ signal} \\ +\hline +0-m && 0-m \\ +m-2m && m-0 \\ +2m-3m && 0-m \\ +3m-4m && m-0 \\ +\cdots && \cdots \\ +\hline +\end{array}\] +This phenomenon is called \emph{aliasing}, or \emph{foldover} of the +signal onto itself. + +This is not good! In particular, it means that audio signals in the +ultrasonic range will get ``folded'' into the audible range. To solve +this problem, we can add an analog \emph{low-pass filter} in front of +the ADC--–usually called an \emph{anti-aliasing} filter---to eliminate +all but the audible sound before it is digitized. In practice, +however, this can be tricky. For example, a steep analog filter +introduces \emph{phase distortion} (i.e.\ frequency-dependent time +delays), and early digital recordings were notorious in the ``harsh +sound'' that resulted. This can be fixed by using a filter with less +steepness (but resulting in more aliasing), or using a time +correlation filter to compensate, or using a technique called +\emph{oversampling}, which is beyond the scope of this text. + +A similar problem occurs at the other end of the digital audio +process---i.e.\ when we reconstruct an analog signal from a digital +signal using a \emph{digital-to-analog converter}, or DAC. The +digital representation of a signal can be viewed mathematically as a +stepwise approximation to the real signal, as shown in Figure +\ref{fig:no-aliasing}, where the sampling rate is ten times the +frequency of interest. As discussed earlier, at the highest frequency +(i.e.\ at one-half the sampling rate), we get a square wave. As we +will see in Chapter~\ref{ch:spectrum-analysis}, a square wave can be +represented mathematically as the sum of an infinite sequence of sine +waves, consisting of the fundamental frequency and all of its odd +harmonics. These harmonics can enter the ultrasonic region, causing +potential havoc in the analog circuitry, or in a dog's ear (dogs can +hear frequencies much higher than humans). The solution is to add yet +another low-pass filter, called an \emph{anti-imaging} or +\emph{smoothing} filter to the output of the DAC. In effect, this +filter ``connects the dots,'' or interpolates, between successive +values of the stepwise approximation. + +\begin{figure}[hbtp] +\centering +\includegraphics[height=3.2in,angle=270]{pics/noaliasing.eps} +\caption{A Properly Sampled Signal} +\label{fig:no-aliasing} +\end{figure} + +In any case, a basic block diagram of a typical digital audio +system---from sound input to sound output---is shown in Figure +\ref{fig:DAW-block-diagram}. + +\begin{figure} +\centering +\includegraphics[height=4.0in]{pics/DAWBlockDiagram.eps} +\caption{Block Diagram of Typical Digital Audio System} +\label{fig:DAW-block-diagram} +\end{figure} + +\subsection{Quantization Error} +\label{sec:quantization} + +In terms of amplitude, remember that we are using digital numbers to +represent an analog signal. For conventional CD's, 16 bits of +precision are used. If we were to compute and then ``listen to'' the +round-off errors that are induced, we would hear subtle imperfections, +called \emph{quantization error}, or more commonly, ``noise.'' + +One might compare this to ``hiss'' on a tape recorder (which is due to +the molecular disarray of the magnetic recording medium), but there +are important differences. First of all, when there is no sound, +there is no quantization error in a digital signal, but there is still +hiss on a tape. Also, when the signal is very low and regular, the +quantization error becomes somewhat regular as well, and is thus +audible as something different from hiss. Indeed, it's only when the +signal is loud and complex that quantization error compares favorably +to tape hiss. + +One solution to the problem of low signal levels mentioned above is to +purposely introduce noise into the system to make the signal less +predictable. This fortuitous use of noise deserves a better name, and +indeed it is called \emph{dither}. + +\subsection{Dynamic Range} +\label{sec:dynamic-range} + +What is the dynamic range of an $n$-bit digital audio system? If we +think of quantization error as noise, it makes sense to +use the equation for $\mathit{SNR}_{dB}$ given in Section \ref{sec:amplitude}: + +\[ \mathit{SNR}_{dB} = 20 \log_{10}\frac{S}{N} \] + +But what should $N$ be, i.e.\ the quantization error? Given a signal +amplitude range of $\pm a$, with $n$ bits of resolution it is divided +into $\nicefrac{2a}{2^n}$ points. Therefore the dynamic range is: +\[\begin{array}{lcl} +20 \log_{10}\left(\dfrac{2a}{\nicefrac{2a}{2^n}}\right) + &=& 20 \times\log_{10}(2^n) \\ + &=& 20 \times n \times\log_{10} (2) \\[.02in] + &\approx& 20 \times n \times (0.3) \\[.02in] + &=& 6n +\end{array}\] +For example, a 16-bit digital audio system results in a dynamic range +of 96 dB, which is pretty good, although a 20-bit system yields 120 +dB, corresponding to the dynamic range of the human ear. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +For each of the following, say whether it is a longitudinal wave or a +transverse wave: +\begin{itemize} +\item A vibrating violin string. +\item Stop-and-go traffic on a highway. +\item ``The wave'' in a crowd at a stadium. +\item ``Water hammer'' in the plumbing of your house. +\item The wave caused by a stone falling in a pond. +\item A radio wave. +\end{itemize} } +\end{exercise} + +\begin{exercise}{\em +You see a lightning strike, and 5 seconds later you hear the thunder. +How far away is the lightning? } +\end{exercise} + +\begin{exercise}{\em +You clap your hands in a canyon, and 2 seconds later you hear an echo. +How far away is the canyon wall? } +\end{exercise} + +\begin{exercise}{\em +By what factor must one increase the RMS level of a signal to yield a +10 dB increase in sound level? } +\end{exercise} + +\begin{exercise}{\em +A dog can hear in the range 60-45,000 Hz, and a bat 2,000-110,000 Hz. +In terms of the frequency response, what are the corresponding dynamic +ranges for these two animals, and how do they compare to that of +humans? } +\end{exercise} + +\begin{exercise}{\em +What is the maximum number of audible overtones in a note whose +fundamental frequency is 100 Hz? 500 Hz? 1500 Hz? 5 kHz? } +\end{exercise} + +\begin{exercise}{\em +Consider a continuous input signal whose frequency is f. Devise a +formula for the frequency r of the reproduced signal given a sample +rate s. } +\end{exercise} + +\begin{exercise}{\em +How much memory is needed to record 3 minutes of stereo sound using +16-bit samples taken at a rate of 44.1 kHz? } +\end{exercise} + +\begin{exercise}{\em +If we want the best possible sound, how large should the table be using +fixed-waveform table-lookup synthesis, in order to cover the audible +frequency range? } +\end{exercise} + +\begin{exercise}{\em +The Doppler effect occurs when a sound source is in motion. For +example, as a police car moves toward you its siren sounds higher than +it really is, and as it goes past you, it gets lower. How fast would +a police car have to go to change a siren whose frequency is the same +as concert A, to a pitch an octave higher? (i.e. twice the frequency) +At that speed, what frequency would we hear after the police car +passes us? } +\end{exercise} + +\vspace{.1in}\hrule + +\out{ ------------------------- + +Oversampling + +Oversampling is a simple “trick” that improves dynamic range as well +as anti-aliasing. The idea is to interpolate between digital samples. +This became popular in early CD players. + +More recently so-called “1-bit oversampling” has become popular. The +idea here is to represent signals using a single bit of quantization, +but sample at a much higher rate. This trade-off in “information +content” is well-known mathematically, and in practice it greatly +simplifies the anti-aliasing problem, because the filter that is +needed can be far less steep (since the higher rate takes us way out +of the audible range). + +}
+ HSoM/SpectrumAnalysis.lhs view
@@ -0,0 +1,986 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\out{+\begin{code}+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/SpectrumAnalysis.lhs. (See HSoM/MakeCode.bat.)++\end{code}+}++\chapter{Spectrum Analysis}+\label{ch:spectrum-analysis}++\begin{code}+{-# LANGUAGE Arrows #-}++module Euterpea.Music.Signal.SpectrumAnalysis where++import Euterpea+import Euterpea.Experimental (fftA)++import Data.Complex (Complex ((:+)), polar)+import Data.Maybe (listToMaybe, catMaybes)++\end{code}++There are many situations where it is desirable to take an existing+sound signal---in particular one that is recorded by a+microphone---and analyze it for its spectral content. If one can do+this effectively, it is then possible (at least in theory) to recreate+the original sound, or to create novel variations of it. The thepry+behind this approach is based on \emph{Fourier's Theorem}, which+states that any periodic signal can be decomposed into a weighted sum+of (a potentially infinite number of) sine waves. In this chapter we+discuss the theory as well as the pragmatics for doing spectrum+analysis in Euterpea.++\section{Fourier's Theorem}+\label{sec:fouriers-theorem}++A \emph{periodic signal} is a signal that repeats itself infinitely+often. Mathematically, a signal $x$ is periodic if there exists a+real number $T$ such that for all integers $n$:+\[ x(t) = x(t + nT) \]+%% \[ (\exists\ T\! \in\! \mathbb{R}) (\forall n\! \in\! \mathbb{Z}): x(t) = x(t + nT) \]+%% where $\mathbb{R}$ is the set of real numbers and $\mathbb{Z}$ is the+%% set of integers. +$T$ is called the \emph{period}, which may be just a few microseconds,+a few seconds, or perhaps days---the only thing that matters is that+the signal repeats itself. Usually we want to find the smallest value+of $T$ that satisfies the above property. For example, a sine wave is+surely periodic; indeed, recall from Section \ref{sec:frequency} that:+\[ \sin (2\pi k + \theta) = \sin \theta \]+for any integer $k$. In this case, $T = 2\pi$, and it is the smallest+value that satisfies this property.++But in what sense is, for example, a single musical note periodic?+Indeed it is not, unless it is repeated infinitely often, which would+not be very interesting musically. Yet something we would like to+know is the spectral content of that single note, or even of a small+portion of that note, within an entire composition. This is one of+the practical problems that we will address later in the chapter.++%% In the case of audio, since humans cannot hear sound lower than+%% about 20 Hz, we need only concern ourselves with periodic signals+%% whose repetition period is less than 50 milliseconds+%% (\nicefrac{1}{20} of a second).++Recall from Section \ref{sec:frequency} that a sine wave can be+represented by: $x(t) = A\sin(\omega t + \phi)$, where $A$ is the+amplitude, $\omega$ is the radian frequency, and $\phi$ is the phase+angle. Joseph Fourier, a french mathematician and physicist, showed+the following result. Any periodic signal $x(t)$ with period $T$ can+be represented as:+\begin{equation}\label{eq:fourier-series}+x(t) = C_0 + \sum_{n=1}^{\infty} C_n \cos(\omega_0 nt + \phi_n)+\end{equation}+This is called \emph{Fourier's Theorem}. $\omega_0 =+\nicefrac{2\pi}{T}$ is called the \emph{fundamental frequency}. Note+that the frequency of each cosine wave in the series is an integer+multiple of the fundamental frequency. The above equation is also+called the \emph{Fourier series} or \emph{harmonic series} (related,+but not to be confused with, the mathematical definition of harmonic+series, which has the precise form $1 + \nicefrac{1}{2} ++\nicefrac{1}{3} + \nicefrac{1}{4} + \cdots$).++The trick, of course, is determining what the coefficients $C_0$,+$...$, $C_n$ and phase angles $\phi_1$, $...$, $\phi_n$ are.+Determining the above equation for a particular periodic signal is+called \emph{Fourier analysis}, and synthesizing a sound based on the+above equation is called \emph{Fourier synthesis}. Theoretically, at+least, we should be able to use Fourier analysis to decompose a sound+of interest into its composite sine waves, and then regenerate it by+artificially generating those composite sine waves and adding them+together (i.e.\ additive synthesis, to be described in+Chapter~\ref{ch:additive}). Of course, we also have to deal with the+fact that the representation may involve an \emph{infinite} number of+composite signals.++As discussed somewhat in Chapter~\ref{ch:signals}, many naturally+occurring vibrations in nature---including the resonances of most+musical instruments---are characterized as having a fundamental+frequency (the perceived pitch) and some combination of multiples of+that frequency, which are often called \emph{harmonics},+\emph{overtones} or \emph{partials}. So Fourier's Theorem seems to be+a good match for this musical application.++\subsection{The Fourier Transform}++When studying Fourier analysis, it is more convenient, mathematically,+to use \emph{complex exponentials}. We can relate working with+complex exponentials back to sines and cosines using \emph{Euler's+ Formula}:+\[\begin{array}{lcl}+e^{j\theta} &=& cos(\theta) + j sin(\theta) \\[.05in]+cos(\theta) &=& \dfrac{1}{2} (e^{j\theta} + e^{-j\theta}) \\[.1in]+sin(\theta) &=& \dfrac{1}{2} (e^{j\theta} - e^{-j\theta})+\end{array}\]++For a periodic signal $x(t)$, which we consider to be a+function of time, we denote its \emph{Fourier transform} by+$\hat{x}(f)$, which is a function of frequency. Each point in+$\hat{x}$ is a complex number that represents the magnitude and phase+of the frequency $f$'s presence in $x(t)$. Using complex+exponentials, the formula for $\hat{x}(f)$ in terms of $x(t)$ is: +\[ \hat{x}(f) = \int_{-\infty}^{\infty} x(t) e^{-j\omega t} dt \] +where $\omega = 2\pi f$, and $j$ is the same as the imaginary unit $i$+used in mathematics.\footnote{Historically, engineers prefer to use+ the symbol $j$ rather than $i$, because $i$ is generally used to+ represent current in an electrical circuit.} Intuitively, the+Fourier transform at a particular frequency $f$ is the integral of the+product of the original signal and a pure sinusiodal wave $e^{-j\omega+ t}$. This latter process is related to the \emph{convolution} of+the two signals, and intuitively will be non-zero only when the signal+has some content of that pure signal in it.++The above equation describes $\hat{x}$ in terms of $x$. We can also+go the other way around---defining $x$ in terms of $\hat{x}$:+\[ x(t) = \int_{-\infty}^{\infty} \hat{x}(f) e^{j\hat{\omega} f} df \]+where $\hat{\omega} = 2\pi t$. This is called the \emph{inverse}+Fourier transform.++%% -2 pi i x e => -2 pi j t f => -j w t+%% 2 pi i x e => 2 pi j t f => -j what f++If we expand the definitions of $\omega$ and $\hat{\omega}$ we can see+ how similar these two equations are:+%% \[\begin{array}{lcl}+\begin{equation}\label{eq:ft}+\hat{x}(f) = \int_{-\infty}^{\infty} x(t) e^{-j2\pi f t} dt+\end{equation}+\begin{equation}\label{eq:ift}+ x(t) = \int_{-\infty}^{\infty} \hat{x}(f) e^{ j2\pi f t} df+\end{equation}+%% \end{array}\]+These two equations, for the Fourier transform and its inverse, are+remarkable in their simplicity and power. They are also remarkable in+the following sense: \emph{no information is lost when converting from+ one to the other}. In other words, a signal can be represented in+terms of its time-varying behavior or its spectral content---they are+equivalent!++A function that has the property that $f(x) = f(-x)$ is called an+\emph{even} function; if $f(x) = - f(-x)$ it is said to be \emph{odd}.+It turns out that, perhaps surprisingly, \emph{any} function can be+expressed as the sum of a single even function and a single odd+function. This may help provide some intuition about the equations+for the Fourier transform, because the complex exponential +$e^{j2\pi f t}$ separates the waveform by which it is being multiplied+into its even and odd parts (recall Euler's formula). The real+(cosine) part affects only the even part of the input, and the+imaginary (sine) part affects only the odd part of the input.++\subsection{Examples}++Let's consider some examples, which are illustrated in+Figure~\ref{fig:fourier-transforms}:+\begin{itemize}+\item+Intuitively, the Fourier transform of a pure cosine wave should be an+impulse function---that is, the spectral content of a cosine wave+should be concentrated completely at the frequency of the cosine wave.+The only catch is that, when working in the complex domain, the+Fourier transform also yields the mirror image of the spectral+content, at a frequency that is the negation of the cosine wave's+frequency, as shown in Figure~\ref{fig:fourier-transforms}a. In other+words, in this case, $\hat{x}(f) = \hat{x}(-f)$, i.e.\ $\hat{x}$ is+even. So the spectral content is the \emph{real} part of the complex+number returned from the Fourier transform (recall Euler's formula).++\item+In the case of a pure sine wave, we should expect a similar result.+The only catch now is that the spectral content is contained in the+\emph{imaginary} part of the complex number returned from the Fourier+transform (recall Euler's formula), and the mirror image is negated.+That is, $\hat{x}(f) = - \hat{x}(-f)$, i.e.\ $\hat{x}$ is odd. This+is illustrated in Figure~\ref{fig:fourier-transforms}b.++\item+Conversely, consider what the spectral content of an impulse function+should be. Because an impulse function is infinitely ``sharp,'' it+would seem that its spectrum should contain energy at every point in+the frequency domain. Indeed, the Fourier transform of an impulse+function centered at zero is a constant, as shown in+Figure~\ref{fig:fourier-transforms}c.++\item+Consider now the spectral content of a square wave. It can be shown+that the Fourier series representation of a square wave is the sum of+the square wave's fundamental frequency plus its harmonically+decreasing (in magnitude) odd harmonics. Specifically:+\begin{equation}\label{eq:square-wave-series}+sq(t) = \sum_{k=1}^{\infty} \frac{1}{k} \sin k\omega t,\quad {\rm for\ odd\ } k+\end{equation}+The spectral content of this signal in shown in+Figure~\ref{fig:fourier-transforms}d.+Figure~\ref{fig:square-wave-series} also shows partial reconstruction+of the square wave from a finite number of its composite signals.+\end{itemize}++It is worth noting that the diagrams in+Figure~\ref{fig:fourier-transforms} make no assumptions about time or+frequency. Therefore, because the Fourier transform and its inverse+are true mathematical inverses, we can read the diagrams as time+domain / frequency domain pairs, or the other way around; i.e.\ as+frequency domain / time domain pairs. For example, interpreting the+diagram on the left of Figure~\ref{fig:fourier-transforms}a in the+frequency domain, is to say that it is the Fourier transform of the+signal on the right (interpreted in the time domain).++\begin{figure}[hbtp]+\centering+\includegraphics[height=2.4in,angle=270]{pics/cosine1.eps}+\includegraphics[height=2.4in,angle=270]{pics/cosine2.eps}+\begin{center}+(a) Cosine wave+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/sine1.eps} +\includegraphics[height=2.4in,angle=270]{pics/sine2.eps} +\begin{center}+(b) Sine wave+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/pulse1.eps}+\includegraphics[height=2.4in,angle=270]{pics/pulse2.eps}+\begin{center}+(c) Impulse function+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/square1.eps} +\includegraphics[height=2.4in,angle=270]{pics/square2.eps} +\begin{center}+(d) Square wave +\end{center}+\caption{Examples of Fourier Transforms}+\label{fig:fourier-transforms}+\end{figure}++\begin{figure}[hbtp]+\centering+\includegraphics[height=2.4in,angle=270]{pics/19_2a.eps}+\begin{center}+(a) Sine wave+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/19_2b.eps} +\begin{center}+(b) Sine wave + third harmonic+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/19_2c.eps} +\begin{center}+(c) Sine wave + third and fifth harmonics+\end{center}+\includegraphics[height=2.4in,angle=270]{pics/19_2d.eps} +\begin{center}+(d) Sum of first eight terms of the Fourier series of a square wave+\end{center}+\caption{Generating a Square Wave from Odd Harmonics}+\label{fig:square-wave-series}+\end{figure}++\section{The Discrete Fourier Transform}+\label{sec:DFT}++Recall from Section \ref{sec:discrete} that we can move from the+continuous signal domain to the discrete domain by replacing the time+$t$ with the quantity $\nicefrac{n}{r}$, where $n$ is the integer+index into the sequence of discrete samples, and $r$ is the sampling+rate. Let us assume that we have done this for $x$, and we will use+square brackets to denote the difference. That is, $x[n]$ denotes the+$n^{\rm th}$ sample of the continuous signal $x(t)$, corresponding to+the value $x(\nicefrac{n}{r})$.++We would now like to compute the \emph{Discrete Fourier Transform}+(DFT) of our discrete signal. But instead of being concerned about+the sampling rate (which can introduce aliasing, for example), our+concern turns to the \emph{number of samples} that we use in computing+the DFT---let's call this $N$. Intuitively, the integrals used in our+equations for the Fourier transform and its inverse should become sums+over the range $0 ... N-1$. This leads to a reformulation of our two+equations (\ref{eq:ft} and \ref{eq:ift}) as follows:\footnote{The+ purpose of the factor $\nicefrac{1}{N}$ in Equation~\ref{eq:dft} is+ to ensure that the DFT and the inverse DFT are in fact inverses of+ each other. But it is just by convention that one equation has this+ factor and the other does not---it would be sufficient if it were+ done the other way around. In fact, all that matters is that the+ product of the two coefficients be $\nicefrac{1}{N}$, and thus it+ would also be sufficient for each equation to have the same+ coefficient, namely $\nicefrac{1}{\sqrt{N}}$. Similarly, the+ negative exponent in one equation and positive in the other is also+ by convention---it would be sufficient to do it the other way+ around.}+\begin{equation}\label{eq:dft}+\hat{x}[k] = \frac{1}{N}\sum_{n=0}^{N-1} + x[n] e^{-j\frac{2\pi k n}{N}},\ \ k = 0, 1, ..., N-1+\end{equation}+%% Analogously, the equation for the inverse DFT is:+\begin{equation}\label{eq:idft}+x[n] = \sum_{k=0}^{N-1} + \hat{x}[k] e^{j\frac{2\pi k n}{N}},\ \ n = 0, 1, ..., N-1+\end{equation}++Despite all of the mathematics up to this point, the reader may now+realize that the discrete Fourier transform as expressed above is+amenable to implementation---for example it should not be difficult to+write Haskell functions that realize each of the above equations. But+before addressing implementation issues, let's discuss a bit more what+the results actually \emph{mean}.++\subsection{Interpreting the Frequency Spectrum}+\label{sec:freq-spectrum}++Just as $x[n]$ represents a sampled version of the continuous input+signal, $\hat{x}[k]$ represents a sampled version of the continous+frequency spectrum. Care must be taken when interpreting either of+these results, keeping in mind the Nyquist-Shannon Sampling Theorem+(recall Section~\ref{sec:digital-audio}) and aliasing+(Section~\ref{sec:aliasing}).++Also recall that the result of a Fourier transform of a periodic+signal is a Fourier series (see Section~\ref{sec:fouriers-theorem}),+in which the signal being analyzed is expressed as multiples of a+fundamental frequency. In equation \ref{eq:dft} above, that+fundamental frequency is the inverse of the duration of the $N$+samples, i.e.\ the inverse of $\nicefrac{N}{r}$, or $\nicefrac{r}{N}$.+For example, if the sampling rate is 44.1 kHz (the CD standard), then:+\begin{itemize}+%% \item If we take $N=44$ samples, then the fundamental frequency will+%% be (about) $r/N = 1000$ Hz.+\item If we take $N=441$ samples, then the fundamental frequency will+ be $\nicefrac{r}{N} = 100$ Hz.+\item If we take $N=4410$ samples, then the fundamental frequency will+ be $\nicefrac{r}{N} = 10$ Hz.+\item If we take $N=44100$ samples, then the fundamental frequency will+ be $\nicefrac{r}{N} = 1$ Hz.+\end{itemize}+Thus, as would be expected, taking more samples yields a \emph{finer}+resolution of the frequency spectrum. On the other hand, note that if+we increase the sampling rate and keep the number of samples fixed, we+get a \emph{coarser} resolution of the spectrum---this also should be+expected, because if we increase the sampling rate we would expect to+have to look at more samples to get the same accuracy.++Analogous to the Nyquist-Shannon Sampling Theorem, the representable+points in the resulting frequency spectrum lie in the range+$\pm\nicefrac{r}{2}$, i.e.\ between plus and minus one-half of the+sampling rate. For the above three cases, respectively, that means+the points are:+\begin{itemize}+%% \item -22 kHz, -21 kHz, ..., -1 kHz, 0, 1 kHz, ..., 21 kHz, 22kHz+%% \item +%% -22.05 kHz, -21.95 kHz, ..., -0.05 kHz, 0.05 kHz, ..., 21.95 kHz, 22.05 kHz+\item + -22.0 kHz, -21.9 kHz, ..., -0.1 kHz, 0, 0.1 kHz, ..., 21.9 kHz, 22.0 kHz+\item+ -22.05 kHz, -22.04 kHz, ..., -10 Hz, 0, 10 Hz, ..., 22.04 kHz, 22.05 kHz+\item + -22.05 kHz, -22.049 kHz, ..., -1 Hz, 0, 1 Hz, ..., 22.049 kHz, 22.05 kHz+\end{itemize}+For practical purposes, the first of these is usually too coarse, the+third is too fine, and the middle one is useful for many applications.++Note that the first range of frequencies above does not quite cover+the range $\pm\nicefrac{r}{2}$. But remember that this is a discrete+representation of the actual frequency spectrum, and the proper+interpretation would include the frequences $+\nicefrac{r}{2}$ and+$-\nicefrac{r}{2}$.++Also note that there are $N+1$ points in each of the above ranges, not+$N$. Indeed, the more general question is, how do these points in the+frequency spectrum correspond to the indices $i = 0, 1, ..., N-1$ in+$\hat{x}[i]$? If we denote each of these frequencies as $f$, the+answer is that:+\begin{equation}\label{eq:f1}+f = \frac{ir}{N},\ \ \ \ i = 0, 1, ..., N-1+\end{equation}+But note that this range of frequencies extends from $0$ to+$(N-1)(\nicefrac{r}{N})$, which exceeds the Nyquist-Shannon sampling+limit of $\nicefrac{r}{2}$. The way out of this dilemma is to realize+that the DFT assumes that the input signal is periodic in time, and+therefore the DFT is periodic in frequency. In other words, values of+$f$ for indices $i$ greater than $\nicefrac{N}{2}$ can be interpreted+as frequencies that are the \emph{negation} of the frequency given by+the formula above. Assuming even $N$, we can revise formula+\ref{eq:f1} as follows:+\begin{equation}\label{eq:f2}+f = \left\{+ \begin{array}{ll}+ i\dfrac{r}{N}, & \quad i = 0, 1, ..., \dfrac{N}{2} \\[0.1in]+ (i-N)\dfrac{r}{N} & \quad i = \dfrac{N}{2}, + \dfrac{N}{2}+1, ..., N-1 \\+ \end{array} \right.+\end{equation}+Note that when $i = \nicefrac{N}{2}$, both equations apply, yielding+$f = \nicefrac{r}{2}$ in the first case, and $f = -\nicefrac{r}{2}$ in+the second. Indeed, the magnitude of the DFT for each of these+frequencies is the same (see discussion in the next section),+reflecting the periodicity of the DFT, and thus is simply a form of+redundancy.++%% \begin{itemize}+%% \item+%% $\hat{x}[i],\ i = 0, 1, 2, ..., \frac{N}{2}$ correspond to the+%% frequencies $0, \frac{r}{N}, \frac{2r}{N}, ..., \frac{r}{2}$.+%% \item+%% $\hat{x}[i],\ i = \frac{N}{2}, \frac{N}{2}+1, \frac{N}{2}+2, ..., N-1$ +%% correspond to the frequencies +%% $-\frac{r}{2}, -\frac{r}{2}+\frac{r}{N}, -\frac{r}{2}+\frac{2r}{N}, +%% ..., -\frac{r}{N}$.+%% \end{itemize} +%% ... This can be viewed s a kind of aliasing in the frequency domain.++The above discussion has assumed a periodic signal whose fundamental+frequency is known, thus allowing us to parameterize the DFT with the+same fundamental frequency. In practice this rarely happens. That+is, the fundamental frequency of the DFT typically has no integral+relationship to the period of the periodic signal. This raises the+question, what happens to the frequencies that ``fall in the gaps''+between the frequencies discussed above? The answer is that the+energy of that frequency component will be distributed amongst+neighboring points in a way that makes sense mathematically, although+the result may look a little funny compared to the ideal result (where+every frequency component is an integer multiple of the fundamental).+The important thing to remember is that these are digital+representations of the exact spectra, just as a digitized signal is+representative of an exact signal. Two digitized signals can look+very different (depending on sample rate, phase angle, and so on), yet+represent the same underlying signal---the same is true of a digitized+spectrum.++In practice, for reasons of computational efficiency, $N$ is usually+chosen to be a power of two. We will return to this issue when we+discuss implementing the DFT.++\subsection{Amplitude and Power of Spectrum}+\label{sec:amp-spectrum}++We discussed above how each sample in the result of a DFT relates to a+point in the frequency spectrum of the input signal. But how do we+determine the amplitude and phase angle of each of those frequency+components? In general each sample in the result of a DFT is a+complex number, thus having both a real and imaginary part, of the+form $a + jb$. We can visualize this number as a point in the complex+Cartesian plane, where the abscissa (x-axis) represents the real part,+and the ordinate (y-axis) represents the imaginary part, as shown in+Figure~\ref{fig:complex-plane}. It is easy to see that the line from+the origin to the point of interest is a vector $A$, whose length is+the \emph{amplitude} of the frequency component in the spectrum:+\begin{equation}\label{eq:amplitude}+A = \sqrt{a^2 + b^2}+\end{equation}+The angle $\theta$ is the \emph{phase}, and it is easily defined from+the figure as:+\begin{equation}\label{eq:phase}+\theta = tan^{-1} \frac{b}{a}+\end{equation}+(This amplitude / phase pair is often called the \emph{polar}+representation of a complex number.)++\begin{figure}[hbtp]+\centering+\includegraphics[height=2.4in]{pics/ComplexToPolar.eps} % angle=270+\caption{Complex and Polar Coordinates}+\label{fig:complex-plane}+\end{figure}++Recall from Section~\ref{sec:amplitude} that power is proportional to+the square of the amplitude. Since taking a square root adds+computational expense, the square root is often omitted from+Equation~\ref{eq:amplitude}, thus yielding a \emph{power spectrum}+instead of an \emph{amplitude spectrum}.++One subtle aspect of the resulting DFT is how to interpret+\emph{negative} frequencies. In the case of having an input whose+samples are all real numbers (i.e.\ there are no imaginary+components), which is true for audio applications, the negative+spectrum is a mirror image of the positive spectrum, and the+amplitude/power is distributed evenly between the two.++\subsection{A Haskell Implementation of the DFT}+\label{sec:haskell-dft}++From equation \ref{eq:dft}, which defines the DFT mathematically, we+can write a Haskell program that implements the DFT. ++The first thing we need to do is understand how complex numbers are+handled in Haskell. They are captured in the |Complex| library, which+must be imported into any program that uses them. The type |Complex+T| is the type of complex numbers whose underlying numeric type is+|T|. We will use, for example, |Complex Double| for testing our DFT.+A complex number $a + jb$ is represented in Haskell as |a :+ b|, and+since |(:+)| is a constructor, such values can be pattern matched.++\syn{Complex numbers in Haskell are captured in the |Complex| library,+ in which complex numbers are defined as a polymorphic data type:+\begin{spec}+infix 6 :++data (RealFloat a) => Complex a = !a :+ !a+\end{spec}+The ``|!|'' in front of the type variables declares that the+constructor |(:+)| is strict in its arguments. For example, the+complex number $a + jb$ is represented by |a :+ b| in Haskell. One+can pattern match on complex number values to extract the real and+imaginary parts, or use one of the predefined selectors defined in the+|Complex| library:+\begin{spec}+realPart, imagPart :: RealFloat a => Complex a -> a+\end{spec}+The |Complex| library also defines the following functions:+\begin{spec}+conjugate :: RealFloat a => Complex a -> Complex a+mkPolar :: RealFloat a => a -> a -> Complex a+cis :: RealFloat a => a -> Complex a+polar :: RealFloat a => Complex a -> (a,a)+magnitude, phase :: RealFloat a => Complex a -> a+\end{spec}+The library also declares instances of |Complex| for the type classes+|Num|, |Fractional|, and |Floating|.+}++Although not as efficient as arrays, for simplicity we choose to use+lists to represent the vectors that are the input and output of the+DFT. Thus if |xs| is the list that represents the signal $x$, then+|xs!!n| is the |n+1|$^{th}$ sample of that signal, and is equivalent+to $x[n]$. Furthermore, using list comprehensions, we can make the+Haskell code look very much like the mathematical definition captured+in Equation \ref{eq:dft}. Finally, we adopt the convention that the+length of the input signal is the number of samples that we will use+for the DFT.++Probably the trickiest part of writing a Haskell program for the DFT+is dealing with the types! In particular, if you look closely at+Equation \ref{eq:dft} you will see that $N$ is used in three different+ways---as an integer (for indexing), as a real number (in the exponent+of $e$), and as a complex number (in the expression+$\nicefrac{1}{N}$).++Here is a Haskell program that implements the DFT:+\begin{code}+dft :: RealFloat a => [Complex a] -> [Complex a]+dft xs = + let lenI = length xs+ lenR = fromIntegral lenI+ lenC = lenR :+ 0+ in [ let i = -2 * pi * fromIntegral k / lenR+ in (1/lenC) * sum [ (xs!!n) * exp (0 :+ i * fromIntegral n)+ | n <- [0,1..lenI-1] ]+ | k <- [0,1..lenI-1] ]+\end{code}+Note that |lenI|, |lenR|, and |lenC| are the integer, real, and+complex versions, respectively, of $N$. Otherwise the code is fairly+straightforward---note in particular how list comprehensions are used+to implement the ranges of $n$ and $k$ in Equation \ref{eq:dft}.++To test our program, let's first create a couple of waveforms. For+example, recall that Equation \ref{eq:square-wave-series} defines the+Fourier series for a square wave. We can implement the first, first+two, and first three terms of this series, corresponding respectively+to Figures~\ref{fig:square-wave-series}a,+\ref{fig:square-wave-series}b, and \ref{fig:square-wave-series}c, by+the following Haskell code:+\begin{code}+mkTerm :: Int -> Double -> [Complex Double]+mkTerm num n = let f = 2 * pi / fromIntegral num+ in [ sin (n * f * fromIntegral i) / n :+ 0+ | i <- [0,1..num-1] ]++mkxa, mkxb, mkxc :: Int-> [Complex Double]+mkxa num = mkTerm num 1+mkxb num = zipWith (+) (mkxa num) (mkTerm num 3)+mkxc num = zipWith (+) (mkxb num) (mkTerm num 5)+\end{code}+Thus |mkTerm num n| is the |n|$^{th}$ term in the series, using |num|+samples.++Using the helper function |printComplexL| defined in+Figure~\ref{fig:pp-code}, which ``pretty prints'' a list of complex+numbers, we can look at the result of our DFT in a more readable+form.\footnote{``Pretty-printing'' real numbers is a subtle task. The+ code in Figure~\ref{fig:pp-code} rounds the number to 10 decimal+ places of accuracy, and inserts spaces before and after to line up+ the decimal points and give a consistent string length. The+ fractional part is not padded with zeros, since that would give a+ false impression of its accuracy. (It is not necessary to+ understand this code in order to understand the concepts in this+ chapter.)}++\begin{figure}+\begin{code}+printComplexL :: [Complex Double] -> IO ()+printComplexL xs =+ let f (i,rl:+im) = + do putStr (spaces (3 - length (show i)) )+ putStr (show i ++ ": (" )+ putStr (niceNum rl ++ ", " )+ putStr (niceNum im ++ ")\n" )+ in mapM_ f (zip [0..length xs - 1] xs)++niceNum :: Double -> String+niceNum d =+ let d' = fromIntegral (round (1e10 * d)) / 1e10+ (dec, fra) = break (== '.') (show d')+ (fra',exp) = break (== 'e') fra+ in spaces (3 - length dec) ++ dec ++ take 11 fra'+ ++ exp ++ spaces (12 - length fra' - length exp)++spaces :: Int -> String+spaces n = take n (repeat ' ')+\end{code}+\caption{Helper Code for Pretty-Printing DFT Results}+\label{fig:pp-code}+\end{figure}++For example, suppose we want to take the DFT of a 16-sample+representation of the first three terms of the square wave series.+Typing the following at the GHCi prompt:+\begin{spec}+printComplexL (dft (mkxc 16))+\end{spec}+will yield the result of the DFT, pretty-printing each number as a+pair, along with its index:+{\small \begin{verbatim}+ 0: ( 0.0 , 0.0 )+ 1: ( 0.0 , -0.5 )+ 2: ( 0.0 , 0.0 )+ 3: ( 0.0 , -0.1666666667 )+ 4: ( 0.0 , 0.0 )+ 5: ( 0.0 , -0.1 )+ 6: ( 0.0 , 0.0 )+ 7: ( 0.0 , 0.0 )+ 8: ( 0.0 , 0.0 )+ 9: ( 0.0 , 0.0 )+ 10: ( 0.0 , 0.0 )+ 11: ( 0.0 , 0.1 )+ 12: ( 0.0 , 0.0 )+ 13: ( 0.0 , 0.1666666667 )+ 14: ( 0.0 , 0.0 )+ 15: ( 0.0 , 0.5 )+\end{verbatim} }++Let's study this result more closely. For sake of argument, assume a+sample rate of 1.6 KHz. Then by construction using |mkxc|, our+square-wave input's fundamental frequency is 100 Hz. Similarly,+recall that the resolution of the DFT is |r/N|, which is also 100 Hz.++Now compare the overall result to Figure+\ref{fig:fourier-transforms}b. Recalling also Equation \ref{eq:f2},+we note that the above DFT results are non-zero precisely at 100, 300,+500, -500, -300, and -100 Hz. This is just what we would expect.+Furthermore, the amplitudes are one-half of the corresponding+harmonically decreasing weights dictated by Equation+\ref{eq:square-wave-series}, namely the values 1, $\nicefrac{1}{6}$,+and $\nicefrac{1}{10}$ (recall the discussion in Section+\ref{sec:amp-spectrum}).++Let's do another example. We can create an impulse function as+follows:+\begin{code}+mkPulse :: Int -> [Complex Double]+mkPulse n = 100 : take (n-1) (repeat 0)+\end{code}+and print its DFT with the command:+\begin{spec}+printComplexL (dft (mkPulse 16))+\end{spec}+whose effect is:+{\small \begin{verbatim}+ 0: ( 6.25 , 0.0 )+ 1: ( 6.25 , 0.0 )+ 2: ( 6.25 , 0.0 )+ 3: ( 6.25 , 0.0 )+ 4: ( 6.25 , 0.0 )+ 5: ( 6.25 , 0.0 )+ 6: ( 6.25 , 0.0 )+ 7: ( 6.25 , 0.0 )+ 8: ( 6.25 , 0.0 )+ 9: ( 6.25 , 0.0 )+10: ( 6.25 , 0.0 )+11: ( 6.25 , 0.0 )+12: ( 6.25 , 0.0 )+13: ( 6.25 , 0.0 )+14: ( 6.25 , 0.0 )+15: ( 6.25 , 0.0 )+\end{verbatim}}+Compare this to Figure \ref{fig:fourier-transforms}c, and note how the+original magnitude of the impulse (100) is distributed evenly among+the 16 points in the DFT ($100/16 = 6.25$).++So far we have considered only input signals whose frequency+components are integral multiples of the DFT's resolution. This+rarely happens in practice, however, because music is simply too+complex, and noisy. As mentioned in \ref{sec:freq-spectrum}, the+energy of the signals that ``fall in the gaps'' is distributed among+neighboring points, although not in as simple a way as you might+think. To get some perspective on this, let's do one other example.+We define a function to generate a signal whose frequeny is $\pi$+times the fundamental frequency:+%% We will modify the function |mkTerm| so that it creates a signal+%% 42\% higher than it used to be:+\begin{code}+x1 num = let f = pi * 2 * pi / fromIntegral num+ in map (:+ 0) [ sin (f * fromIntegral i)+ | i <- [0,1..num-1] ]+\end{code}+$\pi$ is an irrational number, but any number that ``falls in the+gaps'' between indices would do. We can see the result by typing the+command:+\begin{spec}+printComplexL (dft x1)+\end{spec}+which yields:+{\small \begin{verbatim}+ 0: ( -7.9582433e-3 , 0.0 )+ 1: ( -5.8639942e-3 , -1.56630897e-2)+ 2: ( 4.7412105e-3 , -4.56112124e-2)+ 3: ( 0.1860052232 , -0.4318552865 )+ 4: ( -5.72962095e-2, 7.33993364e-2)+ 5: ( -3.95845728e-2, 3.14378088e-2)+ 6: ( -3.47994673e-2, 1.65400768e-2)+ 7: ( -3.29813518e-2, 7.4048103e-3 )+ 8: ( -3.24834325e-2, 0.0 )+ 9: ( -3.29813518e-2, -7.4048103e-3 )+ 10: ( -3.47994673e-2, -1.65400768e-2)+ 11: ( -3.95845728e-2, -3.14378088e-2)+ 12: ( -5.72962095e-2, -7.33993364e-2)+ 13: ( 0.1860052232 , 0.4318552865 )+ 14: ( 4.7412105e-3 , 4.56112124e-2)+ 15: ( -5.8639942e-3 , 1.56630897e-2)+\end{verbatim}}+This is much more complicated than the previous examples! Not only do+the points in the spectrum seem to have varying amounts of energy,+they also have both non-zero real and non-zero imaginary components,+meaning that the magnitude and phase vary at each point. We can+define a function that converts a list of complex numbers into a list+of their polar representations as follows:+\begin{code}+mkPolars :: [Complex Double] -> [Complex Double]+mkPolars = map ((\(m,p)-> m:+p) . polar)+\end{code}+which we can then use to reprint our result:+\begin{spec}+printComplexL (mkPolars (dft x1))+\end{spec}+{\small \begin{verbatim}+ 0: ( 7.9582433e-3 , 3.1415926536 )+ 1: ( 1.67247961e-2, -1.9290259418 )+ 2: ( 4.58569709e-2, -1.4672199604 )+ 3: ( 0.470209455 , -1.1640975898 )+ 4: ( 9.31145435e-2, 2.2336013741 )+ 5: ( 5.05497204e-2, 2.4704023271 )+ 6: ( 3.85302097e-2, 2.6979021519 )+ 7: ( 3.38023784e-2, 2.9207398294 )+ 8: ( 3.24834325e-2, -3.1415926536 )+ 9: ( 3.38023784e-2, -2.9207398294 )+ 10: ( 3.85302097e-2, -2.6979021519 )+ 11: ( 5.05497204e-2, -2.4704023271 )+ 12: ( 9.31145435e-2, -2.2336013741 )+ 13: ( 0.470209455 , 1.1640975898 )+ 14: ( 4.58569709e-2, 1.4672199604 )+ 15: ( 1.67247961e-2, 1.9290259418 )+\end{verbatim} }+If we focus on the magnitude (the first column), we can see that there+is a peak near index 3 (corresponding roughly to the frequency $\pi$),+with small amounts of energy elsewhere.++\vspace{.1in}\hrule++\begin{exercise}{\em +Write a Haskell function |idft| that implements the \emph{inverse} DFT+as captured in Equation~\ref{eq:ift}. Test your code by applying+|idft| to one of the signals used earlier in this section. In other+words, show empirically that, up to round-off errors, |idft (dft xs)+== xs|. }+\end{exercise}++\begin{exercise}{\em +Use |dft| to analyze some of the signals generated using signal+functions defined in Chapter~\ref{ch:sigfuns}. }+\end{exercise}++\todo{To do the above exercise we need to provide a function that+ extracts |N| samples from a sigfun, and somehow keeps it in the+ sigfun world. Perhaps something like:++\begin{spec}+sample :: Rate -> Int -> Signal c a (Event (Table a))+\end{spec}+such that |sample r n| is a sigfun that generates an event every |1/r|+seconds, each event being a table containing |n| samples of the+input. These tables may or may not overlap, depending on the+relationship between |r|, |n|, and the sampling rate. }++\begin{exercise}{\em+Define a function |mkSqWave :: Int -> Int -> [Complex Double]| such+that |mkSqWave num n| is the sum of the first $n$ terms of the Fourier+series of a square wave, having $num$ samples in the result. }+\end{exercise}++\begin{exercise}{\em+Prove mathematically that $x$ and $\hat{x}$ are inverses. Also prove,+using equational reasoning, that |dft| and |idft| are inverses. (For+the latter you may assume that Haskell numeric types obey the standard+axioms of real arithmetic.) }+\end{exercise}++\vspace{.1in}\hrule++\vspace{.1in}++\section{The Fast Fourier Transform}+\label{sec:fft}++In the last section a DFT program was developed in Haskell that was+easy to understand, being a faithful translation of Equation+\ref{eq:dft}. For pedogogical purposes, this effort served us well.+However, for practical purposes, the program is inherently+inefficient.++To see why, think of $x[n]$ and $\hat{x}[k]$ as vectors. Thus, for+example, each element of $\hat{x}$ is the sum of $N$ multiplications+of a vector by a complex exponential (which can be represented as a+pair, the real and imaginary parts). And this overall process must be+repeated for each value of $k$, also $N$ times. Therefore the overall+time complexity of the implied algorithm is O($N^2$). For even+moderate values of $N$, this can be computationally intractable. (Our+choice of lists for the implementation of vectors makes the complexity+even worse, because of the linear-time complexity of indexing, but the+discussion below makes this a moot point.)++Fortunately, there exists a much faster algorithm called the+\emph{Fast Fourier Transform}, or FFT, that reduces the complexity to+O($N\log N$). This difference is quite significant for large values+of $N$, and is the standard algorithm used in most signal processing+applications. We will not go into the details of the FFT algorithm,+other than to note that it is a divide-and-conquer algorithm that+depends on the vector size being a power of two.\footnote{The basic+ FFT algorithm was invented by James Cooley and John Tukey in 1965.}++%% \footnote{James Cooley and John Tukey are+%% usually credited with inventing the FFT in 1965, although it was+%% later discovered that Carl Friedrich Gauss proposed the same+%% algorithm around 1805.}++Rather than developing our own program for the FFT, we will instead+use the Haskell library |Numeric.FFT| to import a function that will+do the job for us. Specifically:+\begin{spec}+fft :: ...+\end{spec}+With this function we could explore the use of the FFT on specific+iinput vectors, as we did earlier with |dft|.++However, our ultimate goal is to have a version of FFT that works on+\emph{signals}. We would like to be able to specify the number of+samples as a power of two (which we can think of as the ``window+size''), the clock rate, and how often we would like to take a+snapshot of the current window (and thus successive windows may or may+not overlap). The resulting signal function takes a signal as input,+and outputs \emph{events} at the specified rate. Events are discussed+in more detail in Chapter~\ref{ch:MUI}.++Indeed, Euterpea provide this functionality for us in a function+called |fftA|:+\begin{spec}+fftA :: Int -> Double -> Int -> SF Double (Event FFTData)+type FFTData = Map Double Double+\end{spec}+|SF| is a signal function type similar to |SigFun|, except that it is+targeted for use in the Musical User Interface (MUI) discussed in+detail in Chapter~\ref{ch:mui}, and thus, for example, does not have a+clock rate. |Map T1 T2| is an abstract type that maps values of type+|T1| to values of type |T2|, and is imported from |Data.Map|.++|fftA winInt rate size| is a signal function that, every |winInt|+samples of the input, creates a window of size |2 ^ size|, and+computes the FFT of that window. For every such result, it issues an+|Event| that maps from frequency to magnitude (using the clock rate+|rate| to determine the proper mapping).++Combining |fftA| with the MUI widgets discussed in+Chapter~\ref{ch:mui}, we can write a simple program that generates a+sine wave whose frequency is controlledd by a slider, and whose+real-time graph as well as its FFT are displayed. The program to do+this is shown in Figure~\ref{fig:fft-mui}.++\begin{figure}+\begin{spec}+fftEx :: UISF () ()+fftEx = proc _ -> do+ f <- hSlider (1, 2000) 440 -< ()+ (d,_) <- convertToUISF 100 simpleSig -< f+ let (s, fft) = unzip d+ _ <- histogram (500, 150) 20 -< listToMaybe (catMaybes fft)+ _ <- realtimeGraph' (500, 150) 200 20 Black -< s+ outA -< ()+ where+ simpleSig :: SigFun CtrRate Double (Double, Event [Double])+ simpleSig = proc f -> do+ s <- osc (tableSinesN 4096 [1]) 0 -< f+ fftData <- fftA 100 256 -< s+ outA -< (s, fftData)++t0 = runMUI (500, 600) "fft Test" fftEx+\end{spec}+\caption{A Real-Time Display of FFT Results}+\label{fig:fft-mui}+\end{figure}++%% fftEx :: UISF () ()+%% fftEx = proc _ -> do+%% f <- hSlider (1, 2000) 440 -< ()+%% (d,_) <- convertToUISF 100 simpleSig -< f+%% let (s,fft) = unzip d+%% _ <- histogram (500,150) 20 -< listToMaybe (catMaybes fft)+%% _ <- realtimeGraph' (500,150) 200 20 Black -< s+%% outA -< ()+%% where+%% simpleSig :: SigFun CtrRate Double (Double, Event FFTData)+%% simpleSig = proc f -> do+%% s <- osc (tableSinesN 4096 [1]) 0 -< f+%% fft <- fftA 100 (rate (undefined :: CtrRate)) 8 -< s+%% outA -< (s, fft)++%% t0 = runMUI (500,600) "fft Test" fftEx++\section{Further Pragmatics}++\todo{Discuss windowing.}++\vspace{.1in}\hrule++\begin{exercise}{\em +Modify the program in Figure~\ref{fig:fft-mui} in the following ways:+\begin{enumerate}+\item+Add a second slider, and use it to control the frequency of a second+oscillator. +\item+Let |s1| and |s2| be the names of the signals whose frequencies are+controlled by the first and second sliders, respectively. Instead of+displaying the FFT of just |s1|, try a variety of combinations of |s1|+and |s2|, such as |s1 + s2|, |s1 - s2|, |s1 * s2|, |1/s1 + 1/s2|, and+|s1 / s2|. Comment on the results.+\item+Use |s2| to control the frequency of |s1| (as was done with |vibrato|+in Chapter~\ref{ch:sigfuns}). Plot the fft of |s1| and comment on the+result.+\item+Instead of using |osc| to generate a pure sine wave, try using other+oscillators and/or table generators to create more complex tones, and+plot their FFT's. Comment on the results.+\end{enumerate}+}+\end{exercise}++\vspace{.1in}\hrule++\section{References}++Most of the ideas in this chapter can be found in any good textbook on+signal processing. The particular arrangement of the material here,+in particular Figure~\ref{fig:fourier-transforms} and the development+and demonstration of a program for the DFT, is borrowed from the+excellent text \emph{Elements of Computer Music} by Moore+\cite{Moore90}.+
+ HSoM/Syntax.lhs view
@@ -0,0 +1,579 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- + +%include lhs2TeX.fmt +%include myFormat.fmt + +% To do: +% change glue.eps to include dotted box for f.g + +\chapter{Syntactic Magic} +\label{ch:hof} + +This chapter introduces several more of Haskell's syntactic devices +that faciliate writing concise and intuitive programs. These devices +will be used frequently in the remainder of the text. + +%% You have now seen several examples where functions are passed as +%% arguments to other functions, such as with |fold| and |map|. In +%% this chapter we will see several examples where functions are also +%% returned as values. This will lead to several techniques for +%% improving definitions that we have already written, techniques that we +%% will use often in the remainder of the text. + +\section{Sections} +\label{sec:sections} + +The use of currying was introduced in Chapter \ref{ch:poly} as a way +to simplify programs. This is a syntactic device that relies on the +way that normal functions are applied, and how those applications are +parsed. + +With a bit more syntax, we can also curry applications of infix +operators such as |(+)|. This syntax is called a {\em + \indexwd{section}}, and the idea is that, in an expression such as +|(x+y)|, we can omit either the |x| or the |y|, and the result (with +the parentheses still intact) is a function of that missing argument. +If {\em both} variables are omitted, it is a function of {\em two} +arguments. In other words, the expressions |(x+)|, |(+y)| and |(+)| +are equivalent, respectively, to the functions: +\begin{spec} +f1 y = x+y +f2 x = x+y +f3 x y = x+y +\end{spec} + +For example, suppose we wish to remove all absolute pitches greater +than 99 from a list, perhaps because everything above that value is +assumed to be unplayable. There is a pre-defined function in Haskell +that can help to achieve this: +\begin{spec} +filter :: (a -> Bool) -> [a] -> [a] +\end{spec} +|filter p xs| returns a list for which each element |x| satisfies the +predicate |p|; i.e.\ |p x| is |True|. + +Using |filter|, we can then write: +\begin{spec} +playable :: [AbsPitch] -> [AbsPitch] +playable xs = let test ap = ap < 100 + in filter test xs +\end{spec} +But using a section, we can write this more succinctly as: +\begin{spec} +playable :: [AbsPitch] -> [AbsPitch] +playable xs = filter (<100) xs +\end{spec} +which can be further simplified using currying: +\begin{spec} +playable :: [AbsPitch] -> [AbsPitch] +playable = filter (<100) +\end{spec} + +This is an extremely concise definition. As you gain experience with +higher-order functions you will not only be able to start writing +definitions such as this directly, but you will also start {\em + thinking} in ``higher-order'' terms. Many more examples of this +kind of reasoning will appear throughout the text. + +%% ... determine, for each absolute +%% pitch in a list, whether it is higher than 57 (which corresponds to +%% concert A). Instead of writing: + +%% \begin{spec} +%% gtConcertA :: [AbsPitch] -> [Bool] +%% gtConcertA xs = let test ap = ap > 57 +%% in map test xs +%% \end{spec} +%% we can simply write: +%% \begin{spec} +%% gtConcertA :: [AbsPitch] -> [Bool] +%% gtConcertA xs = map (>57) xs +%% \end{spec} +%% which can be further simplified using currying: +%% \begin{spec} +%% gtConcertA :: [AbsPitch] -> [Bool] +%% gtConcertA = map (>57) +%% \end{spec} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Define a function |twice| that, given a function |f|, returns a +function that applies |f| twice to its argument. For example: +\begin{spec} +(twice (+1)) 2 ==> 4 +\end{spec} +What is the principal type of |twice|? Describe what |twice twice| +does, and give an example of its use. Also consider the functions +|twice twice twice| and |twice (twice twice)|? } +\end{exercise} + +\begin{exercise}{\em +Generalize |twice| defined in the previous exercise by defining a +function |power| that takes a function |f| and an integer +|n|, and returns a function that applies the function |f| to its +argument |n| times. For example: +\begin{spec} +power (+2) 5 1 ===> 11 +\end{spec} +Use |power| in a musical context to define something useful. +} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Anonymous Functions} +\label{sec:anonymous} + +\index{function!anonymous} + +Another way to define a function in Haskell is in some sense the most +fundamental: it is called an \emph{anonymous function}, or +\emph{lambda expression} (since the concept is drawn directly from +Church's lambda calculus \cite{church41}). The idea is that functions +are values, just like numbers and characters and strings, and +therefore there should be a way to create them without having to give +them a name. As a simple example, an anonymous function that +increments its numeric argument by one can be written |\x -> x+1|. +Anonymous functions are most useful in situations where you do not +wish to name them, which is why they are called ``anonymous.'' +Anonymity is a property also shared by sections, but sections can only +be derived from an existing infix operator. + +\syn{The typesetting used in this textbook prints an actual Greek + lambda character, but in writing |\x -> x+1| in your programs you + will have to type ``\verb!\x -> x+1!'' instead.} + +As another example, to raise the pitch of every element in a list of +pitches |ps| by an octave, we could write: +\begin{spec} +map (\p-> pitch (absPitch p + 12)) ps +\end{spec} +An even better example is an anonymous function that pattern-matches +its argument, as in the following, which doubles the duration of every +note in a list of notes |ns|: +\begin{spec} +map (\(Note d p) -> Note (2*d) p) ns +\end{spec} + +\syn{Anonymous functions can only perform one match against +an argument. That is, you cannot stack together several anonymous +functions to define one function, as you can with equations.} + +Anonymous functions are considered most fundamental because +definitions such as that for |simple| given in Chapter +\ref{ch:intro}: +\begin{spec} +simple x y z = x*(y+z) +\end{spec} +can be written instead as: +\begin{spec} +simple = \x y z -> x*(y+z) +\end{spec} +\syn{|\x y z -> exp| is shorthand for |\x -> \y-> \z -> exp|.} + +We can also use anonymous functions to explain precisely the behavior +of sections. In particular, note that: +\begin{spec} +(x+) ==> \y -> x+y +(+y) ==> \x -> x+y +(+) ==> \x y -> x+y +\end{spec} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Suppose we define a function \indexwdhs{fix} as: +\begin{spec} +fix f = f (fix f) +\end{spec} +What is the principal type of |fix|? (This is tricky!) Suppose +further that we have a recursive function: +\begin{spec} +remainder :: Integer -> Integer -> Integer +remainder a b = if a<b then a + else remainder (a-b) b +\end{spec} +Rewrite this function using |fix| so that it is not recursive. +(Also tricky!) Do you think that this process can be applied to {\em +any} recursive function?} +\end{exercise} + +\vspace{.1in}\hrule + +\section{List Comprehensions} +\label{sec:comprehensions} + +Haskell has a convenient and intuitive way to define a list in such a +way that it resembles the definition of a \emph{set} in mathematics. +For example, recall in the last chapter the definition of the function +|addDur|: +\begin{spec} +addDur :: Dur -> [Dur -> Music a] -> Music a +addDur d ns = let f n = n d + in line (map f ns) +\end{spec} +Here |ns| is a list of notes, each of which does not have a duration +yet assigned to it. If we think of this as a set, we might be led +to write the following solution in mathematical notation: +\[ \{ n\ d\ ||\ n \in ns \} \] +which can be read, ``the set of all notes |n d| such that |n| is an +element of |ns|.'' Indeed, using a Haskell \emph{list comprehension} +we can write almost exactly the same thing: +\begin{spec} +[ n d | n <- ns ] +\end{spec} +The difference, of course, is that the above expression generates an +(ordered) list in Haskell, not an (unordered) set in mathematics. + +List comprehensions allow us to rewrite the definition of |addDur| +much more succinctly and elegantly: +\begin{spec} +addDur :: Dur -> [Dur -> Music a] -> Music a +addDur d ns = line [ n d | n <- ns ] +\end{spec} + +\syn{Liberty is again taken in type-setting by using the symbol |<-| + to mean ``is an element of.'' When writing your programs, you will + have to type ``{\tt <-}'' instead. + +The expression |[ exp || x <- xs]| is actually shorthand for the +expression |map (\x -> exp) xs|. The form |x <- xs| is called a {\em + \indexwd{generator}}, and in general more than one is allowed, as +in: +\begin{spec} +[ (x,y) | x <- [0,1,2], y <- ['a','b'] ] +\end{spec} +which evaluates to the list: +\begin{spec} +[ (0,'a'), (0,'b'), (1,'a'), (1,'b'), (2,'a'), (2,'b') ] +\end{spec} +The order here is important; that is, note that the left-most +generator changes least quickly. + +It is also possible to \emph{filter} values as they are generated; for +example, we can modify the above example to eliminate the odd +integers in the first list: +\begin{spec} +[ (x,y) | x <- [0,1,2], even x, y <- ['a','b'] ] +\end{spec} +where |even n| returns |True| if |n| is even. This example evaluates +to: +\begin{spec} +[ (0,'a'), (0,'b'), (2,'a'), (2,'b') ] +\end{spec} +} + +\syn{When reasoning about list comprehensions (e.g.\ when doing proof + by calculation), we can use the following syntactic translation + into pure functions: +\begin{spec} +[ e | True ] = [ e ] +[ e | q ] = [ e | q, True ] +[ e | b, qs ] = if b then [ e | qs ] else [] +[ e | p <- xs, qs ] = let ok p = [ e | qs ] + ok _ = [] + in concatMap ok xs +[ e | let decls, qs ] = let decls in [ e | qs ] +\end{spec} +where |q| is a single qualifier, |qs| is a sequence of qualifiers, |b| +is a Boolean, |p| is a pattern, and |decls| is a sequence of variable +bindings (a feature of list comprehensions not explained earlier). +} +%% There are several other useful features of list comprehensions, but +%% they are not used in this text. Consult the Haskell Report for +%% details. + +\subsection{Arithmetic Sequences} +\label{sec:arithmetic-sequences} + +\index{arithmetic sequence} +Another convenient syntax for lists whose elements can be enumerated +is called an \emph{arithmetic sequence}. For example, the +arithmetic sequence |[1..10]| is equivalent to the list: +\begin{spec} +[1,2,3,4,5,6,7,8,9,10] +\end{spec} +There are actually four different versions of arithmetic sequences, +some of which generate \emph{infinite} lists (whose use will be +discussed in a later chapter). In the following, let |a=n'-n|: +\begin{spec} +[n..] -- infinite list |n|, |n+1|, |n+2|, ... +[n,n'..] -- infinite list |n|, |n+a|, |n+2*a|, ... +[n..m] -- finite list |n|, |n+1|, |n+2|, ..., |m| +[n,n'..m] -- finite list |n|, |n+a|, |n+2*a|, ..., |m| +\end{spec} + +Arithmetic sequences are discussed in greater detail in Appendix +\ref{ch:class-tour}. + +\vspace{.1in}\hrule + +\begin{exercise}{\em +Using list comprehensions, define a function: +\begin{spec} +apPairs :: [AbsPitch] -> [AbsPitch] -> [(AbsPitch,AbsPitch)] +\end{spec} +such that |apPairs aps1 aps2| is a list of all combinations of the +absolute pitches in |aps1| and |aps2|. Furthermore, for each pair +|(ap1,ap2)| in the result, the absolute value of |ap1-ap2| must be +greater than two and less than eight. + +Finally, write a function to turn the result of |apPairs| into a +|Music Pitch| value by playing each pair of pitches in parallel, and +stringing them all together sequentially. Try varying the rhythm by, +for example, using an eighth note when the first absolute pitch is +odd, and a sixteenth note when it is even, or some other criterion. + +Test your functions by using arithemtic sequences to generate the two +lists of arguments given to |apPairs|.} +\end{exercise} + +\vspace{.1in}\hrule + +\section{Function Composition} +\label{sec:function-composition} + +\begin{figure*} +\centerline{ +\epsfysize=0.75in +\epsfbox{Pics/glue.eps} +} +\caption{Gluing Two Functions Together} +\label{fig:glue} +\end{figure*} + +\index{function!composition||(} +An example of polymorphism that has nothing to do with data structures +arises from the desire to take two functions $f$ and $g$ and ``glue +them together,'' yielding another function $h$ that first applies $g$ +to its argument, and then applies $f$ to that result. This is called +function {\em composition} (just as in mathematics), and Haskell +pre-defines a simple infix operator |(.)| to achieve it, as follows: +\indexhs{(.)} +\begin{spec} +(.) :: (b->c) -> (a->b) -> a -> c +(f . g) x = f (g x) +\end{spec} +\syn{The symbol for function composition is typeset in this textbook + as |.|, which is consistent with mathematical convention. When + writing your programs, however, you will have to use a period, as in + ``\verb!f . g!''.} + +Note the type of the operator |(.)|; it is completely polymorphic. +Note also that the result of the first function to be applied---some +type |b|---must be the same as the type of the argument to the second +function to be applied. Pictorially, if we think of a function as a +black box that takes input at one end and returns some output at the +other, function composition is like connecting two boxes together, end +to end, as shown in Figure \ref{fig:glue}. + +The ability to compose functions using |(.)| is quite handy. For +example, recall the last version of |hList|: +\begin{spec} +hList d ps = line (map (hNote d) ps) +\end{spec} +We can do two simplifications here. First, rewrite the right-hand +side using function composition: +\begin{spec} +hList d ps = (line . map (hNote d)) ps +\end{spec} +Then, use currying simplification: +\begin{spec} +hList d = line . map (hNote d) +\end{spec} + +\section{Higher-Order Thinking} +\label{sec:higher-order-thinking} + +It is worth taking a deep breath here and contemplating what has been +done with |hList|, which has gone through quite a few transformations. +Here is the original definition given in Chapter \ref{ch:intro}: +\begin{spec} +hList d [] = rest 0 +hList d (p:ps) = hNote d p :+: hList d ps +\end{spec} +Compare this to the definition above. You may be distressed to think +that you have to go through all of these transformations just to write +a relatively simple function! There are two points to make about +this: First, you do not have to make \emph{any} of these +transformations if you do not want to. All of these versions of +|hList| are correct, and they all run about equally fast. They are +explained here for pedagogical purposes, so that you understand the +full power of Haskell. Second, with practice, you will find that you +can write the concise higher-order versions of many functions straight +away, without going through all of the steps presented here. + +As mentioned earlier, one thing that helps is to start {\em thinking} +in ``higher-order'' terms. To facilitate this way of thinking it is +helpful to write type signatures that reflect more closely their +higher-order nature. For example, recall these type signatures for +|map|, |filter|, and |(.)|: +\begin{spec} +map :: (a -> b) -> [a] -> [b] +filter :: (a -> Bool) -> [a] -> [a] +(.) :: (b->c) -> (a->b) -> a -> c +\end{spec} +Also recall that the arrow in function types is right associative. +Therefore, another completely equivalent way to write the above type +signatures is: +\begin{spec} +map :: (a -> b) -> ([a] -> [b]) +filter :: (a -> Bool) -> ([a] -> [a]) +(.) :: (b->c) -> (a->b) -> (a->c) +\end{spec} +Although equivalent, the latter versions emphasize the fact that each +of these functions returns a function as its result. |map| +essentially ``lifts'' a function on elements to a function on lists of +elements. |filter| converts a predicate into a function on lists. +And |(.)| returns a function that is the composition of its two +functional arguments. + +So for example, using higher-order thinking, |map (+12)| is a function +that transposes a list of absolute pitches by one octave. |filter +(<100)| is a function that removes all absolute pitches greater than +or equal to 100 (as discussed earlier). And therefore |map (+12) +. filter (<100)| first does the filtering, and then does the +transposition. All very consise and very natural using higher-order +thinking. + +In the remainder of this textbook definitions such as this will be +written directly, using a small set of rich polymorphic functions such +as |foldl|, |map|, |filter|, |(.)|, and a few other functions drawn +from the Standard Prelude and other standard libraries. + +%% For example, suppose we wish to define a +%% function that determines whether all of the elements in a list are +%% greater than zero, and one that determines if at least one is greater +%% than zero. The way to ``think about'' this is to raise ourselves up +%% to the list level, and to just compose functions that transform lists: +%% \begin{spec} +%% allOverZero, oneOverZero :: [Integer] -> Bool +%% allOverZero = and . posInts +%% oneOverZero = or . posInts +%% \end{spec} +%% \syn{|and :: [Bool] -> Bool| and |or :: [Bool] -> Bool| are predefined +%% functions that ``and'' and ``or'' together all of the elements in a +%% list, returning a single Boolean result. The |Bool| type is +%% predefined in Haskell simply as: +%% \begin{spec} +%% data Bool = False | True +%% \end{spec} +%% } +%% Indeed, note that the auxiliary function |posInts| is simple +%% enough that we could incorporate its definition directly, as in: +%% \begin{spec} +%% allOverZero, oneOverZero :: [Integer] -> Bool +%% allOverZero = and . map (>0) +%% oneOverZero = or . map (>0) +%% \end{spec} + +\section{Infix Function Application} + +Haskell predefines an infix operator to apply a function to a value: +\begin{spec} +f $ x = f x +\end{spec} % $ +At first glance this does not seem very useful---after all, why not +simply write |f x| instead of |f $ x|? % $ + +But in fact this operator has a very useful purpose: eliminating +parentheses! In the Standard Prelude, |($)| %% $ +is defined to be right associative, and to have the lowest precedence +level, via the fixity declaration: +\begin{spec} +infixr 0 $ +\end{spec} %% $ +Therefore, note that |f (g x)| is the same as |f $ g x| %% $ +(remember that normal function application always has higher +precedence than infix operator application), and |f (x+1)| is the same +as |f $ x + 1|. %% $ +This ``trick'' is especially useful when there is a sequence of +nested, parenthesized expresssions. For example, recall the following +definition from the last chapter: +\begin{spec} +childSong6 = let t = (dhn/qn)*(69/120) + in instrument RhodesPiano + (tempo t (bassLine :=: mainVoice)) +\end{spec} + +\pagebreak + +We can rewrite the last few lines a bit more clearly as follows: +\begin{spec} +childSong6 = let t = (dhn/qn)*(69/120) + in instrument RhodesPiano $ + tempo t $ + bassLine :=: mainVoice +\end{spec} +Or, on a single line, instead of: +\begin{spec} +instrument RhodesPiano (tempo t (bassLine :=: mainVoice)) +\end{spec} +we can write: +\begin{spec} +instrument RhodesPiano $ tempo t $ bassLine :=: mainVoice +\end{spec} + +\vspace{.1in}\hrule + +\begin{exercise}{\em +The last definition of |hList| still has an argument |d| on the +left-hand side, and one occurence of |d| on the right-hand side. Is +there some way to eliminate it using currying simplification? (Hint: +the answer is yes, but the solution is a bit perverse, and is not +recommended as a way to write your code!)} +\end{exercise} + +\out{ +hList d = line . map (hNote d) + = line . ((map . hNote) d) + = (.) line ((map . hNote) d) + = ((.) line . (map . hNote)) d + +hList = (.) line . (map . hNote) +} + +\begin{exercise}{\em +Use |line|, |map| and |($)| to give a concise definition of |addDur|.} +\end{exercise} % $ + +\begin{exercise}{\em +Rewrite this example: +\begin{spec} +map (\x-> (x+1)/2) xs +\end{spec} +using a composition of sections.} +\end{exercise} + +\begin{exercise}{\em +Consider the expression: +\begin{spec} +map f (map g xs) +\end{spec} +Rewrite this using function composition and a single call to |map|. +Then rewrite the earlier example: +\begin{spec} +map (\x-> (x+1)/2) xs +\end{spec} +as a ``map of a map'' (i.e.\ using two maps).} +\end{exercise} +\index{function!composition||)} + +\begin{exercise}{\em +Go back to any exercises prior to this chapter, and simplify your +solutions using ideas learned here.} +\end{exercise} + +\begin{exercise}{\em +Using higher-order functions introduced in this chapter, fill in the +two missing functions, |f1| and |f2|, in the evaluation below so that +it is valid: +\begin{spec} +f1 (f2 (*) [1, 2, 3, 4]) 5 ==> [5, 10, 15, 20] +\end{spec} +} +\end{exercise} + +\vspace{.1in}\hrule +
+ HSoM/ToMidi.lhs view
@@ -0,0 +1,685 @@+%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*-++%include lhs2TeX.fmt+%include myFormat.fmt++\out{+\begin{code}+-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/ToMidi.lhs. (See HSoM/MakeCode.bat.)++\end{code}+}++\chapter{From Performance to Midi}+\label{ch:midi}++\begin{code}+module Euterpea.IO.MIDI.ToMidi(toMidi, UserPatchMap, defST,+ defUpm, testMidi, testMidiA,+ test, testA, writeMidi, writeMidiA,+ play, playM, playA,+ makeMidi, mToMF, gmUpm, gmTest) where++import Euterpea.Music.Note.Music+import Euterpea.Music.Note.MoreMusic+import Euterpea.Music.Note.Performance+import Euterpea.IO.MIDI.GeneralMidi+import Euterpea.IO.MIDI.MidiIO+import Euterpea.IO.MIDI.ExportMidiFile+import Sound.PortMidi+import Data.List(partition)+import Data.Char(toLower,toUpper)+import Codec.Midi+\end{code}++writeMidi :: (Performable a) => FilePath -> Music a -> IO ()+writeMidi fn = exportMidiFile fn . testMidi++writeMidiA :: (Performable a) => FilePath -> PMap Note1 -> Context+Note1 -> Music a -> IO ()+writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m)++\indexwd{Midi} is shorthand for ``Musical Instrument Digital+Interface,'' and is a standard protocol for controlling electronic+musical instruments \cite{MIDI,General-MIDI}. This chapter describes+how to convert an abstract {\em performance} as defined in Chapter+\ref{ch:performance} into a \emph{standard Midi file} that can be+played on any modern PC with a standard sound card.++\section{An Introduction to Midi}+\label{sec:midi}++Midi is a standard adopted by most, if not all, manufacturers of+electronic instruments and personal computers. At its core is a+protocol for communicating \emph{musical events} (note on, note off,+etc.) and so-called \emph{meta events} (select synthesizer patch,+change tempo, etc.). Beyond the logical protocol, the Midi standard+also specifies electrical signal characteristics and cabling details,+as well as a \emph{standard Midi file} which any Midi-compatible+software package should be able to recognize.++Most ``sound-blaster''-like sound cards on conventional PC's know+about Midi. However, the sound generated by such modules, and the+sound produced from the typically-scrawny speakers on most PC's, is+often quite poor. It is best to use an outboard keyboard or tone+generator, which are attached to a computer via a Midi interface and+cables. It is possible to connect several Midi instruments to the+same computer, with each assigned to a different \emph{channel}.+Modern keyboards and tone generators are quite good. Not only is the+sound excellent (when played on a good stereo system), but they are+also \emph{multi-timbral}, which means they are able to generate many+different sounds simultaneously, as well as \emph{polyphonic}, meaning+that simultaneous instantiations of the same sound are possible.++%% Euterpea provides a way to specify a Midi channel number and General+%% Midi instrument selection for each |InstrumentName| in a Euterpea+%% composition. It also provides a means to generate a Standard Midi+%% File, which can then be played using any conventional Midi software.+%% Finally, it provides a way for existing Midi files to be read and+%% converted into a Music object in Euterpea. In this section the+%% top-level code needed by the user to invoke this functionality will be+%% described, along with the gory details. ++\subsection{General Midi}++Over the years musicians and manufacturers decided that they also+wanted a standard way to refer to commonly used instrument sounds,+such as ``acoustic grand piano,'' ``electric piano,'' ``violin,'' and+``acoustic bass,'' as well as more exotic sounds such as ``chorus+aahs,'' ``voice oohs,'' ``bird tweet,'' and ``helicopter.'' A simple+standard known as \emph{General Midi} was developed to fill this role.+The General Midi standard establishes standard names for 128 common+instrument sounds (also called ``patches'') and assigns an integer+called the \emph{program number} (also called ``program change+number''), to each of them. The instrument names and their program+numbers are grouped into ``familes'' of instrument sounds, as shown in+Table \ref{fig:gm-families}.++\begin{table}+%% \vspace{0.1in} \noindent+\begin{tabular}{||l||l||c||l||l||}\hline+\bf Family & \bf Program \# && \bf Family & \bf Program \# \\+\hline \hline+Piano & 1-8 && Reed & 65-72 \\ \hline+Chromatic Percussion & 9-16 && Pipe & 73-80 \\ \hline+Organ & 17-24 && Synth Lead & 81-88 \\ \hline+Guitar & 25-32 && Synth Pad & 89-96 \\ \hline+Bass & 33-40 && Synth Effects & 97-104 \\ \hline+Strings & 41-48 && Ethnic & 105-112 \\ \hline+Ensemble & 49-56 && Percussive & 113-120 \\ \hline+Brass & 57-64 && Sound Effects & 121-128 \\ \hline+\hline+\end{tabular}+%% \vspace{0.1in}+\caption{General Midi Instrument Families}+\label{fig:gm-families}+\end{table}++Now recall that in Chapter \ref{ch:music} we defined a set of+instruments via the |InstrumentName| data type (see Figure+\ref{fig:instrument-names}). All of the names chosen for that data+type come directly from the General Midi standard, except for two,+|Percussion| and |Custom|, which were added for convenience and+extensibility. By listing the constructors in the order that reflects+this assignment, we can derive an |Enum| instance for |InstrumentName|+that defines the method |toEnum| that essentially does the conversion+from instrument name to program number for us. We can then define a+function:+\begin{spec}+toGM :: InstrumentName -> ProgNum+toGM Percussion = 0+toGM (Custom name) = 0+toGM in = fromEnum in+\end{spec}+\begin{code}+type ProgNum = Int+\end{code}+that takes care of the two extra cases, which are simply assigned to+program number 0.++The derived |Enum| instance also defines a function |fromEnum| that+converts program numbers to instrument names. We can then define:+\begin{spec}+fromGM :: ProgNum -> InstrumentName+fromGM pn | pn >= 0 && pn <= 127 = fromEnum pn+fromGM pn = error ("fromGM: " ++ show pn ++ + " is not a valid General Midi program number")+\end{spec}++\syn{Design bug: Because the |IntrumentName| data type contains a+ non-nullary constructor, namely |Custom|, the |Enum| instance cannot+ be derived. For now it is defined in the module |GeneralMidi|, but+ a better solution is to redefine |InstrumentName| in such a way as+ to avoid this.}++\subsection{Channels and Patch Maps}++A Midi \emph{channel} is in essence a programmable instrument. You+can have up to 16 channels, numbered 0 through 15, each assigned a+different program number (corresponding to an instrument sound, see+above). All of the dynamic ``Note On'' and ``Note Off'' messages (to+be defined shortly) are tagged with a channel number, so up to 16+different instruments can be controlled independently and+simultaneously.++The assignment of Midi channels to instrument names is called a+\emph{patch map}, and we define a simple association list to capture+its structure:+\begin{code}+type UserPatchMap = [(InstrumentName, Channel)]+\end{code}+\begin{spec}+type Channel = Int+\end{spec}++The only thing odd about Midi Channels is that General Midi specifies+that Channel 10 (9 in Euterpea's 0-based numbering) is dedicated to+\emph{percussion} (which is different from the ``percussive+instruments'' described in Table \ref{fig:gm-families}). When Channel+10 is used, any program number to which it is assigned is ignored, and+instead each note corresponds to a different percussion sound. In+particular, General Midi specifies that the notes corresponding to+Midi Keys 35 through 82 correspond to specific percussive sounds.+Indeed, recall that in Chapter \ref{ch:more-music} we in fact captured+these percussion sounds through the |PercussionSound| data type, and+we defined a way to convert such a sound into an absolute pitch+(i.e.\ |AbsPitch|). Euterpea's absolute pitches, by the way, are in+one-to-one correspondence with Midi Key nunmbers.++Except for percussion, the Midi Channel used to represent a particular+instrument is completely arbitrary. Indeed, it is tedious to+explicitly define a new patch map every time the instrumentation of a+piece of music is changed. Therefore it is convenient to define a+function that automatically creates a |UserPatchMap| from a list of+instrument names:+\begin{code}+makeGMMap :: [InstrumentName] -> UserPatchMap+makeGMMap ins = mkGMMap 0 ins+ where mkGMMap _ [] = []+ mkGMMap n _ | n>=15 = + error "MakeGMMap: Too many instruments."+ mkGMMap n (Percussion : ins) = + (Percussion, 9) : mkGMMap n ins+ mkGMMap n (i : ins) = + (i, chanList !! n) : mkGMMap (n+1) ins+ chanList = [0..8] ++ [10..15] -- channel 9 is for percussion+\end{code}+Note that, since there are only 15 Midi channels plus percussion, we+can handle only 15 different instruments, and an error is signaled if+this limit is exceeded.\footnote{It is conceivable to define a+ function to test whether or not two tracks can be combined with a+ Program Change (tracks can be combined if they don't overlap), but+ this remains for future work.}++Finally, we define a function to look up an |InstrumentName| in a+\newline |UserPatchMap|, and return the associated channel as well as+its program number:+\begin{code} +upmLookup :: UserPatchMap -> InstrumentName + -> (Channel, ProgNum)+upmLookup upm iName = (chan, toGM iName)+ where chan = maybe (error ( "instrument " ++ show iName ++ + " not in patch map") )+ id (lookup iName upm)+\end{code}++%% Note that the function that does string matching ignores case, and+%% allows substring matches. For example, |"chur"| matches |"Church+%% Organ"|. Note also that the \emph{first} match succeeds, so using a+%% substring should be done with care to be sure that the correct+%% instrument is selected.++\subsection{Standard Midi Files}++The Midi standard defines the precise format of a \emph{standard Midi+ file}. At the time when the Midi standard was first created, disk+space was at a premium, and thus a compact file structure was+important. Standard Midi files are thus defined at the bit and byte+level, and are quite compact. We are not interested in this low-level+representation (any more than we are interested in the signals that+run on Midi cables), and thus in Euterpea we take a more abstract+approach: We define an algebraic data type called |Midi| to capture+the abstract structure of a standard Midi file, and then define+functions to convert values of this data type to and from actual Midi+files. This separation of concerns makes the structure of the Midi+file clearer, makes debugging easier, and provides a natural path for+extending Euterpea's functionality with direct Midi capability.+% (discussed further in Chapter \ref{ch:reactivity}).++\begin{figure}+\cbox{\small+\begin{spec}+-- From the |Codec.Midi| module++data Midi = Midi { fileType :: FileType,+ timeDiv :: TimeDiv+ tracks :: [Track Ticks] }+ deriving (Eq, Show)++data FileType = SingleTrack | MultiTrack | MultiPattern+ deriving (Eq, Show)++type Track a = [(a, Message)]++data TimeDiv = TicksPerBeat Int -- 1 through ($2^{15}$ - 1)+ | ...+ deriving (Show,Eq)++type Ticks = Int -- 0 through ($2^{28}$ - 1)+type Time = Double+type Channel = Int -- 0 through 15+type Key = Int -- 0 through 127+type Velocity = Int -- 0 through 127+type Pressure = Int -- 0 through 127+type Preset = Int -- 0 through 127+type Tempo = Int -- microseconds per beat, 1 through ($2^{24}$ - 1) ++data Message =+ -- Channel Messages+ NoteOff { channel :: !Channel, key :: !Key, velocity :: !Velocity }+ | NoteOn { channel :: !Channel, key :: !Key, velocity :: !Velocity }+ | ProgramChange { channel :: !Channel, preset :: !Preset }+ | ...+ -- Meta Messages+ | TempoChange !Tempo |+ | ...+ deriving (Show,Eq)++fromAbsTime :: (Num a) => Track a -> Track a+fromAbsTime trk = zip ts' ms + where (ts,ms) = unzip trk+ (_,ts') = mapAccumL (\acc t -> (t,t - acc)) 0 ts +\end{spec}}+\caption{Partial Definition of the |Midi| Data Type}+\label{fig:MidiFile}+\end{figure}++We will not discuss the details of the functions that read and write+the actual Midi files; the interested reader may find them in the+modules |ReadMidi| and |OutputMidi|, respectively. Instead, we will+focus on the |Midi| data type, which is defined in the module+|Codec.Midi|. We do not need all of its functionality, and thus we+show in Figure \ref{fig:MidiFile} only those parts of the module+that we need for this chapter. Here are the salient points about this+data type and the structure of Midi files:+\begin{enumerate} +\item There are three types of Midi files:+\begin{itemize}+\item A Format 0, or |SingleTrack|, Midi file stores its information in+ a single track of events, and is best used only for monophonic+ music.+\item A Format 1, or |MultiTrack|, Midi file stores its information in+ multiple tracks that are played simultaneously, where each track+ normally corresponds to a single Midi Channel.+\item A Format 2, or |MultiPattern|, Midi file also has multiple+ tracks, but they are temporally independent.+\end{itemize} +In this chapter we only use |SingleTrack| and |MultiTrack| Midi files,+depending on how many Channels we need.++\item The \indexwdhs{TimeDiv} field refers to the \emph{time-code+ division} used by the Midi file. We will always use 96 time+ divisions, or ``ticks,'' per quarternote, and thus this field will+ always be |TicksPerBeat 96|.++\item The main body of a Midi file is a list of \indexwdhs{Track}s,+ each of which in turn is a list of time-stamped (in number of ticks)+ |Message|s (or ``events'').++\item There are two kinds of \indexwdhs{Message}s: \emph{channel+ messages} and \emph{meta messages}. Figure \ref{fig:MidiFile} shows+ just those messages that we are interested in:+\begin{enumerate}+\item \indexhs{NoteOn} |NoteOn ch k v| turns on key (pitch) |k|+ with velocity (volume) |v| on Midi channel |ch|. The velocity+ is an integer in the range 0 to 127.+\item \indexhs{NoteOff} |NoteOff ch k v| performs a similar+ function in turning the note off. +\item \indexhs{ProgChange} |ProgChange ch pr| sets the program+ number for channel |ch| to |pr|. This is how an instrument is+ selected.+\item \indexhs{SetTempo} |TempoChange t| sets the tempo to |t|,+ which is the time, in microseconds, of one whole note. Using 120+ beats per minute as the norm, or 2 beats per second, that works out+ to 500,000 microseconds per beat, which is the default value that we+ will use.+\end{enumerate} +\end{enumerate} ++\section{Converting a Performance into Midi}++Our goal is to convert a value of type |Performance| into a value of+type |Midi|. We can summarize the situation pictorially as follows+...++%% \begin{verbatim}+%% *LoadMidi* *ReadMidi*+%% +------+ =loadMidiFile= +-----------+ =readMidi= +-----------++%% | Midi |----------------->| MidiFile |---------------->| Music |+%% | File | | data type | | data type |+%% | |<-----------------| |<----------------| |+%% +------+ +-----------+ *HaskToMidi* +-----------+ +%% *OutputMidi* *MidiFile* *Performance* *Basics*+%% =outputMidiFile= =makeMidi=+%% \end{verbatim}++Given a |UserPatchMap|, a |Performance| is converted into a |Midi|+value by the |toMidi| function. If the given |UserPatchMap| is+invalid, it creates a new one using |makeGMMap| described earlier.+\begin{code}+toMidi :: Performance -> UserPatchMap -> Midi+toMidi pf upm =+ let split = splitByInst pf+ insts = map fst split+ rightMap = if (allValid upm insts) then upm+ else (makeGMMap insts)+ in Midi (if length split == 1 then SingleTrack + else MultiTrack)+ (TicksPerBeat division)+ (map (fromAbsTime . performToMEvs rightMap) split)++division = 96 :: Int+\end{code}++The following function is used to test whether or not every instrument+in a list is found in a |UserPatchMap|:+\begin{code}+allValid :: UserPatchMap -> [InstrumentName] -> Bool+allValid upm = and . map (lookupB upm)++lookupB :: UserPatchMap -> InstrumentName -> Bool+lookupB upm x = or (map ((== x) . fst) upm)+\end{code}+%% lookupB [] _ = False+%% lookupB ((y,_):ys) x = x == y || lookupB ys x++The strategy is to associate each channel with a separate track. Thus+we first partition the event list into separate lists for each+instrument, and signal an error if there are more than 16:+\begin{code}+splitByInst :: Performance -> [(InstrumentName,Performance)]+splitByInst [] = []+splitByInst pf = (i, pf1) : splitByInst pf2+ where i = eInst (head pf)+ (pf1, pf2) = partition (\e -> eInst e == i) pf+\end{code}+Note how |partition| is used to group into |pf1| those events+that use the same instrument as the first event in the performance.+The rest of the events are collected into |pf2|, which is passed+recursively to |splitByInst|.++\indexhs{partition}+\syn{|partition| takes a predicate and a list and returns a pair of+ lists: those elements that satisfy the predicate, and those that do+ not, respectively. |partition| is defined in the |List|+ Library as:+\begin{spec}+partition :: (a -> Bool) -> [a] -> ([a],[a])+partition p xs = + foldr select ([],[]) xs+ where select x (ts,fs) | p x = (x:ts,fs)+ | otherwise = (ts, x:fs)+\end{spec}+}++The crux of the conversion process is in |performToMEvs|, which+converts a |Performance| into a stream of time-stamped messages,+i.e.\ a stream of |(Tick,Message)| pairs:+\begin{code}+type MEvent = (Ticks, Message)++defST = 500000++performToMEvs :: UserPatchMap+ -> (InstrumentName, Performance) + -> [MEvent]+performToMEvs upm (inm, pf) =+ let (chan,progNum) = upmLookup upm inm+ setupInst = (0, ProgramChange chan progNum)+ setTempo = (0, TempoChange defST)+ loop [] = []+ loop (e:es) = let (mev1,mev2) = mkMEvents chan e+ in mev1 : insertMEvent mev2 (loop es)+ in setupInst : setTempo : loop pf+\end{code}++A source of incompatibilty between Euterpea and Midi is that Euterpea+represents notes with an onset and a duration, while Midi represents+them as two separate events, a note-on event and a note-off event.+Thus |MkMEvents| turns a Euterpea |Event| into two |MEvents|, a+|NoteOn| and a |NoteOff|.+\begin{code}+mkMEvents :: Channel -> Event -> (MEvent,MEvent)+mkMEvents mChan (Event { eTime = t, ePitch = p, + eDur = d, eVol = v})+ = ( (toDelta t, NoteOn mChan p v'),+ (toDelta (t+d), NoteOff mChan p v') )+ where v' = max 0 (min 127 (fromIntegral v))++toDelta t = round (t * 2.0 * fromIntegral division)+\end{code}+The time-stamp associated with an event in Midi is called a {\em+delta-time}, and is the time at which the event should occur expressed+in time-code divisions since the beginning of the performance. Since+there are 96 time-code divisions per quarter note, there are 4 times+that many in a whole note; multiplying that by the time-stamp on one+of our |Event|s gives us the proper delta-time.++In the code for |performToMEvs|, note that the location of the+first event returned from |mkMEvents| is obvious; it belongs just+where it was created. However, the second event must be inserted into+the proper place in the rest of the stream of events; there is no way+to know of its proper position ahead of time. The function+\indexwdhs{insertMEvent} is thus used to insert an |MEvent| into an+already time-ordered sequence of |MEvent|s.+\begin{code}+insertMEvent :: MEvent -> [MEvent] -> [MEvent]+insertMEvent mev1 [] = [mev1]+insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') = + if t1 <= t2 then mev1 : mevs+ else mev2 : insertMEvent mev1 mevs'+\end{code}++\section{Putting It All Together}++\todo{Move the code for the |PerformanceDefault| type class, the+ family of |play| functions, and so on, to this section.}++%% We are almost done. All that remains is to write the |MidiFile|+%% value into a real file. The details of this are surprisingly ugly,+%% however, primarily because Midi files were invented at a time when+%% disk space was precious, and thus a compact bit-level representation+%% was chosen. Fortunately, there is a function in the |Euterpea|+%% library that solves this problem for us: \indexhs{outputMidiFile}+%% \begin{code}+%% outputMidiFile :: String -> MidiFile -> IO ()+%% \end{code}++%% To make this easier to use, let's define a function |test| that+%% converts a |Music| value using a default |Context| into a+%% |MidiFile| value, and then writes that to a file |"test.mid"|:+%% \begin{code}+%% test :: Music -> IO ()+%% test m = outputMidiFile "test.mid" +%% (performToMidi (perform defCon m))++%% defCon :: Context+%% defCon = Context { cTime = 0,+%% cInst = AcousticGrandPiano,+%% cDur = metro 120 qn,+%% cKey = 0 }+%% \end{code}++%% So if you type |test m| for some |Music| value |m|, it will+%% be converted to Midi and written to the file |"test.mid"|, which+%% you can then play using whatever Midi-file player is supplied with+%% your computer. If you are running the Hugs implementation of Haskell+%% on Windows 95/NT or Linux, you can invoke the standard media player+%% from Haskell by defining one of the following functions (for these to+%% work you must also import |system| from the Hugs module+%% |System|, via |import System (system)|):+%% \indexhs{testWin95}+%% \indexhs{testNT}+%% \indexhs{testLinux}++%% \begin{code}+%% testWin95, testNT, testLinux :: Music -> IO ()++%% testWin95 m = do test m+%% system "mplayer test.mid"+%% return ()++%% testNT m = do test m+%% system "mplay32 test.mid"+%% return ()++%% testLinux m = do test m+%% system "playmidi -rf test.mid"+%% return ()+%% \end{code}++%% For example, typing:+%% \begin{code}+%% testNT funkGroove+%% \end{code}+%% using Hugs on an NT system will write the |funkGroove| example from+%% Chapter \ref{ch:music} into a Midi file and then automatically fire up+%% the media player so that you can hear the result. Try the above for+%% other examples from Chapter \ref{ch:music}, such as |cMajArp|,+%% |cMajChd|, |pr12|, |waterfall|, and |main|.++\out{++A default UserPatchMap+----------------------++\begin{code}++defUpm :: UserPatchMap+defUpm = [(AcousticGrandPiano,1),+ (Vibraphone,2),+ (AcousticBass,3),+ (Flute,4),+ (TenorSax,5),+ (AcousticGuitarSteel,6),+ (Viola,7),+ (StringEnsemble1,8),+ (AcousticGrandPiano,9)] + -- the GM name for drums is unimportant, only channel 9+\end{code}++Generating MIDI values and MIDI files+-------------------------------------++Generate a MIDI datatype:++\begin{code}++testMidi :: Performable a => Music a -> Midi+testMidi m = toMidi (defToPerf m) defUpm++testMidiA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Midi+testMidiA pm con m = toMidi (toPerf pm con m) defUpm+\end{code} ++Generate a MIDI file:++\begin{code}++test :: Performable a => Music a -> IO ()+test m = exportMidiFile "test.mid" (testMidi m)++testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO ()+testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m)++writeMidi :: Performable a => FilePath -> Music a -> IO ()+writeMidi fn = exportMidiFile fn . testMidi++writeMidiA :: Performable a => + FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO ()+writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m)+\end{code} ++Alternatively, just run "play m", which will play the music+through the default Midi output device on your computer:++\begin{code}++play :: Performable a => Music a -> IO ()+play = playM . testMidi +\end{code} ++Or play a Midi data directly:++\begin{code}++playM :: Midi -> IO ()+playM midi = do+ initialize+ (defaultOutput playMidi) midi + terminate+ return ()+\end{code} ++A play function that takes a PMap and Context:++\begin{code}++playA :: Performable a => PMap Note1 -> Context Note1+ -> Music a -> IO ()+playA pm con m = + let pf = fst $ perfDur pm con m+ in playM (toMidi pf defUpm)+\end{code} %$++A more general function in the tradition of testMidi, makeMidi also+takes a Context and a UserPatchMap.++\begin{code}++makeMidi :: (Music1, Context Note1, UserPatchMap) -> Midi+makeMidi (m,c,upm) = toMidi (perform defPMap c m) upm+\end{code} ++The most general export function from Music to a Midi file.++\begin{code}++mToMF :: PMap a -> Context a -> UserPatchMap -> FilePath -> Music a -> IO ()+mToMF pmap c upm fn m =+ let pf = perform pmap c m+ mf = toMidi pf upm+ in exportMidiFile fn mf+\end{code} ++Some General Midi test functions (use with caution)+---------------------------------------------------++A General MIDI user patch map; i.e. one that maps GM instrument names+to themselves, using a channel that is the patch number modulo 16.+This is for use ONLY in the code that follows, o/w channel duplication+is possible, which will screw things up in general.++\begin{code}++gmUpm :: UserPatchMap+gmUpm = map (\n -> (toEnum n, mod n 16 + 1)) [0..127]+\end{code} ++Something to play each "instrument group" of 8 GM instruments;+this function will play a C major arpeggio on each instrument.++\begin{code}++gmTest :: Int -> IO ()+gmTest i = let gMM = take 8 (drop (i*8) [0..127])+ mu = line (map simple gMM)+ simple n = Modify (Instrument (toEnum n)) cMajArp+ in mToMF defPMap defCon gmUpm "test.mid" mu++cMaj = [ n 4 qn | n <- [c,e,g] ] -- octave 4, quarter notes+cMajArp = toMusic1 (line cMaj)+\end{code} ++}
+ HSoM/myFormat.fmt view
@@ -0,0 +1,214 @@+%format bottom = "\bot" +%format forall = "\forall" +%format == = "==" +%format /= = "\neq" +%format === = "\equiv" +%format ==== = "\cong" +%format ==> = "\Rightarrow" +%format ===> = "\Longrightarrow" +%format ^ = "\char94" +%format :+: = "\mathbin{:\!\!+\!\!:}" +%format !:+: = "\mathbin{\ :\!\!+\!\!:}" +%format +: = "\mathbin{+\!\!:}" +%format /=: = "\mathbin{/\!=:}" +%format :=/ = "\mathbin{:=\!\!/}" +%format !:=: = "\mathbin{\ :=:}" +%format :+ = "\mathbin{:\!\!+}" +%format :. = "\mathbin{:\!\!.}" +%format =:> = "\supseteq" +%format <* = "\mathbin{<\!\!*}" +%format >* = "\mathbin{>\!\!*}" +%format <=* = "\mathbin{\leq\!\!*}" +%format >=* = "\mathbin{\geq\!\!*}" +%format /=* = "\mathbin{\neq\!\!*}" +%format ==* = "\mathbin{==\!\!*}" +%format ->> = "\mathbin{-\!\!\!\gg}" +%format =>> = "\mathbin{=\!\gg}" +%format / = "\mathbin{\!/\!}" +%format !++ = "\mathbin{\ +\!\!\!+}" +%format -< = "\mathbin{-\!\!\!\prec}" +%format >>> = "\mathbin{>\!\!\!>\!\!\!>}" +%format <<< = "\mathbin{<\!\!\!<\!\!\!<}" +%format proc = "\mathbf{proc}" +%format rec = "\mathbf{rec}" +%format e1 +%format e2 +%format e3 +%format e4 +%format T1 +%format T2 +%format T3 +%format T4 +%format m0 +%format m1 +%format m2 +%format m3 +%format m4 +%format m5 +%format m6 +%format m'1 +%format m'2 +%format p0 +%format p1 +%format p2 +%format p3 +%format p4 +%format pr1 +%format pr2 +%format pr3 +%format pr4 +%format pr12 +%format pc1 +%format pc2 +%format d0 +%format d1 +%format d2 +%format d3 +%format d4 +%format d5 +%format d6 +%format x1 +%format x2 +%format x3 +%format x4 +%format y1 +%format y2 +%format xs1 +%format xs2 +%format xs3 +%format xs4 +%format v1 +%format v2 +%format v3 +%format v4 +%format v1a = "\Varid{v}_{1a}" +%format v1b = "\Varid{v}_{1b}" +%format v2a = "\Varid{v}_{2a}" +%format v2b = "\Varid{v}_{2b}" +%format v2c = "\Varid{v}_{2c}" +%format v2d = "\Varid{v}_{2d}" +%format v2e = "\Varid{v}_{2e}" +%format v2f = "\Varid{v}_{2f}" +%format v2g = "\Varid{v}_{2g}" +%format f0 +%format f1 +%format f2 +%format f3 +%format f4 +%format r1 +%format r2 +%format mel1 +%format mel2 +%format b1 +%format b2 +%format b3 +%format ma1 +%format ma2 +%format mb1 +%format mb2 +%format c1 +%format c2 +%format s0 +%format s1 +%format s2 +%format s3 +%format s4 +%format s5 +%format s6 +%format s7 +%format s8 +%format ss1 +%format ss2 +%format ss3 +%format ss4 +%format ss5 +%format ss6 +%format l1 +%format l2 +%format l3 +%format l4 +%format es1 +%format es2 +%format pf1 +%format pf2 +%format t0 +%format t1 +%format t2 +%format tm0 +%format ttm0 +%format tm1 +%format tm2 +%format tm3 +%format ttm3 +%format tm4 +%format tm5 +%format fac1 +%format fac2 +%format ui0 +%format ui1 +%format ui2 +%format ui3 +%format ui4 +%format ui5 +%format ui6 +%format mui0 +%format mui1 +%format mui2 +%format mui3 +%format mui4 +%format mui5 +%format mui'5 +%format mui6 +%format n1 +%format n2 +%format ns1 +%format ns2 +%format r1 +%format r2 +%format toAbsP1 +%format toAbsP2 +%format mkNote1 +%format mkNote2 +%format mkNote3 +%format mkLine1 +%format mkLine2 +%format mkLine3 +%format ps0 +%format ps1 +%format ps2 +%format na1 +%format na2 +%format na3 +%format ap1 +%format ap2 +%format aps1 +%format aps2 +%format tab1 +%format tab2 +%format M1 +%format M2 +%format ld1 +%format ld2 +%format ds1 +%format ds2 +%format toAbsPitches1 +%format toAbsPitches2 +%format line1 +%format line2 +%format reverse1 +%format reverse2 +%format op1 +%format a1 +%format a2 +%format fsm1 +%format sm0 +%format sm1 +%format t'1 +%format t'2 +%format lt0 +%format lt1 +%format flt1 +%format bell1 +%format bell'1 +%format bell2 +
+ License view
@@ -0,0 +1,20 @@+Copyright (c) 2008-2012 Paul Hudak <paul.hudak@yale.edu> ++This software is provided 'as-is', without any express or implied+warranty. In no event will the authors be held liable for any damages+arising from the use of this software.++Permission is granted to anyone to use this software for any purpose,+including commercial applications, and to alter it and redistribute it+freely, subject to the following restrictions:++1. The origin of this software must not be misrepresented; you must not+ claim that you wrote the original software. If you use this software+ in a product, an acknowledgment in the product documentation would+ be appreciated but is not required.++2. Altered source versions must be plainly marked as such, and must not+ be misrepresented as being the original software.++3. This notice may not be removed or altered from any source+ distribution.
+ ReadMe.txt view
@@ -0,0 +1,187 @@+ _____ _ +| ___| | | +| |__ _ _| |_ ___ _ __ _ __ ___ __ _ +| __| | | | __/ _ \ '__| '_ \ / _ \/ _` |+| |__| |_| | || __/ | | |_) | __/ (_| |+\____/\__,_|\__\___|_| | .__/ \___|\__,_|+ | | + |_| ++Euterpea is a domain-specific language embedded in Haskell for +computer music research, education, and development, providing +both note-level and signal-level abstractions. It is a descendant +of Haskore and HasSound, and is intended for both educational purposes +as well as serious computer music applications. Euterpea is a +wide-spectrum DSL, suitable for high-level music representation, +algorithmic composition, and analysis; mid-level concepts such as +MIDI; and low-level audio processing, sound synthesis, and instrument +design. It also includes a "musical user interface," a set of +computer-music specific GUI widgets such as keyboards, pushbuttons, +sliders, and so on. The performance of Euterpea is intended to be +as good as any other computer music language, with the goal of being +able to develop real-time applications, using both MIDI and a +high-performance back-end for real-time audio. ++See Liense for licensing information.++Homepage: http://haskell.cs.yale.edu/+++============================+==== Getting the Source ====+============================++Currently (2/8/2014), the most up-to-date version of Euterpea is +available through GitHub at:++ https://github.com/Euterpea/Euterpea++We recommend checking out the master version, as it should always be +kept stable.++When we reach milestones, we will release stable versions to Hackage.+++============================+======= Installation =======+============================++Installing from source RECOMMENDED (updated 2/8/2014)++ 1) Clone the source from github+ git clone https://github.com/Euterpea/Euterpea++ 2) cd into the Euterpea directory+ cd Euterpea++ 3) install Euterpea with cabal+ cabal install++--------- Windows ----------+There are currently no further steps or known issues installing on Windows.+++---------- Linux -----------+You may require additional steps to get MIDI sound output working on Linux. +First of all, we recommend using TiMidity (http://timidity.sourceforge.net/) +and either Freepats (http://freepats.zenvoid.org/) or PersonalCopy +(ftp://ftp.personalcopy.net/pub/Unison.sf2.gz) for MIDI support. +Make sure timidity is properly depending on the PersonalCopy soundfont +if you're using it.++Make sure timidity is the default MIDI-Through port. The easiest way to +do this is probably to remove the default dummy port:+sudo rmmod snd_seq_dummy+Then, while Euterpea programs are running, you must have timidity running +in the background:+timidity -iA -Os &+++--------- Mac OS X ---------+OS X is the least desirable platform on which to run Euterpea. In fact, +the latest release of OS X (Mavericks) has trouble with GHC in general.++We, the maintainers, currently do not have a Mac to test with, and so we +have no exact instructions for how to set up GHC and Euterpea to get them +into a functioning condition.++Once Euterpea is set up, you may require additional steps to get MIDI sound +output working. Download SimpleSynth and open it before you run ghci. Its +a software MIDI synthesizer that plays MIDI output through the speaker.++Furthermore, you will have to use the ``EnableGUI trick'' to run GUI +programs for Euterpea. To do so, first compile EnableGUI.hs from the +Euterpea/Examples directory to binary:+ghc -c -fffi EnableGUI.hs+(Note: on some systems it is necessary to add the option +``-framework ApplicationServices'')+Then, run your Euterpea GUI programs in ghci like this:++ghci UIExamples.hs EnableGUI+*UIExamples> :m +EnableGUI+*UIExamples EnableGUI> enableGUI >> main++With this, GHCi will be able to fully activate the Graphics Window. (Fully +compiled GUI programs do not suffer from this anomaly.)+++------ Troubleshooting -----+If you get errors about packages not being installed, make sure that cabal +binaries are in your `$PATH`.++To add cabal binaries to your path first add +export PATH=$HOME/.cabal/bin:$PATH+to your .bashrc and then run +source ~/.bashrc+Now you should be able to successfully cabal install.+++============================+======= Building HSoM ======+============================++This Euterpea distribution comes with the source code for the book:++ The Haskell School of Music, by Paul Hudak.++Building the source into a PDF requires LaTeX as well as the package +lhs2TeX. Information about LaTeX can be found at ++ http://www.latex-project.org/++and information about lhs2TeX can be found at++ http://www.andres-loeh.de/lhs2tex/++As lhs2TeX is available on Hackage, it can be installed with cabal:++ cabal install lhs2tex++Once these are ready, building the book can be achieved by running the +batch script MakeTex.bat in the HSoM directory. This will compile the +lhs files into tex files, the tex files to a dvi, the dvi into a ps, and +finally the ps to a pdf.++Note that the files of HSoM are Literate Haskell (lhs) files. As such, +they can be run directly with GHC. However, the batch script MakeCode.bat +will extract just the code. Although they can be regenerated, these +extracted files are already included with the Euterpea distribution, and +many are important files for the proper functioning of the library.+++============================+====== Getting Started =====+============================++A good place to begin learning about Euterpea is from the text that +accompanies this distribution: The Haskell School of Music, by Paul Hudak. +The source files are available in the HSoM directory, and building them +to a PDF is described above.++Using Euterpea is generally as easy as adding++ import Euterpea++to the imports of your Haskell program. However, for specific advanced uses, +other specific imports can be appropriate.++Lastly, the Euterpea.Examples subdirectory contains many examples of using +Euterpea in practice. These examples are designed to showcase Euterpea's +powers, but they may also be useful simply as a starting off point.+++============================+======== Information =======+============================++Euterpea was created by:+ Paul Hudak <paul.hudak@cs.yale.edu>, + Eric Cheng <eric.cheng@aya.yale.edu>,+ Hai (Paul) Liu <hai.liu@aya.yale.edu>+and is currently maintained by+ Paul Hudak <paul.hudak@cs.yale.edu>, + Donya Quick <donya.quick@yale.edu>,+ Dan Winograd-Cort <daniel.winograd-cort@yale.edu>++This file was last modified on 2/8/2014+by Daniel Winograd-Cort
+ Setup.hs view
@@ -0,0 +1,51 @@+import Distribution.Simple+main = defaultMain++-- January 18, 2014+-- The following setup script uses the CCA preprocessor (ccap) to preprocess +-- certain *.as files in the Euterpea code base. As of January 18, 2014, only +-- one file is being preprocessed in this way (Euterpea.IO.Audio.Basics), and +-- as some users have had difficulty with installations due to this +-- preprocessing step, we are removing it from the installation procedure.+-- +-- Now, to process *.as files, one can directly use the ArrowWrap module in +-- Euterpea. In ArrowWrap, all files to be preprocessed must be declared in +-- the list called fileList. Then, simply run main.+-- +-- If this preprocessor is going to be reenabled, or if ArrowWrap is going +-- to be used, one must either add haskell-src-exts >= 1.14.0 to the cabal +-- build-depends or just install it directly.+{-+module Main (main) where++import Distribution.Simple+import Distribution.Simple.PreProcess+import Distribution.Simple.Program+import Distribution.Simple.Utils+import System.Exit++import ArrowWrap++findArrowP verbosity = do+ a <- findProgramLocation verbosity "ccap"+ case a of + Nothing -> error "Preprocessor ccap not found. Please make sure the \+ \CCA library is already installed, and ccap is in \+ \your PATH environment."+ Just p -> return p++ppArrow bi lbi = PreProcessor {+ platformIndependent = True,+ runPreProcessor = + mkSimplePreProcessor $ \inFile outFile verbosity ->+ do info verbosity (inFile ++ " has been preprocessed to " ++ outFile)+ arrowp <- findArrowP verbosity+ runArrowP arrowp inFile outFile+ }++myHooks = simpleUserHooks + { hookedPreProcessors = ("as", ppArrow) : knownSuffixHandlers }++main :: IO ()+main = defaultMainWithHooks myHooks+-}
+ System/Random/Distributions.hs view
@@ -0,0 +1,135 @@+-- Algorithms taken from Dodge and Jerse's Computer Music: Synthesis,+-- Composition, and Performance, Chapter 11. ++module System.Random.Distributions (+ -- * Random Distributions+ linear, exponential, bilExp, gaussian, cauchy, poisson, frequency++ -- * Utility Functions+ , rands++ ) where++import System.Random++{- | Given a random number generator, generates a linearly distributed+random variable between 0 and 1. Returns the random value together+with a new random number generator. The probability density function+is given by++> f(x) = 2(1-x) 0 <= x <= 1+> = 0 otherwise++-}+linear :: (RandomGen g, Floating a, Random a, Ord a) => g -> (a,g)+linear g0 = + let (r1, g1) = randomR (0, 1) g0+ (r2, g2) = randomR (0, 1) g1+ in (min r1 r2, g2)++{- | Takes a random number generator and produces another one+ that avoids generating the given number.+-}+avoid :: (Random a, Eq a, RandomGen g) => a -> (g -> (a,g)) -> g -> (a,g)+avoid x f g = if r == x then avoid x f g' else (r,g')+ where (r,g') = f g++{- | Generates an exponentially distributed random variable given a+spread parameter lambda. A larger spread increases the probability of+generating a small number. The mean of the distribution is+1/lambda. The range of the generated number is [0,inf] although+the chance of getting a very large number is very small.++The probability density function is given by++> f(x) = lambda e^(-lambda * x)+-}+exponential :: (RandomGen g, Floating a, Random a, Eq a) => + a -- ^ horizontal spread of the function.+ -> g -- ^ a random number generator.+ -> (a,g)+exponential lambda g0 = (-log r1 / lambda, g1)+ where (r1, g1) = avoid 0 random g0++{- | Generates a random number with a bilateral exponential distribution. +Similar to exponential, but the mean of the distribution is 0 and+50% of the results fall between (-1/lambda, 1/lambda).++-}+bilExp :: (Floating a, Ord a, Random a, RandomGen g) =>+ a -- ^ horizontal spread of the function.+ -> g -- ^ a random number generator.+ -> (a,g)+bilExp lambda g0 = + let (r', g1) = avoid 0 random g0+ r = 2 * r'+ u = if r > 1 then 2 - r else r+ in (signum (1 - r) * log u / lambda, g1)++{- | Generates a random number with a Gaussian distribution. +-}+gaussian :: (Floating a, Random a, RandomGen g) =>+ a -- ^ standard deviation.+ -> a -- ^ mean.+ -> g -- ^ a random number generator.+ -> (a,g)+gaussian stddev center g0 = + let n = 12+ s = sum $ take n $ randoms g0+ in (stddev * (s - fromIntegral n / 2) + center, fst (split g0))++{- | Generates a Cauchy-distributed random variable. +The distribution is symmetric with a mean of 0. ++-}+cauchy :: (Floating a, Random a, RandomGen g, Eq a) =>+ a -- ^ alpha (density).+ -> g -- ^ a random number generator.+ -> (a,g)+cauchy density g0 = (density * tan (u * pi), g1)+ where (u, g1) = avoid 0.5 random g0++{- | Generates a Poisson-distributed random variable.+The given parameter lambda is the mean of the distribution. +If lambda is an integer, the probability that the result j=lambda-1+will be as great as that of j=lambda. The Poisson distribution+is discrete. The returned value will be a non-negative+integer.++-}+poisson :: (Num t, Ord a, Floating a, RandomGen g, Random a) =>+ a -> g -> (t, g)+poisson lambda g0 = (k 0 us, g1)+ where v = exp (-lambda)+ us = scanl1 (*) (randoms g0)+ g1 = fst (split g0)+ k n (u:us)+ | u >= v = k (n+1) us+ | otherwise = n+ k _ [] = error "System.Random.Distributions.poisson: randoms did not return an infinite list"++{- | Given a list of weight-value pairs, generates a value randomly picked+from the list, weighting the probability of choosing each value by the +weight given.++-}+frequency :: (Floating w, Ord w, Random w, RandomGen g) + => [(w, a)] -> g -> (a,g)+frequency xs g0 = (pick r xs, g1)+ where (r, g1) = randomR (0, tot) g0+ tot = sum (map fst xs)+ pick n ((w,a):xs) + | n <= w = a+ | otherwise = pick (n-w) xs+ pick _ [] = error "System.Random.Distributions.frequency: The impossible happened"+++{- | Given a function generating a random number variable and a random+number generator, produces an infinite list of random values +generated from the given function.++-}+rands :: (RandomGen g, Random a) => + (g -> (a,g)) -> g -> [a]+rands f g = x : rands f g' where (x,g') = f g+
+ Tests/RunAllTests.hs view
@@ -0,0 +1,92 @@+module Main where+import Control.Monad+import System.Console.ANSI+import System.IO+import Data.IORef+import Test.QuickCheck+import Text.Printf+import EuterpeaTests+import Control.Concurrent++totalTests = 1000++-- Thank you, Rosetta Code!+colorStrLn :: ColorIntensity -> Color -> String -> IO ()+colorStrLn fgi fg str = do+ setSGR [SetColor Foreground fgi fg]+ putStr str+ setSGR [Reset]+ putStrLn ""++runTest :: MVar (String, Result) -> (String, IO Result) -> IO ()+runTest result (s, a) = do+ res <- a+ putMVar result (s, res)++printResults :: Int -> MVar (String, Result) -> Handle -> IORef Int -> IO ()+printResults n result log failsR = replicateM_ n $ do+ (s, res) <- takeMVar result+ printf ("%-" ++ show (1 + maximum (map length ((fst . unzip) tests))) ++ "s ") s+ case res of+ Failure _ _ _ _ _ True _ _ -> colorStrLn Vivid Yellow "Interrupted"+ Failure _ _ _ _ r _ _ o -> do+ hPutStrLn log $ s ++ ":\n" ++ o ++ "\n"+ colorStrLn Vivid Red r+ atomicModifyIORef failsR (\x -> (x+1, ()))+ _ -> colorStrLn Vivid Green $ "Passed " ++ show totalTests ++ " trials"++main :: IO ()+main = do+ log <- openFile "error.log" WriteMode+ failsR <- newIORef 0+ result <- newEmptyMVar++ mapM_ (forkIO . runTest result) tests+ printResults (length tests) result log failsR ++ fails <- readIORef failsR+ hClose log+ case fails of+ 0 -> putStrLn "*** All tests passed!"+ _ -> error $ "+++ " ++ show fails ++ " of " ++ show (length tests) ++ " tests failed. See error.log for details."+ return ()++tests = [("AbsPitch_Pitch", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_AbsPitch_Pitch),+ ("Trans_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Trans_Composition),+ ("Retro_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Retro_Composition),+ ("Invert_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Invert_Composition),+ ("RetroInvert_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_RetroInvert_Composition),+ ("Dur_Times_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Times_Composition),+ ("Dur_Take_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Take_Composition),+ ("Take_Repeat_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Take_Repeat_Id),+ ("Mmap_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Id),+ ("Mmap_Function_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Function_Composition),+ ("TimesM_Seq", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_TimesM_Seq),+ ("Mfold_Identity", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mfold_Identity),+ ("revM_SelfInverting", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting),+ ("revM_SelfInverting_weak", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting_weak),+ ("revM_DurationPreserving", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_DurationPreserving),+ ("Perf_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Perf_Id),+ ("Axiom_11_2_1", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_1),+ ("Axiom_11_2_2", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_2),+ ("Axiom_11_2_3", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_3),+ ("Theorem_11_2_1", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Theorem_11_2_1),+ ("Axiom_11_3_1a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1a),+ ("Axiom_11_3_1b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1b),+ ("Axiom_11_3_2a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2a),+ ("Axiom_11_3_2b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2b),+ ("Axiom_11_3_2c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2c),+ ("Axiom_11_3_3a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3a),+ ("Axiom_11_3_3b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3b),+ ("Axiom_11_3_3c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3c),+ ("Axiom_11_3_3d", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3d),+ ("Axiom_11_3_4a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4a),+ ("Axiom_11_3_4b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4b),+ ("Axiom_11_3_5", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_5),+ ("Axiom_11_3_6a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6a),+ ("Axiom_11_3_6b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6b),+ ("Axiom_11_3_6c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6c),+ ("Axiom_11_3_6d", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6d),+ ("Axiom_11_3_8", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8),+ ("Axiom_11_3_8_weak", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8_weak)]+
+ myTestlll.cabal view
@@ -0,0 +1,121 @@+name: myTestlll+version: 1.0.0+Cabal-Version: >= 1.8+license: BSD3+license-file: License+copyright: Copyright (c) 2008-2014 Paul Hudak+category: Sound+stability: experimental+build-type: Custom+author: Mark Santolucito <mark.santolucito@yale.edu>, +maintainer: Mark Santolucito <mark.santolucito@yale.edu>, +bug-reports: mailto:mark.santolucito@yale.edu+homepage: http://haskell.cs.yale.edu/+synopsis: testign upload+description:+ high-performance back-end for real-time audio. +extra-source-files:+ ReadMe.txt,+ ArrowWrap.hs,+ Euterpea/Examples/EnableGUI.hs,+ HSoM/HSoM.lhs,+ HSoM/Preface.lhs,+ HSoM/Intro.lhs,+ HSoM/Music.lhs,+ HSoM/Poly.lhs,+ HSoM/Interlude.lhs,+ HSoM/Syntax.lhs,+ HSoM/MoreMusic.lhs,+ HSoM/QualifiedTypes.lhs,+ HSoM/Performance.lhs,+ HSoM/SelfSimilar.lhs,+ HSoM/Induction.lhs,+ HSoM/Algebra.lhs,+ HSoM/LSystems.lhs,+ HSoM/RandomMusic.lhs,+ HSoM/ToMidi.lhs,+ HSoM/IO.lhs,+ HSoM/Monads.lhs,+ HSoM/MUI.lhs,+ HSoM/Signals.lhs,+ HSoM/SigFuns.lhs,+ HSoM/SpectrumAnalysis.lhs,+ HSoM/Additive.lhs,+ HSoM/List-tour.lhs,+ HSoM/Class-tour.lhs,+ HSoM/Bitans.lhs,+ HSoM/Patterns.lhs,+ HSoM/myFormat.fmt,+ HSoM/HSoM.bib++Test-Suite test-euterpea+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: Tests+ Main-Is: RunAllTests.hs+ Ghc-Options: -threaded+ build-depends: base, Euterpea, + QuickCheck >= 2.6, Cabal >= 1.9.2, + ansi-terminal++Library+ hs-source-dirs: .+ ghc-options: -O2 -funbox-strict-fields -fexcess-precision+ exposed-modules: + Euterpea,+ Euterpea.Experimental,+ Euterpea.ExperimentalPlay,+ Control.CCA.ArrowP,+ Control.SF.SF,+ Euterpea.Examples.EuterpeaExamples+ Euterpea.Examples.Interlude,+ Euterpea.Examples.Instruments,+ Euterpea.Examples.IntervalTrainer,+ Euterpea.Examples.LSystems,+ Euterpea.Examples.MUIExamples,+ Euterpea.Examples.MUI,+ Euterpea.Examples.MusicToSignal,+ Euterpea.Examples.NewResolutions,+ Euterpea.Examples.RandomMusic, + Euterpea.Examples.SelfSimilar,+ Euterpea.Examples.SoundCheck,+ Euterpea.Examples.SSF,+ Euterpea.Examples.SigFuns,+ Euterpea.Examples.Additive,+ Euterpea.IO.Audio.Basics,+ Euterpea.IO.Audio.BasicSigFuns,+ Euterpea.IO.Audio.IO,+ Euterpea.IO.Audio.Render,+ Euterpea.IO.Audio.Types,+ Euterpea.IO.Audio.CSound,+ Euterpea.IO.Audio,+ Euterpea.IO.MIDI.MidiIO, + Euterpea.IO.MIDI.FromMidi,+ Euterpea.IO.MIDI.GeneralMidi,+ Euterpea.IO.MIDI.ToMidi,+ Euterpea.IO.MIDI.ExportMidiFile,+ Euterpea.IO.MIDI,+ Euterpea.IO.MUI.MidiWidgets,+ Euterpea.IO.MUI.InstrumentWidgets,+ Euterpea.IO.MUI.InstrumentBase,+ Euterpea.IO.MUI.FFT,+ Euterpea.IO.MUI.Guitar,+ Euterpea.IO.MUI.Piano,+ Euterpea.IO.MUI.UISFCompat,+ Euterpea.IO.MUI,+ Euterpea.Music.Note.MoreMusic,+ Euterpea.Music.Note.Music,+ Euterpea.Music.Note.Performance,+ Euterpea.Music.Signal.SpectrumAnalysis,+ System.Random.Distributions+ other-modules:+ build-depends:+ base >= 3 && < 5, array, bytestring, random,+ mtl, containers, markov-chain, + CCA >= 0.1.3, UISF >= 0.3, PortMidi, + HCodecs >= 0.2, heap == 0.6.0, + template-haskell, + monadIO, deepseq,+ pure-fft,+ stm, arrows >= 0.4+ if (impl(ghc >= 6.10))+ build-depends: base >= 4 && < 5, syb, ghc-prim