; ****************************************************************
|
; | 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))
|
)
|
