[Morphologie-cvs] r18 - trunk/src
ksprotte at common-lisp.net
ksprotte at common-lisp.net
Fri Jul 6 13:34:53 UTC 2007
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
More information about the Morphologie-cvs
mailing list