[Morphologie-cvs] r15 - trunk/src

Author: ksprotte Date: Fri Jul 6 04:24:17 2007 New Revision: 15

Modified: trunk/src/morphologie.lisp Log: define-ompw -> define-box

Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Fri Jul 6 04:24:17 2007 @@ -20,7 +20,7 @@ ;; with this code. ;; see my reimplementation below

-;; (define-ompw list-modulo (list &optional ncol) +;; (define-box list-modulo (list &optional ncol) ;; "partitions LIST in NCOL lists containing the elements modulo NCOL" ;; :non-generic t ;; (let ((vector (make-array ncol)) res) @@ -36,7 +36,7 @@ (def-menu morphologie) (in-menu morphologie)

-(define-ompw list-modulo (list &optional ncol) +(define-box list-modulo (list &optional ncol) "partitions LIST in NCOL lists containing the elements modulo NCOL" :non-generic t ;; new implementation by Kilian @@ -73,33 +73,33 @@

(defun the-max (x) (apply 'max x))

-(define-ompw g-min (list) +(define-box g-min (list) :non-generic t :export nil ; just for trying things out, we exclude this from the menu (less-deep-mapcar #'the-min (list! list)))

-(define-ompw g-max (list) +(define-box g-max (list) :non-generic t (less-deep-mapcar #'the-max (list! list)))

-(define-ompw l-nth (list l-nth) +(define-box l-nth (list l-nth) :non-generic t (deep-mapcar 'l-nth 'nth l-nth list))

-(define-ompw posn-match (list l-nth) +(define-box posn-match (list l-nth) :non-generic t (deep-mapcar 'l-nth 'nth l-nth (list! list)))

-(define-ompw permut-circ (list &optional nth) +(define-box permut-circ (list &optional nth) :non-generic t (permut-circn (copy-list list) nth))

-(define-ompw permut-circn (list &optional nth) +(define-box permut-circn (list &optional nth) :non-generic t (when list (let ((length (length list)) n-1thcdr) @@ -109,14 +109,13 @@ (prog1 (cdr (nconc (setq n-1thcdr (nthcdr (1- nth) list)) list)) (rplacd n-1thcdr nil))))))

- -(define-ompw primo-passo ((lista nil) (n 1)) +(define-box primo-passo ((lista nil) (n 1)) "prende n elementi di una lista" :non-generic t (let ((f nil)) (dotimes (x n) (push (nth x lista) f)) (nreverse f)))

-(define-ompw scom ((lista1 nil) &optional (n nil)) +(define-box scom ((lista1 nil) &optional (n nil)) "Scompone la lista1 in funzione delle lunghezze indicate nella n" :non-generic t (let ((ris nil)) @@ -135,7 +134,7 @@ (reverse ris)))

-(define-ompw pattern-ridond ((lista nil) &optional (n nil)) +(define-box pattern-ridond ((lista nil) &optional (n nil)) "Restituisce tutte le ripetizioni di tutti i sotto-pattern in cui pu� essere scomposta la sequenza in lista." :non-generic t @@ -145,7 +144,7 @@ (reverse ris)))

-(define-ompw ptrn-recogn ((list (1 2 3 1 2 3 1 2 1 2))) +(define-box ptrn-recogn ((list (1 2 3 1 2 3 1 2 1 2))) "restituisce..." :non-generic t (let* ((ris nil) @@ -159,14 +158,14 @@ (push (append (list (nth x calcoletto)) (list (nth x calcolaccio))) ris))))

-(define-ompw rispero ((lista (1 2)) (n 0)) +(define-box rispero ((lista (1 2)) (n 0)) "E' come spero solo che divide la lista in base al valore messo in n" :non-generic t (scom lista n))

-(define-ompw risperiamo ((lista nil) (n 0)) +(define-box risperiamo ((lista nil) (n 0)) "E' molto simile a speriamo : trova i pattern di n lunghezza all'interno della lista" :non-generic t @@ -175,7 +174,7 @@ (if (equalp (subsetp (list nil) x :test #'equal) nil) (push x ris)))))

-(define-ompw ptrn-ridond-ctrl-prov ((lista nil) (n nil)) +(define-box ptrn-ridond-ctrl-prov ((lista nil) (n nil)) "Restituisce tutti i sotto-pattern che compaiono almeno due volte (ridondanza) e le cui length sono decise da noi in N." @@ -186,7 +185,7 @@ (nreverse ris)))

-(define-ompw ptrn-find ((list (1 2 3 1 2 3 1 2 1 2)) (n nil)) +(define-box ptrn-find ((list (1 2 3 1 2 3 1 2 1 2)) (n nil)) "Donne tous les patterns de longueur N presents dans LIST avec leur nombre d'occurences. Est considere comme pattern tout segment de LIST @@ -235,7 +234,7 @@ (let ((max (apply #'max (mapcar #'cadr list)))) (remove-if #'(lambda (x) (< (cadr x) max)) list)))

-(define-ompw ptrn-reson ((list (a b c a b c b b b b a a)) (windw 5) &optional +(define-box ptrn-reson ((list (a b c a b c b b b b a a)) (windw 5) &optional (step nil) (set nil)) "Avance dans la sequence LIST avec avec une taille de fenetre WINDW et un pas d'avancement (optionnel) STEP . @@ -282,7 +281,7 @@ (sort-list-char a #'car)) result-not-sorted)))))))

-(define-ompw ptrn-smooth ((list (a b c d b b))) +(define-box ptrn-smooth ((list (a b c d b b))) "It returns the list LIST without local repetitions. For example : list equal to (a a b c a b b c d c c) it reurns (a b c a b c d c))" @@ -336,7 +335,7 @@ (setf (nth p r) (append (nth p r) (list i))) (push (list seqa i) r))))))))

-(define-ompw find-permut ((seq nil) (output "permut") &optional (length nil) +(define-box find-permut ((seq nil) (output "permut") &optional (length nil) (ptrn nil)) "Renvoie les permutations de deux elements de la sequence SEQ> deux modes : PERMUTATION renvoie les segments d'elements permutes, POSITION renvoie @@ -367,7 +366,7 @@

(menu-separator)

-(define-ompw ldl-distance ((l-seq ((a b c) (a b b) (a b c))) (change 1.0) +(define-box ldl-distance ((l-seq ((a b c) (a b b) (a b c))) (change 1.0) (ins/sup 1.0) (inex 0.0) (scale "abs") (result "short")) "Estimates the distances between lists of symbols. @@ -526,7 +525,7 @@ r))))) (when (stringp string) (readst string))))

-(define-ompw str->symb ((strings nil)) +(define-box str->symb ((strings nil)) "Converts string or list of strings or list of list of strings into list (list of list) of symbols. !! : please replace double quotes by simple quotes before evalution." (declare (ignore strings)) @@ -542,7 +541,7 @@ !! : please replace double quotes by simple quotes before evalution." (string-to-symbol strings))

-(define-ompw num->alpha ((list nil)) +(define-box num->alpha ((list nil)) "converts list of lists and/or integers to symbols : 0 -> a 1 -> b @@ -567,7 +566,7 @@ etc." (numtochar0 list))

-(define-ompw minirec (list) +(define-box minirec (list) (declare (ignore list)) (error "default method. should not be called."))

@@ -575,7 +574,7 @@

(defmethod minirec ((list list)) (apply #'min (fflat list)))

-(define-ompw midicents-to-name (x &optional approx) +(define-box midicents-to-name (x &optional approx) "Converts a midic number to a CMN name approx values are .5 .25 .125 " :non-generic t @@ -618,12 +617,12 @@

(defun mc->alpha1 (midicents approx) (mc-to-name midicents approx))

-(define-ompw mc->alpha ((midicents nil) approx) +(define-box mc->alpha ((midicents nil) approx) :non-generic t (mc->alpha midicents approx))

-(define-ompw concatstrings ((lofstrings nil)) +(define-box concatstrings ((lofstrings nil)) "Concantenates list of strings into one string." :non-generic t (let ((concatenated @@ -641,7 +640,7 @@ "Converts midicents values into symboles." (string-to-symbol (mc-to-name midiseq approx)))

-(define-ompw midiseq->alpha ((midiseq nil) (approx 0)) +(define-box midiseq->alpha ((midiseq nil) (approx 0)) "Converts midicents values into symboles." :non-generic t (midiseq->alpha1 midiseq approx)) @@ -729,7 +728,7 @@ (format stream "~S " (nth n (cadr from-struct-1))) (format stream "~%~%"))))

-(define-ompw structure-1 ((seq (a b c a b c d a c c d a a b c a)) &optional (alpha? :alpha) (smooth? :yes) +(define-box structure-1 ((seq (a b c a b c d a c c d a a b c a)) &optional (alpha? :alpha) (smooth? :yes) (result :extend) (levels 1) (smth2? :no)) "Donne toutes les structures possibles d'une s�quence de nombres ou de symboles selon une segmentation contrastive, et ce de mani�re r�cursive. @@ -873,7 +872,7 @@

(defun modulo26 (num) (values (mod num 26) (floor (/ num 26))))

-(define-ompw numtochar (num) +(define-box numtochar (num) (declare (ignore num)) (error "default method. should not be called."))

@@ -889,7 +888,7 @@

(defmethod numtochar ((num list)) (mapcar #'numtochar num))

-(define-ompw numtochar0 (num) +(define-box numtochar0 (num) (declare (ignore num)) (error "default method. should not be called."))

@@ -905,7 +904,7 @@

(defmethod numtochar0 ((num list)) (mapcar #'numtochar0 num))

-(define-ompw numtochar2 (num) +(define-box numtochar2 (num) (declare (ignore num)) (error "default method. should not be called."))

@@ -924,7 +923,7 @@ (setf (elt main-string n) (elt k i)) (setf n (1+ n))))))

-(define-ompw numtochar3 (num) +(define-box numtochar3 (num) (declare (ignore num)) (error "default method. should not be called."))

@@ -1103,7 +1102,7 @@ (ac (append (reverse seqr) seq) lisse1 (1- prof) (1+ level) lisse2))))))

-(define-ompw rma-1 ((seq nil) (smoo1 1) (levels 1) &optional (smoo2 0) +(define-box rma-1 ((seq nil) (smoo1 1) (levels 1) &optional (smoo2 0) (alpha? 1) (result 0)) " m�me fonction que structure-1, mais r�cursive : @@ -1281,7 +1280,7 @@ (defun list-char-score (lcs) (setf (car lcs) (list (make-string 1 :initial-element (car lcs)) (cadr lcs))))

-(define-ompw rma-1-scores ((structures nil)) +(define-box rma-1-scores ((structures nil)) "Returns the score of each structure, level by level of the rma-1 analysis." :non-generic t (let ((types (mapcar 'test-eq-l structures)) (scores nil) (s nil)) @@ -1374,7 +1373,7 @@ (setf pat (append pat (list (nth (+ n o) seq))))) (when (equalp pat ptrn) (push n pos-p)))))

-(define-ompw pos-ptrn-l ((lptrn nil) (seq nil) &optional (min 2) (max 12)) +(define-box pos-ptrn-l ((lptrn nil) (seq nil) &optional (min 2) (max 12)) "Gives all positions in seq where starts ptrns. INPUT : lptrn : list of patterns to be found; @@ -1442,7 +1441,7 @@ (flet ((match (x) (and (<= val (max-dom x)) (>= val (min-dom x))))) (position-if #'match list-dom)))

-(define-ompw ins-ptrn ((seq (1 2 3 4 1 2 5 3 4)) (ptrn ((1 2 3 4) (1 2))) +(define-box ins-ptrn ((seq (1 2 3 4 1 2 5 3 4)) (ptrn ((1 2 3 4) (1 2))) &optional (prof 1) (set nil) (marg 0)) "Finds the pattern(s) PTRN in list seq with or without up to a number prof inserted items; @@ -1532,7 +1531,7 @@ (push (list pattern (reverse pos)) r))))

-(define-ompw structure-2 ((seq nil) (n-max 10) (alpha? 1) (result 0) &optional +(define-box structure-2 ((seq nil) (n-max 10) (alpha? 1) (result 0) &optional (length nil) (seuil 10)) "INPUT seq = sequence of nums or symbols; @@ -1662,7 +1661,7 @@ (push (OM::posn-match list-of-pat k) ros)))) (mat-trans (list calcolo calcolaccio))))

-(define-ompw forma ((analys nil) (seq nil) (seuil 1)) +(define-box forma ((analys nil) (seq nil) (seuil 1)) :non-generic t (let ((r nil)) (dolist (l analys (reverse r)) @@ -1724,7 +1723,7 @@ "~%computation time : ~,3F seconds~%~% End of Pattern Analysis (Structure-2)~%" run-time))

-(define-ompw aver-class ((seq nil) (class nil)) +(define-box aver-class ((seq nil) (class nil)) "Return the average center of classes (one dimension)." :non-generic t (let ((r nil) (rt nil) (length (remove-duplicates class))) @@ -1741,7 +1740,7 @@ 10000))))))

-(define-ompw quantize-1 ((seq nil) (class nil)) +(define-box quantize-1 ((seq nil) (class nil)) "Returns the quantization of elements in list according to the classification defined in class (one dimension)" :non-generic t @@ -1761,7 +1760,7 @@ (dolist (n class (reverse rt)) (push (nth n r) rt))))

-(define-ompw l-matrix ((list nil)) +(define-box l-matrix ((list nil)) "Makes a matrix from a list of lists." :non-generic t (let ((mat @@ -1775,7 +1774,7 @@ (setf (aref mat l m) (nth m (nth l list))))))))

-(define-ompw class-1 ((matrix nil) (n 2) &optional (alpha? 0) (centers nil) +(define-box class-1 ((matrix nil) (n 2) &optional (alpha? 0) (centers nil) (verbose "no")) "Clustering 'mouving-clouds' algorithm. Classify elements in matrix of d-dimensions into n classes. The nth element in result-list corresponds @@ -1880,7 +1879,7 @@ (dotimes (j m) (setf sum (+ sum (aref x j i)))) (setf (aref g 0 i) (float (/ sum m))))))

-(define-ompw matrix-center ((matrix nil)) +(define-box matrix-center ((matrix nil)) "Donne les coordonn�es du centre de gravit� d'une matrice des coordonn�es de points en n-dimensions (utiliser l-matrix pour convertir une liste de coordonn�es de points en matrice). @@ -1924,7 +1923,7 @@ (const*matrix (/ 1 (car (array-dimensions matrix))) (multiply-two-matrices (transpose matrix) matrix)))

-(define-ompw dist-euclidienne ((matrix nil)) +(define-box dist-euclidienne ((matrix nil)) "input = matrix of coordinates of points in a d-space; output = upper-matrix of euclidian distances." :non-generic t @@ -1943,7 +1942,7 @@ (setf (aref mat-dist i k) (sqrt temp))))))

-(define-ompw euclidian-d ((matrix nil)) +(define-box euclidian-d ((matrix nil)) "input = matrix of coordinates of points in a d-space; output = upper-matrix of euclidian distances." (let (k @@ -2010,7 +2009,7 @@ (setf tc (CENTRE-GRAVIT\� nuage))))) (dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d))))))

-(define-ompw class-center ((matrix nil) (classes nil)) +(define-box class-center ((matrix nil) (classes nil)) "input = matrix of points in d-dimensions liste of classes founded for each point (line in matrix); Classes must be in numerical representation. @@ -2068,7 +2067,7 @@ (push (/ (length (remove-if-not #'(lambda (x) (equal x ci)) data)) n) p))))

-(define-ompw entropy ((class nil) (res "abs")) +(define-box entropy ((class nil) (res "abs")) "Returns the Shannon entropy value of the data classified. data : list of classes distribution (typically data from class-1); res : absolute or relative entropy; @@ -2117,7 +2116,7 @@ (setf class (str->symb class)) (entropy class res))

-(define-ompw meta-class1 ((matrix nil) (n 2) (iter 1) &optional alpha? centers +(define-box meta-class1 ((matrix nil) (n 2) (iter 1) &optional alpha? centers verbose) "Does n iterations of class-1 algorithm. The classes designation is normalized." @@ -2157,7 +2156,7 @@ (push marker r)) (t (push (- (1- (length set)) (pos (nth c classes) set)) r))))))

-(define-ompw norm-class ((classes nil)) +(define-box norm-class ((classes nil)) "reordonne les classes de class-1. L'ordre de la classe �tant le num�ro de sa premi�re occurence dans la liste des classes. Se connecte typiquement apr�s class-1 ou meta-class1. @@ -2191,7 +2190,7 @@ (dotimes (j (array-dimension mat 1) (push (reverse c) p)) (push (aref mat i j) c))))))

-(define-ompw p-class ((clusters nil)) +(define-box p-class ((clusters nil)) "Give the probability for each to be element of class #" :non-generic t (prob-class clusters)) @@ -2210,7 +2209,7 @@ (when (> (aref prob j i) p) (setf p (aref prob j i)) (setf cl j))) (if (= val? 0) (push cl r) (push (list cl p) r)))))

-(define-ompw res-class ((proba nil) (val? 0)) +(define-box res-class ((proba nil) (val? 0)) "Affects each point i of the matrix prob to the class (j) with higher probability." :non-generic t :menu (val? (0 "classes") (1 "proba")) @@ -2225,7 +2224,7 @@ (pos2 e entropies) (mapcar #'(lambda (n) (nth n clusters)) (pos2 e entropies)))))

-(define-ompw e-test ((clusters nil) (test "min") &optional (out "clust")) +(define-box e-test ((clusters nil) (test "min") &optional (out "clust")) "Returns the clusters which have the minimum or maximum entropy." :non-generic t :menu (test ("min" "min") ("max" "max")) @@ -2443,7 +2442,7 @@ (remove nil r :key #'third))) (reverse (remove-duplicates r :key #'cadr))))

-(define-ompw min-flex-max ((seq +(define-box min-flex-max ((seq (6000 4000 5600 4700 4100 5900 6400 7800 7400 6300 6800 8300 5900)) (result 1) &optional (d-cte nil)) @@ -2487,7 +2486,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2, 3, 4." result)))))

-(define-ompw 1-0-1-reconst ((list nil)) +(define-box 1-0-1-reconst ((list nil)) "fonction dx->x d'OM : renvoie une liste de points depuis une liste d'intervalles . commence � zero" @@ -2495,7 +2494,7 @@ (OM::dx->x 0 list))

-(define-ompw reconst-prim (list start) +(define-box reconst-prim (list start) :non-generic t "est la fonction OM dx->x" (let ((ris start) prim prof last) @@ -2514,7 +2513,7 @@ (push (apply prim (list last -1)) ris)))))))))

-(define-ompw reconstitute ((list nil) (which 1) (start 0)) +(define-box reconstitute ((list nil) (which 1) (start 0)) "reconstitue le profil original. avec optionnels: prim : n'utilise que l'analyse primitive @@ -2551,7 +2550,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2, 3, 4." which))))

-(define-ompw reconst-prim+prof ((list nil)) +(define-box reconst-prim+prof ((list nil)) "Ricostruisce la lista usando min, max, flex pi� eventualmente l'indice di profondit�" :non-generic t @@ -2584,7 +2583,7 @@ (mapcar #'(lambda (x) (nth x seq)) (OM::flat risultato)) (OM::flat risultato))))

-(define-ompw struct2-to-seq ((struct nil) (n nil) &optional ptrns) +(define-box struct2-to-seq ((struct nil) (n nil) &optional ptrns) "Reconstruit une s�quence correspondant � la structure donn�e en struct. Optional : reconstruit une s�quence de m�me structure avec les patterns donn�s en ptrns." @@ -2603,7 +2602,7 @@ donn�s en ptrns." (mapcar #'(lambda (i) (rec-st-2 struct i ptrns)) n))

-(define-ompw reconst-prim+prof+val ((list nil) (start 6000)) +(define-box reconst-prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex pi� eventualmente l'indice di profondit�" :non-generic t @@ -2633,7 +2632,7 @@ ris))))

-(define-ompw pos+prim+prof+val ((list nil) (start 6000)) +(define-box pos+prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex pi� eventualmente l'indice di profondit�" :non-generic t @@ -2715,7 +2714,7 @@ (push valore ris))))))

-(define-ompw controlla-ottave ((list1 nil) (list2 nil) (modul 12)) +(define-box controlla-ottave ((list1 nil) (list2 nil) (modul 12)) "studia i casi particolari della melodia in questione se questa � trasposta pi� o meno esattamente" :non-generic t @@ -2733,7 +2732,7 @@ (if (not (equalp (nth x studio) (nth (+ 1 x) studio))) (push 1 ros)))))

-(define-ompw controlla-direzioni ((list1 nil) (list2 nil)) +(define-box controlla-direzioni ((list1 nil) (list2 nil)) "Studia gli intervalli di due liste e ne fa una analisi" :non-generic t (let ((ris nil) @@ -2743,7 +2742,7 @@ (when (not (equalp (nth x direzioni1) (nth x direzioni2))) (push 1 ris)))))

-(define-ompw controlla-intervalli ((list1 nil) (list2 nil)) +(define-box controlla-intervalli ((list1 nil) (list2 nil)) "Studia gli intervalli di due liste e ne fa una analisi" :non-generic t (let ((ris nil) @@ -2754,7 +2753,7 @@ (push 1 ris)))))

-(define-ompw controlla-rapporti ((list1 nil) (list2 nil)) +(define-box controlla-rapporti ((list1 nil) (list2 nil)) "Verifica se le due liste sono identiche nei rapporti interni con una approssimazione di due decimali." :non-generic t @@ -2773,7 +2772,7 @@ (if (equalp rapporto1 rapporto2) 'ok 'no)))

-(define-ompw duration-case ((list1 nil) (list2 nil)) +(define-box duration-case ((list1 nil) (list2 nil)) "" :non-generic t (let ((ris nil)) @@ -2784,7 +2783,7 @@ (push 1 ris)))))))

-(define-ompw intensity-case ((list1 nil) (list2 nil)) +(define-box intensity-case ((list1 nil) (list2 nil)) "Verifica se le due liste sono identiche nei rapporti interni con una approssimazione di due decimali." :non-generic t @@ -2806,7 +2805,7 @@

(defun mini (l) "Returns the minimum value of a list" (car (sort l '<)))

-(define-ompw dist-1-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) +(define-box dist-1-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (wgth (1 1 1 1))) "" :non-generic t @@ -2832,7 +2831,7 @@ 2)))))))

-(define-ompw dist-2-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) +(define-box dist-2-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) (wgth (1 1 1 1))) "" :non-generic t @@ -2859,7 +2858,7 @@ 2)))))))

-(define-ompw dist-1 ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (scale 1)) +(define-box dist-1 ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (scale 1)) "Returns the smallest distance between two lists of symbols seq1 and seq2 Args : change = cost when changing a symbol in a list without deletion or insertion @@ -2902,7 +2901,7 @@ (format t "~% try arguments 'relative or 'absolute")))))

-(define-ompw dist-2 ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) +(define-box dist-2 ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) (scale 1)) "Returns the smallest distance between two lists of symbols seq1 and seq2 Args : @@ -2969,7 +2968,7 @@ (format t "~% try arguments : 'relative or 'absolute")))))

-(define-ompw distance ((seq1 (a b c d e)) (seq2 (a b c d e)) (change 1) +(define-box distance ((seq1 (a b c d e)) (seq2 (a b c d e)) (change 1) (ins/sup 1) (scale 1) &optional (inex nil)) "Returns the smallest distance between two lists of symbols seq1 and seq2 Args : @@ -2986,7 +2985,7 @@ (dist-1 seq1 seq2 change ins/sup scale)))

-(define-ompw multi-distance ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) +(define-box multi-distance ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (wgth (1 1 1 1)) &optional (inex nil)) "Applique la distance d'�dition � une liste de s�quences avec une pond�ration (entre 0 et 1) @@ -2997,7 +2996,7 @@ (dist-1-ldl seq1 seq2 change ins/sup wgth)))

-(define-ompw resemblance-match (a b) +(define-box resemblance-match (a b) (declare (ignore a b)) (error "default method. should not be called."))

@@ -3017,7 +3016,7 @@ (defun ref-position (list) (mapcar #'(lambda (e) (position e list :test #'equalp)) list))

-(define-ompw resemblance ((a nil) (b nil) (wocc 1.0) (wref 1.0) &optional +(define-box resemblance ((a nil) (b nil) (wocc 1.0) (wref 1.0) &optional (diff "res")) "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences de symboles selon le crit�re de leur structure interne. @@ -3071,7 +3070,7 @@ (dotimes (x (- (length lista) 1) (nreverse ris)) (push (/ (+ (nth x lista) (nth (1+ x) lista)) 2) ris))))

-(define-ompw mean-derivation ((list nil) (GR\� 0) &optional (note? nil)) +(define-box mean-derivation ((list nil) (GR\� 0) &optional (note? nil)) "" :non-generic t (let* ((calcolo @@ -3082,7 +3081,7 @@ (if note? con-note calcolo)))

-(define-ompw der ((lista nil) (n 0)) +(define-box der ((lista nil) (n 0)) "Crea la media tra una lista di valori diviso n" :non-generic t (let ((ris nil)) @@ -3090,7 +3089,7 @@ (push (remove nil (nth x (scom lista n))) ris))))

-(define-ompw med-var ((lista nil) (windw 1)) +(define-box med-var ((lista nil) (windw 1)) "Restituisce la derivata data dalla media delle note decise in n." :non-generic t (let ((ris nil) (calcolo (der lista windw))) @@ -3098,7 +3097,7 @@ (push (/ (apply '+ (nth x calcolo)) (length (nth x calcolo))) ris))))

-(define-ompw variable-derivation ((lista nil) (windw 2) (GR\� 1)) +(define-box variable-derivation ((lista nil) (windw 2) (GR\� 1)) "Restituisce le dirivate variabili successive secondo il valore scelto in GRADO. N rappresenta il valore con cui effettuare la media." :non-generic t @@ -3107,7 +3106,7 @@ (variable-derivation (med-var lista windw) (- GR\� 1) windw)))

-(define-ompw notes-change ((pits 6000) (scale 6000) &optional (mod 12)) +(define-box notes-change ((pits 6000) (scale 6000) &optional (mod 12)) "Cambia un p^rofilo con le note messe in scale." :non-generic t (let* ((pits (list! pits)) @@ -3134,7 +3133,7 @@ octa)))

-(define-ompw octave ((midic 6000)) +(define-box octave ((midic 6000)) "retourne l'octave � partir de c3=octave 3" :non-generic t (let ((midic (list! midic))) @@ -3142,7 +3141,7 @@ midic)))

-(define-ompw makenote ((index 60) (octave 3) &optional (mod 12)) +(define-box makenote ((index 60) (octave 3) &optional (mod 12)) " construction d'une note � partir des donn�es de index, octave e modulo du index" :non-generic t @@ -3160,7 +3159,7 @@ (nth y lista2)) ros))))

-(define-ompw inter-profile ((list1 nil) (list2 nil)) +(define-box inter-profile ((list1 nil) (list2 nil)) "Prepara interlock : non mi ricordo cosa fa esattamente." :non-generic t (let ((ris nil) (y (lettura-modulare list1 list2))) @@ -3178,7 +3177,7 @@ (last list1)))))

-(define-ompw prof-inter ((list1 nil) (list2 nil) (total 1)) +(define-box prof-inter ((list1 nil) (list2 nil) (total 1)) "Restituisce l'interposizione di list1 con list2. Se list1 � pi� piccola di list2 allora la funzione crea un'interposizione di n elementi di list2 dove (= n (- (length list1) 1)). In questo caso si puo' decidere con il @@ -3193,7 +3192,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." total))))

-(define-ompw interlock ((list1 nil) (list2 nil) (GR\� 1)) +(define-box interlock ((list1 nil) (list2 nil) (GR\� 1)) "Interpone una lista2 alla lista1 e prende aleatoriamente le note della lista2" :non-generic t @@ -3203,7 +3202,7 @@ (permut-circ list2 (1- (length list1))) (- GR\� 1))))

-(define-ompw new-inter-profile ((list1 nil) (list2 nil)) +(define-box new-inter-profile ((list1 nil) (list2 nil)) "Prepara interlock : non mi ricordo cosa fa esattamente." :non-generic t (let ((ris nil) (y (lettura-modulare list1 list2))) @@ -3224,7 +3223,7 @@ (last list1)))))

-(define-ompw new-interlock ((list1 nil) (list2 nil) (GR\� 1)) +(define-box new-interlock ((list1 nil) (list2 nil) (GR\� 1)) "Interpone una lista2 alla lista1 e prende aleatoriamente le note della lista2" :non-generic t @@ -3272,7 +3271,7 @@ (y)) ris))))

-(define-ompw correttore ((elmt 1) (range nil)) +(define-box correttore ((elmt 1) (range nil)) "Restituisce un elemento se questo compare all'interno del range. Se l'elemento � escluso allora lo traspone in modo tale che sia il pi� vicino possibile o al limite superiore o a quello inferiore. @@ -3301,7 +3300,7 @@ (dolist (y elmt) (push (correttore y range) ris)) (nreverse ris)))

-(define-ompw trans-approx ((list nil) (range nil)) +(define-box trans-approx ((list nil) (range nil)) "E' meglio di transpoct di Esquisse. Infatti attua lo stesso procedimento ma traspone una nota non inclusa nel range il pi� vicino o al limite superiore o a quello inferiore." @@ -3309,7 +3308,7 @@ (cor-ott-list (mio-transpoct list range) range))

-(define-ompw direct-analysis ((list (6000 4000 6900 7300 6100 5900))) +(define-box direct-analysis ((list (6000 4000 6900 7300 6100 5900))) "donne le signe de la d�riv�e locale (-1. 0 +1) pour chaque point de la liste des valeurs donn�es en entr�e." :non-generic t @@ -3350,7 +3349,7 @@ 1200))))) ris)))))

-(define-ompw malt-mod+ ((list nil) (limit 6000)) +(define-box malt-mod+ ((list nil) (limit 6000)) "" :non-generic t (let ((ris nil) (limite (first (list! limit)))) @@ -3363,7 +3362,7 @@ se non � incluso." (if (<= (g-min range) elmt (g-max range)) elmt nil))

-(define-ompw malt-mod- ((list nil) (limit 6000)) +(define-box malt-mod- ((list nil) (limit 6000)) "" :non-generic t (let ((ris nil) (limite (first (list! limit)))) @@ -3371,7 +3370,7 @@ (push (if (> y limite) (- (* 2 limite) y) y) ris))))

-(define-ompw reflex-int ((ls nil) (value 0) (up/down 1)) +(define-box reflex-int ((ls nil) (value 0) (up/down 1)) "Restituisce la rifleesione delle note che sono superiori o inferiori al valore indicato con 'value'. Il men� permette di selezionare se si vuole una riflessione superiore o inferiore" @@ -3403,7 +3402,7 @@ (first (int-com (list (first asse) (nth x ls)))))) ris))))

-(define-ompw reflex-note ((ls nil) (value 0) (up/down 1)) +(define-box reflex-note ((ls nil) (value 0) (up/down 1)) "Restituisce per la riflessione superiore con UP e quella inferiore con DOWN>" :non-generic t @@ -3414,14 +3413,14 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." up/down))))

-(define-ompw doppio-reflex-note ((list nil) (value nil)) +(define-box doppio-reflex-note ((list nil) (value nil)) "Restituisce due volte REFLEX-NOTE la prima volta a LIST la seconda volta al risultato della prima volta." :non-generic t (reflex-note (reflex-note list (g-min value) 1) (g-max value) 2))

-(define-ompw doppio-reflex-int ((list nil) (value nil)) +(define-box doppio-reflex-int ((list nil) (value nil)) "Restituisce due volte REFLEX-INT la prima volta a LIST la seconda volta al risultato della prima volta." :non-generic t @@ -3430,7 +3429,7 @@

(defun int (elt coppia) (if (< (first coppia) elt (second coppia)) elt nil))

-(define-ompw pass-band ((lista nil) (alt nil)) +(define-box pass-band ((lista nil) (alt nil)) "Restituisce i valori inclusi in ALT." :non-generic t (let ((ris nil)) @@ -3438,7 +3437,7 @@ (if (equalp (int x alt) nil) (int x alt) (push x ris)))))

-(define-ompw correttore-doppio-reflex-note ((list nil) (value nil) (inclu? 1)) +(define-box correttore-doppio-reflex-note ((list nil) (value nil) (inclu? 1)) "Corregge il risultato di 'DOPPIO-REFLEX-NOTE' in modo che se la riflessione supera i limiti con YES abbiamo una trasposizione oltre i limiti stessi ma con TRANS-APPROX altrimenti le note @@ -3453,7 +3452,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." inclu?)))))

-(define-ompw correttore-doppio-reflex-int ((list nil) (value nil)) +(define-box correttore-doppio-reflex-int ((list nil) (value nil)) "Corregge il risultato di 'DOPPIO-REFLEX-INT' in modo che se il risultato di 'DOPPIO-REFLEX-INT supera i limiti dati ripete l'operazione di adattamento fino a che non soddisfa @@ -3467,7 +3466,7 @@ ris))))

-(define-ompw reflexion ((list nil) (axis 6000) (mode? 1) (up/down 1)) +(define-box reflexion ((list nil) (axis 6000) (mode? 1) (up/down 1)) "" :non-generic t :menu (mode? (1 "intrv") (2 "note")) @@ -3481,7 +3480,7 @@ up/down))

-(define-ompw double-reflect ((list nil) (limits 6000) (mode? 1) (inclu? 1)) +(define-box double-reflect ((list nil) (limits 6000) (mode? 1) (inclu? 1)) "" :non-generic t :menu (mode? (1 "intrv") (2 "note")) @@ -3492,7 +3491,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." mode?))))

-(define-ompw comp-octave ((list nil) (range nil)) +(define-box comp-octave ((list nil) (range nil)) "Restituisce una trasposizione della lista mantenendo le altezze assolute all'interno del 'range. Se un elemento non � incluso nel 'range', allora viene tolto dal risultato." @@ -3502,7 +3501,7 @@ (if (equalp (interno y range) nil) (interno y range) (push y ris)))))

-(define-ompw rtm-change ((rhyt nil) (modulo nil) (mode? 1)) +(define-box rtm-change ((rhyt nil) (modulo nil) (mode? 1)) "E' la funzione che cambia un ritmo in funzione del menu MODE? Se MODE? � su mod, questa funzione restituisce i multipli dei valori in MODULI; se � su ptrn allora retituisce una @@ -3516,7 +3515,7 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." mode?)))))

-(define-ompw rtm-change-1 ((rhytm nil) (vals nil)) +(define-box rtm-change-1 ((rhytm nil) (vals nil)) "Se in vals c'� un solo valore allora calcola una approssimazione ritmica in modo tale che tutti i valori risultino un multiplo di vals. Se invece in vals c'� una @@ -3526,7 +3525,7 @@ (let ((vals (list! vals))) (vicini-valori vals rhytm)))

-(define-ompw distanza-modulo ((list nil) (modulo nil)) +(define-box distanza-modulo ((list nil) (modulo nil)) "Caclola per ogni elemento della lista list il modulo corrispondente per ogni elemento della lista Modulo e li raggruppa in sotto-liste." @@ -3536,7 +3535,7 @@ (dolist (x modulo) (push (mod y x) ris)))))

-(define-ompw usa-quel-modulo ((list nil) (moduli nil)) +(define-box usa-quel-modulo ((list nil) (moduli nil)) "Restituisce i valori che sono tutti multupli dei moduli messi in Moduli." :non-generic t @@ -3547,7 +3546,7 @@ (push (- (nth x list) (g-min (nth x calcolo))) ris)))))

-(define-ompw rtm-change-1val ((rht nil) (val 1)) +(define-box rtm-change-1val ((rht nil) (val 1)) "Questa funzione prende ogni elemento di rht e restituisce lo stesso elemento se il (mod rht val) � uguale a 0 altrimenti lo approssima al po� vicino" @@ -3559,7 +3558,7 @@ (push (- y (OM::om// y val)) ris)))))

-(define-ompw tutti-int ((list nil) (ref 1)) +(define-box tutti-int ((list nil) (ref 1)) "Calcola gli intervalli che ci sono fra una lista di note ed un'unica nota di riferimento." :non-generic t @@ -3569,14 +3568,14 @@ (push (OM::x->dx (list ref y)) ris)))))

-(define-ompw segno+picc ((list nil)) +(define-box segno+picc ((list nil)) "Trasforma tutta la lista in valori tutti positivi e prende il valore pi� piccolo." :non-generic t (g-min (mapcar #'(lambda (x) (abs x)) list)))

-(define-ompw nota-vicina ((list nil) (ref 1)) +(define-box nota-vicina ((list nil) (ref 1)) "Prende l'intervallo pi� piccolo di una lista." :non-generic t (let* ((intervalli (tutti-int list ref)) (piccolo (segno+picc intervalli))) @@ -3585,19 +3584,19 @@ (nota-vicina (rest list) ref))))

-(define-ompw tieni-nota ((list nil) (ref 1)) +(define-box tieni-nota ((list nil) (ref 1)) "tiene la nota pi� vicina." :non-generic t (OM::om+ ref (nota-vicina list ref)))

-(define-ompw vicini-valori ((list1 nil) (refs nil)) +(define-box vicini-valori ((list1 nil) (refs nil)) "Prende le note pi� vicine di list per ogni nota di refs." :non-generic t (mapcar #'(lambda (x) (tieni-nota list1 x)) refs))

-(define-ompw arithm-ser2 ((begin 0) (step 1) (xval 5)) +(define-box arithm-ser2 ((begin 0) (step 1) (xval 5)) "Returns a list of XVAL numbers starting from BEGIN with STEP." :non-generic t (algeb begin xval step)) @@ -3613,7 +3612,7 @@ (push (read input-stream) r)) (cddar (reverse r))))

-(define-ompw f0-additive ((step 1) &optional (range (10 4000))) +(define-box f0-additive ((step 1) &optional (range (10 4000))) "Reads f0 additive analysis. step = reads each values at step window (default = 1 (all); range = returns only values (date and frequency) @@ -3639,7 +3638,7 @@ (mat-trans (list (reverse dates) (reverse f0))))))

-(define-ompw pi-dur ((dates nil) (pitches nil) (min 0) (unit 1)) +(define-box pi-dur ((dates nil) (pitches nil) (min 0) (unit 1)) "Calculates de durations of the pitches according to a change in pitch" :non-generic t :menu (unit (1 "sec") (1000 ".001") (10 "1/100")) @@ -3703,7 +3702,7 @@ (let ((r nil)) (dolist (x wlist (nreverse r)) (dotimes (n (/ w 2)) (push x r)))))

-(define-ompw smooth ((list nil) (window 2) (mode 1) &optional (start 0) (end 0)) +(define-box smooth ((list nil) (window 2) (mode 1) &optional (start 0) (end 0)) "Smooth list. INPUT: list : list of values @@ -3790,7 +3789,7 @@ (setf arete (nth n dist))))) arete))

-(define-ompw prim-tree ((dist nil)) +(define-box prim-tree ((dist nil)) "Builds up the shorter tree of the points given in the matrix of distances (list of list), distances must be expressed as ((xi yi di) etc.). prend en entr�e la sortie de ldl-distance en mode extend. @@ -3892,7 +3891,7 @@ (when (> (length substituted) 0) (push (list father substituted) list-of-subst))))))

-(define-ompw s-class ((seq nil) (dist nil) (thresh 0)) +(define-box s-class ((seq nil) (dist nil) (thresh 0)) "Substitute each elt of sequence by its nearest if their distance is equal or lower than threshold and according to the Prim's minimum length tree. Returns the new sequence with substitution and a list of (by (replaced ....))." @@ -3900,7 +3899,7 @@ (substitute-seuil seq dist thresh))

-(define-ompw delta ((list nil) (round 1000)) +(define-box delta ((list nil) (round 1000)) " calcule les diff�rences entre les valeurs cons�cutives avec un arrondi " :non-generic t (let ((l nil) (delta nil)) @@ -3914,7 +3913,7 @@ (remarkable-nodes :initform nil :initarg :remarkable-nodes :accessor remarkable-nodes)))

-(define-ompw draw-tree ((tree nil) &optional (nodes nil) (name nil) +(define-box draw-tree ((tree nil) &optional (nodes nil) (name nil) (fontname "times") (fontsize 12) (fontstyle "normal")) "Draw in a new window a graphic representation of the Prim tree. TREE : a tree list from Prim-tree. @@ -3949,7 +3948,7 @@ tree-wind))

-(define-ompw set-wintree-font (win fontname fontsize fontstyle) +(define-box set-wintree-font (win fontname fontsize fontstyle) (declare (ignore win fontname fontsize fontstyle)) (error "default method. should not be called."))

@@ -3985,7 +3984,7 @@ (fontsize integer) (fontstyle t)) (set-view-font win (list "times" fontsize :bold)))

-(define-ompw view-draw-contents (self) +(define-box view-draw-contents (self) :non-generic t (call-next-method) (let ((h (point-h (view-size self))) (v (point-v (view-size self)))) @@ -3994,7 +3993,7 @@ (make-graph-tree self (tree self) (remarkable-nodes self))))

-(define-ompw window-grow-event-handler (self where) +(define-box window-grow-event-handler (self where) :non-generic t (call-next-method) (invalidate-view self)) @@ -4098,7 +4097,7 @@ x)) coord))))

-(define-ompw ndigit (num) +(define-box ndigit (num) 1)

(defmethod ndigit ((num integer)) @@ -4234,7 +4233,7 @@ (dolist (d dist) (nsubstitute (nth n flags) (nth n list) d :test #'equalp))))

-(define-ompw rep-by-flag (dist list flags) +(define-box rep-by-flag (dist list flags) :non-generic t (rep-by-flag1 dist list flags))

@@ -4370,7 +4369,7 @@ (mapcar #'lul1 (extr-to-extr3 start extremites noeuds)))))) (subseq long-path 0 (1+ (position end long-path :test #'equalp))))))

-(define-ompw path (tree start end) +(define-box path (tree start end) (declare (ignore tree start end)) (error "default method. should not be called."))

@@ -4437,7 +4436,7 @@ (fflat ldl) (lul1 (append (list (lul (car ldl) (cadr ldl))) (cddr ldl)))))

-(define-ompw tree-path ((tree nil) (start nil) (end nil)) +(define-box tree-path ((tree nil) (start nil) (end nil)) "Finds all paths in prim-tree TREE from START to END> Both START end END can be atoms (number, symbols or strings according to the tree) or lists of atoms. @@ -4466,7 +4465,7 @@ (setf (symbol-value name) (make-hash-table :size length))) (print name))

-(define-ompw data-base (name action &optional length) +(define-box data-base (name action &optional length) :non-generic t list "" @@ -4487,7 +4486,7 @@ I was not able to translate this function. Rewrite it by hand! :-P"))

-(define-ompw add-to-data (name) +(define-box add-to-data (name) :non-generic t list ""