From a53ccfa7cc59f72f88c55df3a9b1e5583dd2f8b6 Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Sat, 30 Dec 2023 09:05:59 +0100
Subject: [PATCH] chore(sources): seperate utilities from defmethods
---
sources/gen-harmonies.lisp | 179 ++++++++++++++++++++++++++++-------------------------------
1 files changed, 86 insertions(+), 93 deletions(-)
diff --git a/sources/gen-harmonies.lisp b/sources/gen-harmonies.lisp
index d1ba81a..8b1a64e 100644
--- a/sources/gen-harmonies.lisp
+++ b/sources/gen-harmonies.lisp
@@ -18,100 +18,7 @@
:numouts 1
:doc "creates a list of chords, that contains all possible transpositions & permutations of the given pitch-sets"
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun circular_oml (items)
-(setf (cdr (last items)) items)
-items)
-
-
-(defun flat_oml (liste)
- (cond
- ((null (cdr liste))
- (if (atom (car liste))
- liste
- (flat_oml (car liste))))
-
-
- ((and (listp (car liste)) (not (listp (cadr liste))))
- (append (car liste)
- (flat_oml (cdr liste))))
-
-
- ((and (not (listp (car liste))) (not (listp (cadr liste))))
- (append (list (car liste))
- (flat_oml (cdr liste))))
-
- ((and (listp (car liste)) (listp (cadr liste)))
- (append (car liste)
- (flat_oml (cdr liste))))
-
- ((and (not (listp (car liste))) (listp (cadr liste)))
- (append (list (car liste))
- (flat_oml (cdr liste))))))
-
-(defun get-pos_oml (positions seq)
- (let ((positions (if (atom positions) (list positions) positions)))
- (mapcar #'(lambda (it) (nth it seq)) seq)))
-
-
-(defun permutations_oml (bag)
-
-(if (null bag)
-'(())
-
-(mapcan #'(lambda (e)
- (mapcar #' (lambda (p) (cons e p))
- (permutations_oml (remove e bag :count 1 :test #'eq))))
- bag)))
-
-
-(defun mat-trans_oml (list)
-(loop for y in (let (count-list)
- (dotimes (i (length (car list)))
- (setq count-list (cons i count-list))) (nreverse count-list))
-collect (loop for x in list collect (nth y x))
-
-))
-
-
-
-(defun modulo_oml (pos liste)
-(append
-(nthcdr pos liste)
-(butlast liste (- (length liste) pos))))
-
-
-(defun register-permut_oml (register-list)
-(remove-duplicates
- (om::flat
- (loop for r in register-list
- collect
- (mapcar #'(lambda (l) (permutations_oml
- (append (make-list l :initial-element r)
- (make-list (- (length register-list) l) :initial-element 0))))
- (loop for x from 1 to (length register-list)
- collect x))) 2) :test 'equal))
-
-
-(defun find-pos_oml (item seq)
- (remove nil (loop for s in seq
- for x
- collect (if (equal item s) x))))
-
-
-(defun sum_oml (liste)
- (if (null (cdr liste))
- (car liste)
- (+ (car liste)
- (sum_oml (cdr liste)))))
-
-(defun variations_oml (liste pcl)
- (let* ((liste (remove-duplicates liste))
- (liste (make-list pcl :initial-element liste)))
- (apply #'alexandria:map-product #'list liste)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* (
(instr-list (sort (flat_oml (remove nil (list instr1 instr2 instr3 instr4))) '<))
@@ -171,7 +78,93 @@
(harmon-database (if avoid-empty-voices (mapcar (lambda (x) (remove -1 x)) harmon-database) harmon-database)))
harmon-database))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun circular_oml (items)
+(setf (cdr (last items)) items)
+items)
+
+
+(defun flat_oml (liste)
+ (cond
+ ((null (cdr liste))
+ (if (atom (car liste))
+ liste
+ (flat_oml (car liste))))
+
+
+ ((and (listp (car liste)) (not (listp (cadr liste))))
+ (append (car liste)
+ (flat_oml (cdr liste))))
+
+
+ ((and (not (listp (car liste))) (not (listp (cadr liste))))
+ (append (list (car liste))
+ (flat_oml (cdr liste))))
+
+ ((and (listp (car liste)) (listp (cadr liste)))
+ (append (car liste)
+ (flat_oml (cdr liste))))
+
+ ((and (not (listp (car liste))) (listp (cadr liste)))
+ (append (list (car liste))
+ (flat_oml (cdr liste))))))
+
+(defun get-pos_oml (positions seq)
+ (let ((positions (if (atom positions) (list positions) positions)))
+ (mapcar #'(lambda (it) (nth it seq)) seq)))
+
+
+(defun permutations_oml (bag)
+
+(if (null bag)
+'(())
+
+(mapcan #'(lambda (e)
+ (mapcar #' (lambda (p) (cons e p))
+ (permutations_oml (remove e bag :count 1 :test #'eq))))
+ bag)))
+
+
+
+
+(defun modulo_oml (pos liste)
+(append
+(nthcdr pos liste)
+(butlast liste (- (length liste) pos))))
+
+
+(defun register-permut_oml (register-list)
+(remove-duplicates
+ (om::flat
+ (loop for r in register-list
+ collect
+ (mapcar #'(lambda (l) (permutations_oml
+ (append (make-list l :initial-element r)
+ (make-list (- (length register-list) l) :initial-element 0))))
+ (loop for x from 1 to (length register-list)
+ collect x))) 2) :test 'equal))
+
+
+(defun find-pos_oml (item seq)
+ (remove nil (loop for s in seq
+ for x
+ collect (if (equal item s) x))))
+
+
+(defun sum_oml (liste)
+ (if (null (cdr liste))
+ (car liste)
+ (+ (car liste)
+ (sum_oml (cdr liste)))))
+
+(defun variations_oml (liste pcl)
+ (let* ((liste (remove-duplicates liste))
+ (liste (make-list pcl :initial-element liste)))
+ (apply #'alexandria:map-product #'list liste)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
Gitblit v1.9.1