Euclidian sub-patterns / Masking beats from euclids

@Robin_Hase shared this cool idea they had in the Discord where you would be able to generate an euclidian pattern, but only keeping the first n active beats while silencing the remaining ones. And maybe even offseting it such that you get the first n active beats starting from the o active beat.

It would be something like this:

euclid 5 8 -- |1 ~ 1 1 ~ 1 1 ~ |

euclidSub 5 8 3 0 -- |1 ~ 1 1 ~ ~ ~ ~ |
euclidSub 5 8 3 1 -- |~ ~ 1 1 ~ 1 ~ ~ |

They needed help with a solution that worked in Haskell so here's what I came up with:

import Sound.Tidal.Pattern

_maskList :: [Bool] -> [Bool] -> Int -> Int -> [Bool]
_maskList [] ys _ _ =  ys
_maskList (False:xs) ys n o = _maskList xs (ys ++ [False]) n o
_maskList (True:xs)  ys 0 0 = _maskList xs (ys ++ [False]) 0 0
_maskList (True:xs)  ys n 0 = _maskList xs (ys ++ [True]) (n-1) 0
_maskList (True:xs)  ys n o = _maskList xs (ys ++ [False]) n (o-1)

maskList :: [Bool] -> Int -> Int -> [Bool]
maskList xs n o = _maskList xs [] n o 

bjorklundSub :: (Int, Int) -> Int -> Int -> [Bool]
bjorklundSub t = maskList (bjorklund t)

tParam4 f a b c d p = innerJoin $ (\x y z w -> f x y z w p) <$> a <*> b <*> c <*> d

_euclidSub :: Int -> Int -> Int -> Int -> Pattern a -> Pattern a
_euclidSub n k m o a | n >= 0 = fastcat $ fmap (bool silence a) $ bjorklundSub (n,k) m o
                     | otherwise = fastcat $ fmap (bool a silence) $ bjorklundSub (-n,k) m o

euclidSub = tParam4 _euclidSub

d1 $ euclidSub 7 16 "<4 3>" 1 "bd"

We thought this should be shared here :slight_smile:

4 Likes

many thanks for coming through with the solution so quickly :pray:

this is amazing for call and response patterns, quick example:

d1 $ stack [
euclidSub "5" 16 2 0 "bd" 
euclidSub "<5 5 5 6>" 16 "<3 2>" 2 "sd:1",
euclidSub "<5 5 5 7>" 16 "<0 1>" 4 "808:3",
euclidSub 11 16 "<4 [2 0 4]>" "<4 2 5>" "808:1",
euclidSub 9 16 3 "<5 7>" "808:4",
euclidSub 9 16 3 "<2 2 3>" "808:5"
] 

although the syntax is kind of unwieldy with a total of 5 parameters, i stilll think this is a great way to distribute events unevenly but adhering to the particular patterns generated by the euclidean algorithm.
especially more dense patterns like 11 16 can benefit from being thinned out this way.

i'm not sure if this is a candidate for mininotation-ification, as the extra arguments would have to go after the 3 existing arguments, iE "bd(7,16,2,3,4)" and i guess some cases would need clarification first, such as what happens when you specify an offset large enough that not all n events fit into the pattern anymore (right now they get cut off, which i'm personally ok with but maybe some would prefer it wrapping around?)

This sounds amazing. But because I am not familiar with customizing, could you please help me. What exactly do I have to do to add euclidSub to the bootTidal.hs?

looks like we've missed some import statements... i've added the following to my BootTidal.hs file and got it to work: (edited to fix mistake i made earlier)


import Sound.Tidal.Pattern
import           Sound.Tidal.Bjorklund (bjorklund)
import           Sound.Tidal.Core
import           Data.Bool (bool)

