From e9ccfd91a3a148503208521e5c0cadefb663430e Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Fri, 10 Jan 2025 16:22:16 +0100 Subject: [PATCH 1/4] backported normal function to generate bell curve random values --- src/Sound/Tidal/UI.hs | 19 +++++++++++++++++++ test/Sound/Tidal/UITest.hs | 12 ++++++++++++ 2 files changed, 31 insertions(+) diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index b3af7f38a..a04c9b08d 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -222,6 +222,25 @@ perlin2With x y = (/2) . (+1) $ interp2 <$> xfrac <*> yfrac <*> dota <*> dotb <* perlin2 :: Pattern Double -> Pattern Double perlin2 = perlin2With (sig fromRational) +{- | Generates values in [0,1] that follows a normal (bell-curve) distribution. +One possible application is to "humanize" drums with a slight random delay: +@ +d1 $ + s "bd sn bd sn" + # nudge (segment 4 (0.01 * normal)) +@ +Implemented with the Box-Muller transform. + * the max ensures we don't calculate log 0 + * the rot in u2 ensures we don't just get the same value as u1 +-} +normal :: (Floating a, Ord a) => Pattern a +normal = do + u1 <- max 0.0000001 <$> rand + u2 <- rot 1 rand + let r1 = sqrt (-2 * log u1) + r2 = cos (2 * pi * u2) + pure ((r1 * r2) + 1) / 2 + {- | Randomly picks an element from the given list. @ diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs index 71a3f0980..33ef61bef 100644 --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -139,6 +139,18 @@ run = Event (Context [((1,1),(3,1))]) Nothing (Arc 0 0.5) (6 :: Int), Event (Context [((4,1),(5,1))]) Nothing (Arc 0.5 1) (0 :: Int) ] + describe "normal" $ do + it "produces values within [0,1] in a bell curve" $ do + it "at the start of a cycle" $ + queryArc normal (Arc 0 0) `shouldBe` + [Event (Context []) Nothing (Arc 0 0) (0.3370977:: Float)] + it "at 1/4 of a cycle" $ + queryArc normal (Arc 0.25 0.25) `shouldBe` + [Event (Context []) Nothing (Arc 0.25 0.25) (0.4723987:: Float)] + it "at 3/4 of a cycle" $ + queryArc normal (Arc 0.75 0.75) `shouldBe` + [Event (Context []) Nothing (Arc 0.75 0.75) (0.44856572:: Float)] + describe "range" $ do describe "scales a pattern to the supplied range" $ do describe "from 3 to 4" $ do From c278266a96a8d2c00ca670b1b0b3eb777d3f45ae Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Fri, 10 Jan 2025 16:41:53 +0100 Subject: [PATCH 2/4] backport of #1012 --- tidal.el | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/tidal.el b/tidal.el index 6497b2092..e7e75f4ed 100644 --- a/tidal.el +++ b/tidal.el @@ -240,9 +240,9 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" ;; Generate the functions `tidal-run-d1' and `tidal-stop-d1' (tidal-create-runner "d1") -;; This generates tidal-run-* and tidal-stop-* functions for d1 to d9. +;; This generates tidal-run-* and tidal-stop-* functions for d1 to d10. (mapc #'tidal-create-runner - '("d1" "d2" "d3" "d4" "d5" "d6" "d7" "d8" "d9")) + '("d1" "d2" "d3" "d4" "d5" "d6" "d7" "d8" "d9" "d10")) (defun tidal-run-region () "Place the region in a do block and compile." @@ -264,6 +264,11 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (interactive) (tidal-send-string "main")) +(defun tidal-hush () + "Stop all the patterns currently running." + (interactive) + (tidal-send-string "hush")) + (defun tidal-interrupt-haskell () "Interrupt running process." (interactive) @@ -287,6 +292,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-c ?\C-l] 'tidal-load-buffer) (define-key map [?\C-c ?\C-i] 'tidal-interrupt-haskell) (define-key map [?\C-c ?\C-m] 'tidal-run-main) + (define-key map [?\C-c ?\C-h] 'tidal-hush) (define-key map [?\C-c ?\C-1] 'tidal-run-d1) (define-key map [?\C-c ?\C-2] 'tidal-run-d2) (define-key map [?\C-c ?\C-3] 'tidal-run-d3) @@ -296,6 +302,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-c ?\C-7] 'tidal-run-d7) (define-key map [?\C-c ?\C-8] 'tidal-run-d8) (define-key map [?\C-c ?\C-9] 'tidal-run-d9) + (define-key map [?\C-c ?\C-0] 'tidal-run-d10) (define-key map [?\C-v ?\C-1] 'tidal-stop-d1) (define-key map [?\C-v ?\C-2] 'tidal-stop-d2) (define-key map [?\C-v ?\C-3] 'tidal-stop-d3) @@ -304,7 +311,8 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-v ?\C-6] 'tidal-stop-d6) (define-key map [?\C-v ?\C-7] 'tidal-stop-d7) (define-key map [?\C-v ?\C-8] 'tidal-stop-d8) - (define-key map [?\C-v ?\C-9] 'tidal-stop-d9)) + (define-key map [?\C-v ?\C-9] 'tidal-stop-d9) + (define-key map [?\C-c ?\C-0] 'tidal-stop-d10)) (defun tidal-turn-on-keybindings () "Haskell Tidal keybindings in the local map." @@ -318,6 +326,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-c ?\C-l] 'tidal-load-buffer) (local-set-key [?\C-c ?\C-i] 'tidal-interrupt-haskell) (local-set-key [?\C-c ?\C-m] 'tidal-run-main) + (local-set-key [?\C-c ?\C-h] 'tidal-hush) (local-set-key [?\C-c ?\C-1] 'tidal-run-d1) (local-set-key [?\C-c ?\C-2] 'tidal-run-d2) (local-set-key [?\C-c ?\C-3] 'tidal-run-d3) @@ -327,6 +336,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-c ?\C-7] 'tidal-run-d7) (local-set-key [?\C-c ?\C-8] 'tidal-run-d8) (local-set-key [?\C-c ?\C-9] 'tidal-run-d9) + (local-set-key [?\C-c ?\C-0] 'tidal-run-d10) (local-set-key [?\C-v ?\C-1] 'tidal-stop-d1) (local-set-key [?\C-v ?\C-2] 'tidal-stop-d2) (local-set-key [?\C-v ?\C-3] 'tidal-stop-d3) @@ -335,7 +345,8 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-v ?\C-6] 'tidal-stop-d6) (local-set-key [?\C-v ?\C-7] 'tidal-stop-d7) (local-set-key [?\C-v ?\C-8] 'tidal-stop-d8) - (local-set-key [?\C-v ?\C-9] 'tidal-stop-d9)) + (local-set-key [?\C-v ?\C-9] 'tidal-stop-d9) + (local-set-key [?\C-v ?\C-0] 'tidal-stop-d10))) (defun tidal-mode-menu (map) "Haskell Tidal menu MAP." From f9438dcb433ff23df5d0282d854a0234bdef2eb6 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 16 Jan 2025 09:49:25 +0100 Subject: [PATCH 3/4] clamped box-muller values between [-3,3] and re-scale to achieve a normal [0,1] value range --- src/Sound/Tidal/UI.hs | 10 ++++++---- test/Sound/Tidal/UITest.hs | 8 ++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index a04c9b08d..4a5bdf8f1 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -232,14 +232,16 @@ d1 $ Implemented with the Box-Muller transform. * the max ensures we don't calculate log 0 * the rot in u2 ensures we don't just get the same value as u1 + * clamp the Box-Muller generated values in a [-3,3] range -} normal :: (Floating a, Ord a) => Pattern a normal = do - u1 <- max 0.0000001 <$> rand - u2 <- rot 1 rand - let r1 = sqrt (-2 * log u1) + u1 <- max 0.001 <$> rand + u2 <- rotL 1 rand + let r1 = sqrt $ - (2 * log u1) r2 = cos (2 * pi * u2) - pure ((r1 * r2) + 1) / 2 + clamp n = max (-3) (min 3 n) + pure $ clamp (r1 * r2 + 3) / 6 {- | Randomly picks an element from the given list. diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs index 33ef61bef..587a38f2f 100644 --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -142,14 +142,14 @@ run = describe "normal" $ do it "produces values within [0,1] in a bell curve" $ do it "at the start of a cycle" $ - queryArc normal (Arc 0 0) `shouldBe` - [Event (Context []) Nothing (Arc 0 0) (0.3370977:: Float)] + queryArc normal (Arc 0 0.1) `shouldBe` + [Event (Context []) Nothing (Arc 0 0.1) (0.5 :: Double)] it "at 1/4 of a cycle" $ queryArc normal (Arc 0.25 0.25) `shouldBe` - [Event (Context []) Nothing (Arc 0.25 0.25) (0.4723987:: Float)] + [Event (Context []) Nothing (Arc 0.25 0.25) (0.47110511611574907 :: Double)] it "at 3/4 of a cycle" $ queryArc normal (Arc 0.75 0.75) `shouldBe` - [Event (Context []) Nothing (Arc 0.75 0.75) (0.44856572:: Float)] + [Event (Context []) Nothing (Arc 0.75 0.75) (0.5 :: Double)] describe "range" $ do describe "scales a pattern to the supplied range" $ do From 0dadc19ed9dc5d34fc6d66f955616d94abde16a7 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 16 Jan 2025 12:47:51 +0100 Subject: [PATCH 4/4] adjusted rotL to 1000, to sample from a separate part of the random --- src/Sound/Tidal/UI.hs | 2 +- test/Sound/Tidal/UITest.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index 4a5bdf8f1..a62e36432 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -237,7 +237,7 @@ Implemented with the Box-Muller transform. normal :: (Floating a, Ord a) => Pattern a normal = do u1 <- max 0.001 <$> rand - u2 <- rotL 1 rand + u2 <- rotL 1000 rand let r1 = sqrt $ - (2 * log u1) r2 = cos (2 * pi * u2) clamp n = max (-3) (min 3 n) diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs index 587a38f2f..68af5350a 100644 --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -143,10 +143,10 @@ run = it "produces values within [0,1] in a bell curve" $ do it "at the start of a cycle" $ queryArc normal (Arc 0 0.1) `shouldBe` - [Event (Context []) Nothing (Arc 0 0.1) (0.5 :: Double)] + [Event (Context []) Nothing (Arc 0 0.1) (0.4614205864457064 :: Double)] it "at 1/4 of a cycle" $ queryArc normal (Arc 0.25 0.25) `shouldBe` - [Event (Context []) Nothing (Arc 0.25 0.25) (0.47110511611574907 :: Double)] + [Event (Context []) Nothing (Arc 0.25 0.25) (0.5 :: Double)] it "at 3/4 of a cycle" $ queryArc normal (Arc 0.75 0.75) `shouldBe` [Event (Context []) Nothing (Arc 0.75 0.75) (0.5 :: Double)]