hsc3-lang-0.14: Haskell SuperCollider Language

Safe HaskellSafe-Inferred

Sound.SC3.Lang.Collection

Contents

Description

In cases where a method takes arguments, these precede the collection argument in the haskell variant, so that c.m(i,j) becomes m i j c.

Synopsis

Collection

fill :: (Enum n, Num n) => n -> (n -> a) -> [a]Source

Collection.*fill is map over indices to n.

 fill 4 (* 2) == [0,2,4,6]

size :: Integral n => [a] -> nSource

Collection.size is length.

 size [1,2,3,4] == 4

isEmpty :: [a] -> BoolSource

Collection.isEmpty is null.

 isEmpty [] == True

ignoringIndex :: (a -> b) -> a -> z -> bSource

Function equal to const of f of e.

 select (ignoringIndex even) [1,2,3,4] == [2,4]

collect :: Integral i => (a -> i -> b) -> [a] -> [b]Source

Collection.collect is map with element indices.

 collect (\i _ -> i + 10) [1,2,3,4] == [11,12,13,14]
 collect (\_ j -> j + 11) [1,2,3,4] == [11,12,13,14]

select :: Integral i => (a -> i -> Bool) -> [a] -> [a]Source

Collection.select is filter with element indices.

 select (\i _ -> even i) [1,2,3,4] == [2,4]
 select (\_ j -> even j) [1,2,3,4] == [1,3]

reject :: Integral i => (a -> i -> Bool) -> [a] -> [a]Source

Collection.reject is negated filter with element indices.

 reject (\i _ -> even i) [1,2,3,4] == [1,3]
 reject (\_ j -> even j) [1,2,3,4] == [2,4]

detect :: Integral i => (a -> i -> Bool) -> [a] -> Maybe aSource

Collection.detect is first . select.

 detect (\i _ -> even i) [1,2,3,4] == Just 2

detectIndex :: Integral i => (a -> i -> Bool) -> [a] -> Maybe iSource

Collection.detectIndex is the index locating variant of detect.

 detectIndex (\i _ -> even i) [1,2,3,4] == Just 1

inject :: a -> (a -> b -> a) -> [b] -> aSource

Collection.inject is a variant on foldl.

 inject 0 (+) [1..5] == 15
 inject 1 (*) [1..5] == 120

any' :: Integral i => (a -> i -> Bool) -> [a] -> BoolSource

Collection.any is True if detect is not Nothing.

 any' (\i _ -> even i) [1,2,3,4] == True

every :: Integral i => (a -> i -> Bool) -> [a] -> BoolSource

Collection.every is True if f applies at all elements.

 every (\i _ -> even i) [1,2,3,4] == False

count :: Integral i => (a -> i -> Bool) -> [a] -> iSource

Collection.count is length . select.

 count (\i _ -> even i) [1,2,3,4] == 2

occurencesOf :: (Integral i, Eq a) => a -> [a] -> iSource

Collection.occurencesOf is an == variant of count.

 occurencesOf 2 [1,2,3,4] == 1
 occurencesOf 't' "test" == 2

sum' :: (Num a, Integral i) => (b -> i -> a) -> [b] -> aSource

Collection.sum is sum . collect.

 sum' (ignoringIndex (* 2)) [1,2,3,4] == 20

maxItem :: (Ord b, Integral i) => (a -> i -> b) -> [a] -> bSource

Collection.maxItem is maximum . collect.

 maxItem (ignoringIndex (* 2)) [1,2,3,4] == 8

minItem :: (Integral i, Ord b) => (a -> i -> b) -> [a] -> bSource

Collection.minItem is maximum . collect.

 minItem (ignoringIndex (* 2)) [1,2,3,4] == 2

zipWith_c :: (a -> b -> c) -> [a] -> [b] -> [c]Source

Variant of zipWith that cycles the shorter input.

 zipWith_c (+) [1,2] [3,4,5] == [4,6,6]

zip_c :: [a] -> [b] -> [(a, b)]Source

zipWith_c variant of zip.

 zip_c [1,2] [3,4,5] == [(1,3),(2,4),(1,5)]

zipWith3_c :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]Source

Variant of zipWith3 that cycles the shorter inputs.

 zipWith3_c (,,) [1] [2,3] [4,5,6] == [(1,2,4),(1,3,5),(1,2,6)]

zip3_c :: [a] -> [b] -> [c] -> [(a, b, c)]Source

zipWith3_c based variant of zip3.

 zip3_c [1] [2,3] [4,5,6] == [(1,2,4),(1,3,5),(1,2,6)]

zap_c :: [a -> b] -> [a] -> [b]Source

zipWith_c based variant of applicative <*>.

 zap_c [(+1),negate] [1..6] == [2,-2,4,-4,6,-6]

Sequenceable Collection