:{
_maskList :: [Bool] -> [Bool] -> Int -> Int -> [Bool]
_maskList [] ys _ _ =  ys
_maskList (False:xs) ys n o = _maskList xs (ys ++ [False]) n o
_maskList (True:xs)  ys 0 0 = _maskList xs (ys ++ [False]) 0 0
_maskList (True:xs)  ys n 0 = _maskList xs (ys ++ [True]) (n-1) 0
_maskList (True:xs)  ys n o = _maskList xs (ys ++ [False]) n (o-1)

maskList :: [Bool] -> Int -> Int -> [Bool]
maskList xs n o = _maskList xs [] n o 

bjorklundSub :: (Int, Int) -> Int -> Int -> [Bool]
bjorklundSub t = maskList (bjorklund t)
  
tParam4 f a b c d p = innerJoin $ (\x y z w -> f x y z w p) <$> a <*> b <*> c <*> d

_euclidSub :: Int -> Int -> Int -> Int -> Pattern a -> Pattern a
_euclidSub n k m o a | n >= 0 = fastcat $ fmap (bool silence a) $ bjorklundSub (n,k) m o
                     | otherwise = fastcat $ fmap (bool a silence) $ bjorklundSub (-n,k) m o

euclidSub = tParam4 _euclidSub
:}
3 Likes

Thank you very much @Robin_Hase . I will that out tonight.

The first 3 eights of euclid 5 8:

sew (fmap (<3) $ run 8) (euclid  5 8 0) silence

(0>⅛)|0
(¼>⅜)|0

(is there a simpler expression for the selector function?)

but you want the first f beats, ignoring the rests. Interesting!

The following nearly works

euSub k n f p = sew (fmap (\i -> i*k<f*n ) $ run $ pure n) (euclid (pure k) (pure n) p) silence

but it sometimes gets the number of beats wrong (by one).

euSub 13 51 5 0  -- fine
    (0>1/51)|0
 (4/51>5/51)|0
 (8/51>3/17)|0
(4/17>13/51)|0
   (16/51>⅓)|0

 euSub 13 24 5 0 -- off by one
(0>1/24)|0
(1/12>⅛)|0
   (⅛>⅙)|0
(5/24>¼)|0
(7/24>⅓)|0
(⅜>5/12)|0
3 Likes

ohhhh totally forgot about sew, i love this solution

something i've found after a few hours of playing around with this function is that the last parameter (the offset) makes it possible to have the resulting number of beats be less than the amount specified in the 3rd parameter, which i imagine would be kind of unintuitive.

a more general solution (and fitting with the concept of rhythm as a cycle rather than having boundaries) would be to somehow wrap around the list if that's the case, allowing one to rotate the subpattern along the points of the euclidean rhythm.

