[Morphologie-cvs] r15 - trunk/src
ksprotte at common-lisp.net
ksprotte at common-lisp.net
Fri Jul 6 08:24:17 UTC 2007
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
""
More information about the Morphologie-cvs
mailing list