Wednesday, April 30, 2008

functional music, honorable mention of new composer C.W. Boese

just after the previous post a talented composer (Boese) used the small framework for functional music in haskell for one of his compisitions. His work balances harmony and disharmony in an unbalanced way and thereby balances the unbalancing and balancing forces driving the excellent piece of modern algorithmic music. with his silent permission the source as well the interpretation is attached to this post.

Here's the interpretation using an artifical Clarinet: play.

Here's the source:

boeseboese = Rest (2/4) :+: (hochlauf (-2) 3 boese) :=: (hochlauf (2) 3 boese) :+: boese
boese = rpt 3 freak :=: rpt 3 ghoul :=: rpt 3 funk
grund = (Note (Cis,5) 1)
freak = rptm (Trans (round (abs (duration ghoul)))) 3 funk
ghoul = akkord grund 0
funk = Trans terz grund :=: rptm (Trans quinte) 4 ghoul

just append that to the previous program and adapt the main function.


Maybe it's also worth mentioning, that this was the first piece of haskell code written by him.
Haskell syntax helps to create frameworks with very little effort, that reassemble DSLs. In this case parts of the DSL for functional music from the School Of Expression was used to aid composers in creating algorithmic music without the syntactic burdens of a low-level language like (Ihh.. pfui... bahh) "java", that lack many, even basic features, like being NullPointer free, pattern matching, currying, higher order functions, type inference, laziness, ...etc.

Tuesday, April 29, 2008

Learning Haskell, functional music

As you might have realized, I started to learn Haskell. One of the most fun things to do in any programming language is creating some kind of audible side effects with a program.
Already back in the days when I started programming, I always played around with audio when toying around with a new language.

I have found a wonderful set of lecture slides about haskell and multimedia programming, called school of expression. Inspired by the slides about functional music I implemented a little song. Ahh ... and yes it is intended to sound slightly strange.

I used the synthesis toolkit to transform the music to real noise, simply by piping skini message to std-out.

I used this command line to achieve the results audible in the table:

sven@hhi1214a:~/Mukke$ ghc -o test1 test1.hs && ./test1 | stk-demo Plucked -n 16 -or -ip

Sound samples:




Pluckedplay
Clarinetplay
Whistle(attention very crazy!)play


As always the source...

stueck = anfang :+: mitte :+: ende

anfang = groovy :+: (Trans (-5) trickie)
mitte = seq_overlap (1/3) mitte1 mitte2
mitte1 = (3/4) `schneller` (Trans (-2) groovy)
mitte2 = (3/4) `schneller` groovy
ende = Rest (1/4) :+: (moll_akkord (Note (A,4) 1))

groovy = dumschingbadumschingsching 3 (2/3) -- fast schon swing artiger rythmischer versatz
trickie = dumschingbadumschingsching 2 (3/4)

blim_sching af = ((Note (A,3) (1/4)) :+: (af (Note (A,4) (1/4))))
dumdideldum af = quinten_hochlauf 4 (rpt 2 $ blim_sching af) -- 4 klingt leicht schief
dumschingbadumschingsching r versatz = interleave r versatz (dumdideldum moll_akkord) (Trans 3 (dumdideldum dur_akkord))

main :: IO ()
main = do
mapM_ putStrLn $ music_to_skini stueck 33

-- functional music composition
hochlauf tr n m = rep (Trans quinte) (delay (duration m)) n m
quinten_hochlauf = hochlauf quinte
interleave n dist m1 m2 = (rpt n m1) :=: (Rest dist :+: (rpt n m2))
schneller spdup m = (Tempo ((duration m)*(spdup)) m)

akkord grundton moll_dur = grundton :=: (Trans (3 + moll_dur) grundton) :=: (Trans 7 grundton)
moll_akkord grundton = akkord grundton 0
dur_akkord grundton = akkord grundton 1

terz = 3
gr_terz = 4
quarte = 5
quinte = 7

seq_overlap overlap m1 m2 = m1 :=: (delay ((duration m2) - overlap) m2)

rpt 0 m = Rest 0
rpt n m = m :+: rpt (n-1) m

rptm f 0 m = Rest 0
rptm f n m = m :+: rptm f (n - 1) (f m)

rep f g 0 m = Rest 0
rep f g n m = m :=: g (rep f g (n-1) (f m))

-- functional music basics, based on the school of expression lecture slides
data Music = Note Pitch Dur
| Rest Dur
| Music :+: Music
| Music :=: Music
| Tempo Dur Music
| Trans Int Music
| Instr Int Music
| Control ControlMessage Music
deriving (Show, Eq)

type Dur = Rational

type Pitch = (Tone, Octave)
data Tone = C | Cis | D | Dis | E | F | Fis | G | Gis | A | B | H
deriving (Show, Eq)
type Octave = Int

type ControlMessage = (Int, Int)

-- absolute pitches
type AbsPitch = Int

trans :: Int -> Pitch -> Pitch
trans i p = pitch (absPitch p + i)

