Jazzkell (empty) → 0.0.1
raw patch · 10 files changed
+713/−0 lines, 10 filesdep +Euterpeadep +basedep +randombuild-type:Customsetup-changed
Dependencies added: Euterpea, base, random
Files
- Jazzkell.cabal +31/−0
- Jazzkell.lhs +6/−0
- Jazzkell/JazzTypes.lhs +105/−0
- Jazzkell/Utils.lhs +73/−0
- LICENSE +2/−0
- README.txt +16/−0
- Setup.hs +3/−0
- examples/Hypnotize.lhs +256/−0
- examples/SimpleBossa.lhs +120/−0
- examples/SimpleWalkingBass.lhs +101/−0
+ Jazzkell.cabal view
@@ -0,0 +1,31 @@+name: Jazzkell +version: 0.0.1 +Cabal-Version: >= 1.8 +license: OtherLicense +license-file: LICENSE +copyright: Copyright (c) 2019 Donya Quick +category: Music +stability: experimental +build-type: Custom +author: Donya Quick <donyaquick@gmail.com> +maintainer: Donya Quick <donyaquick@gmail.com> +bug-reports: https://github.com/donya/Jazzkell/issues +homepage: http://www.donyaquick.com/generative-jazz +synopsis: Library for modeling jazz improvisation. +description: + Jazzkell is a Haskell implementation of a functional model for + jazz improvisation. +extra-source-files: + readme.txt + +Library + hs-source-dirs: . + ghc-options: -O2 + extensions: CPP + exposed-modules: + Jazzkell, + Jazzkell.JazzTypes + Jazzkell.Utils + other-modules: + build-depends: + base >= 3 && < 5, Euterpea >= 2.0.6, random>=1.1 && <2.0
+ Jazzkell.lhs view
@@ -0,0 +1,6 @@+> module Jazzkell( +> module Jazzkell.JazzTypes +> ) where + + +> import Jazzkell.JazzTypes
+ Jazzkell/JazzTypes.lhs view
@@ -0,0 +1,105 @@+A Functional Model for Jazz Improvisation: Implementation +Donya Quick + +> module Jazzkell.JazzTypes where +> import Euterpea +> import Data.List (sort) +> import System.Random + +A part name refers to a particular roll in improvisational jazz. We'll define +four and allow an additional custom constructor for generality. + +> data PartType = Solo | Harmony | Bass | Drums | PartType String +> deriving (Eq, Show, Ord) + +A ChordCtxt, or chord context, is information given by notations like "C7" +above a staff on a lead sheet. It has a string symbol that implies a particular +scale. We will represent Scales as a list of pitch class numbers, or Ints. +We will assume that the Scale's members are within the range [0,11] and that +the list is organized in order of the scale's pitch class cycle. In other words, +G-major would be [7,9,11,0,2,4,6]. + +Note that we are not using Euterpea's PitchClass type here. This is to avoid +issues of enharmonic equivalence, since Euterpea's PitchClass type has multiple +constructors that map to the same numerical pitch class (for example, Cs for +C sharp and Df for D flat). + +> type PCNum = Int +> type Scale = [PCNum] +> data ChordCtxt = ChordCtxt{sym::String, scale::Scale} -- TODO: maybe include pitchSpace? +> deriving (Eq, Show) + +A Segment is a portion of a lead sheet having a homogenous chord context. +Segments may have fixed features for some parts, which typically chracterizes +the lead sheet as a composition rather than as simply a chord progression. + +> data SegStyle a = Free | FixedPitch [AbsPitch] | FixedMusic (Music a) +> deriving (Eq, Show) + +> data SegCat = Intro | Regular | Bridge | Ending | End | CustomSeg String +> deriving (Eq, Show, Ord) + +> type Measure = Int +> type Beat = Rational +> type Onset = (Measure, Beat) +> data TimeSig = TimeSig Int Int -- TimeSig 3 4 is 3/4, TimeSig 4 4 is 4/4, etc. +> deriving (Eq, Show) + +> data Segment a = Segment{ +> chordCtxt :: ChordCtxt, -- harmonic context +> category :: SegCat, -- intro, bridge etc. +> styles :: [(PartType, SegStyle a)], -- improv style (free, fixed sections, etc.) +> segOnset :: Onset, -- when does the segment start? +> segDur :: Beat, -- when does the segment end? +> timeSig :: TimeSig} -- what's the time signature in this segment? +> deriving (Eq, Show) + +Finally, a lead sheet is simply a list of segments. + +> type LeadSheet a = [Segment a] + +A state is a collection of features that are tracked between generative iterations. +This is left completely polymorphic. We denote is as the type variable s in the +following definitions. + +On the performance side, a PartFun is a function from a part's State, the current +Segment, the next Segment (if one exists), and what the band just played, to an +updated State and newly emitted Music for the part. + +> type History a = [(PartType, Music a)] +> type PartFun a s = s -> Segment a -> Maybe (Segment a) -> History a -> StdGen -> (StdGen, s, Music a) + +We will then define JazzPart to represent one performer in a group. It will +have a PartType, an instrument, a PartFun defining its behavior, and a current +State. A JazzPart is specific to a style an instrument. + +> data JazzPart a s = JazzPart{ +> partType :: PartType, +> instr :: InstrumentName, +> partFun :: PartFun a s, +> state :: s} + +A JazzBand, then, is a simply a list of JazzParts. + +> type JazzBand a s = [JazzPart a s] + +When we run the JazzBand, we need only supply a LeadSheet. Note that LeadSheet +may potentially be infinite! + +> runBand :: JazzBand a s -> History a -> LeadSheet a -> StdGen -> Music a +> runBand [] h segs g = rest 0 -- no band to play! +> runBand jb h [] g = rest 0 +> runBand jb h (seg1:segs) g = +> let seg2 = if null segs then Nothing else Just (head segs) +> result = runSegment jb h seg1 seg2 g +> (gs, states, ms) = unzip3 result +> jb' = zipWith (\st jp -> jp{state=st}) states jb +> h' = zip (map partType jb) ms +> in foldr1 (:=:) ms :+: runBand jb' h' segs (last gs) + +> runSegment :: JazzBand a s -> History a -> Segment a -> Maybe (Segment a) -> StdGen -> [(StdGen, s, Music a)] +> runSegment [] h seg1 seg2 g = [] +> runSegment (jp:jps) h seg1 seg2 g = +> let (g', st, m) = partFun jp (state jp) seg1 seg2 h g +> m' = instrument (instr jp) m +> in (g', st, m') : runSegment jps h seg1 seg2 g'
+ Jazzkell/Utils.lhs view
@@ -0,0 +1,73 @@+> module Jazzkell.Utils where +> import Euterpea +> import Jazzkell.JazzTypes +> import Data.List +> import System.Random + + +> type PitchSpace = [AbsPitch] + +> derivePitchSpace :: Scale -> AbsPitch -> AbsPitch -> PitchSpace +> derivePitchSpace [] lower upper = [] +> derivePitchSpace s lower upper = +> let s' = sort s +> psRaw = concatMap (\o -> map (+o) s') [0..10] +> in filter (\p -> p<=upper && p>=lower) psRaw + +> filterByScale :: Scale -> PitchSpace -> PitchSpace +> filterByScale s = filter (\p -> (p `mod` 12) `elem` s) + +> orderByNearest :: PitchSpace -> AbsPitch -> [AbsPitch] +> orderByNearest ps p = +> let dists = map (abs . subtract p) ps +> in map snd $ sort $ zip dists ps + +> nearest :: PitchSpace -> AbsPitch -> AbsPitch +> nearest [] p = error "(nearest) empty pitch space." +> nearest ps p = head $ orderByNearest ps p + +> pitches :: Music a -> [a] +> pitches = mFold pFun (++) (++) (\c l -> l) where +> pFun (Note d p) = [p] +> pFun (Rest d) = [] + +> durs :: Music a -> [Dur] +> durs = mFold pFun (++) (++) (\c l -> l) where +> pFun (Note d p) = [d] +> pFun (Rest d) = [d] + + +> infSplit :: StdGen -> [StdGen] -- necessary to get many generators from just one +> infSplit g = let (g1, g2) = split g in g1 : infSplit g2 + +choose: select uniformly at random from a list + +> choose :: StdGen -> [a] -> (StdGen, a) +> choose g [] = error "Nothing to choose from!" +> choose g xs = +> let (r, g') = next g +> in (g', xs !! (r `mod` length xs)) + +> chooseN :: StdGen -> Int -> [a] -> (StdGen, [a]) +> chooseN g0 i xs = if i <= 0 then (g0, []) else +> let (g1, ys) = chooseN g0 (i-1) xs +> (g2, y) = choose g1 xs +> in (g2, y:ys) + +chooseDist: select an item accoring to its probability (a Double) + +> chooseDist :: StdGen -> [(a,Double)] -> (StdGen, a) +> chooseDist g ps = +> let (r, g1) = randomR (0.0, 1.0::Double) g +> in (g1, chooseRec r ps) where +> chooseRec v [(x,p)] = x +> chooseRec v [] = error "Nothing to choose from!" +> chooseRec v ((x,p):ps) = if v <= p && p > 0 then x else chooseRec (v-p) ps + +chooseDistNorm: select an tem according to its probability after normalization +(input probabilities need not be normalized) + +> chooseDistNorm :: StdGen -> [(a,Double)] -> (StdGen, a) +> chooseDistNorm g xs = +> let (vals,probs) = unzip xs +> in chooseDist g $ zip vals (map (/sum probs) probs)
+ LICENSE view
@@ -0,0 +1,2 @@+(c) Donya Quick 2019 +Not for commercial use.
+ README.txt view
@@ -0,0 +1,16 @@+Jazzkel library +(c) Donya Quick 2019 + +Not for commercial use. + +Setup instructions: + +1. Install Haskell Platform and Euterpea using the instructions on + the Euterpea website (www.euterpea.com). Mac and Linux users must + have a synthesizer installed and running before using GHC/GHCi + in order to hear sound! + +2. Load the examples in GHCI (:load filename) and follow the usage + instructions in the file you loaded. The files SimpleBossa.lhs and + SimpleWalkingBass.lhs are examples from the paper. Hypnotize.lhs is + an example of a more complex composition using the same system.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple +main = defaultMain +
+ examples/Hypnotize.lhs view
@@ -0,0 +1,256 @@+Hypnotize: an inifinte, algorithmic jazz composition +Donya Quickan + +"Hypnotize" is an algorithmic composition using the models +in JazzTypes.lhs. It utilizes random lead sheet generation. +The music is slow and somewhat ambient. + +To hear the piece, load this file in GHCi and then run +"play hypnotize" to hear it! It's an infintely long piece +of music, so use Ctrl+C to stop it (you may need to press it +more than once on some computers). + +The implementation here uses type Music (AbsPitch,Volume) to +achieve more diverse textures (in Music AbsPitch, the volumes +are all constant). + +> module Hypnotize where +> import Jazzkell +> import Jazzkell.Utils +> import Euterpea +> import System.Random +> import Data.List (sort, nub) +> import Control.DeepSeq + +State definitions. Only the bass is keeping track of state here. +A data type definition was used to show how state information can +be extracted from more complex types in the future. + +> data HypnoState = HypnoState{ +> nextBassPitch::AbsPitch} +> deriving (Eq, Show) + +> nullState = HypnoState (-1) -- we use -1 to indicate no pitch + +Hypnotize has three parts: a celesta, a piano, and a bass. Both +the celesta and piano are chord-based generative strategies, although +the celesta arpeggiates its chord over a longer time to give the +effect of a melody. + +> celestaSpace = [60..85] + +> celestaFun :: PartFun (AbsPitch, Volume) HypnoState +> celestaFun inState seg1 seg2 hist g = -- seg2 does not affect anything (doesn't matter if Nothing) +> let s = scale $ chordCtxt seg1 +> d = segDur seg1 +> (g2, newChord) = pickChord s celestaSpace g +> (g3, newChord') = permute g2 newChord +> (g4, x) = stagger g3 d newChord' +> m = removeZeros $ cut d x +> in (g4, inState, trimTo seg1 m) + +The bassFun is similar to a walking bass, but plays relatively few +pitches per segment. + +> bassRange = [36..50] + +> bassFun :: PartFun (AbsPitch, Volume) HypnoState +> bassFun inState seg1 Nothing hist g0 = undefined +> bassFun inState seg1 (Just seg2) hist g0 = +> let nbr = nextBassPitch inState +> thisS = scale $ chordCtxt seg1 +> nextS = scale $ chordCtxt seg2 +> (g1, rbr) = choose g0 $ filter (\p -> p `mod` 12 == head thisS) bassRange +> thisRoot = if nbr > 0 then nbr else rbr +> (g2, nextRoot) = choose g1 $ filter (\p -> p `mod` 12 == head nextS) bassRange +> fifthsA = filter (\p -> p `mod` 12 == thisS !! 4) bassRange +> fifthsB = filter (\p -> p < max thisRoot nextRoot && p > min thisRoot nextRoot) fifthsA +> (g3, thisFifth) = choose g2 $ if null fifthsB then fifthsA else fifthsB +> (r, g4) = randomR (0.0::Double, 1.0) g3 +> d = segDur seg1 +> nrDown = if nextRoot-1 < 36 then nextRoot+1 else nextRoot-1 +> fDown = if thisFifth-1 < 36 then thisFifth+1 else thisFifth +> pat1 = note (d-hn) (thisRoot,100) :+: note hn (thisFifth,100) +> pat2 = note (d-hn) (thisRoot,100) :+: note hn (thisRoot+1,100) +> pat3 = note (d-hn) (thisRoot,100) :+: note hn (nrDown,100) +> pat4 = note (d-hn) (thisRoot,100) :+: note hn (nextRoot+1,100) +> pat5 = note (d-hn) (thisRoot,100) :+: note hn (nrDown,100) +> pat6 = note (d-tn) (thisRoot,100) :+: note tn (nextRoot+1,60) +> pat7 = note (d-tn) (thisRoot,100) :+: note tn (nrDown,60) +> pat8 = note (d-hn-tn) (thisRoot,100) :+: note tn (fDown,60) :+: note hn (thisFifth,100) +> pat9 = note (d-hn-tn) (thisRoot,100) :+: note tn (fDown,60) :+: note hn (thisFifth,100) +> outState = inState{nextBassPitch=nextRoot} +> pats = if d > wn then [pat1, pat2, pat3, pat4] +> else [pat1, pat2, pat3, pat4, pat5, pat6, pat7, pat8, pat9] +> (g5, m) = choose g4 pats +> in (g5, outState, trimTo seg1 m) + +The chordFun function defines the behavior for the grand piano. It creates +arpeggiated chords. + +> chordFun :: PartFun (AbsPitch, Volume) HypnoState +> chordFun inState seg1 seg2 hist g = +> let s = scale $ chordCtxt seg1 +> (g1, pcs) = pickChordPCs s g +> d = segDur seg1 +> (g2, pcs') = permute g1 pcs +> ps = map (+60) $ pcs' +> mPat1 = chord $ zipWith (\p i -> rest (i*sn) :+: note d (p,80)) ps [0..] +> mPat2 = rest en :+: mPat1 +> mPat3 = rest den :+: mPat1 +> (g3, mPat) = choose g2 [mPat1, mPat2, mPat3] +> m = trimTo seg1 mPat +> in (g3, inState, m) where +> mkC d ps = chord $ map (\p -> note d (60+p, 80)) ps + +The randomLeadSheet function generates a randomized lead sheet +where there are contiguous groups of segements in the same +randomly chosen key. Within each group, the chords are random +(at the Roman numeral level). + +> randomLeadSheet :: StdGen -> [Segment a] +> randomLeadSheet g0 = +> let (g1, n) = choose g0 [1..4] +> (g2, r) = choose g1 [0..11] +> (g3,g4) = split g2 +> segs = take n $ randomSegGroup g3 r +> in segs ++ randomLeadSheet g4 where +> modes :: [[PCNum]] +> modes = take 7 $ modeRec [0,2,4,5,7,9,11] where +> modeRec s@(x:xs) = s : modeRec (xs++[x]) +> randomSegGroup :: StdGen -> AbsPitch -> [Segment a] +> randomSegGroup g0 r = +> let (g1, i) = choose g0 [0..5] -- omitting locrian, because yuck +> mo = modes !! 0 !! i +> s' = map ((`mod` 12). (+r) . (+mo)) (modes !! i) +> cctxt = ChordCtxt (show s') s' +> (g2, d) = choose g1 [wn, wn, wn, wn, wn, wn, 2*wn] +> seg = Segment cctxt Regular [] (0,0) d (TimeSig 4 4) +> in seg : randomSegGroup g2 r + +Now we can generate a lead sheet with this function and +run the jazz band on it. + +> rls = randomLeadSheet $ mkStdGen 6 + +> myJBP = [JazzPart Harmony Celesta celestaFun nullState, +> JazzPart Bass AcousticBass bassFun nullState, +> JazzPart Harmony AcousticGrandPiano chordFun nullState] + +> hypnotize120bpm = runBand myJBP [] rls (mkStdGen 18) +> hypnotize = tempo 0.6 $ hypnotize120bpm -- slow it down to a better pace + +Use "play hypnotize" in GHCi to hear it! + + +================================ +UTILITY FUNCTIONS + +Trim a music value to the duration fo a segment. + +> trimTo :: Segment a -> Music a -> Music a +> trimTo seg m = removeZeros $ +> cut (segDur seg) $ remove (snd $ segOnset seg) m + +Permute a list of items. + +> permute :: (Eq a) => StdGen -> [a] -> (StdGen, [a]) +> permute g [] = (g, []) +> permute g xs = +> let (g1, x) = choose g xs +> (g2, xs') = permute g1 $ filter (/=x) xs +> in (g2, x:xs') + +Stagger/arpeggiate a chord with stochastic volumes and stochastic +addition of ornaments between notes. + +> stagger :: StdGen -> Dur -> [AbsPitch] -> (StdGen, Music (AbsPitch,Volume)) +> stagger g td ps = +> let (g1,g2) = split g +> vs = map (\v -> 60 + (v `mod` 40)) $ randoms g1 +> pvs = zip ps vs +> (g3, ms) = randDursR g2 td pvs +> (g4, ms') = ornaments g3 ms +> in (g4, ms') + +Add ornaments to a list of musical values (used in stagger). + +> ornaments :: StdGen -> [Music (AbsPitch, Volume)] -> (StdGen, Music (AbsPitch, Volume)) +> ornaments g [] = (g, rest 0) +> ornaments g [x] = (g, x) +> ornaments g (x1:x2:xs) = +> case x2 of +> Prim(Note d (p,v)) -> +> let (g1,r) = choose g [True, False, False, False, False, False, False] +> (g2,p2) = choose g1 [p-1, p+1] +> v2 = 50 +> (g3, xs') = ornaments g2 xs +> newX = if r && dur x1 >= en +> then chDur (-tn) x1 :+: note tn (p2,v2) :+: x2 +> else x1 :+: x2 +> in (g3, newX :+: xs') +> _ -> +> let (g2, xs') = ornaments g (x2:xs) +> in (g2, x1 :+: xs') + +Add duration to a note or rest Music value. + +> chDur d' (Prim (Note d x)) = note (d+d') x +> chDur d' (Prim (Rest d)) = rest (d+d') +> chDur d' x = x + +Add random durations to a list of "a" types for music. These +can be either pitches (AbsPitch) or pitch volume pairs. + +> randDursR :: StdGen -> Dur -> [a] -> (StdGen, [Music a]) +> randDursR g totalDur xs = +> let durs = filter (<=totalDur - (fromIntegral (length xs) *en)) [0, en, qn] +> (g1, rDur) = choose g durs +> (g2, m) = randDurs g1 (totalDur - rDur) xs +> in (g2, if rDur<=0 then m else rest rDur : m) where +> randDurs :: StdGen -> Dur -> [a] -> (StdGen, [Music a]) +> randDurs g totalDur [] = (g, [rest 0]) +> randDurs g totalDur [x] = (g, [note totalDur x]) +> randDurs g totalDur (x:xs) = +> let durs = filter (<=totalDur - (fromIntegral (length xs) *en)) [en, qn, dqn, hn] +> (g1, d) = choose g $ if null durs then [totalDur] else durs +> (g2, ms) = randDurs g1 (totalDur - d) xs +> in (g2, note d x : ms) + +Pick jazzy chord pitch classes from a scale. + +> pickChordPCs :: Scale -> StdGen -> (StdGen, [PCNum]) +> pickChordPCs scale g = +> let (g0, basePCInds) = choose g [[1,2,4,6], [2,3,4], [0,3,4], [0,2,4,6]] +> (g1, i) = choose g [1..5] -- choose an extra note to add +> in (g1, sort $ map (scale !!) (i : basePCInds)) + +Another way of picking jazzy chord pitch classes. + +> pickChordPCs2 :: Scale -> StdGen -> (StdGen, [PCNum]) +> pickChordPCs2 scale g = +> let (n,g1) = random g +> n' = 4 + (n `mod` 10) +> (g2, inds) = chooseN g1 n' [0,0,0,1,2,2,3,4,4,4,5,5,6] +> pcs = map (scale !!) inds +> (g3, pcs') = permute g2 (pcs) -- ensure root and fifth are included +> in (g3, pcs') + +Find all combinations of pitches in a pitch space adhering to +a particular list of pitch classes. + +> allPitchCombos :: PitchSpace -> [PCNum] -> [[AbsPitch]] +> allPitchCombos pSpace [] = [[]] +> allPitchCombos pSpace (pc:pcs) = +> let xs = filter (\x -> x `mod` 12 == pc) pSpace +> ys = allPitchCombos pSpace pcs +> in [(x:y) | x<-xs, y<-ys] + +Given a scale and a pitch space, pick a chord of concrete pitches. + +> pickChord :: Scale -> PitchSpace -> StdGen -> (StdGen, [AbsPitch]) +> pickChord scale pSpace g = +> let (g1, chordPCs) = pickChordPCs2 scale g +> allPossibleChords = allPitchCombos pSpace chordPCs +> in choose g allPossibleChords +
+ examples/SimpleBossa.lhs view
@@ -0,0 +1,120 @@+Simple bossa nova implementation +Donya Quick + +Load this file in GHCi and run "play m" to hear some music. +The lead sheet is finite, so the music will stop on its own. + +This module is an example of a very simple, largely deterministic +implementation of some bossa nova behavior using the JazzTypes framework. +In this case, there is no use of State information in the bass and +harmony, but the lead makes use of a very simplistic piece of state +information (the last pitch played). + +> module SimpleBossa where +> import Jazzkell +> import Jazzkell.Utils +> import Euterpea +> import System.Random +> import Data.List (sort) + +Utility function to cut a piece of music down to the duration +of a segment: + +> trimTo :: Segment a -> Music a -> Music a +> trimTo seg m = removeZeros $ -- necessary because of a bug in Euterpea 2.0.6's cut/remove functions +> cut (segDur seg / 4) $ +> remove ((snd $ segOnset seg) / 4) m + +Our state, which is only used by the soloing algorithm: + +> data SimpleState = LastPitch AbsPitch | NullState +> deriving (Eq, Show) + +Simple walking bass pattern following the bossa nova rhythm: + +> bassFun :: PartFun AbsPitch s +> bassFun s seg1 seg2 hist g = +> let p1 = 36 + (head $ scale $ chordCtxt seg1) +> p2 = p1 + 7 +> mPat = note dqn p1 :+: note en p2 :+: note dqn p2 :+: note en p1 +> m = trimTo seg1 (forever mPat) +> in case seg2 of Nothing -> (g, s, note (segDur seg1 / 4) p1) +> Just _ -> (g, s, m) + +Some simple chords following the bossa nova rhythm: + +> chordFun :: PartFun AbsPitch s +> chordFun s seg1 seg2 hist g = +> let ps = map ((scale $ chordCtxt seg1) !!) [0,2,4,6] +> mkChord d = chord $ map (note d . (+60)) ps +> mPat = rest qn :+: mkChord qn :+: rest en :+: mkChord en :+: rest qn +> m = trimTo seg1 (forever mPat) +> in case seg2 of Nothing -> (g, s, mkChord $ segDur seg1) +> Just _ -> (g, s, m) + +Our solo pitch space: + +> soloPSpace = [70..84] + +The soloing algorithm does a random walk through the pitch space +above. It uses the state to ensure smooth transitions across segment +boundaries. + +> soloFun :: PartFun AbsPitch SimpleState +> soloFun NullState seg1 seg2 hist g = +> let (g',p) = choose g soloPSpace +> in soloFun (LastPitch p) seg1 seg2 hist g' +> soloFun (LastPitch lp) seg1 seg2 hist g0 = +> let sPSpace = filterByScale (scale $ chordCtxt seg1) soloPSpace +> n = round (2*segDur seg1) +> (g1, g2) = split g0 +> ps = take n $ randMelody g0 sPSpace lp +> mel = line $ map (note en) ps +> lastP = last $ pitches mel +> in case seg2 of +> Nothing -> (g2, LastPitch (head ps), note (segDur seg1) (head ps)) +> Just _ -> (g2, LastPitch (last ps), mel) + +> randMelody :: StdGen -> [AbsPitch] -> AbsPitch -> [AbsPitch] +> randMelody g0 pSpace lastP = +> let nearPs = filter (/=lastP) $ orderByNearest pSpace lastP +> (g1, p) = choose g0 $ take 5 nearPs +> in p : randMelody g1 pSpace p + +Putting it all together: + +> myJB :: JazzBand AbsPitch SimpleState +> myJB = [JazzPart Bass AcousticBass bassFun NullState, +> JazzPart Bass ElectricGrandPiano chordFun NullState, +> JazzPart Bass Marimba soloFun (LastPitch 70)] + +Finally, we'll test it on a lead sheet. + +> cM7 = ChordCtxt "CM7" [0,2,4,5,7,9,11] -- C major +> dmM7 = ChordCtxt "DmM7" [2,4,5,7,9,11,0] -- D dorian +> g7 = ChordCtxt "G7" [7,9,11,0,2,4,5] -- G mixolydian + +> seg1 = Segment dmM7 Regular [] (0,0) 4 (TimeSig 4 4) +> seg2 = Segment g7 Regular [] (1,0) 4 (TimeSig 4 4) +> seg3 = Segment cM7 Regular [] (2,0) 4 (TimeSig 4 4) +> seg4 = Segment cM7 Regular [] (3,0) 4 (TimeSig 4 4) +> seg5 = Segment dmM7 Regular [] (4,0) 2 (TimeSig 4 4) +> seg6 = Segment g7 Ending [] (4,2) 2 (TimeSig 4 4) +> seg7 = Segment dmM7 Regular [] (5,0) 2 (TimeSig 4 4) +> seg8 = Segment g7 Ending [] (5,2) 2 (TimeSig 4 4) +> seg9 = Segment cM7 Regular [] (6,0) 4 (TimeSig 4 4) +> seg10 = Segment g7 Regular [] (7,0) 4 (TimeSig 4 4) +> seg11 = Segment cM7 End [] (8,0) 4 (TimeSig 4 4) + +> (g0, s0, m0) = soloFun (LastPitch 70) seg1 (Just seg1) [] (mkStdGen 6) +> ps0 = pitches m0 + +> (g1, s1, m1) = soloFun s0 seg1 (Just seg1) [] g0 +> ps1 = pitches m1 + +> (g2, s2, m2) = soloFun s1 seg1 (Just seg1) [] g1 +> ps2 = pitches m2 + +> ls = [seg1, seg2, seg3, seg4, seg5, seg6, seg7, seg8, seg9, seg10, seg11] + +> m = runBand myJB [] ls (mkStdGen 6)
+ examples/SimpleWalkingBass.lhs view
@@ -0,0 +1,101 @@+Simple walking bass implementation +Donya Quick + +Load this file in GHCi and run "play m" to hear some music. +Use Ctrl+C to stop (the music is infinite). You may need to +press it a few times to stop. + +> module SimpleWalkingBass where +> import Jazzkell +> import Jazzkell.Utils +> import Euterpea +> import System.Random + +> data WalkingState = NextRoot AbsPitch | NullState +> deriving (Eq, Show) + +Taking a single step in the walking bass. Given a pitch space, the +current pitch, and the destination pitch, we take a step between them +if possible. If they are too close together, we take a step nearby. + +> makeStep :: [AbsPitch] -> AbsPitch -> AbsPitch -> StdGen -> (StdGen, AbsPitch) +> makeStep pitchSpace p1 p2 g = +> let pH = max p1 p2 +> pL = min p1 p2 +> midPs = filter (\p -> p<pH && p>pL) pitchSpace +> nearPs = filter (\p -> p<pL+7 && p>pL-7 && p/=pL && p/=pH) pitchSpace +> ps = if null midPs then nearPs else midPs +> in choose g ps + +The walk function iteratively applies makeStep to produce a walking bass +line spanning some number of beats. It takes the number of beats (i), +a pitch space for the bass, and starting and ending pitches. + +> walk :: Int -> [AbsPitch] -> AbsPitch -> AbsPitch -> StdGen -> (StdGen, [AbsPitch]) +> walk 0 pSpace p1 p2 g = (g, []) +> walk i pSpace p1 p2 g = +> let (g2, pMid) = makeStep pSpace p1 p2 g +> (g3, ps) = walk (i-1) pSpace pMid p2 g2 +> in (g3, p1 : ps) + +A pitch space for our bass: + +> bassRange = [36..50] :: [AbsPitch] + +The PartFun for the walking bass uses the walk function to fill the +number of beats in the current segment (seg1). It also must choose the +target root pitch for the next segment (seg2), which is ketp a part +of the bass's state. + +> wBassFun :: PartFun AbsPitch WalkingState +> wBassFun NullState seg1 seg2 hist g = +> let scale1 = scale $ chordCtxt seg1 +> pSpace = filter (\p -> (elem (mod p 12) scale1)) bassRange +> roots = filter (\p -> mod p 12 == scale1 !! 0) pSpace +> (g', r) = choose g roots +> beats = round (segDur seg1) +> in wBassFun (NextRoot r) seg1 seg2 hist g +> wBassFun (NextRoot r) seg1 Nothing hist g = +> (g, NullState, note (segDur seg1) r) +> wBassFun (NextRoot r) seg1 (Just seg2) hist g = +> let scale1 = scale $ chordCtxt seg1 +> scale2 = scale $ chordCtxt seg2 +> pSpace1 = filter (\p -> elem (mod p 12) scale1) bassRange +> pSpace2 = filter (\p -> elem (mod p 12) scale2) bassRange +> roots2 = filter (\p -> mod p 12 == scale2 !! 0) pSpace2 +> (g1, nextR) = choose g roots2 +> beats = round (4*segDur seg1) +> (g2, pitches) = walk beats pSpace1 r nextR g1 +> bassLine = line $ map (note qn) pitches +> in (g2, NextRoot nextR, cut (segDur seg1/4) bassLine) + +A very simple chord function that we can use along with our +bassline (just so we can hear some chords): + +> chordFun :: PartFun AbsPitch s +> chordFun s seg1 seg2 hist g = +> let ps = map ((scale $ chordCtxt seg1) !!) [0,2,4,6] +> d = segDur seg1 / 4 +> m = chord $ map (note d . (+60)) ps +> in (g, s, m) + +Now we put the two together as a jazz band. + +> myJB :: JazzBand AbsPitch WalkingState +> myJB = [JazzPart Bass AcousticBass wBassFun NullState, +> JazzPart Bass ElectricGrandPiano chordFun NullState] + +Finally, we'll test it on a simple lead sheet. + +> cM7 = ChordCtxt "CM7" [0,2,4,5,7,9,11] +> dmM7 = ChordCtxt "DmM7" [2,4,5,7,9,11,0] -- dorian +> g7 = ChordCtxt "G7" [7,9,11,0,2,4,5] + +> seg1 = Segment dmM7 Regular [] (0,0) 4 (TimeSig 4 4) +> seg2 = Segment g7 Regular [] (1,0) 4 (TimeSig 4 4) +> seg3 = Segment cM7 Regular [] (2,0) 4 (TimeSig 4 4) +> seg4 = Segment cM7 Regular [] (3,0) 4 (TimeSig 4 4) + +> ls = concat $ repeat [seg1, seg2, seg3, seg4] + +> m = runBand myJB [] ls (mkStdGen 5)