From 2b28dadf2717822f52e944d2b4b4542809281b55 Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Sat, 30 Dec 2023 10:57:07 +0100
Subject: [PATCH] feat(sources): avoid-doublings
---
sources/harmon-progress.lisp | 75 +++++++++++++++++++------------------
1 files changed, 39 insertions(+), 36 deletions(-)
diff --git a/sources/harmon-progress.lisp b/sources/harmon-progress.lisp
index 4c6b48f..9609f14 100644
--- a/sources/harmon-progress.lisp
+++ b/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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
Gitblit v1.9.1