pitch :: AbsPitch -> Pitch
pitch p = ([C, Cis, D, Dis, E, F, Fis, G, Gis, A, B, H] !! mod p 12, p `quot` 12)

absPitch :: Pitch -> AbsPitch
absPitch (n, o) = (o * 12) + (case n of C -> 0; Cis -> 1; D -> 2; Dis -> 3; E -> 4; F -> 5; Fis -> 6; G -> 7; Gis -> 8; A -> 9; B -> 10; H -> 11)

-- delay
delay :: Dur -> Music -> Music
delay d = ((Rest d) :+:)

-- absolute durations
abs_dur :: BeatPM -> Dur -> AbsDur
abs_dur bpm d = (fromRational d) / (bpm / (60.0))

type BeatPM = Float
type AbsDur = Float

-- calculate the duration of a piece of music
duration :: Music -> Dur
duration m = case m of
Rest d -> d
Note _ d -> d
m1 :+: m2 -> duration m1 + duration m2
m1 :=: m2 -> max (duration m1) (duration m2)
Tempo d _ -> d
Trans _ m1 -> duration m1
Instr _ m1 -> duration m1
Control _ m1 -> duration m1

-- convert to a simple event stream of musical events with absolute values
-- that soley consist of NoteOn and NoteOff events with midi notes and timestamps
data MusicEvent = MusicEv MusicEventType AbsPitch AbsDur
deriving (Show, Eq)

data MusicEventType = NoteOn | NoteOff
deriving (Show, Eq)

to_event_stream :: BeatPM -> Music -> AbsDur -> (AbsDur, [MusicEvent])
to_event_stream bpm um start_time =
case m of
Note p d ->
let dur = start_time + (abs_dur bpm d)
in (dur, [(MusicEv NoteOn (absPitch p) start_time), (MusicEv NoteOff (absPitch p) dur)])

Rest d ->
(start_time + (abs_dur bpm d), [])

Tempo d m1 ->
to_event_stream (bpm * (fromRational (duration m1)) * 1.0/(fromRational d)) m1 start_time

m1 :+: m2 ->
(total_dur, evt_str1 ++ evt_str2)
where (st1, evt_str1) = to_event_stream bpm m1 start_time
(total_dur, evt_str2) = to_event_stream bpm m2 st1

m1 :=: m2 ->
(max dur1 dur2, merge evt_str1 evt_str2)
where (dur1, evt_str1) = to_event_stream bpm m1 start_time
(dur2, evt_str2) = to_event_stream bpm m2 start_time

_ -> (start_time, [])

where
m = transpose_all um 0
transpose_all :: Music -> Int -> Music
transpose_all m tr = case m of
Trans tr2 m1 -> transpose_all m1 (tr + tr2)
Note p d -> Note (trans tr p) d
m1 :+: m2 -> (transpose_all m1 tr) :+: (transpose_all m2 tr)
m1 :=: m2 -> (transpose_all m1 tr) :=: (transpose_all m2 tr)
other -> other
merge :: [MusicEvent] -> [MusicEvent] -> [MusicEvent]
merge l1 l2 = mergea l1 l2 []
mergea :: [MusicEvent] -> [MusicEvent] -> [MusicEvent] -> [MusicEvent]
mergea [] l2 acc = acc ++ l2
mergea l1 [] acc = acc ++ l1
mergea l1@(e1@(MusicEv _ _ dur1):r1) l2@(e2@(MusicEv _ _ dur2):r2) acc
| dur1 <= dur2 = mergea r1 l2 (acc ++ [e1]) | dur1 > dur2 = mergea l1 r2 (acc ++ [e2])

-- convert to skinni
{-

Friday, April 11, 2008

Haskell Thread Ring Benchmark

Not as fast as the erlang version coming soon:




import Control.Monad
import Control.Concurrent
import System.Environment
import System.CPUTime

fork_ring_elem prev_mvar _ = do
next_mvar <- newEmptyMVar
forkIO (ring_elem prev_mvar next_mvar)
return next_mvar

ring_elem :: MVar Int -> MVar Int -> IO ()
ring_elem prev_mv next_mv = run
where run = do
token <- takeMVar prev_mv
putMVar next_mv (token - 1)
when ( token > 0 ) run

first_ring_elem :: MVar Int -> MVar Int -> IO ()
first_ring_elem prev_mv next_mv = run
where run = do
token <- takeMVar prev_mv
putMVar next_mv (token - 1)
putStrLn "."
when ( token > 0 ) run

main = do
(procsArg:roundsArg:_) <- getArgs
first_mvar <- newMVar ((read procsArg) * (read roundsArg))
t1 <- getCPUTime
last_mvar <- foldM fork_ring_elem first_mvar [2..(read procsArg)]
t2 <- getCPUTime
putStrLn ("forked processes in " ++ (show (t2 - t1)) ++ " ps")
first_ring_elem last_mvar first_mvar
t3 <- getCPUTime
putStrLn "\n***finished***"
putStrLn ("total time: " ++ (show (t3 - t1)) ++ " ps")