From a1ce5acfe568c14f71dde70febed7d7b0cfee6c9 Mon Sep 17 00:00:00 2001
From: Marlon Schumacher <schumacher@hfm-karlsruhe.de>
Date: Fri, 28 Mar 2025 01:08:21 +0100
Subject: [PATCH] feat: add first version of gen-srr function
---
.gitignore | 9 +++
SRR.lisp | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 180 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c9a6dfe
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,9 @@
+# Mac OSX Finder
+.DS_Store
+
+# LispWorks files
+*.*fasl
+*.*~
+
+# OM Reference files
+reference-pages/
diff --git a/SRR.lisp b/SRR.lisp
new file mode 100644
index 0000000..735008b
--- /dev/null
+++ b/SRR.lisp
@@ -0,0 +1,171 @@
+; ****************************************************************
+; | OM-SRR, 2023 |
+; | |
+; | Library for spectral rhythm model via integer time ratios |
+; | (partials) as phase-alilgned amplitude modulations. |
+; | See https://steffenkrebber.de/research/sinusoidal-run-rhythm/|
+; ****************************************************************
+;
+;This program is free software; you can redistribute it and/or
+;modify it under the terms of the GNU General Public License
+;as published by the Free Software Foundation; either version 2
+;of the License, or (at your option) any later version.
+;
+;See file LICENSE for further informations on licensing terms.
+;
+;This program is distributed in the hope that it will be useful,
+;but WITHOUT ANY WARRANTY; without even the implied warranty of
+;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;GNU General Public License for more details.
+;
+;You should have received a copy of the GNU General Public License
+;along with this program; if not, write to the Free Software
+;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA.
+;
+;Authors: M. Schumacher
+
+(in-package :om)
+
+; main function
+
+; gen-wave
+
+(defmethod! gen-partial (subdivision &key (precision 0.01) (decimals 5))
+
+ ;:icon 141
+ ;:initvals '(0 0.1 5)
+ ;:indoc '("subdivision" "precision" "decimals")
+ :numouts 2
+
+ (let* ((sampled-function (multiple-value-list
+ (om-sample #'cos (* subdivision precision) 0 (* subdivision (* 2 pi)) decimals)))
+ (x-points (second sampled-function))
+ (y-points (third sampled-function)))
+
+
+ (values (om/ x-points subdivision) y-points)
+ )
+ )
+
+; example
+
+; (gen-partial 8)
+
+
+; GEN-SRR
+
+; legacy method
+
+(defmethod! gen-srr_2 (subdivision1 subdivision2 &key (precision 0.01) (decimals 5))
+
+ ;:icon 141
+ ;:initvals '(0 0.1 5)
+ ;:indoc '("subdivision" "sampling-factor" "decimals")
+ :numouts 2
+
+ (let* ((pointlist1 (multiple-value-list (gen-partial subdivision1 :precision precision :decimals decimals)))
+ (pointlist2 (multiple-value-list (gen-partial subdivision2 :precision precision :decimals decimals)))
+ )
+ (values (first pointlist1)
+ (om* 0.25 (om+ 2 (om+ (second pointlist1) (second pointlist2))))
+ )
+ )
+ )
+
+(defmethod! gen-srr (&rest subdivisions)
+
+ :icon 988
+ :initvals '(nil)
+ :indoc '("subdivisions")
+ :numouts 2
+ (let ((valuelist (mat-trans
+ (loop for sub in subdivisions
+ collect (multiple-value-list (gen-wave1 sub :sampling-factor 2))))))
+ ; (print valuelist)
+
+ (values (caar valuelist)
+ (om* (expt 0.5 (length subdivisions))
+ (om+ (length subdivisions) ;(apply 'om+ (second valuelist)))))
+ (loop for i from 0 to (1- (length (car (second valuelist))))
+ collect (reduce '+ (loop for list in (second valuelist) collect (nth i list)))
+ ))
+ )
+ )
+ )
+ )
+
+
+ (let* ((pointlist1 (multiple-value-list (gen-wave1 subdivision1)))
+ (pointlist2 (multiple-value-list (gen-wave1 subdivision2)))
+ )
+ (values (first pointlist1)
+ (om* 0.25 (om+ 2 (om+ (second pointlist1) (second pointlist2))))
+ )
+ )
+ )
+
+(loop for i from 0 to (1- (length (car *testwave*)))
+ collect (reduce '+ (loop for list in *testwave* collect (nth i list)))
+ )
+
+(loop for i from 0 to (1- (length (car *testwave*)))
+ collect ;(dx->x (nth i (car *testwave*)) (loop for list in (cdr *testwave*) collect (nth i list)))
+ (reduce '+ (loop for list in *testwave* collect (nth i list)))
+ )
+
+(loop for list in *testwave* collect (nth 0 list))
+
+*testwave*
+
+(nth 0 (car *testwave*))
+(dx->x
+(cdr *testwave*)
+
+(defparameter *testwave* '((1.0 -0.98999 0.96017 -0.91113 0.84385 -0.75969 0.66032 -0.54773 0.42418 -0.29214 0.15425 -0.01328 -0.12796) (1.0 0.07074 -0.98999 -0.2108 0.96017 0.34664 -0.91113 -0.47554 0.84385 0.59492 -0.75969 -0.7024 0.66032) (1.0 -0.41615 -0.65364 0.96017 -0.1455 -0.83907 0.84385 0.13674 -0.95766 0.66032 0.40808 -0.99996 0.42418)))
+
+
+(om+ '((1 2) (5 6)))
+(om+ '(1 2) '(5 6) '(5 6))
+(om+ '((1.0 -0.98999 0.96017 -0.91113 0.84385 -0.75969 0.66032 -0.54773 0.42418 -0.29214 0.15425 -0.01328 -0.12796) (1.0 0.07074 -0.98999 -0.2108 0.96017 0.34664 -0.91113 -0.47554 0.84385 0.59492 -0.75969 -0.7024 0.66032) (1.0 -0.41615 -0.65364 0.96017 -0.1455 -0.83907 0.84385 0.13674 -0.95766 0.66032 0.40808 -0.99996 0.42418)))
+(apply 'om+ '((1.0 -0.98999 0.96017 -0.91113 0.84385 -0.75969 0.66032 -0.54773 0.42418 -0.29214 0.15425 -0.01328 -0.12796) (1.0 0.07074 -0.98999 -0.2108 0.96017 0.34664 -0.91113 -0.47554 0.84385 0.59492 -0.75969 -0.7024 0.66032) (1.0 -0.41615 -0.65364 0.96017 -0.1455 -0.83907 0.84385 0.13674 -0.95766 0.66032 0.40808 -0.99996 0.42418)))
+
+(apply 'om+ '((1 2) (5 6)))
+
+(mapcar
+ #'(lambda (x) (om+ 2 x))
+ '((1 2) (5 6)))
+
+
+; output the object or the point lists
+; optionally output cartesian or polar representation
+
+
+; Computation of Farey-Sequence
+; A Farey sequence of order n is the sequence of irreducible fractions between 0 and 1 that have denominators less than or equal to n, arranged in increasing order.
+
+(defun farey-sequence (n)
+ "Compute the Farey sequence of order n."
+ (let ((fractions '()))
+ (loop for denominator from 1 to n
+ do (loop for numerator from 0 to denominator
+ when (and (>= numerator 0) (<= numerator denominator)
+ (= 1 (gcd numerator denominator)))
+ do (push (cons numerator denominator) fractions)))
+ (sort fractions (lambda (a b)
+ (let ((num-a (car a)) (den-a (cdr a))
+ (num-b (car b)) (den-b (cdr b)))
+ (< (* num-a (float den-b)) (* num-b (float den-a))))))
+
+ ; (loop for (a . b) in fractions collect
+ ; (/ a b)
+ ; )
+ ))
+
+;; Example usage
+(print (farey-sequence 5))
+(farey-sequence 5)
+
+(let ((conspair '(1 . 5)))
+ (/ (car conspair)
+ (cdr conspair))
+)
--
Gitblit v1.9.1