diff -urN Gauche-libsvm-0.1/Makefile.in Gauche-libsvm-0.1.new/Makefile.in --- Gauche-libsvm-0.1/Makefile.in 2005-07-27 21:44:09.000000000 -1000 +++ Gauche-libsvm-0.1.new/Makefile.in 2005-11-06 13:20:59.000000000 -1000 @@ -8,6 +8,8 @@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ +datadir = @datadir@ +srcdir = @srcdir@ VPATH = $(srcdir) LIBSVM = libsvm @@ -24,10 +26,10 @@ EXEEXT = @EXEEXT@ # Module-specific stuff -PACKAGE = libsvm +PACKAGE = Gauche-libsvm ARCHFILES = libsvm.$(SOEXT) -SCMFILES = libsvm.scm +SCMFILES = util/svm/libsvm.scm HEADERS = TARGET = $(ARCHFILES) @@ -35,9 +37,9 @@ CONFIG_GENERATED = Makefile config.cache config.log config.status \ configure.lineno autom4te*.cache $(PACKAGE).gpd -HEADER_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --siteincdir` -SCM_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --sitelibdir` -ARCH_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --sitearchdir` +GAUCHE_PKGINCDIR = @GAUCHE_PKGINCDIR@ +GAUCHE_PKGLIBDIR = @GAUCHE_PKGLIBDIR@ +GAUCHE_PKGARCHDIR = @GAUCHE_PKGARCHDIR@ libsvm_SRCS = libsvm.c libsvmlib.stub $(LIBSVM)/svm.o libsvm_CFLAGS = -I$(LIBSVM)/ -g @@ -55,10 +57,10 @@ $(GOSH) -I. test.scm > test.log install : all - $(INSTALL) -m 444 -T $(HEADER_INSTALL_DIR) $(HEADERS) - $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR) $(SCMFILES) - $(INSTALL) -m 555 -T $(ARCH_INSTALL_DIR) $(ARCHFILES) - $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR)/.packages $(PACKAGE).gpd + $(INSTALL) -m 444 -T $(GAUCHE_PKGINCDIR) $(HEADERS) + $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR) $(SCMFILES) + $(INSTALL) -m 555 -T $(GAUCHE_PKGARCHDIR) $(ARCHFILES) + $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR)/.packages $(PACKAGE).gpd clean : $(GAUCHE_PACKAGE) compile --clean libsvm $(libsvm_SRCS) diff -urN Gauche-libsvm-0.1/VERSION Gauche-libsvm-0.1.new/VERSION --- Gauche-libsvm-0.1/VERSION 2005-11-06 13:26:57.000000000 -1000 +++ Gauche-libsvm-0.1.new/VERSION 2005-11-06 13:21:42.000000000 -1000 @@ -1 +1 @@ -0.1 +0.2 diff -urN Gauche-libsvm-0.1/configure.in Gauche-libsvm-0.1.new/configure.in --- Gauche-libsvm-0.1/configure.in 2005-07-27 19:13:08.000000000 -1000 +++ Gauche-libsvm-0.1.new/configure.in 2005-11-06 00:27:01.000000000 -1000 @@ -5,7 +5,7 @@ dnl AC_PREREQ(2.54) -AC_INIT(Gauche-libsvm, 0.1, nel@soraneko.com) +AC_INIT(Gauche-libsvm, 0.2, nel@soraneko.com) dnl If you want to use the system name (OS, architecture, etc) in the dnl configure, uncomment the following line. In such a case, you need dnl to copy config.guess and config.sub from automake distribution. @@ -28,6 +28,15 @@ AC_SUBST(OBJEXT) AC_SUBST(EXEEXT) +ac_default_prefix=`$GAUCHE_CONFIG --prefix` + +GAUCHE_PKGINCDIR=`$GAUCHE_CONFIG --pkgincdir` +GAUCHE_PKGLIBDIR=`$GAUCHE_CONFIG --pkglibdir` +GAUCHE_PKGARCHDIR=`$GAUCHE_CONFIG --pkgarchdir` +AC_SUBST(GAUCHE_PKGINCDIR) +AC_SUBST(GAUCHE_PKGLIBDIR) +AC_SUBST(GAUCHE_PKGARCHDIR) + dnl Check for headers. dnl Add your macro calls to check required headers, if you have any. diff -urN Gauche-libsvm-0.1/libsvm/svm.cpp Gauche-libsvm-0.1.new/libsvm/svm.cpp --- Gauche-libsvm-0.1/libsvm/svm.cpp 2005-07-27 19:13:07.000000000 -1000 +++ Gauche-libsvm-0.1.new/libsvm/svm.cpp 2005-09-22 16:15:45.000000000 -1000 @@ -23,7 +23,7 @@ #define INF HUGE_VAL #define TAU 1e-12 #define Malloc(type,n) (type *)malloc((n)*sizeof(type)) -#if 1 +#if 0 void info(char *fmt,...) { va_list ap; diff -urN Gauche-libsvm-0.1/libsvm.c Gauche-libsvm-0.1.new/libsvm.c --- Gauche-libsvm-0.1/libsvm.c 2005-07-27 22:35:36.000000000 -1000 +++ Gauche-libsvm-0.1.new/libsvm.c 2005-11-06 13:24:04.000000000 -1000 @@ -1,150 +1,124 @@ +#include #include "libsvm.h" static int * list_to_int_array (ScmObj ls) { - ScmObj e; - int *result; - int i=0; + ScmObj e; + int *result = NULL; + int i=0; + int len = Scm_Length(ls); - if (!SCM_LISTP (ls)) - { - Scm_Error ("list required, but got ~S", ls); + if (len < 0) { + Scm_Error ("list required, but got %S", ls); } - result = SCM_NEW_ARRAY (int, Scm_Length (ls)); + result = SCM_NEW_ATOMIC2(int*, sizeof(int)*len); - SCM_FOR_EACH (e, ls) - { - ScmObj item = SCM_CAR (e); - if (SCM_INTEGERP (item)) - { - result[i] = SCM_INT_VALUE (item); - i++; - } - else - { - Scm_Error ("integer required, but got ~S", i); - } + SCM_FOR_EACH (e, ls) { + ScmObj item = SCM_CAR (e); + result[i] = Scm_GetInteger(item); + i++; } - return result; + return result; } static double * list_to_double_array (ScmObj ls) { - ScmObj e; - double *result; - int i=0; + ScmObj e; + double *result = NULL; + int i=0; + int len = Scm_Length(ls); - if (!SCM_LISTP (ls)) - { - Scm_Error ("list required, but got ~S", ls); + if (len < 0) { + Scm_Error ("list required, but got %S", ls); } - result = SCM_NEW_ARRAY (double, Scm_Length (ls)); + result = SCM_NEW_ATOMIC2(double*, sizeof(double)*len); - SCM_FOR_EACH (e, ls) - { - ScmObj item = SCM_CAR (e); - if (SCM_REALP (item)) - { - result[i] = Scm_GetDouble (item); - i++; - } - else - { - Scm_Error ("integer required, but got ~S", i); - } + SCM_FOR_EACH (e, ls) { + ScmObj item = SCM_CAR (e); + result[i] = Scm_GetDouble(item); + i++; } - return result; + return result; } static ScmObj -scm_double_array_to_list (double *a, int n) +scm_double_array_to_list(const double *a, int n) { - int i; - ScmObj r = SCM_NIL; + int i; + ScmObj h = SCM_NIL, t = SCM_NIL; - for (i=0 ; ip); + for (i=0 ; isvm_type = svm_type; - param->kernel_type = kernel_type; - param->degree = degree; /* for poly */ - param->gamma = gamma; /* for poly/rbf/sigmoid */ - param->coef0 = coef0; /* for poly/sigmoid */ - - /* these are for training only */ - param->cache_size = cache_size; /* in MB */ - param->eps = eps; /* stopping criteria */ - param->C = C; /* for C_SVC, EPSILON_SVR and NU_SVR */ - param->nr_weight = nr_weight; /* for C_SVC */ - param->weight_label = list_to_int_array (weight_label); /* for C_SVC */ - param->weight = list_to_double_array (weight); /* for C_SVC */ - param->nu = nu; /* for NU_SVC, ONE_CLASS, and NU_SVR */ - param->p = p; /* for EPSILON_SVR */ - param->shrinking = shrinking; /* use the shrinking heuristics */ - param->probability = probability; /* do probability estimates */ + param->svm_type = svm_type; + param->kernel_type = kernel_type; + param->degree = degree; /* for poly */ + param->gamma = gamma; /* for poly/rbf/sigmoid */ + param->coef0 = coef0; /* for poly/sigmoid */ + + /* these are for training only */ + param->cache_size = cache_size; /* in MB */ + param->eps = eps; /* stopping criteria */ + param->C = C; /* for C_SVC, EPSILON_SVR and NU_SVR */ + param->nr_weight = nr_weight; /* for C_SVC */ + param->weight_label = list_to_int_array (weight_label); /* for C_SVC */ + param->weight = list_to_double_array (weight); /* for C_SVC */ + param->nu = nu; /* for NU_SVC, ONE_CLASS, and NU_SVR */ + param->p = p; /* for EPSILON_SVR */ + param->shrinking = shrinking; /* use the shrinking heuristics */ + param->probability = probability; /* do probability estimates */ - scm_param->p = param; - - return SCM_OBJ (scm_param); + scm_param->p = param; + + return SCM_OBJ(scm_param); } struct svm_parameter * @@ -175,9 +149,9 @@ static void scm_svm_model_finalizer (ScmObj z, void *data) { - if (SCM_SVM_MODEL_P (z)) + if (SCM_SVM_MODEL_P (z)) { - svm_destroy_model (SCM_SVM_MODEL(z)->model); + svm_destroy_model (SCM_SVM_MODEL(z)->model); } } @@ -208,35 +182,37 @@ } static struct svm_node * -scm_alist_to_svm_nodes (ScmObj alist) +scm_alist_to_svm_nodes (ScmObj alist, int use_malloc) { struct svm_node *node; ScmObj e, _e; int coli = 0; + int alen = Scm_Length(alist); - node = SCM_NEW_ARRAY (struct svm_node, Scm_Length (alist) + 1); + if (alen < 0) Scm_Error("proper list required, but got %S", alist); + + if (use_malloc) { + node = (struct svm_node*)malloc(sizeof(struct svm_node[1])*(alen + 1)); + } else { + node = SCM_NEW_ATOMIC2(struct svm_node*, + sizeof(struct svm_node[1])*(alen + 1)); + } SCM_FOR_EACH (_e, alist) { e = SCM_CAR (_e); if (SCM_PAIRP (e)) - { - ScmObj index = SCM_CAR (e); - ScmObj value = SCM_CDR (e); - - if (!SCM_INTEGERP (index)) - { - Scm_Error ("integer required, but got %S", index); - } - - node[coli].index = SCM_INT_VALUE (index); - node[coli].value = Scm_GetDouble (value); - } + { + ScmObj index = SCM_CAR (e); + ScmObj value = SCM_CDR (e); + node[coli].index = Scm_GetInteger(index); + node[coli].value = Scm_GetDouble(value); + } else - { - Scm_Error ("pair required, but got %S", node); - } + { + Scm_Error ("pair required, but got %S", node); + } coli++; } @@ -252,9 +228,11 @@ { struct svm_problem *p = SCM_NEW (struct svm_problem); p->l = Scm_Length (alist); + if (p->l < 0) Scm_Error("proper list required, but got %S", alist); - p->x = SCM_NEW_ARRAY (struct svm_node *, p->l); - p->y = SCM_NEW_ARRAY (double, p->l); + p->x = SCM_NEW_ATOMIC2(struct svm_node **, + sizeof(struct svm_node *)*(p->l)); + p->y = SCM_NEW_ATOMIC2(double*, sizeof(double)*(p->l)); { ScmObj _row, row; @@ -262,13 +240,12 @@ SCM_FOR_EACH (_row, alist) { - double label; - row = SCM_CAR (_row); + row = SCM_CAR (_row); - p->y[rowi] = Scm_GetDouble (SCM_CAR (row)); - p->x[rowi] = scm_alist_to_svm_nodes (SCM_CDR (row)); + p->y[rowi] = Scm_GetDouble (SCM_CAR (row)); + p->x[rowi] = scm_alist_to_svm_nodes (SCM_CDR (row), TRUE); - rowi++; + rowi++; } } @@ -300,35 +277,36 @@ double scm_svm_predict (struct svm_model *model, ScmObj alist) { - return svm_predict (model, scm_alist_to_svm_nodes (alist)); + return svm_predict (model, scm_alist_to_svm_nodes (alist, FALSE)); } ScmObj scm_svm_predict_values (struct svm_model *model, ScmObj alist) { - int n = Scm_Length (alist); - double *prob = SCM_NEW_ARRAY (double, n); - svm_predict_probability (model, scm_alist_to_svm_nodes (alist), prob); - return scm_double_array_to_list (prob, n); + int nclass = svm_get_nr_class(model); + int nvals = nclass*(nclass-1)/2; + double *prob = SCM_NEW_ATOMIC2(double*, sizeof(double)*nvals); + svm_predict_values(model, scm_alist_to_svm_nodes (alist, FALSE), prob); + return scm_double_array_to_list(prob, nvals); } ScmObj scm_svm_predict_probability (struct svm_model *model, ScmObj alist) { - int n = Scm_Length (alist); - double *values = SCM_NEW_ARRAY (double, n); - svm_predict_values (model, scm_alist_to_svm_nodes (alist), values); - return scm_double_array_to_list (values, n); + int nclass = svm_get_nr_class(model); + double *values = SCM_NEW_ARRAY (double, nclass); + svm_predict_probability(model, scm_alist_to_svm_nodes (alist, FALSE), values); + return scm_double_array_to_list (values, nclass); } -void -scm_svm_cross_validation (struct svm_problem *model, struct svm_parameter *p, int nr_fold) -{ - int n = svm_get_nr_class (model); - double *values = SCM_NEW_ARRAY (double, n); - svm_cross_validation (model, p, nr_fold, values); - return scm_double_array_to_list (values, n); -} +//ScmObj +//scm_svm_cross_validation (struct svm_problem *model, struct svm_parameter *p, int nr_fold) +//{ +// int n = svm_get_nr_class ((const struct svm_problem*)model); +// double *values = SCM_NEW_ARRAY (double, n); +// svm_cross_validation (model, p, nr_fold, values); +// return scm_double_array_to_list (values, n); +//} ScmObj scm_svm_get_labels (struct svm_model *model) @@ -338,3 +316,14 @@ svm_get_labels (model, values); return scm_int_array_to_list (values, n); } + +extern void Scm_Init_libsvmlib (ScmModule *); + +void +Scm_Init_libsvm () +{ + ScmModule *mod; + SCM_INIT_EXTENSION(libsvm); + mod = SCM_MODULE (SCM_FIND_MODULE ("util.svm.libsvm", TRUE)); + Scm_Init_libsvmlib(mod); +} diff -urN Gauche-libsvm-0.1/libsvm.h Gauche-libsvm-0.1.new/libsvm.h --- Gauche-libsvm-0.1/libsvm.h 2005-07-27 22:22:20.000000000 -1000 +++ Gauche-libsvm-0.1.new/libsvm.h 2005-11-06 13:24:12.000000000 -1000 @@ -3,6 +3,8 @@ #include #include +#include + struct _scm_svm_problem { @@ -75,7 +77,7 @@ double scm_svm_predict (struct svm_model *model, ScmObj alist); ScmObj scm_svm_predict_probability (struct svm_model *model, ScmObj alist); -void scm_svm_cross_validation (struct svm_problem *, struct svm_parameter *, int nr_weight); +ScmObj scm_svm_cross_validation (struct svm_problem *, struct svm_parameter *, int nr_weight); ScmObj scm_svm_get_labels (struct svm_model *model); diff -urN Gauche-libsvm-0.1/libsvm.scm Gauche-libsvm-0.1.new/libsvm.scm --- Gauche-libsvm-0.1/libsvm.scm 2005-07-27 21:56:23.000000000 -1000 +++ Gauche-libsvm-0.1.new/libsvm.scm 1969-12-31 14:00:00.000000000 -1000 @@ -1,32 +0,0 @@ -(define-module libsvm - (export-all)) - -(select-module libsvm) - -(dynamic-load "libsvm") - -(define (svm-parameter . kwds) - (let-keywords* kwds ((svm-type C_SVC) - (kernel-type RBF) - (degree 3) - (gamma 1) - (coef0 0) - (cache-size 40) - (eps 0.001) - (C 1) - (nr-weight 0) - (weight-label '()) - (weight '()) - (nu 0.5) - (p 0.1) - (shrinking 1) - (probability 0)) - (svm-parameter-new svm-type kernel-type - degree gamma coef0 - cache-size eps C - nr-weight - weight-label weight - nu p - shrinking probability))) - -(provide "libsvm") \ No newline at end of file diff -urN Gauche-libsvm-0.1/libsvmlib.stub Gauche-libsvm-0.1.new/libsvmlib.stub --- Gauche-libsvm-0.1/libsvmlib.stub 2005-07-28 14:54:17.000000000 -1000 +++ Gauche-libsvm-0.1.new/libsvmlib.stub 2005-11-06 13:23:34.000000000 -1000 @@ -11,11 +11,6 @@ (define-enum RBF) (define-enum SIGMOID) -(define-type "const char *" "c string" - "SCM_STRINGP" - "Scm_GetStringConst" - "SCM_MAKE_STR_COPYING") - (define-cclass "scm_svm_problem *" "Scm_scm_svm_problem_class" () ()) @@ -55,13 +50,13 @@ (define-cproc svm-train (problem:: parameter::) (return "svm_train")) -(define-cproc svm-cross-validation (problem:: parameter:: nr_fold::) - (return "scm_svm_cross_validation")) +;(define-cproc svm-cross-validation (problem:: parameter:: nr_fold::) +; (return "scm_svm_cross_validation")) -(define-cproc svm-save-model (model_file_name:: model::) +(define-cproc svm-save-model (model_file_name:: model::) (return "svm_save_model")) -(define-cproc svm-load-model (model_file_name::) +(define-cproc svm-load-model (model_file_name::) (return "svm_load_model")) (define-cproc svm-get-svm-type (model::) @@ -85,16 +80,6 @@ (define-cproc svm-predict-probability (model:: alist) (return "scm_svm_predict_probability")) -" -void Scm_Init_libsvmlib (ScmModule *); -void -Scm_Init_libsvm () -{ - ScmModule *mod = SCM_MODULE (SCM_FIND_MODULE (\"libsvm\", TRUE)); - Scm_Init_libsvmlib (mod); -} -" - ;; Local variables: ;; mode: scheme ;; end: diff -urN Gauche-libsvm-0.1/test.scm Gauche-libsvm-0.1.new/test.scm --- Gauche-libsvm-0.1/test.scm 2005-07-28 14:54:17.000000000 -1000 +++ Gauche-libsvm-0.1.new/test.scm 2005-11-06 13:20:44.000000000 -1000 @@ -1,8 +1,9 @@ (use gauche.test) +(use srfi-1) ; for every (test-start "libsvm") -(use libsvm) -(test-module 'libsvm) +(use util.svm.libsvm) +(test-module 'util.svm.libsvm) (define svm #f) (define problem #f) @@ -15,7 +16,7 @@ (test "svm-parameter-new" (lambda () - (set! svm (svm-parameter-new C_SVC RBF 3 1 0 40 0.001 1 0 '() '() 0.5 0.1 1 0)) + (set! svm (svm-parameter-new C_SVC RBF 3 1 0 40 0.001 1 0 '() '() 0.5 0.1 1 1)) svm) (lambda (a b) (is-a? b a))) @@ -80,16 +81,17 @@ (test* "svm-get-nr-class" RBF (svm-get-nr-class model)) -(test* "svm-get-labels" '(0 1) +(test* "svm-get-labels" '(1 0) (svm-get-labels model)) -(test* "svm-predict-values" '() - (svm-predict-values model '((1 . 1) (101 . 1)))) +(test* "svm-predict-values" '(0.9) + (svm-predict-values model '((1 . 1) (101 . 1))) + (lambda (thres value) (every < thres value))) -(test* "svm-predict-probability" '() +(test* "svm-predict-probability" '(0.0 0.0) (svm-predict-probability model '((1 . 1) (101 . 1)))) -(test* "svm-predict-probability" '() +(test* "svm-predict-probability" '(0.0 0.0) (svm-predict-probability model '((2 . 1) (102 . 1)))) (test-end) diff -urN Gauche-libsvm-0.1/util/svm/libsvm.scm Gauche-libsvm-0.1.new/util/svm/libsvm.scm --- Gauche-libsvm-0.1/util/svm/libsvm.scm 1969-12-31 14:00:00.000000000 -1000 +++ Gauche-libsvm-0.1.new/util/svm/libsvm.scm 2005-11-06 13:20:16.000000000 -1000 @@ -0,0 +1,31 @@ +(define-module util.svm.libsvm + (export-all)) +(select-module util.svm.libsvm) + +(dynamic-load "libsvm") + +(define (svm-parameter . kwds) + (let-keywords* kwds ((svm-type C_SVC) + (kernel-type RBF) + (degree 3) + (gamma 1) + (coef0 0) + (cache-size 40) + (eps 0.001) + (C 1) + (nr-weight 0) + (weight-label '()) + (weight '()) + (nu 0.5) + (p 0.1) + (shrinking 1) + (probability 0)) + (svm-parameter-new svm-type kernel-type + degree gamma coef0 + cache-size eps C + nr-weight + weight-label weight + nu p + shrinking probability))) + +(provide "util/svm/libsvm")