series :: (Num a, Integral i) => i -> a -> a -> [a]Source

SequenceableCollection.*series is an arithmetic series with arguments size, start and step.

 > Array.series(5,10,2) == [10,12,14,16,18]
 series 5 10 2 == [10,12 .. 18]

Note that this is quite different from the SimpleNumber.series method, which is equal to enumFromThenTo.

 > 5.series(7,10) == [5,7,9]
 enumFromThenTo 5 7 10 == [5,7,9]

geom :: (Integral i, Num a) => i -> a -> a -> [a]Source

SequenceableCollection.*geom is a geometric series with arguments size, start and grow.

 > Array.geom(5,3,6) == [3,18,108,648,3888]
 geom 5 3 6 == [3,18,108,648,3888]

fib :: (Integral i, Num a) => i -> a -> a -> [a]Source

SequenceableCollection.*fib is the Fibonacci series where n is number of elements, i is the initial step and j the initial value.

 > Array.fib(5,2,32) == [32,34,66,100,166]
 fib 5 2 32 == [32,34,66,100,166]

first :: [t] -> Maybe tSource

SequenceableCollection.first is a total variant of head.

 > [3,4,5].first == 3
 first [3,4,5] == Just 3
 first' [3,4,5] == 3
 > [].first == nil
 first [] == Nothing

first' :: [t] -> tSource

Synonym for head.

lastM :: [t] -> Maybe tSource

Total variant of last.

 > (1..5).last == 5
 lastM [1..5] == Just 5
 L.last [1..5] == 5
 > [].last == nil
 lastM [] == Nothing

last :: [t] -> Maybe tSource

SequenceableCollection.last is a synonym for lastM.

last' :: [t] -> tSource

Synonym for last.

indexOf :: Eq a => [a] -> a -> Maybe IntSource

SequenceableCollection.indexOf is a variant of elemIndex with reversed arguments.

 > [3,4,100,5].indexOf(100) == 2
 indexOf [3,4,100,5] 100 == Just 2

indexOf' :: Eq a => [a] -> a -> IntSource

fromJust variant of indexOf.

indexOfEqual :: Eq a => [a] -> a -> Maybe IntSource

SequenceableCollection.indexOfEqual is just indexOf.

indexOfGreaterThan :: Ord a => a -> [a] -> Maybe IntSource

SequenceableCollection.indexOfGreaterThan is the index of the first greater element.

 indexOfGreaterThan 70 [10,5,77,55,12,123] == Just 2

indexIn :: (Ord a, Num a) => a -> [a] -> IntSource

SequenceableCollection.indexIn is the index of nearest element.

 indexIn 5.2 [2,3,5,6] == 2

indexInBetween :: (Ord a, Fractional a) => a -> [a] -> aSource

SequenceableCollection.indexInBetween is the linearly interpolated fractional index.

 indexInBetween 5.2 [2,3,5,6] == 2.2

keep :: Integral i => i -> [a] -> [a]Source

SequenceableCollection.keep is, for positive n a synonym for take, and for negative n a variant on drop based on the length of l.

 > [1,2,3,4,5].keep(3) == [1,2,3]
 keep 3 [1,2,3,4,5] == [1,2,3]
 > [1,2,3,4,5].keep(-3) == [3,4,5]
 keep (-3) [1,2,3,4,5] == [3,4,5]
 > [1,2].keep(-4) == [1,2]
 keep (-4) [1,2] == [1,2]

drop :: Integral i => i -> [a] -> [a]Source

SequenceableCollection.drop is, for positive n a synonym for drop, for negative n a variant on take based on the length of l.

 > [1,2,3,4,5].drop(3) == [4,5]
 L.drop 3 [1,2,3,4,5] == [4,5]
 > [1,2,3,4,5].drop(-3) == [1,2]
 Sound.SC3.Lang.Collection.drop (-3) [1,2,3,4,5] == [1,2]
 > [1,2].drop(-4) == []
 Sound.SC3.Lang.Collection.drop (-4) [1,2] == []

extension :: [[a]] -> [()]Source

Function to calculate a list equal in length to the longest input list, therefore being productive over infinite lists.

 extension [[1],[2,3],[4,5,6]] == [(),(),()]
 take 3 (extension [[1],[2..]]) == [(),(),()]

flop :: [[a]] -> [[a]]Source

SequenceableCollection.flop is a variant of transpose that cycles input sequences and extends rather than truncates.

 > [(1..3),(4..5),(6..9)].flop == [[1,4,6],[2,5,7],[3,4,8],[1,5,9]]
 flop [[1..3],[4..5],[6..9]] == [[1,4,6],[2,5,7],[3,4,8],[1,5,9]]
 > [[1,2,3],[4,5,6],[7,8]].flop == [[1,4,7],[2,5,8],[3,6,7]]
 flop [[1,2,3],[4,5,6],[7,8]] == [[1,4,7],[2,5,8],[3,6,7]]