( just for fun i've spent a good few hours trying to get chatGPT to come up with a solution, but to no avail. i guess haskell is hard even for large language models :smiley: )

here's a stateful approach in javascript:

//first, iterate over the input array until we have reached a number of 'True' values equal to 'os'. 
//then, beginning at that index, iterate over the input array for a number of steps equal to the length of the input list, wrapping at the boundaries
//for each element that is true in the input array, the element in the output array at that Index should be true unless the total number of true values in the output array is equal to 'num', 
//in that case the element at that Index in the output array should be false.

function rotateEuclidSubgroup(list, num, os) {
  let len = list.length;
  let trueCount = 0;
  let output = Array(len).fill(false);
  let i = 0;
  
  while (trueCount < os && i < len) {
    if (list[i]) {
      trueCount++;
    }
    i++;
  }
  
  i %= len;
  trueCount = 0;
  
  while (trueCount < num && i < len) {
    if (list[i]) {
      trueCount++;
      output[i] = true;
    }
    i = (i + 1) % len;
  }
  
  return output;
}

//example output

let list = [true,false,false,true,false,false,true,false]

rotateEuclidSubgroup(list,2,0)
// [true, false, false, true, false, false, false, false]
rotateEuclidSubgroup(list,1,2)
// [false, false, false, false, false, false, true, false]
rotateEuclidSubgroup(list,2,2)
// [true, false, false, false, false, false, true, false]
rotateEuclidSubgroup(list,3,3)
// [true, false, false, true, false, false, true, false]

@Robin_Hase Actually I added the above code to the bootTidal.hs, but then Tidal starts with this error.


And starting code like

d1 $ euclidSub 7 16 "<4 3>" 1 "bd"

is answered with

Do you have an idea why?

that's strange, here's my full BootTidal.hs file for reference, it's the default one for Tidal 1.9.3 with the above lines added:

:set -XOverloadedStrings
:set prompt ""

import Sound.Tidal.Context

import System.IO (hSetEncoding, stdout, utf8)
hSetEncoding stdout utf8

tidal <- startTidal (superdirtTarget {oLatency = 0.05, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cVerbose = True, cFrameTimespan = 1/20})

:{
let only = (hush >>)
    p = streamReplace tidal
    hush = streamHush tidal
    panic = do hush
               once $ sound "superpanic"
    list = streamList tidal
    mute = streamMute tidal
    unmute = streamUnmute tidal
    unmuteAll = streamUnmuteAll tidal
    unsoloAll = streamUnsoloAll tidal
    solo = streamSolo tidal
    unsolo = streamUnsolo tidal
    once = streamOnce tidal
    first = streamFirst tidal
    asap = once
    nudgeAll = streamNudgeAll tidal
    all = streamAll tidal
    resetCycles = streamResetCycles tidal
    setCycle = streamSetCycle tidal
    setcps = asap . cps
    getcps = streamGetcps tidal
    getnow = streamGetnow tidal
    xfade i = transition tidal True (Sound.Tidal.Transition.xfadeIn 4) i
    xfadeIn i t = transition tidal True (Sound.Tidal.Transition.xfadeIn t) i
    histpan i t = transition tidal True (Sound.Tidal.Transition.histpan t) i
    wait i t = transition tidal True (Sound.Tidal.Transition.wait t) i
    waitT i f t = transition tidal True (Sound.Tidal.Transition.waitT f t) i
    jump i = transition tidal True (Sound.Tidal.Transition.jump) i
    jumpIn i t = transition tidal True (Sound.Tidal.Transition.jumpIn t) i
    jumpIn' i t = transition tidal True (Sound.Tidal.Transition.jumpIn' t) i
    jumpMod i t = transition tidal True (Sound.Tidal.Transition.jumpMod t) i
    jumpMod' i t p = transition tidal True (Sound.Tidal.Transition.jumpMod' t p) i
    mortal i lifespan release = transition tidal True (Sound.Tidal.Transition.mortal lifespan release) i
    interpolate i = transition tidal True (Sound.Tidal.Transition.interpolate) i
    interpolateIn i t = transition tidal True (Sound.Tidal.Transition.interpolateIn t) i
    clutch i = transition tidal True (Sound.Tidal.Transition.clutch) i
    clutchIn i t = transition tidal True (Sound.Tidal.Transition.clutchIn t) i
    anticipate i = transition tidal True (Sound.Tidal.Transition.anticipate) i
    anticipateIn i t = transition tidal True (Sound.Tidal.Transition.anticipateIn t) i
    forId i t = transition tidal False (Sound.Tidal.Transition.mortalOverlay t) i
    d1 = p 1 . (|< orbit 0)
    d2 = p 2 . (|< orbit 1)
    d3 = p 3 . (|< orbit 2)
    d4 = p 4 . (|< orbit 3)
    d5 = p 5 . (|< orbit 4)
    d6 = p 6 . (|< orbit 5)
    d7 = p 7 . (|< orbit 6)
    d8 = p 8 . (|< orbit 7)
    d9 = p 9 . (|< orbit 8)
    d10 = p 10 . (|< orbit 9)
    d11 = p 11 . (|< orbit 10)
    d12 = p 12 . (|< orbit 11)
    d13 = p 13
    d14 = p 14
    d15 = p 15
    d16 = p 16
:}


import Sound.Tidal.Pattern
import           Sound.Tidal.Bjorklund (bjorklund)
import           Sound.Tidal.Core
import           Data.Bool (bool)

