- morphologie-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[Morphologie-cvs] CVS morphologie
by ksprotte 22 Jan '09

22 Jan '09

Update of /project/morphologie/cvsroot/morphologie In directory cl-net:/tmp/cvs-serv10501 Added Files: test-file Log Message: adding a test-file to the repo for testing --- /project/morphologie/cvsroot/morphologie/test-file 2009/01/22 11:32:46 NONE +++ /project/morphologie/cvsroot/morphologie/test-file 2009/01/22 11:32:46 1.1 hi this is just a test file

1 0

[Morphologie-cvs] r29 - trunk/src
by ksprotte＠common-lisp.net 09 Aug '07

09 Aug '07

Author: ksprotte Date: Thu Aug 9 06:45:00 2007 New Revision: 29 Modified: trunk/src/morphologie.lisp Log: small ch Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Thu Aug 9 06:45:00 2007 @@ -76,7 +76,7 @@ (menu-add-symbol l-matrix) ;;; internal-boxes will in fact contain all boxes that follow -(menu-separator) +(menu-separator :in morphologie) (define-menu internal-boxes :in morphologie :print-name "Internal-Boxes") (in-menu internal-boxes)

1 0

[Morphologie-cvs] r28 - in trunk: . src
by ksprotte＠common-lisp.net 09 Aug '07

09 Aug '07