The null case at flop is not handled equivalently to SC3

 > [].flop == [[]]
 flop [] /= [[]]
 flop [] == []

The flop and extendSequences functions are non-strict and productive.

 take 4 (flop [[1..3],[4..]]) == [[1,4],[2,5],[3,6],[1,7]]
 map (take 4) (extendSequences [[1..3],[4..]]) == [[1,2,3,1],[4,5,6,7]]

integrate :: Num a => [a] -> [a]Source

SequenceableCollection.integrate is the incremental sum of elements.

 > [3,4,1,1].integrate == [3,7,8,9]
 integrate [3,4,1,1] == [3,7,8,9]

differentiate :: Num a => [a] -> [a]Source

SequenceableCollection.differentiate is the pairwise difference between elements, with an implicit 0 at the start.

 > [3,4,1,1].differentiate == [3,1,-3,0]
 differentiate [3,4,1,1] == [3,1,-3,0]
 > [0,3,1].differentiate == [0,3,-2]
 differentiate [0,3,1] == [0,3,-2]

separateAt :: (a -> a -> Bool) -> [a] -> ([a], [a])Source

Variant of separate that performs initial separation.

separate :: (a -> a -> Bool) -> [a] -> [[a]]Source

SequenceableCollection.separate applies the predicate f to each adjacent pair of elements at l. If the predicate is True, then a separation is made between the elements.

 > [3,2,1,2,3,2].separate({|a,b| a<b}) == [[3,2,1],[2],[3,2]]
 separate (<) [3,2,1,2,3,2] == [[3,2,1],[2],[3,2]]
 > [1,2,3,5,6,8].separate({|a,b| (b - a) > 1}) == [[1,2,3],[5,6],[8]]
 separate (\a b -> (b - a) > 1) [1,2,3,5,6,8] == [[1,2,3],[5,6],[8]]

clump :: Int -> [a] -> [[a]]Source

SequenceableCollection.clump is a synonym for chunksOf.

 > [1,2,3,4,5,6,7,8].clump(3) == [[1,2,3],[4,5,6],[7,8]]
 clump 3 [1,2,3,4,5,6,7,8] == [[1,2,3],[4,5,6],[7,8]]

clumps :: [Int] -> [a] -> [[a]]Source

SequenceableCollection.clumps is a synonym for splitPlaces.

 > [1,2,3,4,5,6,7,8].clumps([1,2]) == [[1],[2,3],[4],[5,6],[7],[8]]
 clumps [1,2] [1,2,3,4,5,6,7,8] == [[1],[2,3],[4],[5,6],[7],[8]]

List and Array

lace :: Integral i => i -> [[a]] -> [a]Source

List.lace is a concatenated transposition of cycled subsequences.

 > [[1,2,3],[6],[8,9]].lace(12) == [1,6,8,2,6,9,3,6,8,1,6,9]
 lace 12 [[1,2,3],[6],[8,9]] == [1,6,8,2,6,9,3,6,8,1,6,9]

wrapExtend :: Integral i => i -> [a] -> [a]Source

List.wrapExtend extends a sequence by cycling. wrapExtend is in terms of take and cycle.

 > [1,2,3,4,5].wrapExtend(9) == [1,2,3,4,5,1,2,3,4]
 wrapExtend 9 [1,2,3,4,5] == [1,2,3,4,5,1,2,3,4]

cycleFold :: [a] -> [a]Source

Infinite variant of foldExtend.

foldExtend :: Integral i => i -> [a] -> [a]Source

List.foldExtend extends sequence by folding backwards at end. foldExtend is in terms of cycleFold, which is in terms of mirror1.

 > [1,2,3,4,5].foldExtend(10)
 foldExtend 10 [1,2,3,4,5] == [1,2,3,4,5,4,3,2,1,2]

clipExtend :: Integral i => i -> [a] -> [a]Source

Array.clipExtend extends sequence by repeating last element.

 > [1,2,3,4,5].clipExtend(9) == [1,2,3,4,5,5,5,5,5]
 clipExtend 9 [1,2,3,4,5] == [1,2,3,4,5,5,5,5,5]

cycleClip :: [a] -> [a]Source

Infinite variant of clipExtend.

extendSequences :: [[a]] -> [[a]]Source

Cycle input sequences to extension of input.

 extendSequences [[1],[2,3],[4,5,6]] == [[1,1,1],[2,3,2],[4,5,6]]

normalizeSum :: Fractional a => [a] -> [a]Source

ArrayedCollection.normalizeSum ensures sum of elements is one.

 > [1,2,3].normalizeSum == [1/6,1/3,0.5]
 normalizeSum [1,2,3] == [1/6,2/6,3/6]

