Changeset 32437 in project


Ignore:
Timestamp:
05/19/15 03:00:14 (5 years ago)
Author:
daishi
Message:

improved version of libsvm

Location:
release/4/libsvm/branches
Files:
1 added
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/libsvm/branches/using-gc/libsvm.scm

    r20847 r32437  
    2121;; 2. Better handling for larger datasets
    2222;; 3. Memory management - can we automate deleting of objects when scheme object gc-ed?
     23
     24
     25;; Modified by Daishi Kato to work with weight, probability, and set-finalizer!
    2326
    2427(module
     
    4346    svm-get-svr-probability
    4447    svm-predict
    45     svm-free-model-content
    46     svm-destroy-model
    47     svm-destroy-param
     48    svm-predict-probability
     49    ;svm-free-model-content
     50    ;svm-destroy-model
     51    ;svm-destroy-param
    4852    svm-check-parameter
    4953    svm-check-probability-model
    5054    )
    5155  (import chicken extras foreign scheme)
     56  (use srfi-4)
    5257
    5358  #>
     59  #include <assert.h>
    5460  #include "svm.h"
    5561  <#
     
    8591             (problem (create-svm-problem (length definition) max-feature-index))
    8692             (i 0))
     93        (set-finalizer! problem destroy-svm-problem)
    8794        (for-each (lambda (instance)
    8895                    (problem-set-label! problem i (exact->inexact (car instance)))
     
    98105      (let ((problem (create-svm-problem (length definition) (- (length (car definition)) 1)))
    99106            (i 0))
     107        (set-finalizer! problem destroy-svm-problem)
    100108        (for-each (lambda (instance)
    101109                    (problem-set-label! problem i (exact->inexact (car instance)))
     
    125133                     C_return(problem);"))
    126134
     135  (define destroy-svm-problem
     136    (foreign-lambda* void (((c-pointer (struct "svm_problem")) problem))
     137      "free(problem->y);
     138       free(problem->x[0]);
     139       free(problem->x);
     140       free(problem);"))
     141
    127142  (define problem-set-label!
    128143    (foreign-lambda* void (((c-pointer (struct "svm_problem")) problem) (int index) (double value))
     
    139154                     problem->x[index][feature].value = 0.0;"))
    140155 
    141   (define make-svm-node
     156  (define (make-svm-node index value)
     157    (let ((node (create-svm-node index value)))
     158      (set-finalizer! node destroy-svm-node)
     159      node))
     160
     161  (define create-svm-node
    142162    (foreign-lambda* (c-pointer (struct "svm_node")) ((int index) (double value))
    143163                     "struct svm_node * node = malloc(sizeof(struct svm_node));
     
    145165                     node->value = value;
    146166                     C_return(node);"
     167   ))
     168
     169  (define destroy-svm-node
     170    (foreign-lambda* void (((c-pointer (struct "svm_node")) node))
     171      "free(node);"
    147172   ))
    148173
     
    159184              (eps 0.001) ;     stopping criteria
    160185              (C 1.0) ; for C_SVC, EPSILON_SVR and NU_SVR
    161               (nr-weight 0) ;    for C_SVC
    162               ; int *weight_label;      for C_SVC ;; ??
    163               ; double* weight;         for C_SVC ;; ??
     186              (weight '()) ;     cons list for nr_weight, weight_label, weight
    164187              (nu 0.5) ;        for NU_SVC, ONE_CLASS, and NU_SVR
    165188              (p 0.1) ; for EPSILON_SVR
     
    167190              (probability 0) ; do probability estimates
    168191              )
    169       (build-parameter svm-type kernel-type degree gamma coef0 cache-size eps C nr-weight nu p shrinking probability))
    170 
    171     (define build-parameter
     192      (let ((param (create-svm-parameter svm-type kernel-type degree gamma coef0 cache-size eps C (length weight) (map car weight) (map cdr weight) nu p shrinking probability)))
     193        (set-finalizer! param svm-destroy-param)
     194        param))
     195
     196    (define create-svm-parameter
    172197      (foreign-lambda* (c-pointer (struct "svm_parameter"))
    173198                       ((int svm_type)
     
    180205                        (double C)
    181206                        (int nr_weight)
     207                        (scheme-object weight_label)
     208                        (scheme-object weight)
    182209                        (double nu)
    183210                        (double p)
     
    185212                        (int probability))
    186213     "struct svm_parameter * param = malloc(sizeof(struct svm_parameter));
     214      int i;
     215      C_word itm, lst;
    187216      param->svm_type = svm_type;
    188217      param->kernel_type = kernel_type;
     
    194223      param->C = C;
    195224      param->nr_weight = nr_weight;
    196       param->weight_label = NULL;
    197       param->weight = NULL;
     225      param->weight_label = malloc(sizeof(int) * nr_weight);
     226      for (i = 0, lst = weight_label; i < nr_weight; i++) {
     227        assert(C_i_pairp(lst) == C_SCHEME_TRUE);
     228        itm = C_u_i_car(lst);
     229        lst = C_u_i_cdr(lst);
     230        assert(C_fixnump(itm) == C_SCHEME_TRUE);
     231        param->weight_label[i] = C_unfix(itm);
     232      }
     233      param->weight = malloc(sizeof(double) * nr_weight);
     234      for (i = 0, lst = weight; i < nr_weight; i++) {
     235        assert(C_i_pairp(lst) == C_SCHEME_TRUE);
     236        itm = C_u_i_car(lst);
     237        lst = C_u_i_cdr(lst);
     238        if (C_immediatep(itm)) {
     239          assert(C_fixnump(itm) == C_SCHEME_TRUE);
     240          param->weight[i] = C_unfix(itm);
     241        } else {
     242          assert(C_flonump(itm) == C_SCHEME_TRUE);
     243          param->weight[i] = C_flonum_magnitude(itm);
     244        }
     245      }
    198246      param->nu = nu;
    199247      param->p = p;
     
    226274
    227275      (define problem-num-instances
    228         (foreign-lambda* integer (((c-pointer (struct svm_problem)) prob))
     276        (foreign-lambda* integer (((c-pointer (struct "svm_problem")) prob))
    229277                         "int size = prob->l;
    230278                         C_return(size);"))
     
    232280      ;; uses read-problem from svm-train.c
    233281      ;; -- reads in a problem in svmlight format and returns a pointer to the problem
    234       (define read-problem 
     282      (define read-problem-sub
    235283        (foreign-lambda* c-pointer ((c-string filename))
    236284                         "
     
    252300        elements = 0;
    253301
    254         int max_line_len = 1024;
    255         char * line = malloc(sizeof(char) * max_line_len);
     302        //int max_line_len = 1024;
     303        //char * line = malloc(sizeof(char) * max_line_len);
     304        char * line;
    256305        while((line = readline(fp)) != NULL)
    257306        {
     
    268317                ++elements;
    269318                ++prob->l;
     319                free(line);
    270320        }
    271321        rewind(fp);
     
    311361                        max_index = inst_max_index;
    312362                x_space[j++].index = -1;
     363                free(line);
    313364        }
    314365
     
    317368                         "
    318369                         ))
     370
     371      (define (read-problem filename)
     372        (let ((problem (read-problem-sub filename)))
     373          (set-finalizer! problem destroy-svm-problem)
     374          problem))
    319375
    320376      ;; access parts of problem
     
    358414      ;; input: const struct svm_problem *, const struct svm_parameter *
    359415      ;; output: struct svm_model *
    360       (define svm-train
     416      (define svm-train-sub
    361417        (foreign-lambda (c-pointer (struct "svm_model"))
    362418                        "svm_train"
     
    364420                        (c-pointer (struct "svm_parameter"))))
    365421
     422      (define (svm-train problem param)
     423        (let ((model (svm-train-sub problem param)))
     424          (set-finalizer! model svm-free-and-destroy-model)
     425          model))
     426
    366427      ;; input: const struct svm_problem *, const struct svm_parameter *, int nr_fold, double * target
    367428      ;; output: void
     
    376437      ;; input: const char * file_name
    377438      ;; output: struct svm_model *
    378       (define svm-load-model
     439      (define svm-load-model-sub
    379440        (foreign-lambda c-pointer "svm_load_model" c-string))
     441
     442      (define (svm-load-model filename)
     443        (let ((model (svm-load-model-sub filename)))
     444          (set-finalizer! model svm-free-and-destroy-model)
     445          model))
    380446
    381447      ;; input: const struct svm_model *
     
    412478      ;; input: const struct svm_model *, const struct svm_node *, double * prob_estimates
    413479      ;; output: double
    414       ;         (define svm-predict-probability
    415       ;           (foreign-lambda double "svm_predict_probability" c-pointer c-pointer double-pointer))
     480      (define svm-predict-probability-sub
     481        (foreign-lambda double "svm_predict_probability" (c-pointer (struct "svm_model")) (c-pointer (struct "svm_node")) f64vector))
     482
     483      (define (svm-predict-probability model node)
     484        (let* ((estimates (make-f64vector (svm-get-nr-class model)))
     485               (prob (svm-predict-probability-sub model node estimates)))
     486          (cons prob estimates)))
    416487
    417488      ;; input: struct svm_model *
    418489      ;; output: void
    419       (define svm-free-model-content
    420         (foreign-lambda void "svm_free_model_content" c-pointer))
     490      ;(define svm-free-model-content
     491      ;  (foreign-lambda void "svm_free_model_content" c-pointer))
    421492
    422493      ;; input: struct svm_model *
    423494      ;; output: void
    424       (define svm-destroy-model
    425         (foreign-lambda void "svm_destroy_model" c-pointer))
     495      ;(define svm-destroy-model
     496      ;  (foreign-lambda void "svm_destroy_model" c-pointer))
     497
     498      (define svm-free-and-destroy-model
     499        (foreign-lambda* void (((c-pointer (struct "svm_model")) model))
     500          "svm_free_and_destroy_model(&model);"))
    426501
    427502      ;; input: struct svm_parameter *
Note: See TracChangeset for help on using the changeset viewer.