:{
_maskList :: [Bool] -> [Bool] -> Int -> Int -> [Bool]
_maskList [] ys _ _ =  ys
_maskList (False:xs) ys n o = _maskList xs (ys ++ [False]) n o
_maskList (True:xs)  ys 0 0 = _maskList xs (ys ++ [False]) 0 0
_maskList (True:xs)  ys n 0 = _maskList xs (ys ++ [True]) (n-1) 0
_maskList (True:xs)  ys n o = _maskList xs (ys ++ [False]) n (o-1)

maskList :: [Bool] -> Int -> Int -> [Bool]
maskList xs n o = _maskList xs [] n o 

bjorklundSub :: (Int, Int) -> Int -> Int -> [Bool]
bjorklundSub t = maskList (bjorklund t)
  
tParam4 f a b c d p = innerJoin $ (\x y z w -> f x y z w p) <$> a <*> b <*> c <*> d

_euclidSub :: Int -> Int -> Int -> Int -> Pattern a -> Pattern a
_euclidSub n k m o a | n >= 0 = fastcat $ fmap (bool silence a) $ bjorklundSub (n,k) m o
                     | otherwise = fastcat $ fmap (bool a silence) $ bjorklundSub (-n,k) m o

euclidSub = tParam4 _euclidSub
:}


:{
let getState = streamGet tidal
    setI = streamSetI tidal
    setF = streamSetF tidal
    setS = streamSetS tidal
    setR = streamSetR tidal
    setB = streamSetB tidal
:}

:set prompt "tidal> "
:set prompt-cont ""

default (Pattern String, Integer, Double)

which version of tidal are you on?

Yes, this

:{
import Sound.Tidal.Pattern
import           Sound.Tidal.Bjorklund (bjorklund)

...
:}

will not work. Apparently, you can put several value/function declarations in such a :{ .. :} group, but only one import declaration or statement (tidal <- ...). The documentation does not make this very explicit (3. Using GHCi — Glasgow Haskell Compiler 9.4.4 User's Guide )

oh my! i haven't spotted that mistake, my bad.

@Robin_Hase I still have Tidal 1.8.0, maybe I have to update first.

ok so.... about 10 long hours of trying to wrap my head around haskell later:

--not entirely sure if all of these are needed ?

import Sound.Tidal.Pattern

import Data.List

import Sound.Tidal.Bjorklund (bjorklund)

import Sound.Tidal.Core

import Data.Bool (bool)

_boolReduce :: [Bool] -> Int -> [Bool]
_boolReduce bools num = helper bools num 0
  where 
    helper [] _ _ = []
    helper (x:xs) num count
      | x == True && count < num = True : helper xs num (count + 1)
      | otherwise = False : helper xs num count


_listRotOffIdx :: [Bool] -> Int -> ([Bool], Int)
_listRotOffIdx bools off = (take len $ drop start doubleBools, start)
    where
        len = length bools
        doubleBools = bools ++ bools
        start = if null trueIndices then 0 else (trueIndices !! (off `mod` (length trueIndices)))
        trueIndices = findIndices (==True) bools

_rotateList :: [a] -> Int -> [a]
_rotateList xs n = drop n_ xs ++ take n_ xs
  where
    len = length xs
    n_ = n `mod` len



reduceAndRotate' :: [Bool] -> Int -> Int -> [Bool]
reduceAndRotate' list num off  = _rotateList res rot
	where 
	res = _boolReduce (fst (_listRotOffIdx list off)) num
	rot = (-(snd (_listRotOffIdx list off)))



_euclidSub' :: Int -> Int -> Int -> Int -> Pattern a -> Pattern a
_euclidSub' n k m o a | n >= 0 = fastcat $ fmap (bool silence a) $ reduceAndRotate' (bjorklund (n,k)) m o
                     | otherwise = fastcat $ fmap (bool a silence) $ reduceAndRotate' (bjorklund (-n,k)) m o

euclidSub' = tParam4 _euclidSub'

--the 4th argument now wraps around, allowing to pattern "off" and "num" independently!

d1 $ euclidSub' 9 16 "<[3 2] 2>" "<4 2 3>" "bd"

d2 $ euclidSub' 9 16 "<[3 2] 2>" "<6 4 5 0>" "808:3"

i'm sure the code is somewhat ridiculous, but it works!
took a lot of flailing around helplessly with chatGPT and slowly making sense of the few bits it got right via hoogle & "learning you a haskell".
the breakthrough moment was when i found i had to split the task into very simple subtasks so that chatGPT would get them right, and then find a way to combine those. suddenly it went click and i had a glimpse of what functional programming is about.
would absolutely recommend this approach to anyone who's scared of haskell, really learned a lot today :slight_smile:

1 Like