Skip to content

Stepwise parity #1181

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: main
Choose a base branch
from
Draft

Stepwise parity #1181

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
32a814d
add polymeter
yaxu Mar 2, 2025
5c3f2b3
pm alias for polymeter
yaxu Mar 2, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions tidal-core/src/Sound/Tidal/Pattern.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,9 @@ withStepsPat f p = p {steps = f <$> steps p}
withSteps :: (Rational -> Rational) -> Pattern a -> Pattern a
withSteps f p = p {steps = fmap (fmap f) $ steps p}

hasSteps :: Pattern a -> Bool
hasSteps = isJust . steps

pace :: Pattern Rational -> Pattern a -> Pattern a
pace target p@(Pattern _ (Just t) _) = setSteps (Just target) $ fast (target / t) p
-- raise error?
Expand Down
14 changes: 12 additions & 2 deletions tidal-core/src/Sound/Tidal/Stepwise.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,14 +18,15 @@

module Sound.Tidal.Stepwise where

import Control.Applicative (liftA2)
import Data.List (sort, sortOn)
import Data.Maybe (fromJust, isJust, mapMaybe)
import Sound.Tidal.Core (stack, timecat, zoompat)
import Sound.Tidal.Pattern
import Sound.Tidal.Utils (enumerate, nubOrd, pairs)

-- _lcmsteps :: [Pattern a] -> Maybe Time
-- _lcmsteps pats = foldl1 lcmr <$> (sequence $ map steps pats)
_lcmsteps :: [Pattern a] -> Pattern Time
_lcmsteps pats = foldl1 (liftA2 lcmr) $ mapMaybe steps pats

s_patternify :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
s_patternify f (Pattern _ _ (Just a)) b = f a b
Expand Down Expand Up @@ -125,6 +126,15 @@ _extend factor pat = withStepsPat (_fast factor) $ _expand factor $ _fast factor
extend :: Pattern Rational -> Pattern a -> Pattern a
extend = s_patternify _extend

polymeter :: [Pattern a] -> Pattern a
polymeter pats = stack $ map (pace targetSteps) pats'
where
targetSteps = _lcmsteps pats'
pats' = filter hasSteps pats

pm :: [Pattern a] -> Pattern a
pm = polymeter

{-
s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_while patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat
Expand Down
10 changes: 7 additions & 3 deletions tidal-core/test/Sound/Tidal/StepwiseTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,9 +12,9 @@ import Sound.Tidal.Pattern
fast,
rev,
)
import Sound.Tidal.Stepwise (expand, stepcat, stepdrop, steptake)
import Sound.Tidal.Stepwise (expand, polymeter, stepcat, stepdrop, steptake)
import Sound.Tidal.UI (inv, iter, linger, segment)
import Test.Hspec ( describe, it, shouldBe, Spec )
import Test.Hspec (Spec, describe, it, shouldBe)
import TestUtils (compareP, firstCycleValues)
import Prelude hiding ((*>), (<*))

Expand Down Expand Up @@ -47,4 +47,8 @@ run =
it "invert" $ (firstCycleValues <$> steps (inv "1 0 1" :: Pattern Bool)) `shouldBe` Just [3]
it "chop" $ (firstCycleValues <$> steps (chop 3 $ sound "a b")) `shouldBe` Just [6]
it "chop" $ (firstCycleValues <$> steps (striate 3 $ sound "a b")) `shouldBe` Just [6]

describe "polymeter" $ do
it "can repeat patterns to step count lcm" $
compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e"]) "{a b c, d e}%6"
it "can work with 3 patterns" $
compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e", "f g h i"]) "{a b c, d e, f g h i}%12"
Loading