> module Transition.Fractals where
>
> import Transition.Basics
> import Transition.Translate (toMelody, toMidi)
> import Haskore.Interface.MIDI.Render (playMidi)
> -- import qualified Haskore.Music.GeneralMIDI as GM
> -- import qualified Haskore.Music             as Music
> -- import qualified Haskore.Melody            as Melody
> -- import qualified Haskore.Music.Rhythmic    as RhyMusic
> import Random
> import Array
> import List

> out = playMidi . toMidi . Instr "Acoustic Grand Piano"

A program to implement Iterated Function Systems as described by
Barnsley.

For simplicity, vectors and matrices are implemented with
Haskell lists and lists of lists, respectively:

> type Vector = [Double]	 -- vectors as lists
> type Matrix = [Vector]	 -- matrices as lists of lists
> type AT     = Vector -> Vector -- affine transformations
> type IFS    = [AT]		 -- iterated function system

General matrix operations:
(These will facilitate moving to higher dimensions later.)

> vadd :: Vector -> Vector -> Vector
> vadd = zipWith (+)
> 
> vvmult :: Vector -> Vector -> Double
> vvmult v1 v2 = foldl (+) 0 (zipWith (*) v1 v2)
> 
> mvmult :: Matrix -> Vector -> Vector
> mvmult m v = map (vvmult v) m
> 
> cvmult :: Double -> Vector -> Vector
> cvmult c v = map (c*) v

The following simulates the Iterated Function System for the
SierPinski Triangle as described in Barnsley's "Desktop Fractal 
Design Handbook".

First the affine transformations:

> st1,st2,st3 :: AT
> st1 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
>        `vadd` [8,8,8]
> st2 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
>        `vadd` [30,16,2]
> st3 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
>        `vadd` [20,40,30]

> init0 :: Vector
> init0 = [0,0,0]

Now we have an Iterated Function System:

> st :: IFS
> st = [st1,st2,st3]

And here is the result:

> ranResult x = scanl f init0 threeWayFlip
>               where f init r = (x!!r) init

where "threeWayFlip" is a list of random indices in the range 0-2,
which simulates flipping the three-sided coin in Barnsley.

> threeWayFlip = randomRs (0,2) (mkStdGen 42)

Alternatively, here is deterministic rendering of the triangle
to n levels using a "seed" which is a list of points:

> detRender :: IFS -> [Vector] -> Int -> Bool -> [Vector]
> detRender ifs seed n b = (iterate (applyIFS ifs b) seed) !! n

The sequence "(iterate (applyIFS ifs b) seed)" above is a Cauchy sequence
whose limit point is the attractor of the IFS.  Each element in this
sequence is mathematically a set of points, but here we represent the set
as a list.  Thus the order of the elements in the list is important if we
are to interpret them in a musical context.  The Bool flag selects between
two different orderings, as reflected in the list comprehensions below.

> applyIFS :: IFS -> Bool -> [Vector] -> [Vector]
> applyIFS ifs True  seed = [ f v | f <- ifs,  v <- seed ]
> applyIFS ifs False seed = [ f v | v <- seed, f <- ifs  ]

> seed :: [Vector]
> seed = [[0,0,0]]

> detResult x = detRender x seed 4

--------

> t1,t2,t3 :: [[Int]]
> t1 = map (map truncate) (ranResult st)
> t2 = map (map truncate) (detResult st True)
> t3 = map (map truncate) (detResult st False)

> playIt n d t =
>   let m = line (map (chord . (map (mkNote d))) (take n t))
>   in out m

> mkNote d p = Note (pitch p) d []

try: playIt 100 tn t2

--------------------------------------------------------------------------
-- Tom M's version of IFS's

> w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13 :: AT
> w1 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [348.0,0.2]
> w2 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [96.0,16.5]
> w3 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [756.0,24.8]
> 
> w4 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [151.9,0.99]
> w5 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [207.6,0.08]
> w6 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [711.5,0.53]
> 
> w7 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [250.0,0.0]
> w8 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [400.0,7.8]
> w9 v = (cvmult 0.01 ([[50.0,0.0],[0.0,50.0]] `mvmult` v))
>        `vadd` [600.0,10.9]

> tf10,tf11,tf12,tf13 :: ([[Double]], [Double])
> tf10 = ([[50.0,0.0],[0.0,50.0],[0.0,50.0]],[200.0,2.1,0.3])
> tf11 = ([[50.0,0.0],[0.0,50.0],[0.0,50.0]],[100.0,4.15,0.7])
> tf12 = ([[50.0,0.0],[0.0,50.0],[0.0,50.0]],[600.0,0.5,0.9])
> tf13 = ([[50.0,0.0],[0.0,50.0],[0.0,50.0]],[300.0,5.5,0.5])

> w10 v = (cvmult 0.01 ((fst tf10) `mvmult` v)) `vadd` (snd tf10)
> w11 v = (cvmult 0.01 ((fst tf11) `mvmult` v)) `vadd` (snd tf11)
> w12 v = (cvmult 0.01 ((fst tf12) `mvmult` v)) `vadd` (snd tf12)
> w13 v = (cvmult 0.01 ((fst tf13) `mvmult` v)) `vadd` (snd tf13)

-------------------------------------------------------------------------

Self Similar Music from SOE
---------------------------

> data Cluster = Cluster SNote [Cluster]
> type SNote   = (AbsPitch,Dur)

This particular kind of tree happens to be called a {\em rose tree}.
An \hs{SNote} is just a ``simple note.''

The sequence of \hs{SNote}s at each level of the cluster is the
melodic fragment for that level.  The very top cluster will contain a
"dummy" note, the next level will contain the original melody, the
next level will contain one iteration of the process described
earlier, and so forth.

To achieve this I will define a function \hs{selfSim} that takes the
initial melody as argument and generates an infinitely deep cluster:

> selfSim :: [SNote] -> Cluster
> selfSim pat = Cluster (0,0) (map mkCluster pat)
>     where mkCluster note 
>             = Cluster note (map (mkCluster . addmult note) pat)
> 
> addmult (p0,d0) (p1,d1) = (p0+p1,d0*d1)

Note that \hs{selfSim} itself is not recursive, but \hs{mkCluster} is.

Next, I define a function to skim off the notes at the \hs{n}th level,
or \hs{n}th ``fringe,'' of a cluster:

> fringe :: Int -> Cluster -> [SNote]
> fringe 0 (Cluster note cls) = [note]
> fringe n (Cluster note cls) = concat (map (fringe (n-1)) cls)

All that is left to do is convert this into a \hs{Music} value that we
can convert to MIDI:

> simToHask :: [SNote] -> Music
> simToHask ss = let mkNote (p,d) = Note (pitch p) d []
>                in line (map mkNote ss)

Putting it all together:

> pat :: [SNote]
> -- pat = [(3,0.5),(4,0.25),(0,0.25),(6,1.0)]
> pat = [(3,0.5),(4,0.4),(0,0.4),(6,0.6)]

> ssm l t
>  = let s = Trans 0
>             (Tempo t 
>               (simToHask (fringe l (selfSim pat))))
>    in out s -- :=: Trans (-24) (revM s)

try: ssm 4 2