Algorithm-Cluster

 view release on metacpan or  search on metacpan

perl/Cluster.xs  view on Meta::CPAN

new (class, nodes)
    char* class
    SV* nodes

    PREINIT:
    Tree* tree;
    SV* obj;
    int i;
    int n;
    AV* array;
    int* flag;

    CODE:
    if(!SvROK(nodes) || SvTYPE(SvRV(nodes)) != SVt_PVAV) { 
        croak("Algorithm::Cluster::Tree::new expects an array of nodes\n");
    }
    array = (AV *) SvRV(nodes);
    n = (int) av_len(array) + 1;
    tree = malloc(sizeof(Tree));
    if (tree) {
        tree->n = n;

perl/Cluster.xs  view on Meta::CPAN

        tree->nodes[i].distance = node->distance;
    }

    if (i < n) {
        /* break encountered */
        free(tree->nodes);
        free(tree);
        croak("Algorithm::Cluster::Tree::new expects an array of nodes\n");
    }

    flag = malloc((2*n+1)*sizeof(int));
    if(flag) {
         int j;
        for (i = 0; i < 2*n+1; i++) flag[i] = 0;
        for (i = 0; i < n; i++) {
            j = tree->nodes[i].left;
            if (j < 0) {
                j = -j-1;
                if (j>=i) break;
            }
            else j+=n;
            if (flag[j]) break;
            flag[j] = 1;
            j = tree->nodes[i].right;
            if (j < 0) {
                j = -j-1;
                if (j>=i) break;
            }
            else j+=n;
            if (flag[j]) break;
            flag[j] = 1;
        }
        free(flag);
    }

    if (!flag || i < n) {
        /* break encountered */
        free(tree->nodes);
        free(tree);
        croak("the array of nodes passed to Algorithm::Cluster::Tree::new does not represent a valid tree\n");
    }

    RETVAL = newSViv(0);
    obj = newSVrv(RETVAL, class);
    sv_setiv(obj, PTR2IV(tree));
    SvREADONLY_on(obj);

perl/Cluster.xs  view on Meta::CPAN

        n = tree->n + 1;
    }
    indices = malloc(n*sizeof(int));
    if (!indices) {
        if(values) free(values);
        croak("sort: insufficient memory");
    }
    /* --------------------------------------------------------------- */
    ok = sorttree(tree->n, tree->nodes, values, indices);
    if(values) free(values);
    /* -- Check for errors flagged by the C routine ------------------ */
    if (!ok) {
        free(indices);
        croak("sort: Error in the sorttree routine");
    }
    for(i=0; i<n; i++) XPUSHs(sv_2mortal(newSVnv(indices[i])));
    free(indices);

void
cut(obj, nclusters=0)
    SV* obj

src/cluster.c  view on Meta::CPAN

transpose (input) int
If transpose == 0, the distance between two rows in the matrix is calculated.
Otherwise, the distance between two columns in the matrix is calculated.
============================================================================
*/
{
    double result = 0.;
    double denom1 = 0.;
    double denom2 = 0.;
    int flag = 0;

    /* flag will remain zero if no nonzero combinations of mask1 and mask2 are
     * found.
     */
    if (transpose == 0) /* Calculate the distance between two rows */ {
        int i;
        for (i = 0; i < n; i++) {
            if (mask1[index1][i] && mask2[index2][i]) {
                double term1 = data1[index1][i];
                double term2 = data2[index2][i];
                double w = weight[i];
                result += w*term1*term2;
                denom1 += w*term1*term1;
                denom2 += w*term2*term2;
                flag = 1;
            }
        }
    }
    else {
        int i;
        for (i = 0; i < n; i++) {
            if (mask1[i][index1] && mask2[i][index2]) {
                double term1 = data1[i][index1];
                double term2 = data2[i][index2];
                double w = weight[i];
                result += w*term1*term2;
                denom1 += w*term1*term1;
                denom2 += w*term2*term2;
                flag = 1;
            }
        }
    }
    if (!flag) return 0.;
    if (denom1 == 0.) return 1.;
    if (denom2 == 0.) return 1.;
    result = result / sqrt(denom1*denom2);
    result = 1. - result;
    return result;
}

