chore(sources): seperate utilities from defmethods

Lorenz Lehmann

30.12.23 a53ccfa7cc59f72f88c55df3a9b1e5583dd2f8b6

chore(sources): seperate utilities from defmethods

Utility functions in the lisp files gen-harmonies and harmon-progress were moved outside the main functions and placed at the end of the lisp code

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




 sources/harmon-progress.lisp

@@ -6,6 +6,9 @@
;Supervision: Marlon Schumacher
;======================================




(in-package :omlead)

(om::defmethod! harmon-progress (harmon-database first-chord chordnumber &key avoid-repetitions voice-tie1 voice-tie2 voice-tie3 voice-tie4 voice-interval1 voice-interval2 voice-interval3 voice-interval4 voice-counter1  counter-interval1 voice-counter2 counter-interval2 voice-counter3 counter-interval3 voice-counter4 counter-interval4 voice-counter5 counter-interval5 voice-counter6 counter-interval6 base-list)
@@ -14,42 +17,7 @@

:numouts 1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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 posn-match_oml (list positions)
  (cond ((null positions) '())
        ((atom positions) (nth positions list))
        (t (append (list (posn-match_oml list (car positions)))
                   (if (posn-match_oml list (cdr positions))
                       (posn-match_oml list (cdr positions))
                     '())))))


(defun subs-posn_oml (list position item)
  (loop for a from 0 
        for b in list 
        collect (if (= a position) item b)))


(defun oml- (list atom)
(mapcar (lambda (it) (- it atom)) list))


(defun find-dups_oml (liste)
(car 
(remove nil
(mapcar #'(lambda (l c) (eq l c)) liste  (cdr liste)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(let* ((harmon-database harmon-database)
@@ -613,7 +581,42 @@
                  (nreverse (push second external-list))
                  (values second))))))
               
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
              
(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 posn-match_oml (list positions)
  (cond ((null positions) '())
        ((atom positions) (nth positions list))
        (t (append (list (posn-match_oml list (car positions)))
                   (if (posn-match_oml list (cdr positions))
                       (posn-match_oml list (cdr positions))
                     '())))))


(defun subs-posn_oml (list position item)
  (loop for a from 0 
        for b in list 
        collect (if (= a position) item b)))


(defun oml- (list atom)
(mapcar (lambda (it) (- it atom)) list))


(defun find-dups_oml (liste)
(car 
(remove nil
(mapcar #'(lambda (l c) (eq l c)) liste  (cdr liste)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;