Author: ksprotte Date: Fri Jul 6 09:34:52 2007 New Revision: 18 Modified: trunk/src/morphologie.lisp Log: replaced most of the :menu strings to keywords Modified: trunk/src/morphologie.lisp ============================================================================== --- trunk/src/morphologie.lisp (original) +++ trunk/src/morphologie.lisp Fri Jul 6 09:34:52 2007 @@ -340,7 +340,7 @@ (setf (nth p r) (append (nth p r) (list i))) (push (list seqa i) r)))))))) -(define-box 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 @@ -358,13 +358,13 @@ PTRN : pattern of which permutations are looking for. If not empty (nil), desactivates LENGTH>" :non-generic t - :menu (output ("pos" "positions") ("permut" "permutations")) + :menu (output (:pos "positions") (:permut "permutations")) (assert (listp ptrn)) (if (and (and length (listp length)) (null ptrn)) (mapcar #'(lambda (x) (find-permut seq output x 'nil)) length) (let ((r (if ptrn (permuts seq ptrn) (local-permut seq length)))) - (cond ((equalp "pos" output) r) - ((equalp "permut" output) + (cond ((equalp :pos output) r) + ((equalp :permut output) (if ptrn (mapcar #'car r) (mapcar #'(lambda (x) (mapcar #'car x)) r))))))) @@ -372,8 +372,8 @@ (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; @@ -385,16 +385,16 @@ OUTPUT A matrix of distances" :non-generic t - :menu (scale ("rel" "relative") ("abs" "absolute")) - :menu (result ("short" "short") ("ext" "extended") ("save" "save")) + :menu (scale :rel :abs) + :menu (result :short :ext :save) (when (not (= (length l-seq) (length (remove-duplicates (copy-tree l-seq) :test #'equal)))) (format t "ldl-distance warning: duplicates in input list.~%")) (let ((r nil)) - (if (equalp scale "rel") (setf scale 1) (setf scale 2)) - (cond ((equalp result "short") (setf result 1)) - ((equalp result "ext") (setf result 2)) - ((equalp result "save") (setf result 2)) + (if (equalp scale :rel) (setf scale 1) (setf scale 2)) + (cond ((equalp result :short) (setf result 1)) + ((equalp result :ext) (setf result 2)) + ((equalp result :save) (setf result 2)) (t (print "Error result menu doesn't exist.") (abort))) (cond ((= inex 0.0) (dotimes (l1 (length l-seq) @@ -1780,13 +1780,13 @@ (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. The classe number is arbitrary" :menu (alpha? (1 "alpha") (0 "num")) - :menu (verbose ("no" "no") ("yes" "yes")) + :menu (verbose :no :yes) (declare (ignore matrix n)) (error "default method. should not be called.")) @@ -2072,7 +2072,7 @@ (push (/ (length (remove-if-not #'(lambda (x) (equal x ci)) data)) n) p)))) -(define-box 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; @@ -2082,7 +2082,7 @@ 0 <= entropy <= 1.0 if res = relative. 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")) + :menu (res (:abs "absolute") (:rel "relative")) (declare (ignore class res)) (error "default method. should not be called.")) @@ -2097,7 +2097,7 @@ 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)) + (if (equalp res :abs) (setf res 1) (setf res 0)) (cond ((= res 1) (eshannon class)) ((= res 0) (let ((cl (remove-duplicates class))) @@ -2126,19 +2126,19 @@ "Does n iterations of class-1 algorithm. The classes designation is normalized." :non-generic t - :menu (alpha? ("alpha" "alpha") ("num" "num")) - :menu (verbose ("no" "no") ("yes" "yes")) + :menu (alpha? :alpha :num) + :menu (verbose :no :yes) (when (and (listp matrix) (not (arrayp matrix))) (setf matrix (l-matrix matrix))) - (if (equalp "no" verbose) (setf verbose "no") (setf verbose "yes")) + (if (equalp :no verbose) (setf verbose :no) (setf verbose :yes)) (let ((r nil) res-r) (dotimes (a iter (setf r (prob-class (reverse r)))) (let ((classa (class-1 matrix n 0 centers verbose))) - (when (equal verbose "yes") + (when (equal verbose :yes) (format t "~% Meta-class1 - iteration #~S -~%" (1+ a))) (push classa r))) (setf res-r (res-class r 0)) - (if (equalp "num" alpha?) + (if (equalp :num alpha?) (values res-r (mat-to-ldl (class-center matrix res-r)) (mat-to-ldl r)) (values (to-alpha (mapcar #'1+ res-r)) (mat-to-ldl (class-center matrix res-r)) @@ -2229,13 +2229,13 @@ (pos2 e entropies) (mapcar #'(lambda (n) (nth n clusters)) (pos2 e entropies))))) -(define-box 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")) - :menu (out ("clust" "clust") ("nth" "nth")) - (if (equalp "min" test) (setf test 0) (setf test 1)) - (if (equalp "clust" out) + :menu (test :min :max) + :menu (out :clust :nth) + (if (equalp :min test) (setf test 0) (setf test 1)) + (if (equalp :clust out) (car (remove-duplicates (test-entropie clusters test 1) :test #'equalp)) (test-entropie clusters test 0))) @@ -3022,12 +3022,12 @@ (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; Wref : poids de la structure de repetition." - :menu (diff ("res" "res") ("diss" "diss")) + :menu (diff :res :diss) (declare (ignore a b wocc wref)) (error "default method. should not be called.")) @@ -3043,7 +3043,7 @@ (occ-b (mapcar #'(lambda (x) (apply #'+ x)) mb)) (ref-a (ref-position a)) (ref-b (ref-position b))) - (if (equalp "diss" diff) + (if (equalp :diss diff) (multi-distance (mapcar #'(lambda (x y) (list x y)) occ-a ref-a) (mapcar #'(lambda (x y) (list x y)) occ-b ref-b) 1 1 (list wocc wref)) (- 100.0