moduleHaskore.Example.FractalwhereimportPreludehiding(init)importSystem.Random(randomRs,mkStdGen)importData.Array(Array,(!),listArray,bounds)importqualifiedHaskore.Basic.PitchasPitchimportqualifiedHaskore.MusicasMusicimportqualifiedHaskore.MelodyasMelodyimportHaskore.Music((+:+))importqualifiedHaskore.Basic.DurationasDurtypeVectora=[a]typeMatrixa=[Vectora]typeATa=Vectora->VectoratypeIFSa=ArrayInt(ATa)-- First define some general matrix operations.-- These will facilitate moving to higher dimensions later.vadd::Numa=>Vectora->Vectora->Vectoravadd=zipWith(+)vvmult::Numa=>Vectora->Vectora->avvmultv1v2=sum(zipWith(*)v1v2)mvmult::Numa=>Matrixa->Vectora->Vectoramvmultmv=map(vvmultv)mcvmult::Numa=>a->Vectora->Vectoracvmultz=map(z*)---------------------------------------------------------------------{- The following simulates the Iterated Function System for the
Sierpinski Triangle as described in Barnsley's "Desktop Fractal
Design Handbook". -}-- First the affine transformations:w0,w1,w2::Fractionala=>ATaw0v=(cvmult0.01([[50,0],[0,50],[50,0]]`mvmult`v))`vadd`[8,8,8]w1v=(cvmult0.01([[50,0],[0,50],[50,0]]`mvmult`v))`vadd`[30,16,2]w2v=(cvmult0.01([[50,0],[0,50],[50,0]]`mvmult`v))`vadd`[20,40,30]init0::Numa=>Vectorainit0=[0,0,0]-- Now we have an Iterated Function System:ws::Fractionala=>IFSaws=letwl=[w0,w1,w2]inlistArray(0,lengthwl-1)wl-- And here is the result:result::[VectorRational]result=letws'=ws-- make it monomorphfinitr=(ws'!r)initinscanlfinit0(randomRs(boundsws')(mkStdGen215))-- (read "42" :: StdGen)-- where "randomRs" computes a list of random indices in the range 0-2,-- which simulates flipping the coin in Barnsley.--------mkNote::[Rational]->Melody.T()mkNote[a,b,c]=Music.rest(Dur.fromRatio(b/20))+:+Melody.note(Pitch.fromInt(rounda))(Dur.fromRatio(c/20))()mkNote_=error"mkNote: Need three components."{- Of course, a triple would be the better type
but that would complicate the vector computation. -}sourceToMusic::[[Rational]]->Melody.T()sourceToMusics=Music.chord(mapmkNotes)song::Melody.T()song=Music.transpose(-12)(sourceToMusic(take128result))