/* ********************************************************************* */

static double

src/cluster.c  view on Meta::CPAN

transpose (input) int
If transpose == 0, the distance between two rows in the matrix is calculated.
Otherwise, the distance between two columns in the matrix is calculated.
============================================================================
*/
{
    double result = 0.;
    double denom1 = 0.;
    double denom2 = 0.;
    int flag = 0;
    /* flag will remain zero if no nonzero combinations of mask1 and mask2 are
     * found.
     */

    if (transpose == 0) /* Calculate the distance between two rows */ {
        int i;
        for (i = 0; i < n; i++) {
            if (mask1[index1][i] && mask2[index2][i]) {
                double term1 = data1[index1][i];
                double term2 = data2[index2][i];
                double w = weight[i];
                result += w*term1*term2;
                denom1 += w*term1*term1;
                denom2 += w*term2*term2;
                flag = 1;
            }
        }
    }
    else {
        int i;
        for (i = 0; i < n; i++) {
            if (mask1[i][index1] && mask2[i][index2]) {
                double term1 = data1[i][index1];
                double term2 = data2[i][index2];
                double w = weight[i];
                result += w*term1*term2;
                denom1 += w*term1*term1;
                denom2 += w*term2*term2;
                flag = 1;
            }
        }
    }
    if (!flag) return 0.;
    if (denom1 == 0.) return 1.;
    if (denom2 == 0.) return 1.;
    result = fabs(result) / sqrt(denom1*denom2);
    result = 1. - result;
    return result;
}

/* *********************************************************************    */

static double

src/cluster.c  view on Meta::CPAN

transpose (input) int
If transpose == 0, the distance between two rows in the matrix is calculated.
Otherwise, the distance between two columns in the matrix is calculated.
============================================================================
*/
{
    double con = 0;
    double dis = 0;
    double exx = 0;
    double exy = 0;
    int flag = 0;
    /* flag will remain zero if no nonzero combinations of mask1 and mask2 are
     * found.
     */
    double denomx;
    double denomy;
    double tau;
    int i, j;

    if (transpose == 0) {
        for (i = 0; i < n; i++) {
            if (mask1[index1][i] && mask2[index2][i]) {

src/cluster.c  view on Meta::CPAN

                        const double x2 = data1[index1][j];
                        const double y1 = data2[index2][i];
                        const double y2 = data2[index2][j];
                        const double w = weight[i] * weight[j];
                        if (x1 < x2 && y1 < y2) con += w;
                        else if (x1 > x2 && y1 > y2) con += w;
                        else if (x1 < x2 && y1 > y2) dis += w;
                        else if (x1 > x2 && y1 < y2) dis += w;
                        else if (x1 == x2 && y1 != y2) exx += w;
                        else if (x1 != x2 && y1 == y2) exy += w;
                        flag = 1;
                    }
                }
            }
        }
    }
    else {
        for (i = 0; i < n; i++) {
            if (mask1[i][index1] && mask2[i][index2]) {
                for (j = 0; j < i; j++) {
                    if (mask1[j][index1] && mask2[j][index2]) {

src/cluster.c  view on Meta::CPAN

                        const double x2 = data1[j][index1];
                        const double y1 = data2[i][index2];
                        const double y2 = data2[j][index2];
                        const double w = weight[i] * weight[j];
                        if (x1 < x2 && y1 < y2) con += w;
                        else if (x1 > x2 && y1 > y2) con += w;
                        else if (x1 < x2 && y1 > y2) dis += w;
                        else if (x1 > x2 && y1 < y2) dis += w;
                        else if (x1 == x2 && y1 != y2) exx += w;
                        else if (x1 != x2 && y1 == y2) exy += w;
                        flag = 1;
                    }
                }
            }
        }
    }
    if (!flag) return 0.;
    denomx = con + dis + exx;
    denomy = con + dis + exy;
    if (denomx == 0) return 1;
    if (denomy == 0) return 1;
    tau = (con-dis)/sqrt(denomx*denomy);
    return 1.-tau;
}

/* *********************************************************************    */