Author: ksprotte Date: Thu Aug 9 05:53:10 2007 New Revision: 28 Modified: trunk/morphologie.asd trunk/src/missing-om-functions.txt trunk/src/morphologie.lisp trunk/src/utils.lisp Log: release 3.0.3 Modified: trunk/morphologie.asd ============================================================================== --- trunk/morphologie.asd (original) +++ trunk/morphologie.asd Thu Aug 9 05:53:10 2007 @@ -4,7 +4,7 @@ #+sbcl (setq sb-impl::*default-external-format* :latin-1) (defsystem :morphologie - :version "3.0.1" + :version "3.0.3" :components ((:static-file "morphologie.asd") (:static-file "load.lisp") @@ -14,4 +14,4 @@ ((:file "package") (:file "utils") (:file "morphologie")))) - :depends-on (:ompw)) + :depends-on (:ompw :ompw-utils)) Modified: trunk/src/missing-om-functions.txt ============================================================================== --- trunk/src/missing-om-functions.txt (original) +++ trunk/src/missing-om-functions.txt Thu Aug 9 05:53:10 2007 @@ -1,18 +1 @@ -om::dx->x -om::arithm-ser -om::x-append -om::create-list -om::om-round -om::g-scaling/sum -om::sort-list -om::om/ -om::posn-match -om::om- -om::nth-random -om::permut-random -om::list-explode -om::om-abs -om::om// -om::flat -om::x->dx -om::om+ +;; there are no more missing functions :) \ No newline at end of file Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Thu Aug 9 05:53:10 2007 @@ -12,13 +12,73 @@ ;;; ;;; the encoding of this file is latin-1 -;;; that's the best common demoninator +;;; that's the best common denominator (in-package :morph) -;;; watch out for functions like OM::.... -;;; still in this file +(define-menu morphologie) +(in-menu morphologie) +(define-menu analysis :in morphologie) +(in-menu analysis) +(menu-add-symbol ptrn-find) +(menu-add-symbol ptrn-reson) +(menu-add-symbol ptrn-smooth) +(menu-add-symbol ins-ptrn) +(menu-add-symbol min-flex-max) +(menu-add-symbol direct-analysis) +(menu-add-symbol find-permut) +(menu-add-symbol contrasts-lev.1) +(menu-add-symbol contrasts-all-lev) +(menu-add-symbol new-old-analysis) +(menu-add-symbol energy-prof-morph-analysis) + +(define-menu structure :in morphologie) +(in-menu structure) +(menu-add-symbol structure-1) +(menu-add-symbol structure-2) + +(define-menu reconstitute :in morphologie) +(in-menu reconstitute) +(menu-add-symbol 1-0-1-reconst) +(menu-add-symbol reconstitute) +(menu-add-symbol struct2-to-seq) + +(define-menu distance :in morphologie) +(in-menu distance) +(menu-add-symbol euclidian-d) +(menu-add-symbol distance) +(menu-add-symbol ldl-distance) +(menu-add-symbol multi-distance) +(menu-add-symbol resemblance) +(menu-add-symbol prim-tree) +(menu-add-symbol tree-path) +(menu-add-symbol draw-tree) + +(define-menu classification :in morphologie) +(in-menu classification) +(menu-add-symbol s-class) +(menu-add-symbol class-1) +(menu-add-symbol meta-class1) +(menu-add-symbol quantize-1) +(menu-add-symbol entropy) +(menu-add-symbol e-test) + +(define-menu utilities :in morphologie) +(in-menu utilities) +(menu-add-symbol delta) +(menu-add-symbol smooth) +(menu-add-symbol midiseq->alpha) +(menu-add-symbol rep-by-flag) +(menu-add-symbol mc->alpha) +(menu-add-symbol str->symb) +(menu-add-symbol concatstrings) +(menu-add-symbol l-matrix) + +;;; internal-boxes will in fact contain all boxes that follow +(menu-separator) +(define-menu internal-boxes :in morphologie :print-name "Internal-Boxes") +(in-menu internal-boxes) ;; I tried to get this version of LIST-MODULO to run - but there is a problem ;; with this code. @@ -37,14 +97,6 @@ ;; :do (push (remove nil (nreverse (svref vector i))) res)) ;; (nreverse res))) -(define-menu morphologie) -(in-menu morphologie) - -;;; until all OM symbols are out -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package :om) - (defpackage :om (:use :cl)))) - (define-box list-modulo (list &optional ncol) "partitions LIST in NCOL lists containing the elements modulo NCOL" :non-generic t @@ -244,7 +296,7 @@ (remove-if #'(lambda (x) (< (cadr x) max)) list))) (define-box ptrn-reson ((list (a b c a b c b b b b a a)) (windw 5) &optional - (step nil) (set nil)) + (step nil) (set nil)) "Avance dans la sequence LIST avec avec une taille de fenetre WINDW et un pas d'avancement (optionnel) STEP . Renvoie pour chaque fen�tre le nombre d'occurrences d'un �l�ment. @@ -345,7 +397,7 @@ (push (list seqa i) r)))))))) (define-box find-permut ((seq nil) (output :permut) &optional (length nil) - (ptrn nil)) + (ptrn nil)) "Renvoie les permutations de deux elements de la sequence SEQ> deux modes : PERMUTATION renvoie les segments d'elements permutes, POSITION renvoie les segments d'elements et leurs positions dans la sequence. @@ -373,11 +425,9 @@ (mapcar #'car r) (mapcar #'(lambda (x) (mapcar #'car x)) r))))))) -(menu-separator) - (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)) + (ins/sup 1.0) (inex 0.0) (scale :abs) + (result :short)) "Estimates the distances between lists of symbols. INPUT l-seq : list of lists of symbols; @@ -738,7 +788,7 @@ (format stream "~%~%")))) (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)) + (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. @@ -1112,7 +1162,7 @@ lisse2)))))) (define-box rma-1 ((seq nil) (smoo1 1) (levels 1) &optional (smoo2 0) - (alpha? 1) (result 0)) + (alpha? 1) (result 0)) " m�me fonction que structure-1, mais r�cursive : s'applique aussi aux structures trouv�es, avec LEVELS @@ -1451,7 +1501,7 @@ (position-if #'match list-dom))) (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 3)) + &optional (prof 1) (set nil) (marg 3)) "Finds the pattern(s) PTRN in list seq with or without up to a number prof inserted items; Return each pattern and its start positions. @@ -1541,7 +1591,7 @@ (define-box structure-2 ((seq nil) (n-max 10) (alpha? 1) (result 0) &optional - (length nil) (seuil 10)) + (length nil) (seuil 10)) "INPUT seq = sequence of nums or symbols; n-max = maximum number of patterns accepted in structure of seq; @@ -1667,7 +1717,7 @@ (calcoletto (mapcar #'(lambda (x) (first x)) compl)) (calcolaccio (dolist (k calcoletto (nreverse ros)) - (push (OM::posn-match list-of-pat k) ros)))) + (push (ompw-utils:posn-match list-of-pat k) ros)))) (mat-trans (list calcolo calcolaccio)))) (define-box forma ((analys nil) (seq nil) (seuil 1)) @@ -1784,7 +1834,7 @@ (define-box class-1 ((matrix nil) (n 2) &optional (alpha? 0) (centers nil) - (verbose :no)) + (verbose :no)) "Clustering 'mouving-clouds' algorithm. Classify elements in matrix of d-dimensions into n classes. The nth element in result-list corresponds to the nth element (line) of matrix. @@ -2452,9 +2502,9 @@ (reverse (remove-duplicates r :key #'cadr)))) (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)) + (6000 4000 5600 4700 4100 5900 6400 7800 7400 6300 + 6800 8300 5900)) + (result 1) &optional (d-cte nil)) "analyse une sequence en detectant trois formes primitives: minima: element pr�c�d� et suivi par un �l�ment de valeur plus grande. @@ -2500,7 +2550,7 @@ renvoie une liste de points depuis une liste d'intervalles . commence � zero" :non-generic t - (OM::dx->x 0 list)) + (ompw-utils:dx->x 0 list)) (define-box reconst-prim (list start) @@ -2565,32 +2615,32 @@ :non-generic t (let ((ris nil) (start 0)) (dolist (y list - (OM::flat + (ompw-utils:flat (if (equalp "flex" (first (first list))) (nreverse ris) (cons start (nreverse ris))))) (push (cond ((equalp (first y) "min") - (rest (OM::x-append - (OM::arithm-ser start (* -1 (second y)) -1) - (rest (OM::arithm-ser (* -1 (second y)) start - 1))))) + (rest (ompw-utils:x-append + (ompw-utils:arithm-ser start (* -1 (second y)) -1) + (rest (ompw-utils:arithm-ser (* -1 (second y)) start + 1))))) ((equalp (first y) "max") - (rest (OM::x-append - (OM::arithm-ser start (second y) 1) - (rest (OM::arithm-ser (second y) start -1))))) + (rest (ompw-utils:x-append + (ompw-utils:arithm-ser start (second y) 1) + (rest (ompw-utils:arithm-ser (second y) start -1))))) ((equalp (first y) "flex") - (OM::create-list (second y) start))) + (make-list (second y) :initial-element start))) ris)))) (defun rec-st-2 (struct |N�| &optional seq) (let* ((rs (nth |N�| struct)) (risultato - (mapcar #'(lambda (x) (OM::flat (nth x (cadr rs)))) + (mapcar #'(lambda (x) (ompw-utils:flat (nth x (cadr rs)))) (mapcar #'1- (cadar rs))))) (if seq - (mapcar #'(lambda (x) (nth x seq)) (OM::flat risultato)) - (OM::flat risultato)))) + (mapcar #'(lambda (x) (nth x seq)) (ompw-utils:flat risultato)) + (ompw-utils:flat risultato)))) (define-box struct2-to-seq ((struct nil) (n nil) &optional ptrns) "Reconstruit une s�quence correspondant � la structure donn�e en struct. @@ -2616,9 +2666,9 @@ pi� eventualmente l'indice di profondit�" :non-generic t (let ((ris nil)) - (dotimes (x (length list) (OM::flat (nreverse ris))) + (dotimes (x (length list) (ompw-utils:flat (nreverse ris))) (push (cond ((equalp (first (nth x list)) "max") - (OM::x-append + (ompw-utils:x-append (arithm-ser2 start (* -1 (/ (- start (second (nth x list))) (third (nth x list)))) @@ -2627,7 +2677,7 @@ (/ (- start (second (nth x list))) (third (nth x list))) (third (nth x list))))) ((equalp (first (nth x list)) "min") - (OM::x-append + (ompw-utils:x-append (arithm-ser2 start (* -1 (/ (- start (second (nth x list))) (third (nth x list)))) @@ -2636,8 +2686,8 @@ (/ (- start (second (nth x list))) (third (nth x list))) (third (nth x list))))) ((equalp (first (nth x list)) "flex") - (OM::create-list (third (nth x list)) - (second (nth x list))))) + (make-list (third (nth x list)) + :initial-element (second (nth x list))))) ris)))) @@ -2647,7 +2697,7 @@ :non-generic t (let ((ris nil) (valore nil)) (dotimes (x (length list) - (OM::flat (OM::x-append (nreverse ris) start))) + (ompw-utils:flat (ompw-utils:x-append (nreverse ris) start))) (cond ((and (and (equalp (second (nth x list)) "min") (= x 0)) (< start (third (nth x list)))) (format t @@ -2660,10 +2710,10 @@ (abort)) ((and (equalp (second (nth x list)) "min") (= x 0)) (setf valore - (OM::x-append + (ompw-utils:x-append (arithm-ser2 start (* -1.0 - (abs (OM::om-round + (abs (ompw-utils:m-round (/ (- (third (nth 0 list)) start) (fourth (nth 0 list)))))) (fourth (nth 0 list))) @@ -2671,10 +2721,10 @@ (push valore ris)) ((and (equalp (second (nth x list)) "max") (= x 0)) (setf valore - (OM::x-append + (ompw-utils:x-append (arithm-ser2 start (* 1.0 - (abs (OM::om-round + (abs (ompw-utils:m-round (/ (- (third (nth 0 list)) start) (fourth (nth 0 list)))))) (fourth (nth 0 list))) @@ -2682,10 +2732,10 @@ (push valore ris)) ((equalp (second (nth x list)) "min") (setf valore - (OM::x-append + (ompw-utils:x-append (rest (arithm-ser2 (first (last valore)) (* -1.0 - (abs (OM::om-round + (abs (ompw-utils:m-round (/ (- (third (nth x list)) (third (nth (- x 1) list))) (- (first (nth x list)) @@ -2700,10 +2750,10 @@ (push valore ris)) ((equalp (second (nth x list)) "max") (setf valore - (OM::x-append + (ompw-utils:x-append (rest (arithm-ser2 (first (last valore)) (* 1.0 - (abs (OM::om-round + (abs (ompw-utils:m-round (/ (- (third (nth x list)) (third (nth (- x 1) list))) (- (first (nth x list)) @@ -2718,8 +2768,8 @@ (push valore ris)) ((equalp (second (nth x list)) "flex") (setf valore - (OM::create-list (fourth (nth x list)) - (third (nth x list)))) + (make-list (fourth (nth x list)) + :initial-element (third (nth x list)))) (push valore ris)))))) @@ -2729,8 +2779,8 @@ :non-generic t (let* ((ris nil) (ros nil) - (ottave1 (OM::om// (OM::om// list1 1200) modul)) - (ottave2 (OM::om// (OM::om// list2 1200) modul)) + (ottave1 (ompw-utils:m-floor (ompw-utils:m-floor list1 1200) modul)) + (ottave2 (ompw-utils:m-floor (ompw-utils:m-floor list2 1200) modul)) (studio (dotimes (x (length ottave1) (nreverse ris)) (push (- (nth x ottave1) (nth x ottave2)) ris)))) @@ -2755,8 +2805,8 @@ "Studia gli intervalli di due liste e ne fa una analisi" :non-generic t (let ((ris nil) - (intervalli1 (OM::x->dx list1)) - (intervalli2 (OM::x->dx list2))) + (intervalli1 (ompw-utils:x->dx list1)) + (intervalli2 (ompw-utils:x->dx list2))) (dotimes (x (length intervalli1) (apply '+ (nreverse ris))) (when (not (equalp (nth x intervalli1) (nth x intervalli2))) (push 1 ris))))) @@ -2770,12 +2820,12 @@ (ros nil) (rapporto1 (dotimes (x (- (length list1) 1) (nreverse ris)) - (push (OM::om-round + (push (ompw-utils:m-round (/ (abs (nth (+ 1 x) list1)) (abs (nth x list1))) 2) ris))) (rapporto2 (dotimes (k (- (length list2) 1) (nreverse ros)) - (push (OM::om-round + (push (ompw-utils:m-round (/ (abs (nth (+ 1 k) list2)) (abs (nth k list2))) 2) ros)))) (if (equalp rapporto1 rapporto2) 'ok 'no))) @@ -2801,12 +2851,12 @@ (rus nil) (rapporto1 (dotimes (x (- (length list1) 1) (nreverse ris)) - (push (OM::om-round + (push (ompw-utils:m-round (/ (abs (nth (+ 1 x) list1)) (abs (nth x list1))) 2) ris))) (rapporto2 (dotimes (k (- (length list2) 1) (nreverse ros)) - (push (OM::om-round + (push (ompw-utils:m-round (/ (abs (nth (+ 1 k) list2)) (abs (nth k list2))) 2) ros)))) (if (equalp rapporto1 rapporto2) (push 1 rus)))) @@ -2815,7 +2865,7 @@ (defun mini (l) "Returns the minimum value of a list" (car (sort l '<))) (define-box dist-1-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) - (wgth (1 1 1 1))) + (wgth (1 1 1 1))) "" :non-generic t (cond ((not (equalp (length (car seq1)) (length (car seq2)))) @@ -2831,7 +2881,7 @@ "~%WARNING : bad definition of wgth; setting all weigths to the first of wgth list...~%Look at the documentation.") (make-list (length (car seq1)) :initial-element (car wgth))) (t wgth)))) - (setf wgth (OM::g-scaling/sum wgth 1.0)) + (setf wgth (ompw-utils:m-scaling/sum wgth 1.0)) (dotimes (x (length matrix1) (sqrt ris)) (setf ris (+ ris @@ -2841,7 +2891,7 @@ (define-box dist-2-ldl ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) - (wgth (1 1 1 1))) + (wgth (1 1 1 1))) "" :non-generic t (cond ((not (equalp (length (car seq1)) (length (car seq2)))) @@ -2857,7 +2907,7 @@ "~%WARNING : bad definition of wgth; setting all weigths to the first of wgth list...~%Look at the documentation.") (make-list (length (car seq1)) :initial-element (car wgth))) (t wgth)))) - (setf wgth (OM::g-scaling/sum wgth 1.0)) + (setf wgth (ompw-utils:m-scaling/sum wgth 1.0)) (dotimes (x (length matrix1) (sqrt ris)) (setf ris (+ ris @@ -2911,7 +2961,7 @@ (define-box dist-2 ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) (inex 0) - (scale 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 @@ -2978,7 +3028,7 @@ (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)) + (ins/sup 1) (scale 1) &optional (inex nil)) "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 @@ -2995,7 +3045,7 @@ (define-box multi-distance ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1) - (wgth (1 1 1 1)) &optional (inex nil)) + (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) pour chaque �l�ment (ou position) des listes." @@ -3026,7 +3076,7 @@ (mapcar #'(lambda (e) (position e list :test #'equalp)) list)) (define-box resemblance ((a nil) (b nil) (wocc 1.0) (wref 1.0) &optional - (diff :res)) + (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. Wocc : poids de la structure d'occurence; @@ -3079,13 +3129,13 @@ (dotimes (x (- (length lista) 1) (nreverse ris)) (push (/ (+ (nth x lista) (nth (1+ x) lista)) 2) ris)))) -(define-box 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 - (if (= 1 GR\�) + (if (= 1 GR) (med-fix list) - (mean-derivation (med-fix list) (- GR\� 1) note?))) + (mean-derivation (med-fix list) (- GR 1) note?))) (con-note (when note? (notes-change calcolo note? 48)))) (if note? con-note calcolo))) @@ -3106,13 +3156,13 @@ (push (/ (apply '+ (nth x calcolo)) (length (nth x calcolo))) ris)))) -(define-box 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 - (if (= 1 GR\�) + (if (= 1 GR) (med-var lista windw) - (variable-derivation (med-var lista windw) (- GR\� 1) windw))) + (variable-derivation (med-var lista windw) (- GR 1) windw))) (define-box notes-change ((pits 6000) (scale 6000) &optional (mod 12)) @@ -3121,24 +3171,24 @@ (let* ((pits (list! pits)) (scale (list! scale)) (modsca - (OM::om// - (OM::sort-list + (ompw-utils:m-floor + (sort-list (remove-duplicates - (OM::om// (OM::om/ scale (/ 100 (/ mod 12))) - mod))))) + (ompw-utils:m-floor (ompw-utils:m/ scale (/ 100 (/ mod 12))) + mod))))) (pitmods - (OM::om// (OM::om/ pits (/ 100 (/ mod 12))) mod)) + (ompw-utils:m-floor (ompw-utils:m/ pits (/ 100 (/ mod 12))) mod)) (octa (octave pits)) (posdifs (mapcar #'(lambda (p) (position (g-min - (OM::om-abs - (OM::om- modsca p))) - (OM::om-abs - (OM::om- modsca p)))) + (ompw-utils:m-abs + (ompw-utils:m- modsca p))) + (ompw-utils:m-abs + (ompw-utils:m- modsca p)))) pitmods))) (mapcar #'(lambda (index octave) (makenote index octave mod)) - (OM::posn-match modsca posdifs) + (ompw-utils:posn-match modsca posdifs) octa))) @@ -3146,7 +3196,7 @@ "retourne l'octave � partir de c3=octave 3" :non-generic t (let ((midic (list! midic))) - (mapcar #'(lambda (x) (OM::om- (OM::om// x 1200) 2)) + (mapcar #'(lambda (x) (ompw-utils:m- (ompw-utils:m-floor x 1200) 2)) midic))) @@ -3172,7 +3222,7 @@ "Prepara interlock : non mi ricordo cosa fa esattamente." :non-generic t (let ((ris nil) (y (lettura-modulare list1 list2))) - (OM::flat + (ompw-utils:flat (append (dotimes (x (1- (length list1)) (nreverse ris)) (push (mat-trans (list (list (nth x list1)) @@ -3201,27 +3251,27 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." total)))) -(define-box 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 - (if (= GR\� 1) - (inter-profile list1 (OM::permut-random list2)) - (interlock (inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\� 1)))) + (if (= GR 1) + (inter-profile list1 (ompw-utils:permute-random list2)) + (interlock (inter-profile list1 (ompw-utils:permute-random list2)) + (permut-circ list2 (1- (length list1))) (- GR 1)))) (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))) - (OM::flat + (ompw-utils:flat (append (dotimes (x (1- (length list1)) (nreverse ris)) (push (mat-trans (list (list (nth x list1)) (list - (OM::om+ - (OM::nth-random + (ompw-utils:m+ + (ompw-utils:nth-random (list 1200 0 -1200)) (trans-approx (list (nth x y)) @@ -3232,33 +3282,33 @@ (last list1))))) -(define-box 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 - (if (= GR\� 1) - (new-inter-profile list1 (OM::permut-random list2)) - (new-interlock (new-inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\� 1)))) + (if (= GR 1) + (new-inter-profile list1 (ompw-utils:permute-random list2)) + (new-interlock (new-inter-profile list1 (ompw-utils:permute-random list2)) + (permut-circ list2 (1- (length list1))) (- GR 1)))) (defun int-com-ottava (lista) "Restituisce l'intervallo complementare ad ull'intervallo in 'lista' ma all'interno di un'ottava." (let ((ris nil)) - (OM::flat + (ompw-utils:flat (dotimes (x (- (length lista) 1) (nreverse ris)) - (push (OM::x->dx + (push (ompw-utils:x->dx (append (list (nth x lista)) (list (- (nth x lista) (* (- 12 (mod (/ (- - (first (OM::x->dx lista)) + (first (ompw-utils:x->dx lista)) (* (first - (OM::om// - (OM::x->dx lista) + (ompw-utils:m-floor + (ompw-utils:x->dx lista) 1200)) 1200)) 100) @@ -3322,10 +3372,10 @@ des valeurs donn�es en entr�e." :non-generic t (let ((ris nil)) - (dotimes (x (length (OM::x->dx list)) (nreverse ris)) - (cond ((> (nth x (OM::x->dx list)) 0) (push '1 ris)) - ((< (nth x (OM::x->dx list)) 0) (push '-1 ris)) - ((= (nth x (OM::x->dx list)) 0) (push '0 ris)))))) + (dotimes (x (length (ompw-utils:x->dx list)) (nreverse ris)) + (cond ((> (nth x (ompw-utils:x->dx list)) 0) (push '1 ris)) + ((< (nth x (ompw-utils:x->dx list)) 0) (push '-1 ris)) + ((= (nth x (ompw-utils:x->dx list)) 0) (push '0 ris)))))) (defun int-com (lista) @@ -3333,27 +3383,27 @@ prima nota dell'intervallo stesso. Questo significa che se ho SOL3 DO4, la funzione restituisce do4 sol4." (let ((ris nil)) - (OM::flat + (ompw-utils:flat (dotimes (x (- (length lista) 1) (nreverse ris)) - (push (OM::x->dx + (push (ompw-utils:x->dx (append (list (nth x lista)) (list (- (- (nth x lista) (* (- 12 (mod (/ (- - (first (OM::x->dx lista)) + (first (ompw-utils:x->dx lista)) (* (first - (OM::om// - (OM::x->dx lista) + (ompw-utils:m-floor + (ompw-utils:x->dx lista) 1200)) 1200)) 100) 12)) 100)) - (* (first (OM::om// - (OM::x->dx lista) + (* (first (ompw-utils:m-floor + (ompw-utils:x->dx lista) 1200)) 1200))))) ris))))) @@ -3468,7 +3518,7 @@ i limiti di esistenza." :non-generic t (let ((risultato (doppio-reflex-int list value)) (ris nil)) - (dolist (y risultato (OM::flat (nreverse ris))) + (dolist (y risultato (ompw-utils:flat (nreverse ris))) (push (if (int y value) y (correttore-doppio-reflex-int (list! (1+ y)) value)) @@ -3540,7 +3590,7 @@ li raggruppa in sotto-liste." :non-generic t (let ((ris nil)) - (dolist (y list (OM::list-explode (nreverse ris) (length list))) + (dolist (y list (ompw-utils:list-explode (nreverse ris) (length list))) (dolist (x modulo) (push (mod y x) ris))))) @@ -3548,7 +3598,7 @@ "Restituisce i valori che sono tutti multupli dei moduli messi in Moduli." :non-generic t - (let ((ris nil) (calcolo (distanza-modulo list (OM::om-abs moduli)))) + (let ((ris nil) (calcolo (distanza-modulo list (ompw-utils:m-abs moduli)))) (dotimes (x (length list) (nreverse ris)) (if (subsetp (list 0) (list! (nth x calcolo)) :test #'equal) (push (nth x list) ris) @@ -3562,19 +3612,19 @@ :non-generic t (let ((ris nil)) (dolist (y rht (nreverse ris)) - (if (= (OM::om// y val) 0) + (if (= (ompw-utils:m-floor y val) 0) (push y ris) - (push (- y (OM::om// y val)) ris))))) + (push (- y (ompw-utils:m-floor y val)) ris))))) (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 - (OM::flat + (ompw-utils:flat (let ((ris nil)) (dolist (y list (nreverse ris)) - (push (OM::x->dx (list ref y)) ris))))) + (push (ompw-utils:x->dx (list ref y)) ris))))) (define-box segno+picc ((list nil)) @@ -3596,7 +3646,7 @@ (define-box tieni-nota ((list nil) (ref 1)) "tiene la nota pi� vicina." :non-generic t - (OM::om+ ref (nota-vicina list ref))) + (ompw-utils:m+ ref (nota-vicina list ref))) (define-box vicini-valori ((list1 nil) (refs nil)) @@ -3923,7 +3973,7 @@ remarkable-nodes))) (define-box draw-tree ((tree nil) &optional (nodes nil) (name nil) - (fontname "times") (fontsize 12) (fontstyle :normal)) + (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. Optional arguments : @@ -4501,9 +4551,130 @@ "" (add-to-datase name)) -;;; just a test - I will remove it -(menu-separator) -(menu-add-symbol +) + +;;; Paolo Aralla code + +(define-box contrasts-lev.1 (sequence) + :non-generic t + "The Analysis of the Contrasts, formulated by Herv� Rivi�re and Frederic Voisin, and implemented in the OpenMusic Morphologie Library, is a model able to describe the becoming of the form in the time. +It points out the hierarchic relation created by the temporal sequence of the events: in fact, for the mnemonic activity, each event is datum point for every following event and datum point for the previous ones. +The numerical transcription carried out through the Analysis of Contrasts describes the entry order of the events in the time. +We could define the numerical transcription created using the analysis of contrasts as morphological structure of the entry order of the events. +From this starting point it is possible to identify the presence of internal patterns and analyse their potential capacity to describe and re-establish the form in its original status. + +exemple: Contrasts-lev.1 (a d f g f) ------> (1 2 3 4 3) +" + :icon + 128 + (let* ((elements (reverse (remove-duplicates (reverse sequence)))) ; TODO use from-end t + (order (ompw-utils:arithm-ser 1 (length elements) 1)) + (analisis-contrasts-level.1 + (mapcar #'(lambda (x y) + (mapcar #'(lambda (z) (if (equalp x z) y 'nil)) sequence)) + elements + order))) + (ompw-utils:flat (ompw-utils:mat-trans (mapcar #'(lambda (list) (remove nil list)) analisis-contrasts-level.1))))) + + +(define-box contrasts-all-lev (sequence) + :non-generic t + "The Analysis of the Contrasts, formulated by Herv� Rivi�re and Frederic Voisin, and implemented in the OpenMusic Morphologie Library, is a model able to describe the becoming of the form in the time. +It points out the hierarchic relation created by the temporal sequence of the events: in fact, for the mnemonic activity, each event is datum point for every following event and datum point for the previous ones. +The numerical transcription carried out through the Analysis of Contrasts describes the entry order of the events in the time. +We could define the numerical transcription created using the analysis of contrasts as morphological structure of the entry order of the events. +From this starting point it is possible to identify the presence of internal patterns and analyse their potential capacity to describe and re-establish the form in its original status. + +exemple: Contrasts-all-lev (a d f g f) ------> ((1 2 3 4 3) (1 2 3 2) (1 2 1) (1 2))" + :icon + 128 + (let* ((counter-sequence (ompw-utils:arithm-ser (length sequence) 1 -1)) + (contrasts-lev.1-for-all-level + (mapcar #'(lambda (x) + (contrasts-lev.1 (last sequence x))) + counter-sequence))) + (butlast contrasts-lev.1-for-all-level))) + + +(define-box new-old-analysis ((sequence (a b c d e f g a b c h u i o p))) + "The analysis of contrasts, which is the function at heart of the Morphologie Library developed by Jacopo Baboni Schilingi and Frederic Voisin, identifies the occurrences within any sequence of events. +Such analysis is of quantitative type, and has considerable development potentialities towards a qualitative description of the processes that put in relation morphologic structure of the message, mnemonic�perceptive activity and psychic response. +The hierarchies that the analysis of contrasts describes become qualitatively pertinent to the mnemonic activity. +We have called New/Old Analysis the function that describes the newness level of an event in relation to the context in which it appears. +The importance of such a function is crucial, because it describes from the point of view of the psychic response the different newness level of the single event in the time. +The steps to define New/Old Analysis are three: + +1. Measurement of the distances: +it allows to quantify the local distance between the different events in relation to their first appearance in the time. + +\(defun distances (sequence) + (mapcar #' (lambda (x) (x->dx x)) (Contrasts-all-lev sequence))) + +2. Attribution of different weights to the datum points: +this step is crucial, because it strengthens the global hierarchy among the various analysis level in relation to the time parameter. + +\(defun weights (sequence) + (mapcar #' (lambda (x) (apply '+ x)) + (Contrasts-all-lev sequence))) + +3. Application of weights to the distances: +this further step is just the application of different weights - obtained considering every time one of the events as datum point (global parameter, ex. nr. 3) +- to the distances between the various contiguous events (local parameter). + +\(defun Contrasts-lev.1*weights (sequence) + (mapcar #' (lambda (x y) (om* y x)) + (distances sequence) (weights sequence))) + +;-------- + +\(defun Contrasts-all-lev*weights (sequence) + (reverse (mapcar #' (lambda (xx) (apply '+ xx)) + (mat-trans (mapcar #' (lambda (x) (reverse x)) (Contrasts-lev.1*weights sequence)))))) + +A theoretical problem we have faced is the relation between the object we have analysed and the previous and following events. +Any events chain perceived as belonging to a whole and complete organism stays anyway in relation with the previous and following sequential chain. +In case of performance of a music piece, the silence acts as a frame of the structure, and, being a frame, it becomes organic element of the structure analysed. +It is worth to underline that even in case of extrapolation, like in the here quoted examples (a thematic fragment, a subject of a fugue, etc.), +the object is perceived as an unit, and therefore the silence places it in a well defined mental space. + +\(x-append 'symbol-silence-start sequence 'symbol-silence-end) +" + :non-generic t + (let* ((sequence-whit-silence-start-end + (ompw-utils:x-append 'symbol-silence-start sequence + 'symbol-silence-end)) + (distances + (mapcar #'(lambda (x) (ompw-utils:x->dx x)) + (contrasts-all-lev sequence-whit-silence-start-end))) + (weights + (mapcar #'(lambda (x) (apply '+ x)) + (contrasts-all-lev sequence-whit-silence-start-end))) + (contrasts-lev.1*weights + (mapcar #'(lambda (x y) (ompw-utils:m* y x)) distances weights)) + (contrasts-all-lev*weights + (reverse (mapcar #'(lambda (xx) (apply '+ xx)) + (ompw-utils:mat-trans (mapcar + #'(lambda (x) (reverse x)) + contrasts-lev.1*weights)))))) + (butlast contrasts-all-lev*weights))) + + +(define-box energy-prof-morph-analysis (sequence) + :non-generic t + " +The step that allows to transform the New/Old Analysis function into a model able to simulate the psychic response of the perceptive act to the morphologic structure occurs using three functions. +Then, to this the three functions apply allowing to define the energy profile. +1. In the first passage, the transformation into absolute abs value contains all the relations with reference to the first element of the chain. +At this point, the data don't represent the ageing degree of the events anymore, but they are mere distance (it doesn't matter if they are old or new, they are to be intended nearly as physical distance between the various data stored in space/memory) related to a virtual point zero (a kind of possible present) +2. In the second passage, the use of the local derivative, implemented in OpenMusic under the name of x-->dx, the contiguous relations are again pointed out, and the distance identified in the first passage is assimilated to the energy needed to cover the contiguous distances in the space/memory +3 - Finally, the transformation into absolute abs value, because of the transformation of the distances into energy, brings all the data back to positive values. +" + :icon + 128 + (let* ((analysis-old-new (cons '0 (new-old-analysis sequence))) + (absolute-value (ompw-utils:m-abs analysis-old-new)) + (local-derivative (ompw-utils:x->dx absolute-value)) + (absolute-value2 (ompw-utils:m-abs local-derivative))) + absolute-value2)) (install-menu morphologie) Modified: trunk/src/utils.lisp ============================================================================== --- trunk/src/utils.lisp (original) +++ trunk/src/utils.lisp Thu Aug 9 05:53:10 2007 @@ -27,6 +27,12 @@ res))) (nreverse res))) +;;; TODO rename this to deep-sort-list +(defun sort-list (list &optional (pred '<)) + (cond ((null list) nil) + ((atom (first list)) (sort list pred)) + (t (cons (sort-list (first list) pred) (sort-list (rest list) pred))))) + (defun flat-once (list) (if (consp (car list)) (apply 'append list) list))