slide :: Integral i => i -> i -> [a] -> [a]Source

List.slide is an identity window function with subsequences of length w and stride of n.

 > [1,2,3,4,5,6].slide(3,1)
 slide 3 1 [1,2,3,4,5,6] == [1,2,3,2,3,4,3,4,5,4,5,6]
 > [1,2,3,4,5,6].slide(3,2)
 slide 3 2 [1,2,3,4,5,6] == [1,2,3,3,4,5]
 > [1,2,3,4,5,6].slide(4,2)
 slide 4 2 [1,2,3,4,5,6] == [1,2,3,4,3,4,5,6]

mirror :: [a] -> [a]Source

List.mirror concatentates with tail of reverse to make a palindrome.

 > [1,2,3,4].mirror == [1,2,3,4,3,2,1]
 mirror [1,2,3,4] == [1,2,3,4,3,2,1]

mirror1 :: [a] -> [a]Source

List.mirror1 is as mirror but with last element removed.

 > [1,2,3,4].mirror1 == [1,2,3,4,3,2]
 mirror1 [1,2,3,4] == [1,2,3,4,3,2]

mirror2 :: [a] -> [a]Source

List.mirror2 concatenate with reverse to make a palindrome, as mirror does, but with the center element duplicated.

 > [1,2,3,4].mirror2 == [1,2,3,4,4,3,2,1]
 mirror2 [1,2,3,4] == [1,2,3,4,4,3,2,1]

stutter :: Integral i => i -> [a] -> [a]Source

List.stutter repeats each element n times.

 > [1,2,3].stutter(2) == [1,1,2,2,3,3]
 stutter 2 [1,2,3] == [1,1,2,2,3,3]

rotateLeft :: Integral i => i -> [a] -> [a]Source

Rotate n places to the left.

 rotateLeft 1 [1..5] == [2,3,4,5,1]
 rotateLeft 3 [1..7] == [4,5,6,7,1,2,3]

rotateRight :: Integral i => i -> [a] -> [a]Source

Rotate n places to the right.

 rotateRight 1 [1..5] == [5,1,2,3,4]
 rotateRight 3 [1..7] == [5,6,7,1,2,3,4]

rotate :: Integral i => i -> [a] -> [a]Source

Array.rotate is in terms of rotateLeft and rotateRight, where negative n rotates left and positive n rotates right.

 > (1..5).rotate(1) == [5,1,2,3,4]
 rotate 1 [1..5] == [5,1,2,3,4]
 > (1..5).rotate(-1) == [2,3,4,5,1]
 rotate (-1) [1..5] == [2,3,4,5,1]
 > (1..5).rotate(3) == [3,4,5,1,2]
 rotate 3 [1..5] == [3,4,5,1,2]

windex :: (Ord a, Num a) => [a] -> a -> Maybe IntSource

ArrayedCollection.windex takes a list of probabilities, which should sum to n, and returns the an index value given a (0,n) input.

 mapMaybe (windex [0.1,0.3,0.6]) [0,0.1 .. 0.4] == [0,1,1,1,2]

Signals & wavetables

t2_window :: Integral i => i -> [t] -> [(t, t)]Source

List of 2-tuples of elements at distance (stride) n.

 t2_window 3 [1..9] == [(1,2),(4,5),(7,8)]

t2_adjacent :: [t] -> [(t, t)]Source

List of 2-tuples of adjacent elements.

 t2_adjacent [1..6] == [(1,2),(3,4),(5,6)]
 t2_adjacent [1..5] == [(1,2),(3,4)]

t2_overlap :: [b] -> [(b, b)]Source

List of 2-tuples of overlapping elements.

 t2_overlap [1..4] == [(1,2),(2,3),(3,4)]

t2_concat :: [(a, a)] -> [a]Source

Concat of 2-tuples.

 t2_concat (t2_adjacent [1..6]) == [1..6]
 t2_concat (t2_overlap [1..4]) == [1,2,2,3,3,4]

from_wavetable :: Num n => [n] -> [n]Source

A Signal is half the size of a Wavetable, each element is the sum of two adjacent elements of the Wavetable.

 from_wavetable [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5] == [0.0,0.5,1.0,0.5]
 let s = [0,0.5,1,0.5] in from_wavetable (to_wavetable s) == s

to_wavetable :: Num a => [a] -> [a]Source

A Wavetable is has n * 2 + 2 elements, where n is the number of elements of the Signal. Each signal element e0 expands to the two elements (2 * e0 - e1, e1 - e0) where e1 is the next element, or zero at the final element. Properly wavetables are only of power of two element signals.

 > Signal[0,0.5,1,0.5].asWavetable == Wavetable[-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]
 to_wavetable [0,0.5,1,0.5] == [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]