Algorithm-Cluster

 view release on metacpan or  search on metacpan

perl/Cluster.xs  view on Meta::CPAN

        croak("set_distance should be applied to an Algorithm::Cluster::Node object");
    }
    node = INT2PTR(Node*,SvIV(SvRV(obj)));
    node->distance = distance;

void DESTROY (obj)
    SV* obj
    PREINIT:
    I32* temp;
    Node* node;
    PPCODE:
    temp = PL_markstack_ptr++;
    node = INT2PTR(Node*, SvIV(SvRV(obj)));
    free(node);
    if (PL_markstack_ptr != temp) {
        /* truly void, because dXSARGS not invoked */
        PL_markstack_ptr = temp;
        XSRETURN_EMPTY;
        /* return empty stack */
    }  /* must have used dXSARGS; list context implied */
    return;  /* assume stack size is correct */

perl/Cluster.xs  view on Meta::CPAN

    SV* order 

    PREINIT:
    int i;
    int n;
    Tree* tree;
    int* indices;
    double* values = NULL;
    int ok;

    PPCODE:
    if (!sv_isa(obj, "Algorithm::Cluster::Tree")) {
        croak("sort can only be applied to an Algorithm::Cluster::Tree object");
    }
    tree = INT2PTR(Tree*,SvIV(SvRV(obj)));
    if (order) {
        if(!SvROK(order) || SvTYPE(SvRV(order)) != SVt_PVAV) { 
            croak("Algorithm::Cluster::Tree::sort expects an order array\n");
        }
        values = malloc_row_perl2c_dbl(aTHX_ order, &n);
        if (!values) {

perl/Cluster.xs  view on Meta::CPAN

void
cut(obj, nclusters=0)
    SV* obj
    int nclusters
    PREINIT:
    int ok;
    int i;
    int n;
    Tree* tree;
    int* clusterid;
    PPCODE:
    if (!sv_isa(obj, "Algorithm::Cluster::Tree")) {
        croak("cut can only be applied to an Algorithm::Cluster::Tree object\n");
    }
    tree = INT2PTR(Tree*,SvIV(SvRV(obj)));
    n = tree->n + 1;
    if (nclusters < 0) {
        croak("cut: Requested number of clusters should be positive\n");
    }
    if (nclusters > n) {
        croak("cut: More clusters requested than items available\n");

perl/Cluster.xs  view on Meta::CPAN

    }
    for(i=0; i<n; i++) XPUSHs(sv_2mortal(newSVnv(clusterid[i])));
    free(clusterid);


void DESTROY (obj)
    SV* obj
    PREINIT:
    I32* temp;
    Tree* tree;
    PPCODE:
    temp = PL_markstack_ptr++;
    tree = INT2PTR(Tree*, SvIV(SvRV(obj)));
    free(tree->nodes);
    free(tree);
    if (PL_markstack_ptr != temp) {
        /* truly void, because dXSARGS not invoked */
        PL_markstack_ptr = temp;
        XSRETURN_EMPTY;
        /* return empty stack */
    }  /* must have used dXSARGS; list context implied */

perl/Cluster.xs  view on Meta::CPAN

    int      ndata;
    double   error;
    int      ifound;
    int      ok;

    double  * weight;
    double ** matrix;
    int    ** mask;


    PPCODE:
    /* ------------------------
     * Don't check the parameters, because we rely on the Perl
     * caller to check most parameters.
     */

    /* ------------------------
     * Malloc space for the return values from the library function
     */
    if (transpose==0) {
        nobjects = nrows;

perl/Cluster.xs  view on Meta::CPAN

    PREINIT:
    double** distancematrix;
    SV  *    clusterid_ref;
    int *    clusterid;
    double   error;
    int      ifound;



    PPCODE:
    /* ------------------------
     * Don't check the parameters, because we rely on the Perl
     * caller to check most parameters.
     */

    /* ------------------------
     * Malloc space for the return values from the library function
     */
    clusterid = malloc(nobjects * sizeof(int));
    if (!clusterid) {

perl/Cluster.xs  view on Meta::CPAN

    int    ** mask;

    double ** cdata;
    int    ** cmask;
    int       cnrows = 0; /* Initialize to make the compiler shut up */
    int       cncols = 0; /* Initialize to make the compiler shut up */

    int i;
    int ok;

    PPCODE:

    /* ------------------------
     * Don't check the parameters, because we rely on the Perl
     * caller to check most paramters.
     */
        if (transpose==0)
        {    cnrows = nclusters;
             cncols = ncols;
        }
        else if (transpose==1)

perl/Cluster.xs  view on Meta::CPAN

    double ** data;
    int    ** mask;
    double  * weight;
    double ** matrix;

    int       i;
    int       ok;


    PPCODE:
    /* ------------------------
     * Don't check the parameters, because we rely on the Perl
     * caller to check most parameters.
     */

    /* ------------------------
     * Malloc space for the return values from the library function
     */
        if (transpose==0) {
        nobjects = nrows;

perl/Cluster.xs  view on Meta::CPAN

    double ** matrix;
    int    ** mask;

    int ok;

    int i;
    AV * matrix_av;
    const int ndata = transpose ? nrows : ncols;
    const int nelements = transpose ? ncols : nrows;

    PPCODE:
    /* ------------------------
     * Don't check the parameters, because we rely on the Perl
     * caller to check most paramters.
     */

    /* ------------------------
     * Allocate space for clusterid[][2]. 
     */
    clusterid = malloc(nelements*sizeof(int[2]));
    if (!clusterid) {

perl/Cluster.xs  view on Meta::CPAN

    double* m;
    int i;
    int j;
    int nmin;
    int error;
    SV * mean_ref;
    SV * coordinates_ref;
    SV * pc_ref;
    SV * eigenvalues_ref;

    PPCODE:
    if(SvTYPE(SvRV(data_ref)) != SVt_PVAV) { 
        croak("argument to _pca is not an array reference\n");
    }
    nmin = nrows < ncols ? nrows : ncols;
    /* -- Create the output variables -------------------------------------- */
    u = parse_data(aTHX_ data_ref, NULL);
    w = malloc(nmin*sizeof(double));
    v = malloc(nmin*sizeof(double*));
    m = malloc(ncols*sizeof(double));
    if (v) {