1 0

[Morphologie-cvs] r27 - trunk
by ksprotte＠common-lisp.net 01 Aug '07

01 Aug '07

Author: ksprotte Date: Wed Aug 1 14:31:25 2007 New Revision: 27 Modified: trunk/morphologie.asd Log: ch Modified: trunk/morphologie.asd ============================================================================== --- trunk/morphologie.asd (original) +++ trunk/morphologie.asd Wed Aug 1 14:31:25 2007 @@ -7,6 +7,7 @@ :version "3.0.1" :components ((:static-file "morphologie.asd") + (:static-file "load.lisp") (:module :src :serial t :components

1 0

[Morphologie-cvs] r26 - in trunk: . src
by ksprotte＠common-lisp.net 01 Aug '07

01 Aug '07

Author: ksprotte Date: Wed Aug 1 13:54:59 2007 New Revision: 26 Modified: trunk/morphologie.asd trunk/src/morphologie.lisp Log: (alpha? :alpha) (verbose :no) Modified: trunk/morphologie.asd ============================================================================== --- trunk/morphologie.asd (original) +++ trunk/morphologie.asd Wed Aug 1 13:54:59 2007 @@ -4,7 +4,7 @@ #+sbcl (setq sb-impl::*default-external-format* :latin-1) (defsystem :morphologie - :version "3.0" + :version "3.0.1" :components ((:static-file "morphologie.asd") (:module :src Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Wed Aug 1 13:54:59 2007 @@ -2125,8 +2125,8 @@ (setf class (str->symb class)) (entropy class res)) -(define-box meta-class1 ((matrix nil) (n 2) (iter 1) &optional alpha? centers - verbose) +(define-box meta-class1 ((matrix nil) (n 2) (iter 1) &optional (alpha? :alpha) centers + (verbose :no)) "Does n iterations of class-1 algorithm. The classes designation is normalized." :non-generic t

1 0

[Morphologie-cvs] r25 - trunk/src
by ksprotte＠common-lisp.net 20 Jul '07

20 Jul '07

Author: ksprotte Date: Fri Jul 20 11:17:04 2007 New Revision: 25 Modified: trunk/src/morphologie.lisp Log: I changed ES to DS Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Fri Jul 20 11:17:04 2007 @@ -601,7 +601,7 @@ "~D~D" (nth note-number '("C" "CN+" "CS--" "CS-" "CS" "CS+" "CS++" "DN-" "D" - "DN+" "DS--" "DS-" "ES" "DS+" "DS++" "EN-" "E" "EN+" + "DN+" "DS--" "DS-" "DS" "DS+" "DS++" "EN-" "E" "EN+" "ES--" "ES-" "F" "FN+" "FS--" "FS-" "FS" "FS+" "FS++" "GN-" "G" "GN+" "GS--" "GS-" "GS" "GS+" "GS++" "AN-" "A" "AN+" "AS--" "AS-" "BF" "AS+" "AS++" "BN-" "B"

1 0

[Morphologie-cvs] r24 - trunk/src
by ksprotte＠common-lisp.net 20 Jul '07

20 Jul '07

Author: ksprotte Date: Fri Jul 20 10:46:59 2007 New Revision: 24 Modified: trunk/src/morphologie.lisp Log: small fix to mc->alpha; also (intern ... "MORPH") Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Fri Jul 20 10:46:59 2007 @@ -607,7 +607,7 @@ "A" "AN+" "AS--" "AS-" "BF" "AS+" "AS++" "BN-" "B" "BN+" "BS--" "BS-")) octave-number) - "MORPH2"))) + "MORPH"))) (defun mc-to-name (midicents &optional (approx 0)) @@ -628,7 +628,7 @@ (define-box mc->alpha ((midicents nil) approx) :non-generic t - (mc->alpha midicents approx)) + (mc->alpha1 midicents approx)) (define-box concatstrings ((lofstrings nil))

1 0

[Morphologie-cvs] r23 - in trunk: . src
by ksprotte＠common-lisp.net 15 Jul '07

15 Jul '07

Author: ksprotte Date: Sun Jul 15 10:27:06 2007 New Revision: 23 Modified: trunk/morphologie.asd trunk/src/morphologie.lisp trunk/src/utils.lisp Log: file-dialog and external-format :latin-1 Modified: trunk/morphologie.asd ============================================================================== --- trunk/morphologie.asd (original) +++ trunk/morphologie.asd Sun Jul 15 10:27:06 2007 @@ -1,5 +1,8 @@ (in-package :asdf) +;; This is a hack to read latin-1 instead of utf-8 +#+sbcl (setq sb-impl::*default-external-format* :latin-1) + (defsystem :morphologie :version "3.0" :components Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Sun Jul 15 10:27:06 2007 @@ -5,12 +5,15 @@ ;;;* IRCAM, Paris, november 1998 for Morphologie 1.0 * ;;;* may 1999 for Morphologie 2.0 * ;;;* * -;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles géometriques * +;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles g�ometriques * ;;;* Analysis fonctions, pattern recognition and morphological classification of geometric profiles * ;;;* * ;;;************************************************************************************************************* ;;; +;;; the encoding of this file is latin-1 +;;; that's the best common demoninator + (in-package :morph) ;;; watch out for functions like OM::.... @@ -142,7 +145,7 @@ (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." + cui pu� essere scomposta la sequenza in lista." :non-generic t (let ((ris nil) (x (scom lista n)) y) (loop :while x @@ -244,8 +247,8 @@ (step nil) (set nil)) "Avance dans la sequence LIST avec avec une taille de fenetre WINDW et un pas d'avancement (optionnel) STEP . -Renvoie pour chaque fenêtre le nombre d'occurrences d'un élément. -L'entrée optionnelle SET specifie les segments recherches dans LIST>" +Renvoie pour chaque fen�tre le nombre d'occurrences d'un �l�ment. +L'entr�e optionnelle SET specifie les segments recherches dans LIST>" :non-generic t (count-ptrn-win list windw step set)) @@ -348,8 +351,8 @@ les segments d'elements et leurs positions dans la sequence. optionnels : - LENGTH : longueur des segments. 2 par defaut. -- PTRN : segment dont les permutations sont recherchés. -tous par défaut. desactive LENGTH> +- PTRN : segment dont les permutations sont recherch�s. +tous par d�faut. desactive LENGTH> Returns all permutations of two elements in SEQ with their respective positions in seq. @@ -446,7 +449,7 @@ (defparameter **alpha** (quote (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z - #\°))) + #\�))) (defparameter **num** (quote (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) @@ -736,24 +739,24 @@ (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. + "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. INPUT -seq : séquence de symboles ou nombres (liste); -alpha? : résultat en mode alphabétique ou numérique (YES NO), optional; +seq : s�quence de symboles ou nombres (liste); +alpha? : r�sultat en mode alphab�tique ou num�rique (YES NO), optional; lisse? : optional YES : suppression des elements repetes immediatements dans seq . -result : menu déroulant, quatre possibilités : - short = liste des critères de segmentation et leur segmentation respective; - exten = analyse détaillée; +result : menu d�roulant, quatre possibilit�s : + short = liste des crit�res de segmentation et leur segmentation respective; + exten = analyse d�taill�e; - save = analyse détaillée écrite en un fichier texte. + save = analyse d�taill�e �crite en un fichier texte. OUTPUT en mode short, pour le traitement de l'analyse, liste de liste selon le format : -\((critères de segmentation) -\(forme selon critère)...)" +\((crit�res de segmentation) +\(forme selon crit�re)...)" :non-generic t :menu (alpha? :alpha :num) :menu (smooth? :yes :no) @@ -1111,10 +1114,10 @@ (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 : -s'applique aussi aux structures trouvées, avec LEVELS +m�me fonction que structure-1, mais r�cursive : +s'applique aussi aux structures trouv�es, avec LEVELS comme niveau de recursion. -memes caractéristiques que structure-1 +memes caract�ristiques que structure-1 Recursive Mark Analysis. Returns only found structures." :non-generic t (when (< levels 1) @@ -1874,7 +1877,7 @@ The classe number is arbitrary" (class-1 (l-matrix matrix) n alpha? centers verbose)) -(defun CENTRE-GRAVIT\é (x) +(defun CENTRE-GRAVIT\� (x) (let (sum g (n (nth 1 (array-dimensions x))) @@ -1886,9 +1889,9 @@ (setf (aref g 0 i) (float (/ sum m)))))) (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). + "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). " :non-generic t (let (sum @@ -1902,18 +1905,18 @@ (setf (aref g 0 i) (float (/ sum m)))))) -(defun X-CENTR\éE (x) - (let ((g (CENTRE-GRAVIT\é x)) +(defun X-CENTR\�E (x) + (let ((g (CENTRE-GRAVIT\� x)) (n (nth 1 (array-dimensions x))) (m (nth 0 (array-dimensions x))) - CENTR\éE) - (setq CENTR\éE (make-array (list m n))) - (dotimes (i m CENTR\éE) - (dotimes (j n) (setf (aref CENTR\éE i j) (aref g 0 j)))) - (setf CENTR\éE (subtract-two-matrices x CENTR\éE)))) + CENTR\�E) + (setq CENTR\�E (make-array (list m n))) + (dotimes (i m CENTR\�E) + (dotimes (j n) (setf (aref CENTR\�E i j) (aref g 0 j)))) + (setf CENTR\�E (subtract-two-matrices x CENTR\�E)))) (defun dist-grav (x) - (let ((grav (CENTRE-GRAVIT\é x)) + (let ((grav (CENTRE-GRAVIT\� x)) d-grav diff (m (nth 0 (array-dimensions x))) @@ -1989,7 +1992,7 @@ collect (aref mat-dist i j))))) (defun rand-classes (m n) - "crée une m-liste aléatoire de n nombres différents" + "cr�e une m-liste al�atoire de n nombres diff�rents" (let ((alea nil) (alea-test nil)) (dotimes (a m alea) (push (random n) alea)) (setf alea-test (remove-duplicates alea)) @@ -1997,7 +2000,7 @@ (defun centre-classes (x classes *m* *n* *n-cl*) "input = matrice des points - liste-vecteur des classes attribuées à chaque point + liste-vecteur des classes attribu�es � chaque point output = matrice des centres de chaque classe" (let (nuage point c tc centres) (setf centres (make-array (list *n-cl* *n*))) @@ -2012,7 +2015,7 @@ (cond ((eq (nth a classes) b) (setf point (+ point 1)) (dotimes (d *n*) (setf (aref nuage (- point 1) d) (aref x a d))) - (setf tc (CENTRE-GRAVIT\é nuage))))) + (setf tc (CENTRE-GRAVIT\� nuage))))) (dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d)))))) (define-box class-center ((matrix nil) (classes nil)) @@ -2042,7 +2045,7 @@ (setf point (+ point 1)) (dotimes (d *n*) (setf (aref nuage (- point 1) d) (aref matrix a d))) - (setf tc (CENTRE-GRAVIT\é nuage))))) + (setf tc (CENTRE-GRAVIT\� nuage))))) (dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d)))))) @@ -2066,7 +2069,7 @@ data : list of classes distribution (typically data from class-1; OUT Shannon entropie value, 0 <= entropie <= (log n 2). -Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, +Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, Seuil, Paris, 1997." (let ((cl (remove-duplicates data)) (n (length data)) (p nil)) (dolist (ci cl (- 0 (apply #'+ (mapcar #'(lambda (x) (* x (log x 2))) p)))) @@ -2081,7 +2084,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, +Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, Seuil, Paris, 1997." :menu (res (:abs "absolute") (:rel "relative")) (declare (ignore class res)) @@ -2095,7 +2098,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, +Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, Seuil, Paris, 1997." (cond ((not (member 'nil (mapcar #'atom class))) (if (equalp res :abs) (setf res 1) (setf res 0)) @@ -2117,7 +2120,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, +Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, Seuil, Paris, 1997." (setf class (str->symb class)) (entropy class res)) @@ -2148,8 +2151,8 @@ (defun normalize-class (classes) "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." +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." (let ((set nil) (r nil) (marker -1) (tempset nil) n) (when (stringp classes) (setf classes (str->symb classes))) (setf n (length (remove-duplicates classes))) @@ -2164,8 +2167,8 @@ (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. +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. IN : string or list (of symbols or lists or strings)." :non-generic t (if (or (stringp classes) (not (listp (car classes)))) @@ -2453,23 +2456,23 @@ 6800 8300 5900)) (result 1) &optional (d-cte nil)) "analyse une sequence en detectant trois formes primitives: -minima: element précédé et suivi par un élément +minima: element pr�c�d� et suivi par un �l�ment de valeur plus grande. -maxima: element précédé et suivi par un élément +maxima: element pr�c�d� et suivi par un �l�ment de valeur plus petite -flex: element précédé et suivi par un élément -de valeur égale +flex: element pr�c�d� et suivi par un �l�ment +de valeur �gale ex : (10 8 8 6 6 5 2 2 2 1) OM->(pure-flex- (8 2) (6 2) (2 3)) -le premier chiffre indique la valeur répétée - et le deuxième terme de la liste indique son nombre d'occurrences. -la deuxième entrée est un menu WHICH qui permet de selectionner +le premier chiffre indique la valeur r�p�t�e + et le deuxi�me terme de la liste indique son nombre d'occurrences. +la deuxi�me entr�e est un menu WHICH qui permet de selectionner les informations: prim: succession des primitives -prof: succession des primitives et profondeur en nombre d'éléments de +prof: succession des primitives et profondeur en nombre d'�l�ments de chaque primitive -vals: idem que prof + valeur correspondant à chaque primitive +vals: idem que prof + valeur correspondant � chaque primitive every: idem que vals + position de chaque primitive" :non-generic t :menu (result (1 "prim") (2 "prof") (3 "vals") (4 "every")) @@ -2495,7 +2498,7 @@ (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" + d'intervalles . commence � zero" :non-generic t (OM::dx->x 0 list)) @@ -2558,7 +2561,7 @@ (define-box reconst-prim+prof ((list nil)) "Ricostruisce la lista usando min, max, flex - più eventualmente l'indice di profondità" + pi� eventualmente l'indice di profondit�" :non-generic t (let ((ris nil) (start 0)) (dolist (y list @@ -2580,8 +2583,8 @@ ris)))) -(defun rec-st-2 (struct |N°| &optional seq) - (let* ((rs (nth |N°| struct)) +(defun rec-st-2 (struct |N�| &optional seq) + (let* ((rs (nth |N�| struct)) (risultato (mapcar #'(lambda (x) (OM::flat (nth x (cadr rs)))) (mapcar #'1- (cadar rs))))) @@ -2590,27 +2593,27 @@ (OM::flat risultato)))) (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." + "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." (declare (ignore struct n)) (error "default method. should not be called.")) (defmethod struct2-to-seq ((struct list) (n integer) &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." + "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." (rec-st-2 struct n ptrns)) (defmethod struct2-to-seq ((struct list) (n list) &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." + "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." (mapcar #'(lambda (i) (rec-st-2 struct i ptrns)) n)) (define-box reconst-prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex - più eventualmente l'indice di profondità" + pi� eventualmente l'indice di profondit�" :non-generic t (let ((ris nil)) (dotimes (x (length list) (OM::flat (nreverse ris))) @@ -2640,7 +2643,7 @@ (define-box pos+prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex - più eventualmente l'indice di profondità" + pi� eventualmente l'indice di profondit�" :non-generic t (let ((ris nil) (valore nil)) (dotimes (x (length list) @@ -2722,7 +2725,7 @@ (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" + � trasposta pi� o meno esattamente" :non-generic t (let* ((ris nil) (ros nil) @@ -2993,9 +2996,9 @@ (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) - pour chaque élément (ou position) des listes." + "Applique la distance d'�dition � une liste + de s�quences avec une pond�ration (entre 0 et 1) + pour chaque �l�ment (ou position) des listes." :non-generic t (if inex (dist-2-ldl seq1 seq2 change ins/sup inex wgth) @@ -3024,8 +3027,8 @@ (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. + "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences +de symboles selon le crit�re de leur structure interne. Wocc : poids de la structure d'occurence; Wref : poids de la structure de repetition." :menu (diff :res :diss) @@ -3034,8 +3037,8 @@ (defmethod resemblance ((a list) (b list) (wocc float) (wref float) &optional diff) - "Calcule une valeur de ressemblance entre 0 et 100 entre deux séquences -de symboles selon le critère de leur structure interne. + "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences +de symboles selon le crit�re de leur structure interne. Wocc : poids de la structure d'occurence; Wref : poids de la structure de repetition." (let* ((ma (resemblance-match a a)) @@ -3076,13 +3079,13 @@ (dotimes (x (- (length lista) 1) (nreverse ris)) (push (/ (+ (nth x lista) (nth (1+ x) lista)) 2) ris)))) -(define-box 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 - (if (= 1 GR\°) + (if (= 1 GR\�) (med-fix list) - (mean-derivation (med-fix list) (- GR\° 1) note?))) + (mean-derivation (med-fix list) (- GR\� 1) note?))) (con-note (when note? (notes-change calcolo note? 48)))) (if note? con-note calcolo))) @@ -3103,13 +3106,13 @@ (push (/ (apply '+ (nth x calcolo)) (length (nth x calcolo))) ris)))) -(define-box 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 - (if (= 1 GR\°) + (if (= 1 GR\�) (med-var lista windw) - (variable-derivation (med-var lista windw) (- GR\° 1) windw))) + (variable-derivation (med-var lista windw) (- GR\� 1) windw))) (define-box notes-change ((pits 6000) (scale 6000) &optional (mod 12)) @@ -3140,7 +3143,7 @@ (define-box octave ((midic 6000)) - "retourne l'octave à partir de c3=octave 3" + "retourne l'octave � partir de c3=octave 3" :non-generic t (let ((midic (list! midic))) (mapcar #'(lambda (x) (OM::om- (OM::om// x 1200) 2)) @@ -3148,14 +3151,14 @@ (define-box makenote ((index 60) (octave 3) &optional (mod 12)) - " construction d'une note à partir des données + " construction d'une note � partir des donn�es de index, octave e modulo du index" :non-generic t (+ (/ (* index 100 12) mod) (* (+ 2 octave) 1200))) (defun lettura-modulare (lista1 lista2) - "Se la prima lista è più grande della seconda lista, allora legge + "Se la prima lista � pi� grande della seconda lista, allora legge modularmente la seconda lista restituendo un length uguale al length di lista1." (let ((ros nil)) @@ -3184,10 +3187,10 @@ (define-box prof-inter ((list1 nil) (list2 nil) (total 1)) - "Restituisce l'interposizione di list1 con list2. Se list1 è più piccola + "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 - menù se avere la prima ricorsione per completare list2." + men� se avere la prima ricorsione per completare list2." :non-generic t :menu (total (1 "ltd") (2 "copl")) (case total @@ -3198,14 +3201,14 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." total)))) -(define-box 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 - (if (= GR\° 1) + (if (= GR\� 1) (inter-profile list1 (OM::permut-random list2)) (interlock (inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\° 1)))) + (permut-circ list2 (1- (length list1))) (- GR\� 1)))) (define-box new-inter-profile ((list1 nil) (list2 nil)) @@ -3229,14 +3232,14 @@ (last list1))))) -(define-box 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 - (if (= GR\° 1) + (if (= GR\� 1) (new-inter-profile list1 (OM::permut-random list2)) (new-interlock (new-inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\° 1)))) + (permut-circ list2 (1- (length list1))) (- GR\� 1)))) (defun int-com-ottava (lista) @@ -3279,9 +3282,9 @@ (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. - Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto + Se l'elemento � escluso allora lo traspone in modo tale che sia + il pi� vicino possibile o al limite superiore o a quello inferiore. + Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto sotto il DO e il SOL# viene trasposto sopra il SOL." :non-generic t (let ((max (g-max range)) (min (g-min range))) @@ -3297,26 +3300,26 @@ (defun cor-ott-list (elmt range) "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. - Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto + Se l'elemento � escluso allora lo traspone in modo tale che sia + il pi� vicino possibile o al limite superiore o a quello inferiore. + Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto sotto il DO e il SOL# viene trasposto sopra il SOL.La differenza - con 'CORRETTORE' è che questo modulo agisce su una lista intera." + con 'CORRETTORE' � che questo modulo agisce su una lista intera." (let ((ris nil)) (dolist (y elmt) (push (correttore y range) ris)) (nreverse ris))) (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ù + procedimento ma traspone una nota non inclusa nel range il pi� vicino o al limite superiore o a quello inferiore." :non-generic t (cor-ott-list (mio-transpoct list range) range)) (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." + "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 (let ((ris nil)) (dotimes (x (length (OM::x->dx list)) (nreverse ris)) @@ -3364,8 +3367,8 @@ (defun interno (elmt range) - "Restituisce l'elemento se è incluso nel 'range' e nil - se non è incluso." + "Restituisce l'elemento se � incluso nel 'range' e nil + se non � incluso." (if (<= (g-min range) elmt (g-max range)) elmt nil)) (define-box malt-mod- ((list nil) (limit 6000)) @@ -3378,7 +3381,7 @@ (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 + al valore indicato con 'value'. Il men� permette di selezionare se si vuole una riflessione superiore o inferiore" :non-generic t :menu (up/down (1 "up") (2 "down")) @@ -3499,7 +3502,7 @@ (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 + assolute all'interno del 'range. Se un elemento non � incluso nel 'range', allora viene tolto dal risultato." :non-generic t (let ((ris nil)) @@ -3509,8 +3512,8 @@ (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 + Se MODE? � su mod, questa funzione restituisce i multipli + dei valori in MODULI; se � su ptrn allora retituisce una struttura ritmica che utlilizza solamente i valori in MODULO" :non-generic t :menu (mode? (1 "mod") (2 "ptrn")) @@ -3522,9 +3525,9 @@ (define-box rtm-change-1 ((rhytm nil) (vals nil)) - "Se in vals c'è un solo valore allora calcola una + "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 + risultino un multiplo di vals. Se invece in vals c'� una lista di valori allora approssima tutti i valori in rtm con i valori di vals." :non-generic t @@ -3554,8 +3557,8 @@ (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" + lo stesso elemento se il (mod rht val) � uguale a 0 + altrimenti lo approssima al po� vicino" :non-generic t (let ((ris nil)) (dolist (y rht (nreverse ris)) @@ -3576,13 +3579,13 @@ (define-box segno+picc ((list nil)) "Trasforma tutta la lista in valori tutti positivi e prende il valore - più piccolo." + pi� piccolo." :non-generic t (g-min (mapcar #'(lambda (x) (abs x)) list))) (define-box nota-vicina ((list nil) (ref 1)) - "Prende l'intervallo più piccolo di una lista." + "Prende l'intervallo pi� piccolo di una lista." :non-generic t (let* ((intervalli (tutti-int list ref)) (piccolo (segno+picc intervalli))) (if (equalp (abs (first intervalli)) piccolo) @@ -3591,13 +3594,13 @@ (define-box tieni-nota ((list nil) (ref 1)) - "tiene la nota più vicina." + "tiene la nota pi� vicina." :non-generic t (OM::om+ ref (nota-vicina list ref))) (define-box vicini-valori ((list1 nil) (refs nil)) - "Prende le note più vicine di list per ogni nota di refs." + "Prende le note pi� vicine di list per ogni nota di refs." :non-generic t (mapcar #'(lambda (x) (tieni-nota list1 x)) refs)) @@ -3798,8 +3801,8 @@ (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. -See: E. Diday & all, 1982 : Elements d'analyse de données, Dunod, Paris. pp. 110-111." +prend en entr�e la sortie de ldl-distance en mode extend. +See: E. Diday & all, 1982 : Elements d'analyse de donn�es, Dunod, Paris. pp. 110-111." :non-generic t (assert (not (member 0 dist :test #'equalp :key #'third)) nil @@ -3906,7 +3909,7 @@ (define-box delta ((list nil) (round 1000)) - " calcule les différences entre les valeurs consécutives avec un arrondi " + " calcule les diff�rences entre les valeurs cons�cutives avec un arrondi " :non-generic t (let ((l nil) (delta nil)) (dotimes (n (- (length list) 1)) Modified: trunk/src/utils.lisp ============================================================================== --- trunk/src/utils.lisp (original) +++ trunk/src/utils.lisp Sun Jul 15 10:27:06 2007 @@ -31,42 +31,3 @@ (if (consp (car list)) (apply 'append list) list)) -#-(or lispworks digitool) -(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:") - button-string) - (declare (ignore button-string)) - (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt) - (force-output *query-io*) - (parse-namestring (read-line *query-io*))) - -#+digitool -(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:") - button-string) - (ccl::choose-new-file-dialog :prompt prompt :button-string button-string)) - -#+lispworks -(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:") - button-string) - (capi:prompt-for-file prompt :operation :save)) - -#-(or lispworks digitool) -(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:") - button-string) - (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt) - (force-output *query-io*) - (let ((path (parse-namestring (read-line *query-io*)))) - (if (probe-file path) - path - (progn - (format *query-io* "~&ERROR: ~A does not exist.~%" path) - (choose-file-dialog :prompt prompt :button-string button-string))))) - -#+digitool -(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:") - button-string) - (ccl::choose-file-dialog :prompt prompt :button-string button-string)) - -#+lispworks -(defun choose-file-dialog (&key (prompt "Enter the path for a new file:") - button-string) - (capi:prompt-for-file prompt))

1 0

[Morphologie-cvs] r22 - trunk/src
by ksprotte＠common-lisp.net 12 Jul '07

12 Jul '07

Author: ksprotte Date: Thu Jul 12 11:37:58 2007 New Revision: 22 Modified: trunk/src/morphologie.lisp Log: this was just a test Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Thu Jul 12 11:37:58 2007 @@ -9,6 +9,7 @@ ;;;* Analysis fonctions, pattern recognition and morphological classification of geometric profiles * ;;;* * ;;;************************************************************************************************************* +;;; (in-package :morph)

1 0

[Morphologie-cvs] r21 - trunk/src
by ksprotte＠common-lisp.net 12 Jul '07

12 Jul '07

Author: ksprotte Date: Thu Jul 12 10:45:16 2007 New Revision: 21 Modified: trunk/src/morphologie.lisp Log: converted to utf-8 Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Thu Jul 12 10:45:16 2007 @@ -5,7 +5,7 @@ ;;;* IRCAM, Paris, november 1998 for Morphologie 1.0 * ;;;* may 1999 for Morphologie 2.0 * ;;;* * -;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles g�ometriques * +;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles géometriques * ;;;* Analysis fonctions, pattern recognition and morphological classification of geometric profiles * ;;;* * ;;;************************************************************************************************************* @@ -141,7 +141,7 @@ (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." + cui può essere scomposta la sequenza in lista." :non-generic t (let ((ris nil) (x (scom lista n)) y) (loop :while x @@ -243,8 +243,8 @@ (step nil) (set nil)) "Avance dans la sequence LIST avec avec une taille de fenetre WINDW et un pas d'avancement (optionnel) STEP . -Renvoie pour chaque fen�tre le nombre d'occurrences d'un �l�ment. -L'entr�e optionnelle SET specifie les segments recherches dans LIST>" +Renvoie pour chaque fenêtre le nombre d'occurrences d'un élément. +L'entrée optionnelle SET specifie les segments recherches dans LIST>" :non-generic t (count-ptrn-win list windw step set)) @@ -347,8 +347,8 @@ les segments d'elements et leurs positions dans la sequence. optionnels : - LENGTH : longueur des segments. 2 par defaut. -- PTRN : segment dont les permutations sont recherch�s. -tous par d�faut. desactive LENGTH> +- PTRN : segment dont les permutations sont recherchés. +tous par défaut. desactive LENGTH> Returns all permutations of two elements in SEQ with their respective positions in seq. @@ -445,7 +445,7 @@ (defparameter **alpha** (quote (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z - #\�))) + #\°))) (defparameter **num** (quote (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) @@ -735,24 +735,24 @@ (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. + "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. INPUT -seq : s�quence de symboles ou nombres (liste); -alpha? : r�sultat en mode alphab�tique ou num�rique (YES NO), optional; +seq : séquence de symboles ou nombres (liste); +alpha? : résultat en mode alphabétique ou numérique (YES NO), optional; lisse? : optional YES : suppression des elements repetes immediatements dans seq . -result : menu d�roulant, quatre possibilit�s : - short = liste des crit�res de segmentation et leur segmentation respective; - exten = analyse d�taill�e; +result : menu déroulant, quatre possibilités : + short = liste des critères de segmentation et leur segmentation respective; + exten = analyse détaillée; - save = analyse d�taill�e �crite en un fichier texte. + save = analyse détaillée écrite en un fichier texte. OUTPUT en mode short, pour le traitement de l'analyse, liste de liste selon le format : -\((crit�res de segmentation) -\(forme selon crit�re)...)" +\((critères de segmentation) +\(forme selon critère)...)" :non-generic t :menu (alpha? :alpha :num) :menu (smooth? :yes :no) @@ -1110,10 +1110,10 @@ (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 : -s'applique aussi aux structures trouv�es, avec LEVELS +même fonction que structure-1, mais récursive : +s'applique aussi aux structures trouvées, avec LEVELS comme niveau de recursion. -memes caract�ristiques que structure-1 +memes caractéristiques que structure-1 Recursive Mark Analysis. Returns only found structures." :non-generic t (when (< levels 1) @@ -1873,7 +1873,7 @@ The classe number is arbitrary" (class-1 (l-matrix matrix) n alpha? centers verbose)) -(defun CENTRE-GRAVIT\� (x) +(defun CENTRE-GRAVIT\é (x) (let (sum g (n (nth 1 (array-dimensions x))) @@ -1885,9 +1885,9 @@ (setf (aref g 0 i) (float (/ sum m)))))) (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). + "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). " :non-generic t (let (sum @@ -1901,18 +1901,18 @@ (setf (aref g 0 i) (float (/ sum m)))))) -(defun X-CENTR\�E (x) - (let ((g (CENTRE-GRAVIT\� x)) +(defun X-CENTR\éE (x) + (let ((g (CENTRE-GRAVIT\é x)) (n (nth 1 (array-dimensions x))) (m (nth 0 (array-dimensions x))) - CENTR\�E) - (setq CENTR\�E (make-array (list m n))) - (dotimes (i m CENTR\�E) - (dotimes (j n) (setf (aref CENTR\�E i j) (aref g 0 j)))) - (setf CENTR\�E (subtract-two-matrices x CENTR\�E)))) + CENTR\éE) + (setq CENTR\éE (make-array (list m n))) + (dotimes (i m CENTR\éE) + (dotimes (j n) (setf (aref CENTR\éE i j) (aref g 0 j)))) + (setf CENTR\éE (subtract-two-matrices x CENTR\éE)))) (defun dist-grav (x) - (let ((grav (CENTRE-GRAVIT\� x)) + (let ((grav (CENTRE-GRAVIT\é x)) d-grav diff (m (nth 0 (array-dimensions x))) @@ -1988,7 +1988,7 @@ collect (aref mat-dist i j))))) (defun rand-classes (m n) - "cr�e une m-liste al�atoire de n nombres diff�rents" + "crée une m-liste aléatoire de n nombres différents" (let ((alea nil) (alea-test nil)) (dotimes (a m alea) (push (random n) alea)) (setf alea-test (remove-duplicates alea)) @@ -1996,7 +1996,7 @@ (defun centre-classes (x classes *m* *n* *n-cl*) "input = matrice des points - liste-vecteur des classes attribu�es � chaque point + liste-vecteur des classes attribuées à chaque point output = matrice des centres de chaque classe" (let (nuage point c tc centres) (setf centres (make-array (list *n-cl* *n*))) @@ -2011,7 +2011,7 @@ (cond ((eq (nth a classes) b) (setf point (+ point 1)) (dotimes (d *n*) (setf (aref nuage (- point 1) d) (aref x a d))) - (setf tc (CENTRE-GRAVIT\� nuage))))) + (setf tc (CENTRE-GRAVIT\é nuage))))) (dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d)))))) (define-box class-center ((matrix nil) (classes nil)) @@ -2041,7 +2041,7 @@ (setf point (+ point 1)) (dotimes (d *n*) (setf (aref nuage (- point 1) d) (aref matrix a d))) - (setf tc (CENTRE-GRAVIT\� nuage))))) + (setf tc (CENTRE-GRAVIT\é nuage))))) (dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d)))))) @@ -2065,7 +2065,7 @@ data : list of classes distribution (typically data from class-1; OUT Shannon entropie value, 0 <= entropie <= (log n 2). -Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, +Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, Seuil, Paris, 1997." (let ((cl (remove-duplicates data)) (n (length data)) (p nil)) (dolist (ci cl (- 0 (apply #'+ (mapcar #'(lambda (x) (* x (log x 2))) p)))) @@ -2080,7 +2080,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, +Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, Seuil, Paris, 1997." :menu (res (:abs "absolute") (:rel "relative")) (declare (ignore class res)) @@ -2094,7 +2094,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, +Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, Seuil, Paris, 1997." (cond ((not (member 'nil (mapcar #'atom class))) (if (equalp res :abs) (setf res 1) (setf res 0)) @@ -2116,7 +2116,7 @@ Shannon entropie value 0 <= entropy <= (log n 2) if res = absolute; 0 <= entropy <= 1.0 if res = relative. -Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde, +Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde, Seuil, Paris, 1997." (setf class (str->symb class)) (entropy class res)) @@ -2147,8 +2147,8 @@ (defun normalize-class (classes) "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." +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." (let ((set nil) (r nil) (marker -1) (tempset nil) n) (when (stringp classes) (setf classes (str->symb classes))) (setf n (length (remove-duplicates classes))) @@ -2163,8 +2163,8 @@ (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. +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. IN : string or list (of symbols or lists or strings)." :non-generic t (if (or (stringp classes) (not (listp (car classes)))) @@ -2452,23 +2452,23 @@ 6800 8300 5900)) (result 1) &optional (d-cte nil)) "analyse une sequence en detectant trois formes primitives: -minima: element pr�c�d� et suivi par un �l�ment +minima: element précédé et suivi par un élément de valeur plus grande. -maxima: element pr�c�d� et suivi par un �l�ment +maxima: element précédé et suivi par un élément de valeur plus petite -flex: element pr�c�d� et suivi par un �l�ment -de valeur �gale +flex: element précédé et suivi par un élément +de valeur égale ex : (10 8 8 6 6 5 2 2 2 1) OM->(pure-flex- (8 2) (6 2) (2 3)) -le premier chiffre indique la valeur r�p�t�e - et le deuxi�me terme de la liste indique son nombre d'occurrences. -la deuxi�me entr�e est un menu WHICH qui permet de selectionner +le premier chiffre indique la valeur répétée + et le deuxième terme de la liste indique son nombre d'occurrences. +la deuxième entrée est un menu WHICH qui permet de selectionner les informations: prim: succession des primitives -prof: succession des primitives et profondeur en nombre d'�l�ments de +prof: succession des primitives et profondeur en nombre d'éléments de chaque primitive -vals: idem que prof + valeur correspondant � chaque primitive +vals: idem que prof + valeur correspondant à chaque primitive every: idem que vals + position de chaque primitive" :non-generic t :menu (result (1 "prim") (2 "prof") (3 "vals") (4 "every")) @@ -2494,7 +2494,7 @@ (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" + d'intervalles . commence à zero" :non-generic t (OM::dx->x 0 list)) @@ -2557,7 +2557,7 @@ (define-box reconst-prim+prof ((list nil)) "Ricostruisce la lista usando min, max, flex - pi� eventualmente l'indice di profondit�" + più eventualmente l'indice di profondità" :non-generic t (let ((ris nil) (start 0)) (dolist (y list @@ -2579,8 +2579,8 @@ ris)))) -(defun rec-st-2 (struct |N�| &optional seq) - (let* ((rs (nth |N�| struct)) +(defun rec-st-2 (struct |N°| &optional seq) + (let* ((rs (nth |N°| struct)) (risultato (mapcar #'(lambda (x) (OM::flat (nth x (cadr rs)))) (mapcar #'1- (cadar rs))))) @@ -2589,27 +2589,27 @@ (OM::flat risultato)))) (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." + "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." (declare (ignore struct n)) (error "default method. should not be called.")) (defmethod struct2-to-seq ((struct list) (n integer) &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." + "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." (rec-st-2 struct n ptrns)) (defmethod struct2-to-seq ((struct list) (n list) &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." + "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." (mapcar #'(lambda (i) (rec-st-2 struct i ptrns)) n)) (define-box reconst-prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex - pi� eventualmente l'indice di profondit�" + più eventualmente l'indice di profondità" :non-generic t (let ((ris nil)) (dotimes (x (length list) (OM::flat (nreverse ris))) @@ -2639,7 +2639,7 @@ (define-box pos+prim+prof+val ((list nil) (start 6000)) "Ricostruisce la lista usando min, max, flex - pi� eventualmente l'indice di profondit�" + più eventualmente l'indice di profondità" :non-generic t (let ((ris nil) (valore nil)) (dotimes (x (length list) @@ -2721,7 +2721,7 @@ (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" + è trasposta più o meno esattamente" :non-generic t (let* ((ris nil) (ros nil) @@ -2992,9 +2992,9 @@ (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) - pour chaque �l�ment (ou position) des listes." + "Applique la distance d'édition à une liste + de séquences avec une pondération (entre 0 et 1) + pour chaque élément (ou position) des listes." :non-generic t (if inex (dist-2-ldl seq1 seq2 change ins/sup inex wgth) @@ -3023,8 +3023,8 @@ (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. + "Calcule une valeur de ressemblance entre 0 et 100 entre deux séquences +de symboles selon le critère de leur structure interne. Wocc : poids de la structure d'occurence; Wref : poids de la structure de repetition." :menu (diff :res :diss) @@ -3033,8 +3033,8 @@ (defmethod resemblance ((a list) (b list) (wocc float) (wref float) &optional diff) - "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences -de symboles selon le crit�re de leur structure interne. + "Calcule une valeur de ressemblance entre 0 et 100 entre deux séquences +de symboles selon le critère de leur structure interne. Wocc : poids de la structure d'occurence; Wref : poids de la structure de repetition." (let* ((ma (resemblance-match a a)) @@ -3075,13 +3075,13 @@ (dotimes (x (- (length lista) 1) (nreverse ris)) (push (/ (+ (nth x lista) (nth (1+ x) lista)) 2) ris)))) -(define-box 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 - (if (= 1 GR\�) + (if (= 1 GR\°) (med-fix list) - (mean-derivation (med-fix list) (- GR\� 1) note?))) + (mean-derivation (med-fix list) (- GR\° 1) note?))) (con-note (when note? (notes-change calcolo note? 48)))) (if note? con-note calcolo))) @@ -3102,13 +3102,13 @@ (push (/ (apply '+ (nth x calcolo)) (length (nth x calcolo))) ris)))) -(define-box 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 - (if (= 1 GR\�) + (if (= 1 GR\°) (med-var lista windw) - (variable-derivation (med-var lista windw) (- GR\� 1) windw))) + (variable-derivation (med-var lista windw) (- GR\° 1) windw))) (define-box notes-change ((pits 6000) (scale 6000) &optional (mod 12)) @@ -3139,7 +3139,7 @@ (define-box octave ((midic 6000)) - "retourne l'octave � partir de c3=octave 3" + "retourne l'octave à partir de c3=octave 3" :non-generic t (let ((midic (list! midic))) (mapcar #'(lambda (x) (OM::om- (OM::om// x 1200) 2)) @@ -3147,14 +3147,14 @@ (define-box makenote ((index 60) (octave 3) &optional (mod 12)) - " construction d'une note � partir des donn�es + " construction d'une note à partir des données de index, octave e modulo du index" :non-generic t (+ (/ (* index 100 12) mod) (* (+ 2 octave) 1200))) (defun lettura-modulare (lista1 lista2) - "Se la prima lista � pi� grande della seconda lista, allora legge + "Se la prima lista è più grande della seconda lista, allora legge modularmente la seconda lista restituendo un length uguale al length di lista1." (let ((ros nil)) @@ -3183,10 +3183,10 @@ (define-box prof-inter ((list1 nil) (list2 nil) (total 1)) - "Restituisce l'interposizione di list1 con list2. Se list1 � pi� piccola + "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 - men� se avere la prima ricorsione per completare list2." + menù se avere la prima ricorsione per completare list2." :non-generic t :menu (total (1 "ltd") (2 "copl")) (case total @@ -3197,14 +3197,14 @@ (otherwise (error "Got ~s, was expecting one of 1, 2." total)))) -(define-box 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 - (if (= GR\� 1) + (if (= GR\° 1) (inter-profile list1 (OM::permut-random list2)) (interlock (inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\� 1)))) + (permut-circ list2 (1- (length list1))) (- GR\° 1)))) (define-box new-inter-profile ((list1 nil) (list2 nil)) @@ -3228,14 +3228,14 @@ (last list1))))) -(define-box 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 - (if (= GR\� 1) + (if (= GR\° 1) (new-inter-profile list1 (OM::permut-random list2)) (new-interlock (new-inter-profile list1 (OM::permut-random list2)) - (permut-circ list2 (1- (length list1))) (- GR\� 1)))) + (permut-circ list2 (1- (length list1))) (- GR\° 1)))) (defun int-com-ottava (lista) @@ -3278,9 +3278,9 @@ (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. - Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto + Se l'elemento è escluso allora lo traspone in modo tale che sia + il più vicino possibile o al limite superiore o a quello inferiore. + Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto sotto il DO e il SOL# viene trasposto sopra il SOL." :non-generic t (let ((max (g-max range)) (min (g-min range))) @@ -3296,26 +3296,26 @@ (defun cor-ott-list (elmt range) "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. - Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto + Se l'elemento è escluso allora lo traspone in modo tale che sia + il più vicino possibile o al limite superiore o a quello inferiore. + Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto sotto il DO e il SOL# viene trasposto sopra il SOL.La differenza - con 'CORRETTORE' � che questo modulo agisce su una lista intera." + con 'CORRETTORE' è che questo modulo agisce su una lista intera." (let ((ris nil)) (dolist (y elmt) (push (correttore y range) ris)) (nreverse ris))) (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� + procedimento ma traspone una nota non inclusa nel range il più vicino o al limite superiore o a quello inferiore." :non-generic t (cor-ott-list (mio-transpoct list range) range)) (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." + "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 (let ((ris nil)) (dotimes (x (length (OM::x->dx list)) (nreverse ris)) @@ -3363,8 +3363,8 @@ (defun interno (elmt range) - "Restituisce l'elemento se � incluso nel 'range' e nil - se non � incluso." + "Restituisce l'elemento se è incluso nel 'range' e nil + se non è incluso." (if (<= (g-min range) elmt (g-max range)) elmt nil)) (define-box malt-mod- ((list nil) (limit 6000)) @@ -3377,7 +3377,7 @@ (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 + al valore indicato con 'value'. Il menù permette di selezionare se si vuole una riflessione superiore o inferiore" :non-generic t :menu (up/down (1 "up") (2 "down")) @@ -3498,7 +3498,7 @@ (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 + assolute all'interno del 'range. Se un elemento non è incluso nel 'range', allora viene tolto dal risultato." :non-generic t (let ((ris nil)) @@ -3508,8 +3508,8 @@ (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 + Se MODE? è su mod, questa funzione restituisce i multipli + dei valori in MODULI; se è su ptrn allora retituisce una struttura ritmica che utlilizza solamente i valori in MODULO" :non-generic t :menu (mode? (1 "mod") (2 "ptrn")) @@ -3521,9 +3521,9 @@ (define-box rtm-change-1 ((rhytm nil) (vals nil)) - "Se in vals c'� un solo valore allora calcola una + "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 + risultino un multiplo di vals. Se invece in vals c'è una lista di valori allora approssima tutti i valori in rtm con i valori di vals." :non-generic t @@ -3553,8 +3553,8 @@ (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" + lo stesso elemento se il (mod rht val) è uguale a 0 + altrimenti lo approssima al poù vicino" :non-generic t (let ((ris nil)) (dolist (y rht (nreverse ris)) @@ -3575,13 +3575,13 @@ (define-box segno+picc ((list nil)) "Trasforma tutta la lista in valori tutti positivi e prende il valore - pi� piccolo." + più piccolo." :non-generic t (g-min (mapcar #'(lambda (x) (abs x)) list))) (define-box nota-vicina ((list nil) (ref 1)) - "Prende l'intervallo pi� piccolo di una lista." + "Prende l'intervallo più piccolo di una lista." :non-generic t (let* ((intervalli (tutti-int list ref)) (piccolo (segno+picc intervalli))) (if (equalp (abs (first intervalli)) piccolo) @@ -3590,13 +3590,13 @@ (define-box tieni-nota ((list nil) (ref 1)) - "tiene la nota pi� vicina." + "tiene la nota più vicina." :non-generic t (OM::om+ ref (nota-vicina list ref))) (define-box vicini-valori ((list1 nil) (refs nil)) - "Prende le note pi� vicine di list per ogni nota di refs." + "Prende le note più vicine di list per ogni nota di refs." :non-generic t (mapcar #'(lambda (x) (tieni-nota list1 x)) refs)) @@ -3797,8 +3797,8 @@ (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. -See: E. Diday & all, 1982 : Elements d'analyse de donn�es, Dunod, Paris. pp. 110-111." +prend en entrée la sortie de ldl-distance en mode extend. +See: E. Diday & all, 1982 : Elements d'analyse de données, Dunod, Paris. pp. 110-111." :non-generic t (assert (not (member 0 dist :test #'equalp :key #'third)) nil @@ -3905,7 +3905,7 @@ (define-box delta ((list nil) (round 1000)) - " calcule les diff�rences entre les valeurs cons�cutives avec un arrondi " + " calcule les différences entre les valeurs consécutives avec un arrondi " :non-generic t (let ((l nil) (delta nil)) (dotimes (n (- (length list) 1))

1 0