hsc3-lang-0.15: Sound/SC3/Lang/Pattern/P/SC3.hs
-- | @sclang@ value pattern functions.
--
-- SC3 /value/ patterns: `pbrown` (Pbrown), `pclutch` (Pclutch),
-- `pcollect` (Pcollect), `pconst` (Pconst), `pdegreeToKey`
-- (PdegreeToKey), `pdiff` (Pdiff), `pdrop` (Pdrop), `pdurStutter`
-- (PdurStutter), `pexprand` (Pexprand), `pfinval` (Pfinval), `pfuncn`
-- (Pfuncn), `pgeom` (Pgeom), `pif` (Pif), `place` (Place), `pn` (Pn),
-- `ppatlace` (Ppatlace), `prand` (Prand), `preject` (Preject),
-- `prorate` (Prorate), `pselect` (Pselect), `pseq` (Pseq), `pser`
-- (Pser), `pseries` (Pseries), `pshuf` (Pshuf), `pslide` (Pslide),
-- `pstutter` (Pstutter), `pswitch1` (Pswitch1), `pswitch` (Pswitch),
-- `ptuple` (Ptuple), `pwhite` (Pwhite), `pwrand` (Pwrand), `pwrap`
-- (Pwrap), `pxrand` (Pxrand).
--
-- SC3 variant patterns: `pbrown`', `prand'`, `prorate'`, `pseq1`,
-- `pseqn`, `pser1`, `pseqr`, `pwhite'`, `pwhitei`.
--
-- SC3 collection patterns: `pfold`
module Sound.SC3.Lang.Pattern.P.SC3 where
import Control.Monad {- base -}
import qualified Data.List as L {- base -}
import Data.Monoid {- base -}
import System.Random {- random -}
import Sound.SC3 {- hsc3 -}
import Sound.SC3.Lang.Core
import Sound.SC3.Lang.Pattern.P.Core
import Sound.SC3.Lang.Pattern.P.Base
import qualified Sound.SC3.Lang.Collection as C
import qualified Sound.SC3.Lang.Math as M
import qualified Sound.SC3.Lang.Pattern.List as P
import qualified Sound.SC3.Lang.Pattern.Stream as I
import qualified Sound.SC3.Lang.Random.Gen as R
-- * SC3 Collection Patterns
-- | Variant of 'C.flop'.
--
-- > pflop' [toP [1,2],toP [3,4,5]] == toP [[1,3],[2,4],[1,5]]
-- > pflop' [toP [1,2],3] == toP [[1,3],[2,3]]
-- > pflop' [pseq [1,2] 1,pseq [3,4] inf]
pflop' :: [P a] -> P [a]
pflop' l = toP (C.flop (map unP l))
-- | 'fmap' 'toP' of 'pflop''.
--
-- > C.flop [[1,2],[3,4,5]] == [[1,3],[2,4],[1,5]]
-- > pflop [toP [1,2],toP [3,4,5]] == toP (map toP [[1,3],[2,4],[1,5]])
pflop :: [P a] -> P (P a)
pflop = fmap toP . pflop'
{- | Type specialised 'P.ffold'.
> pfold (toP [10,11,12,-6,-7,-8]) (-7) 11 == toP [10,11,10,-6,-7,-6]
> audition (pbind [(K_degree,pfold (pseries 4 1 inf) (-7) 11)
> ,(K_dur,0.0625)])
The underlying primitive is then `fold_` function.
> let f = fmap (\n -> fold_ n (-7) 11)
> in audition (pbind [(K_degree,f (pseries 4 1 inf))
> ,(K_dur,0.0625)])
-}
pfold :: (RealFrac n) => P n -> n -> n -> P n
pfold = P.ffold
-- | Pattern variant of 'C.normalizeSum'.
pnormalizeSum :: Fractional n => P n -> P n
pnormalizeSum = liftP C.normalizeSum
-- * SC3 Patterns
{-| Pbrown. Lifted 'P.brown'. SC3 pattern to generate
psuedo-brownian motion.
> pbrown 'α' 0 9 1 5 == toP [4,4,5,4,3]
> audition (pbind [(K_dur,0.065)
> ,(K_freq,pbrown 'α' 440 880 20 inf)])
-}
pbrown :: (Enum e,Random n,Num n,Ord n) => e -> n -> n -> n -> Int -> P n
pbrown e l r s n = ptake n (toP (P.brown e l r s))
{-| Pclutch. SC3 sample and hold pattern. For true values in the
control pattern, step the value pattern, else hold the previous value.
> > c = Pseq([1,0,1,0,0,1,1],inf);
> > p = Pclutch(Pser([1,2,3,4,5],8),c);
> > r = [1,1,2,2,2,3,4,5,5,1,1,1,2,3];
> > p.asStream.all == r
> let {c = pbool (pseq [1,0,1,0,0,1,1] inf)
> ;p = pclutch (pser [1,2,3,4,5] 8) c
> ;r = toP [1,1,2,2,2,3,4,5,5,1,1,1,2,3]}
> in p == toP [1,1,2,2,2,3,4,5,5,1,1,1,2,3]
Note the initialization behavior, nothing is generated until the
first true value.
> let {p = pseq [1,2,3,4,5] 1
> ;q = pbool (pseq [0,0,0,0,0,0,1,0,0,1,0,1] 1)}
> in pclutch p q == toP [1,1,1,2,2,3]
> > Pbind(\degree,Pstutter(Pwhite(3,10,inf),Pwhite(-4,11,inf)),
> > \dur,Pclutch(Pwhite(0.1,0.4,inf),
> > Pdiff(Pkey(\degree)).abs > 0),
> > \legato,0.3).play;
> let {d = pstutter (pwhite 'α' 3 10 inf) (pwhitei 'β' (-4) 11 inf)
> ;p = [(K_degree,d)
> ,(K_dur,pclutch (pwhite 'γ' 0.1 0.4 inf)
> (pbool (abs (pdiff d) >* 0)))
> ,(K_legato,0.3)]}
> in audition (pbind p)
-}
pclutch :: P a -> P Bool -> P a
pclutch p q =
let r = fmap (+ 1) (pcountpost q)
in pstutter r p
-- | Pcollect. SC3 name for 'fmap', ie. patterns are functors.
--
-- > > Pcollect({|i| i * 3},Pseq(#[1,2,3],1)).asStream.all == [3,6,9]
-- > pcollect (* 3) (toP [1,2,3]) == toP [3,6,9]
--
-- > > Pseq(#[1,2,3],1).collect({|i| i * 3}).asStream.all == [3,6,9]
-- > fmap (* 3) (toP [1,2,3]) == toP [3,6,9]
pcollect :: (a -> b) -> P a -> P b
pcollect = fmap
{- | Pconst. SC3 pattern to constrain the sum of a numerical pattern.
Is equal to /p/ until the accumulated sum is within /t/ of /n/. At
that point, the difference between the specified sum and the
accumulated sum concludes the pattern.
> > p = Pconst(10,Pseed(Pn(1000,1),Prand([1,2,0.5,0.1],inf),0.001));
> > p.asStream.all == [0.5,0.1,0.5,1,2,2,0.5,1,0.5,1,0.9]
> let p = pconst 10 (prand 'α' [1,2,0.5,0.1] inf) 0.001
> in (p,Data.Foldable.sum p)
> > Pbind(\degree,Pseq([-7,Pwhite(0,11,inf)],1),
> > \dur,Pconst(4,Pwhite(1,4,inf) * 0.25)).play
> let p = [(K_degree,pcons (-7) (pwhitei 'α' 0 11 inf))
> ,(K_dur,pconst 4 (pwhite 'β' 1 4 inf * 0.25) 0.001)]
> in audition (pbind p)
-}
pconst :: (Ord a,Num a) => a -> P a -> a -> P a
pconst n p t =
let f _ [] = []
f j (i:is) = if i + j < n - t
then i : f (j + i) is
else [n - j]
in toP (f 0 (unP p))
{-| PdegreeToKey. SC3 pattern to derive notes from an index into a
scale.
> let {p = pseq [0,1,2,3,4,3,2,1,0,2,4,7,4,2] 2
> ;q = pure [0,2,4,5,7,9,11]
> ;r = [0,2,4,5,7,5,4,2,0,4,7,12,7,4,0,2,4,5,7,5,4,2,0,4,7,12,7,4]}
> in pdegreeToKey p q (pure 12) == toP r
> let {p = pseq [0,1,2,3,4,3,2,1,0,2,4,7,4,2] 2
> ;q = pseq (map return [[0,2,4,5,7,9,11],[0,2,3,5,7,8,11]]) 1
> ;r = [0,2,4,5,7,5,4,2,0,4,7,12,7,4,0,2,3,5,7,5,3,2,0,3,7,12,7,3]}
> in pdegreeToKey p (pstutter 14 q) (pure 12) == toP r
This is the pattern variant of 'M.degreeToKey'.
> let s = [0,2,4,5,7,9,11]
> in map (M.degreeToKey s 12) [0,2,4,7,4,2,0] == [0,4,7,12,7,4,0]
> > Pbind(\note,PdegreeToKey(Pseq([1,2,3,2,5,4,3,4,2,1],2),
> > #[0,2,3,6,7,9],
> > 12),\dur,0.25).play
> let {n = pdegreeToKey (pseq [1,2,3,2,5,4,3,4,2,1] 2)
> (pure [0,2,3,6,7,9])
> 12}
> in audition (pbind [(K_note,n),(K_dur,0.25)])
> > s = #[[0,2,3,6,7,9],[0,1,5,6,7,9,11],[0,2,3]];
> > d = [1,2,3,2,5,4,3,4,2,1];
> > Pbind(\note,PdegreeToKey(Pseq(d,4),
> > Pstutter(3,Prand(s,inf)),
> > 12),\dur,0.25).play;
> let {s = map return [[0,2,3,6,7,9],[0,1,5,6,7,9,11],[0,2,3]]
> ;d = [1,2,3,2,5,4,3,4,2,1]
> ;k = pdegreeToKey (pseq d 4)
> (pstutter 3 (prand 'α' s 14))
> (pn 12 40)}
> in audition (pbind [(K_note,k),(K_dur,0.25)])
-}
pdegreeToKey :: (RealFrac a) => P a -> P [a] -> P a -> P a
pdegreeToKey = pzipWith3 (\i j k -> M.degreeToKey j k i)
-- | Pdiff. SC3 pattern to calculate adjacent element difference.
--
-- > > Pdiff(Pseq([0,2,3,5,6,8,9],1)).asStream.all == [2,1,2,1,2,1]
-- > pdiff (pseq [0,2,3,5,6,8,9] 1) == toP [2,1,2,1,2,1]
pdiff :: Num n => P n -> P n
pdiff p = ptail p - p
-- | Pdrop. Lifted 'L.drop'.
--
-- > > p = Pseries(1,1,20).drop(5);
-- > > p.asStream.all == [6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
--
-- > pdrop 5 (pseries 1 1 10) == toP [6,7,8,9,10]
-- > pdrop 1 mempty == mempty
pdrop :: Int -> P a -> P a
pdrop n = liftP (drop n)
{- | PdurStutter. Lifted 'P.durStutter'.
> > s = Pseq(#[1,1,1,1,1,2,2,2,2,2,0,1,3,4,0],inf);
> > d = Pseq(#[0.5,1,2,0.25,0.25],1);
> > PdurStutter(s,d).asStream.all == [0.5,1,2,0.25,0.25]
> let {s = pseq [1,1,1,1,1,2,2,2,2,2,0,1,3,4,0] inf
> ;d = pseq [0.5,1,2,0.25,0.25] 1}
> in pdurStutter s d == toP [0.5,1.0,2.0,0.25,0.25]
Applied to duration.
> > d = PdurStutter(Pseq(#[1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4],inf),
> > Pseq(#[0.5,1,2,0.25,0.25],inf));
> > Pbind(\freq,440,\dur,d).play
> let {s = pseq [1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4] inf
> ;d = pseq [0.5,1,2,0.25,0.25] inf}
> in audition (pbind [(K_freq,440),(K_dur,pdurStutter s d)])
Applied to frequency.
> let {s = pseq [1,1,1,1,1,2,2,2,2,2,3,3,3,3,4,4,0,4,4] inf
> ;d = pseq [0,2,3,5,7,9,10] inf + 80}
> in audition (pbind [(K_midinote,pdurStutter s d),(K_dur,0.15)])
-}
pdurStutter :: Fractional a => P Int -> P a -> P a
pdurStutter = liftP2 P.durStutter
-- | Pexprand. Lifted 'P.exprand'.
--
-- > > Pexprand(0.0001,1,10).asStream.all
-- > pexprand 'α' 0.0001 1 10
--
-- > > Pbind(\freq,Pexprand(0.0001,1,inf) * 600 + 300,\dur,0.02).play
--
-- > audition (pbind [(K_freq,pexprand 'α' 0.0001 1 inf * 600 + 300)
-- > ,(K_dur,0.02)])
pexprand :: (Enum e,Random a,Floating a) => e -> a -> a -> Int -> P a
pexprand e l r = toP . P.exprand e l r
-- | Pfinval. Alias for 'ptake'
--
-- > > Pfinval(5,Pseq(#[1,2,3],inf)).asStream.all == [1,2,3,1,2]
-- > pfinval 5 (pseq [1,2,3] inf) == toP [1,2,3,1,2]
pfinval :: Int -> P a -> P a
pfinval = ptake
{-|
A variant of the SC3 pattern that evaluates a closure at each
step. The haskell variant function has a 'StdGen' form.
> > p = Pfuncn({exprand(0.1,0.3) + #[1,2,3,6,7].choose},inf);
> > Pbind(\freq,p * 100 + 300,\dur,0.02).play
> let {exprand = Sound.SC3.Lang.Random.Gen.exprand
> ;choose = Sound.SC3.Lang.Random.Gen.choose
> ;p = pfuncn 'α' (exprand 0.1 0.3) inf
> ;q = pfuncn 'β' (choose [1,2,3,6,7]) inf}
> in audition (pbind [(K_freq,(p + q) * 100 + 300),(K_dur,0.02)])
Of course in this case there is a pattern equivalent.
> let {p = pexprand 'α' 0.1 0.3 inf + prand 'β' [1,2,3,6,7] inf}
> in audition (pbind [(K_freq,p * 100 + 300),(K_dur,0.02)])
-}
pfuncn :: Enum e => e -> (StdGen -> (n,StdGen)) -> Int -> P n
pfuncn e f n = toP (P.funcn e f n)
{- | Pgeom. SC3 geometric series pattern.
> > Pgeom(3,6,5).asStream.all == [3,18,108,648,3888]
> pgeom 3 6 5 == toP [3,18,108,648,3888]
> > Pgeom(1,2,10).asStream.all == [1,2,4,8,16,32,64,128,256,512]
> pgeom 1 2 10 == toP [1,2,4,8,16,32,64,128,256,512]
Real numbers work as well.
> > p = Pgeom(1.0,1.1,6).collect({|i| (i * 100).floor});
> > p.asStream.all == [100,110,121,133,146,161];
> let p = fmap (floor . (* 100)) (pgeom 1.0 1.1 6)
> in p == toP [100,110,121,133,146,161]
> > Pbind(\degree,Pseries(-7,1,15),
> > \dur,Pgeom(0.5,0.89140193218427,15)).play;
> audition (pbind [(K_degree,pseries (-7) 1 15)
> ,(K_dur,pgeom 0.5 0.89140193218427 15)])
There is a list variant.
> > 5.geom(3,6)
> C.geom 5 3 6 == [3,18,108,648,3888]
-}
pgeom :: (Num a) => a -> a -> Int -> P a
pgeom i s n = toP (C.geom n i s)
-- | Pif. SC3 /implicitly repeating/ pattern-based conditional expression.
--
-- > > a = Pfunc({0.3.coin});
-- > > b = Pwhite(0,9,3);
-- > > c = Pwhite(10,19,3);
-- > > Pfin(9,Pif(a,b,c)).asStream.all
--
-- > let {a = fmap (< 0.75) (pwhite 'α' 0.0 1.0 inf)
-- > ;b = pwhite 'β' 0 9 6
-- > ;c = pwhite 'γ' 10 19 6}
-- > in pif a b c * (-1) == toP [-7,-3,-11,-17,-18,-6,-3,-4,-5]
pif :: P Bool -> P a -> P a -> P a
pif = liftP3_repeat P.if_demand
-- | Place. SC3 interlaced embedding of subarrays.
--
-- > > Place([0,[1,2],[3,4,5]],3).asStream.all == [0,1,3,0,2,4,0,1,5]
-- > C.lace 9 [[0],[1,2],[3,4,5]] == [0,1,3,0,2,4,0,1,5]
-- > place [[0],[1,2],[3,4,5]] 3 == toP [0,1,3,0,2,4,0,1,5]
--
-- > > Place(#[1,[2,5],[3,6]],2).asStream.all == [1,2,3,1,5,6]
-- > C.lace 6 [[1],[2,5],[3,6]] == [1,2,3,1,5,6]
-- > place [[1],[2,5],[3,6]] 2 == toP [1,2,3,1,5,6]
--
-- > C.lace 12 [[1],[2,5],[3,6..]] == [1,2,3,1,5,6,1,2,9,1,5,12]
-- > place [[1],[2,5],[3,6..]] 4 == toP [1,2,3,1,5,6,1,2,9,1,5,12]
place :: [[a]] -> Int -> P a
place a n =
let f = toP . concat . take_inf n . L.transpose . map cycle
in f a
-- | Pn. SC3 pattern to repeat the enclosed pattern a number of
-- times.
--
-- > pn 1 4 == toP [1,1,1,1]
-- > pn (toP [1,2,3]) 3 == toP [1,2,3,1,2,3,1,2,3]
--
-- This is related to `concat`.`replicate` in standard list processing.
--
-- > concat (replicate 4 [1]) == [1,1,1,1]
-- > concat (replicate 3 [1,2,3]) == [1,2,3,1,2,3,1,2,3]
--
-- There is a `pconcatReplicate` near-alias (reversed argument order).
--
-- > pconcatReplicate 4 1 == toP [1,1,1,1]
-- > pconcatReplicate 3 (toP [1,2]) == toP [1,2,1,2,1,2]
--
-- This is productive over infinite lists.
--
-- > concat (replicate inf [1])
-- > pconcat (replicate inf 1)
-- > pconcatReplicate inf 1
pn :: P a -> Int -> P a
pn p n = mconcat (replicate n p)
{- | Ppatlace. SC3 /implicitly repeating/ pattern to lace input patterns.
> > p = Ppatlace([1,Pseq([2,3],2),4],5);
> > p.asStream.all == [1,2,4,1,3,4,1,2,4,1,3,4,1,4]
> ppatlace [1,pseq [2,3] 2,4] 5 == toP [1,2,4,1,3,4,1,2,4,1,3,4,1,4]
> > p = Ppatlace([1,Pseed(Pn(1000,1),Prand([2,3],inf))],5);
> > p.asStream.all == [1,3,1,3,1,3,1,2,1,2]
> ppatlace [1,prand 'α' [2,3] inf] 5 == toP [1,3,1,2,1,3,1,2,1,2]
> > Pbind(\degree,Ppatlace([Pseries(0,1,8),Pseries(2,1,7)],inf),
> > \dur,0.25).play;
> let p = [(K_degree,ppatlace [pseries 0 1 8,pseries 2 1 7] inf)
> ,(K_dur,0.125)]
> in audition (pbind p)
-}
ppatlace :: [P a] -> Int -> P a
ppatlace a n =
let a' = L.transpose (map unP_repeat a)
in toP (L.concat (take_inf n a'))
{-| Prand. SC3 pattern to make n random selections from a list of
patterns, the resulting pattern is flattened (joined).
> > p = Pseed(Pn(1000,1),Prand([1,Pseq([10,20,30]),2,3,4,5],6));
> > p.asStream.all == [3,5,3,10,20,30,2,2]
> prand 'α' [1,toP [10,20],2,3,4,5] 5 == toP [5,2,10,20,2,1]
> > Pbind(\note,Prand([0,1,5,7],inf),\dur,0.25).play
> audition (pbind [(K_note,prand 'α' [0,1,5,7] inf),(K_dur,0.25)])
Nested sequences of pitches:
> > Pbind(\midinote,Prand([Pseq(#[60,61,63,65,67,63]),
> > Prand(#[72,73,75,77,79],6),
> > Pshuf(#[48,53,55,58],2)],inf),
> > \dur,0.25).play
> let {n = prand 'α' [pseq [60,61,63,65,67,63] 1
> ,prand 'β' [72,73,75,77,79] 6
> ,pshuf 'γ' [48,53,55,58] 2] inf}
> in audition (pbind [(K_midinote,n),(K_dur,0.075)])
The below cannot be written as intended with the list
based pattern library. This is precisely because the
noise patterns are values, not processes with a state
threaded non-locally.
> do {n0 <- Sound.SC3.Lang.Random.IO.rrand 2 5
> ;n1 <- Sound.SC3.Lang.Random.IO.rrand 3 9
> ;let p = pseq [prand 'α' [pempty,pseq [24,31,36,43,48,55] 1] 1
> ,pseq [60,prand 'β' [63,65] 1
> ,67,prand 'γ' [70,72,74] 1] n0
> ,prand 'δ' [74,75,77,79,81] n1] inf
> in return (ptake 24 p)}
-}
prand :: Enum e => e -> [P a] -> Int -> P a
prand = join .:: prand'
-- | Preject. SC3 pattern to rejects values for which the predicate
-- is true. reject f is equal to filter (not . f).
--
-- > preject (== 1) (pseq [1,2,3] 2) == toP [2,3,2,3]
-- > pfilter (not . (== 1)) (pseq [1,2,3] 2) == toP [2,3,2,3]
--
-- > > p = Pseed(Pn(1000,1),Pwhite(0,255,20).reject({|x| x.odd}));
-- > > p.asStream.all == [224,60,88,94,42,32,110,24,122,172]
--
-- > preject odd (pwhite 'α' 0 255 10) == toP [32,158,62,216,240,20]
--
-- > > p = Pseed(Pn(1000,1),Pwhite(0,255,20).select({|x| x.odd}));
-- > > p.asStream.all == [151,157,187,129,45,245,101,79,77,243]
--
-- > pselect odd (pwhite 'α' 0 255 10) == toP [241,187,119,127]
preject :: (a -> Bool) -> P a -> P a
preject f = liftP (filter (not . f))
{- | Prorate. SC3 /implicitly repeating/ sub-dividing pattern.
> > p = Prorate(Pseq([0.35,0.5,0.8]),1);
> > p.asStream.all == [0.35,0.65,0.5,0.5,0.8,0.2];
> let p = prorate (fmap Left (pseq [0.35,0.5,0.8] 1)) 1
> in fmap roundE (p * 100) == toP [35,65,50,50,80,20]
> > p = Prorate(Pseq([0.35,0.5,0.8]),Pseed(Pn(100,1),Prand([20,1],inf)));
> > p.asStream.all == [7,13,0.5,0.5,16,4]
> let p = prorate (fmap Left (pseq [0.35,0.5,0.8] 1))
> (prand 'α' [20,1] 3)
> in fmap roundE (p * 100) == toP [35,65,1000,1000,80,20]
> > l = [[1,2],[5,7],[4,8,9]].collect(_.normalizeSum);
> > Prorate(Pseq(l,1)).asStream.all
> let l = map (Right . C.normalizeSum) [[1,2],[5,7],[4,8,9]]
> in prorate (toP l) 1
> > Pfinval(5,Prorate(0.6,0.5)).asStream.all == [0.3,0.2,0.3,0.2,0.3]
> pfinval 5 (prorate (fmap Left 0.6) 0.5) == toP [0.3,0.2,0.3,0.2,0.3]
> > Pbind(\degree,Pseries(4,1,inf).fold(-7,11),
> > \dur,Prorate(0.6,0.5)).play
> audition (pbind [(K_degree,pfold (pseries 4 1 inf) (-7) 11)
> ,(K_dur,prorate (fmap Left 0.6) 0.25)])
-}
prorate :: Num a => P (Either a [a]) -> P a -> P a
prorate = pjoin_repeat .: pzipWith prorate'
-- | Pselect. See 'pfilter'.
--
-- > pselect (< 3) (pseq [1,2,3] 2) == toP [1,2,1,2]
pselect :: (a -> Bool) -> P a -> P a
pselect f = liftP (filter f)
{-| Pseq. SC3 pattern to cycle over a list of patterns. The repeats
pattern gives the number of times to repeat the entire list.
> pseq [return 1,return 2,return 3] 2 == toP [1,2,3,1,2,3]
> pseq [1,2,3] 2 == toP [1,2,3,1,2,3]
> pseq [1,pn 2 2,3] 2 == toP [1,2,2,3,1,2,2,3]
There is an 'inf' value for the repeats variable.
> ptake 3 (pdrop (10^5) (pseq [1,2,3] inf)) == toP [2,3,1]
Unlike the SC3 Pseq, `pseq` does not have an offset argument to give a
starting offset into the list.
> pseq (C.rotate 3 [1,2,3,4]) 3 == toP [2,3,4,1,2,3,4,1,2,3,4,1]
As scale degrees.
> > Pbind(\degree,Pseq(#[0,0,4,4,5,5,4],1),
> > \dur,Pseq(#[0.5,0.5,0.5,0.5,0.5,0.5,1],1)).play
> audition (pbind [(K_degree,pseq [0,0,4,4,5,5,4] 1)
> ,(K_dur,pseq [0.5,0.5,0.5,0.5,0.5,0.5,1] 1)])
> > Pseq(#[60,62,63,65,67,63],inf) + Pseq(#[0,0,0,0,-12],inf)
> let n = pseq [60,62,63,65,67,63] inf + pser [0,0,0,0,-12] 25
> in audition (pbind [(K_midinote,n),(K_dur,0.2)])
Pattern `b` pattern sequences `a` once normally, once transposed up a
fifth and once transposed up a fourth.
> > a = Pseq(#[60,62,63,65,67,63]);
> > b = Pseq([a,a + 7,a + 5],inf);
> > Pbind(\midinote,b,\dur,0.3).play
> let {a = pseq [60,62,63,65,67,63] 1
> ;b = pseq [a,a + 7,a + 5] inf}
> in audition (pbind [(K_midinote,b),(K_dur,0.13)])
-}
pseq :: [P a] -> Int -> P a
pseq a i =
let a' = mconcat a
in if i == inf then pcycle a' else pn a' i
-- | Pser. SC3 pattern that is like 'pseq', however the repeats
-- variable gives the number of elements in the sequence, not the
-- number of cycles of the pattern.
--
-- > pser [1,2,3] 5 == toP [1,2,3,1,2]
-- > pser [1,pser [10,20] 3,3] 9 == toP [1,10,20,10,3,1,10,20,10]
-- > pser [1,2,3] 5 * 3 == toP [3,6,9,3,6]
pser :: [P a] -> Int -> P a
pser a i = ptake i (pcycle (mconcat a))
-- | Pseries. SC3 arithmetric series pattern, see also 'pgeom'.
--
-- > pseries 0 2 10 == toP [0,2,4,6,8,10,12,14,16,18]
-- > pseries 9 (-1) 10 == toP [9,8 .. 0]
-- > pseries 1.0 0.2 3 == toP [1.0::Double,1.2,1.4]
pseries :: (Num a) => a -> a -> Int -> P a
pseries i s n = toP (C.series n i s)
{- | Pshuf. SC3 pattern to return @n@ repetitions of a shuffled
-- sequence.
> > Pshuf([1,2,3,4],2).asStream.all
> pshuf 'α' [1,2,3,4] 2 == toP [2,4,3,1,2,4,3,1]
> > Pbind(\degree,Pshuf([0,1,2,4,5],inf),\dur,0.25).play
> audition (pbind [(K_degree,pshuf 'α' [0,1,2,4,5] inf)
> ,(K_dur,0.25)])
-}
pshuf :: Enum e => e -> [a] -> Int -> P a
pshuf e a =
let (a',_) = R.scramble a (mkStdGen (fromEnum e))
in pn (toP a')
{- | Pslide. Lifted 'P.slide'.
> > Pslide([1,2,3,4],inf,3,1,0).asStream.all
> pslide [1,2,3,4] 4 3 1 0 True == toP [1,2,3,2,3,4,3,4,1,4,1,2]
> pslide [1,2,3,4,5] 3 3 (-1) 0 True == toP [1,2,3,5,1,2,4,5,1]
> > Pbind(\degree,Pslide((-6,-4 .. 12),8,3,1,0),
> > \dur,Pseq(#[0.1,0.1,0.2],inf),
> > \sustain,0.15).play
> audition (pbind [(K_degree,pslide [-6,-4 .. 12] 8 3 1 0 True)
> ,(K_dur,pseq [0.05,0.05,0.1] inf)
> ,(K_sustain,0.15)])
-}
pslide :: [a] -> Int -> Int -> Int -> Int -> Bool -> P a
pslide = toP .::::: P.slide
{- | Pstutter. SC3 /implicitly repeating/ pattern to repeat each
-- element of a pattern /n/ times.
> > Pstutter(2,Pseq([1,2,3],1)).asStream.all == [1,1,2,2,3,3]
> pstutter 2 (pseq [1,2,3] 1) == toP [1,1,2,2,3,3]
The count input may be a pattern.
> let {p = pseq [1,2] inf
> ;q = pseq [1,2,3] 2}
> in pstutter p q == toP [1,2,2,3,1,1,2,3,3]
> pstutter (toP [1,2,3]) (toP [4,5,6]) == toP [4,5,5,6,6,6]
> pstutter 2 (toP [4,5,6]) == toP [4,4,5,5,6,6]
Stutter scale degree and duration with the same random sequence.
> > Pbind(\n,Pwhite(3,10,inf),
> > \degree,Pstutter(Pkey(\n),Pwhite(-4,11,inf)),
> > \dur,Pstutter(Pkey(\n),Pwhite(0.05,0.4,inf)),
> > \legato,0.3).play
> let {n = pwhite 'α' 3 10 inf
> ;p = [(K_degree,pstutter n (pwhitei 'β' (-4) 11 inf))
> ,(K_dur,pstutter n (pwhite 'γ' 0.05 0.4 inf))
> ,(K_legato,0.3)]}
> in audition (pbind p)
-}
pstutter :: P Int -> P a -> P a
pstutter = liftP2_repeat P.stutter
-- | Pswitch. Lifted 'P.switch'.
--
-- > let p = pswitch [pseq [1,2,3] 2,pseq [65,76] 1,800] (toP [2,2,0,1])
-- > in p == toP [800,800,1,2,3,1,2,3,65,76]
pswitch :: [P a] -> P Int -> P a
pswitch l = liftP (P.switch (map unP l))
-- | Pswitch1. Lifted /implicitly repeating/ 'P.switch1'.
--
-- > > l = [Pseq([1,2,3],inf),Pseq([65,76],inf),8];
-- > > p = Pswitch1(l,Pseq([2,2,0,1],3));
-- > > p.asStream.all == [8,8,1,65,8,8,2,76,8,8,3,65];
--
-- > let p = pswitch1 [pseq [1,2,3] inf
-- > ,pseq [65,76] inf
-- > ,8] (pseq [2,2,0,1] 6)
-- > in p == toP [8,8,1,65,8,8,2,76,8,8,3,65,8,8,1,76,8,8,2,65,8,8,3,76]
pswitch1 :: [P a] -> P Int -> P a
pswitch1 l = liftP (P.switch1 (map unP_repeat l))
-- | Ptuple. 'pseq' of 'ptranspose_st_repeat'.
--
-- > > l = [Pseries(7,-1,8),3,Pseq([9,7,4,2],1),Pseq([4,2,0,0,-3],1)];
-- > > p = Ptuple(l,1);
-- > > p.asStream.all == [[7,3,9,4],[6,3,7,2],[5,3,4,0],[4,3,2,0]]
--
-- > let p = ptuple [pseries 7 (-1) 8
-- > ,3
-- > ,pseq [9,7,4,2] 1
-- > ,pseq [4,2,0,0,-3] 1] 1
-- > in p == toP [[7,3,9,4],[6,3,7,2],[5,3,4,0],[4,3,2,0]]
ptuple :: [P a] -> Int -> P [a]
ptuple p = pseq [ptranspose_st_repeat p]
{- | Pwhite. Lifted 'P.white'.
> pwhite 'α' 0 9 5 == toP [3,0,1,6,6]
> pwhite 'α' 0 9 5 - pwhite 'α' 0 9 5 == toP [0,0,0,0,0]
The pattern below is alternately lower and higher noise.
> let {l = pseq [0.0,9.0] inf
> ;h = pseq [1.0,12.0] inf}
> in audition (pbind [(K_freq,pwhite' 'α' l h * 20 + 800)
> ,(K_dur,0.25)])
-}
pwhite :: (Random n,Enum e) => e -> n -> n -> Int -> P n
pwhite = toP .::: P.white
{- | Pwrand. Lifted 'P.wrand'.
> let w = C.normalizeSum [12,6,3]
> in pwrand 'α' [1,2,3] w 6 == toP [2,1,2,3,3,2]
> > r = Pwrand.new([1,2,Pseq([3,4],1)],[1,3,5].normalizeSum,6);
> > p = Pseed(Pn(100,1),r);
> > p.asStream.all == [2,3,4,1,3,4,3,4,2]
> let w = C.normalizeSum [1,3,5]
> in pwrand 'ζ' [1,2,pseq [3,4] 1] w 6 == toP [3,4,2,2,3,4,1,3,4]
> > Pbind(\degree,Pwrand((0..7),[4,1,3,1,3,2,1].normalizeSum,inf),
> > \dur,0.25).play;
> let {w = C.normalizeSum [4,1,3,1,3,2,1]
> ;d = pwrand 'α' (C.series 7 0 1) w inf}
> in audition (pbind [(K_degree,d),(K_dur,0.25)])
-}
pwrand :: (Enum e) => e -> [P a] -> [Double] -> Int -> P a
pwrand e a w = toP . P.wrand e (map unP a) w
-- | Pwrap. Type specialised 'P.fwrap', see also 'pfold'.
--
-- > > p = Pwrap(Pgeom(200,1.25,9),200,1000.0);
-- > > r = p.asStream.all.collect({|n| n.round});
-- > > r == [200,250,313,391,488,610,763,954,392];
--
-- > let p = fmap roundE (pwrap (pgeom 200 1.25 9) 200 1000)
-- > in p == toP [200,250,312,391,488,610,763,954,391]
pwrap :: (Ord a,Num a) => P a -> a -> a -> P a
pwrap = P.fwrap
-- | Pxrand. Lifted 'P.xrand'.
--
-- > let p = pxrand 'α' [1,toP [2,3],toP [4,5,6]] 9
-- > in p == toP [4,5,6,2,3,4,5,6,1]
--
-- > > Pbind(\note,Pxrand([0,1,5,7],inf),\dur,0.25).play
--
-- > audition (pbind [(K_note,pxrand 'α' [0,1,5,7] inf),(K_dur,0.25)])
pxrand :: Enum e => e -> [P a] -> Int -> P a
pxrand e a n = toP (P.xrand e (map unP a) n)
-- * Variant SC3 Patterns
-- | Lifted /implicitly repeating/ 'P.pbrown''.
--
-- > pbrown' 'α' 1 700 (pseq [1,20] inf) 4 == toP [415,419,420,428]
pbrown' :: (Enum e,Random n,Num n,Ord n) =>
e -> P n -> P n -> P n -> Int -> P n
pbrown' e l r s n =
let f = liftP3_repeat (I.brown e)
in ptake n (f l r s)
-- | Un-joined variant of 'prand'.
--
-- > let p = prand' 'α' [1,toP [2,3],toP [4,5,6]] 5
-- > in p == toP [toP [4,5,6],toP [4,5,6],toP [2,3],toP [4,5,6],1]
prand' :: Enum e => e -> [P a] -> Int -> P (P a)
prand' e a n = toP (P.rand' e a n)
-- | Underlying pattern for 'prorate'.
--
-- > prorate' (Left 0.6) 0.5
prorate' :: Num a => Either a [a] -> a -> P a
prorate' p =
case p of
Left p' -> toP . P.rorate_n' p'
Right p' -> toP . P.rorate_l' p'
{-|
Variant of `pseq` that retrieves only one value from each pattern
on each list traversal. Compare to `pswitch1`.
> pseq [pseq [1,2] 1,pseq [3,4] 1] 2 == toP [1,2,3,4,1,2,3,4]
> pseq1 [pseq [1,2] 1,pseq [3,4] 1] 2 == toP [1,3,2,4]
> pseq1 [pseq [1,2] inf,pseq [3,4] inf] 3 == toP [1,3,2,4,1,3]
> let {p = prand' 'α' [pempty,toP [24,31,36,43,48,55]] inf
> ;q = pflop [60,prand 'β' [63,65] inf
> ,67,prand 'γ' [70,72,74] inf]
> ;r = psplitPlaces (pwhite 'δ' 3 9 inf)
> (toP [74,75,77,79,81])
> ;n = pjoin (pseq1 [p,q,r] inf)}
> in audition (pbind [(K_midinote,n),(K_dur,0.13)])
-}
pseq1 :: [P a] -> Int -> P a
pseq1 a i = join (ptake i (pflop a))
-- | A variant of 'pseq' to aid translating a common SC3 idiom where a
-- finite random pattern is included in a @Pseq@ list. In the SC3
-- case, at each iteration a new computation is run. This idiom does
-- not directly translate to the declarative haskell pattern library.
--
-- > > Pseq([1,Prand([2,3],1)],5).asStream.all
-- > pseq [1,prand 'α' [2,3] 1] 5 == toP [1,3,1,3,1,3,1,3,1,3]
--
-- Although the intended pattern can usually be expressed using an
-- alternate construction:
--
-- > > Pseq([1,Prand([2,3],1)],5).asStream.all
-- > ppatlace [1,prand 'α' [2,3] inf] 5 == toP [1,3,1,2,1,3,1,2,1,2]
--
-- the 'pseqn' variant handles many common cases.
--
-- > > Pseq([Pn(8,2),Pwhite(9,16,1)],5).asStream.all
--
-- > let p = pseqn [2,1] [8,pwhite 'α' 9 16 inf] 5
-- > in p == toP [8,8,10,8,8,9,8,8,12,8,8,15,8,8,15]
pseqn :: [Int] -> [P a] -> Int -> P a
pseqn n q =
let rec p c = if c == 0
then mempty
else let (i,j) = unzip (zipWith psplitAt n p)
in mconcat i <> rec j (c - 1)
in rec (map pcycle q)
{-|
A variant of 'pseq' that passes a new seed at each invocation,
see also 'pfuncn'.
> > pseqr (\e -> [pshuf e [1,2,3,4] 1]) 2 == toP [2,3,4,1,4,1,2,3]
> let {d = pseqr (\e -> [pshuf e [-7,-3,0,2,4,7] 4
> ,pseq [0,1,2,3,4,5,6,7] 1]) inf}
> in audition (pbind [(K_degree,d),(K_dur,0.15)])
> > Pbind(\dur,0.2,
> > \midinote,Pseq([Pshuf(#[60,61,62,63,64,65,66,67],3)],inf)).play
> let {m = pseqr (\e -> [pshuf e [60,61,62,63,64,65,66,67] 3]) inf}
> in audition (pbind [(K_dur,0.2),(K_midinote,m)])
-}
pseqr :: (Int -> [P a]) -> Int -> P a
pseqr f n = mconcat (L.concatMap f [1 .. n])
-- | Variant of 'pser' that consumes sub-patterns one element per
-- iteration.
--
-- > pser1 [1,pser [10,20] 3,3] 9 == toP [1,10,3,1,20,3,1,10,3]
pser1 :: [P a] -> Int -> P a
pser1 a i = ptake i (join (pflop a))
-- | Lifted /implicitly repeating/ 'P.pwhite'.
--
-- > pwhite' 'α' 0 (pseq [9,19] 3) == toP [3,0,1,6,6,15]
pwhite' :: (Enum e,Random n) => e -> P n -> P n -> P n
pwhite' e = liftP2_repeat (P.white' e)
-- | Lifted 'P.whitei'.
--
-- > pwhitei 'α' 1 9 5 == toP [5,1,7,7,8]
--
-- > audition (pbind [(K_degree,pwhitei 'α' 0 8 inf),(K_dur,0.15)])
pwhitei :: (RealFracE n,Random n,Enum e) => e -> n -> n -> Int -> P n
pwhitei = toP .::: P.whitei
-- * UId variants
-- | 'liftUId' of 'pbrown'.
pbrownM :: (UId m,Num n,Ord n,Random n) => n -> n -> n -> Int -> m (P n)
pbrownM = liftUId4 pbrown
-- | 'liftUId' of 'pexprand'.
pexprandM :: (UId m,Random a,Floating a) => a -> a -> Int -> m (P a)
pexprandM = liftUId3 pexprand
-- | 'liftUId' of 'prand'.
prandM :: UId m => [P a] -> Int -> m (P a)
prandM = liftUId2 prand
-- | 'liftUId' of 'pshuf'.
pshufM :: UId m => [a] -> Int -> m (P a)
pshufM = liftUId2 pshuf
-- | 'liftUId' of 'pwhite'.
pwhiteM :: (UId m,Random n) => n -> n -> Int -> m (P n)
pwhiteM = liftUId3 pwhite
-- | 'liftUId' of 'pwhitei'.
pwhiteiM :: (UId m,RealFracE n,Random n) => n -> n -> Int -> m (P n)
pwhiteiM = liftUId3 pwhitei
-- | 'liftUId' of 'pwrand'.
pwrandM :: UId m => [P a] -> [Double] -> Int -> m (P a)
pwrandM = liftUId3 pwrand
-- | 'liftUId' of 'pxrand'.
pxrandM :: UId m => [P a] -> Int -> m (P a)
pxrandM = liftUId2 pxrand