Exemplo n.º 1
0
/* cs_add: sparse matrix addition */
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double alpha, beta ;
    cs Amatrix, Bmatrix, *A, *B, *C, *D ;
    if (nargout > 1 || nargin < 2 || nargin > 4)
    {
        mexErrMsgTxt ("Usage: C = cs_add(A,B,alpha,beta)") ;
    }
    A = cs_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ;    /* get A */
    B = cs_mex_get_sparse (&Bmatrix, 0, 1, pargin [1]) ;    /* get B */
    alpha = (nargin < 3) ? 1 : mxGetScalar (pargin [2]) ;   /* get alpha */
    beta  = (nargin < 4) ? 1 : mxGetScalar (pargin [3]) ;   /* get beta */
    C = cs_add (A,B,alpha,beta) ;       /* C = alpha*A + beta *B */
    cs_dropzeros (C) ;                  /* drop zeros */
    D = cs_transpose (C, 1) ;           /* sort result via double transpose */
    cs_spfree (C) ;
    C = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    pargout [0] = cs_mex_put_sparse (&C) ;      /* return C */
}
Exemplo n.º 2
0
/* cs_symperm: symmetric permutation of a symmetric sparse matrix. */
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    cs Amatrix, *A, *C, *D ;
    csi ignore, n, *P, *Pinv ;
    if (nargout > 1 || nargin != 2)
    {
        mexErrMsgTxt ("Usage: C = cs_symperm(A,p)") ;
    }
    A = cs_mex_get_sparse (&Amatrix, 1, 1, pargin [0]) ;
    n = A->n ;
    P = cs_mex_get_int (n, pargin [1], &ignore, 1) ;    /* get P */
    Pinv = cs_pinv (P, n) ;                             /* P=Pinv' */
    C = cs_symperm (A, Pinv, 1) ;                       /* C = A(p,p) */
    D = cs_transpose (C, 1) ;                           /* sort C */
    cs_spfree (C) ;
    C = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    pargout [0] = cs_mex_put_sparse (&C) ;              /* return C */
    cs_free (P) ;
    cs_free (Pinv) ;
}
/* cs_permute: permute a sparse matrix */
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    cs Amatrix, *A, *C, *D ;
    int ignore, *P, *Q, *Pinv ;
    if (nargout > 1 || nargin != 3)
    {
        mexErrMsgTxt ("Usage: C = cs_permute(A,p,q)") ;
    }
    A = cs_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ;    /* get A */
    P = cs_mex_get_int (A->m, pargin [1], &ignore, 1) ;     /* get P */
    Q = cs_mex_get_int (A->n, pargin [2], &ignore, 1) ;     /* get Q */
    Pinv = cs_pinv (P, A->m) ;              /* P = Pinv' */
    C = cs_permute (A, Pinv, Q, 1) ;        /* C = A(p,q) */
    D = cs_transpose (C, 1) ;               /* sort C via double transpose */
    cs_spfree (C) ;
    C = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    pargout [0] = cs_mex_put_sparse (&C) ;          /* return C */
    cs_free (Pinv) ;
    cs_free (P) ;
    cs_free (Q) ;
}
Exemplo n.º 4
0
/* Modified version of Tim Davis's cs_lu_mex.c file for MATLAB */
void install_lu(SEXP Ap, int order, double tol, Rboolean err_sing)
{
    // (order, tol) == (1, 1) by default, when called from R.
    SEXP ans;
    css *S;
    csn *N;
    int n, *p, *dims;
    CSP A = AS_CSP__(Ap), D;
    R_CheckStack();

    n = A->n;
    if (A->m != n)
	error(_("LU decomposition applies only to square matrices"));
    if (order) {		/* not using natural order */
	order = (tol == 1) ? 2	/* amd(S'*S) w/dense rows or I */
	    : 1;		/* amd (A+A'), or natural */
    }
    S = cs_sqr(order, A, /*qr = */ 0);	/* symbolic ordering */
    N = cs_lu(A, S, tol);	/* numeric factorization */
    if (!N) {
	if(err_sing)
	    error(_("cs_lu(A) failed: near-singular A (or out of memory)"));
	else {
	    /* No warning: The useR should be careful :
	     * Put  NA  into  "LU" factor */
	    set_factors(Ap, ScalarLogical(NA_LOGICAL), "LU");
	    return;
	}
    }
    cs_dropzeros(N->L);		/* drop zeros from L and sort it */
    D = cs_transpose(N->L, 1);
    cs_spfree(N->L);
    N->L = cs_transpose(D, 1);
    cs_spfree(D);
    cs_dropzeros(N->U);		/* drop zeros from U and sort it */
    D = cs_transpose(N->U, 1);
    cs_spfree(N->U);
    N->U = cs_transpose(D, 1);
    cs_spfree(D);
    p = cs_pinv(N->pinv, n);	/* p=pinv' */
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseLU")));
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
    dims[0] = n; dims[1] = n;
    SET_SLOT(ans, install("L"),
	     Matrix_cs_to_SEXP(N->L, "dtCMatrix", 0));
    SET_SLOT(ans, install("U"),
	     Matrix_cs_to_SEXP(N->U, "dtCMatrix", 0));
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, /* "p" */
			      INTSXP, n)), p, n);
    if (order)
	Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"),
				  INTSXP, n)), S->q, n);
    cs_nfree(N);
    cs_sfree(S);
    cs_free(p);
    UNPROTECT(1);
    set_factors(Ap, ans, "LU");
}
Exemplo n.º 5
0
cs* cs_sorted_multiply2(const cs* a, const cs* b)
{
  cs* D = cs_multiply(a,b);
  cs* E = cs_transpose(D,1);
  cs_spfree(D);
  cs* C = cs_transpose(E,1);
  cs_spfree(E);
  return C;
}
Exemplo n.º 6
0
cs* cs_sorted_multiply(const cs* a, const cs* b)
{
  cs* A = cs_transpose (a, 1) ;
  cs* B = cs_transpose (b, 1) ;
  cs* D = cs_multiply (B,A) ;   /* D = B'*A' */
  cs_spfree (A) ;
  cs_spfree (B) ;
  cs_dropzeros (D) ;      /* drop zeros from D */
  cs* C = cs_transpose (D, 1) ;   /* C = D', so that C is sorted */
  cs_spfree (D) ;
  return C;
}
Exemplo n.º 7
0
/* cs_lu: sparse LU factorization, with optional fill-reducing ordering */
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    css *S ;
    csn *N ;
    cs Amatrix, *A, *D ;
    csi n, order, *p ;
    double tol ;
    if (nargout > 4 || nargin > 3 || nargin < 1)
    {
        mexErrMsgTxt ("Usage: [L,U,p,q] = cs_lu (A,tol)") ;
    }
    A = cs_mex_get_sparse (&Amatrix, 1, 1, pargin [0]) ;        /* get A */
    n = A->n ;
    if (nargin == 2)                        /* determine tol and ordering */
    {
        tol = mxGetScalar (pargin [1]) ;
        order = (nargout == 4) ? 1 : 0 ;    /* amd (A+A'), or natural */
    }
    else
    {
        tol = 1 ;
        order = (nargout == 4) ? 2 : 0 ;    /* amd(S'*S) w/dense rows or I */
    }
    S = cs_sqr (order, A, 0) ;              /* symbolic ordering, no QR bound */
    N = cs_lu (A, S, tol) ;                 /* numeric factorization */
    if (!N) mexErrMsgTxt ("cs_lu failed (singular, or out of memory)") ;
    cs_dropzeros (N->L) ;                   /* drop zeros from L and sort it */
    D = cs_transpose (N->L, 1) ;
    cs_spfree (N->L) ;
    N->L = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    cs_dropzeros (N->U) ;                   /* drop zeros from U and sort it */
    D = cs_transpose (N->U, 1) ;
    cs_spfree (N->U) ;
    N->U = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    p = cs_pinv (N->pinv, n) ;              /* p=pinv' */
    pargout [0] = cs_mex_put_sparse (&(N->L)) ;     /* return L */
    pargout [1] = cs_mex_put_sparse (&(N->U)) ;     /* return U */
    pargout [2] = cs_mex_put_int (p, n, 1, 1) ;     /* return p */
    /* return Q */
    if (nargout == 4) pargout [3] = cs_mex_put_int (S->q, n, 1, 0) ;
    cs_nfree (N) ;
    cs_sfree (S) ;
}
Exemplo n.º 8
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    csi n, nel, s ;
    cs *A, *AT ;
    if (nargout > 1 || nargin != 3)
    {
        mexErrMsgTxt ("Usage: C = cs_frand(n,nel,s)") ;
    }
    n = mxGetScalar (pargin [0]) ;
    nel = mxGetScalar (pargin [1]) ;
    s = mxGetScalar (pargin [2]) ;

    n = CS_MAX (1,n) ;
    nel = CS_MAX (1,nel) ;
    s = CS_MAX (1,s) ;

    AT = cs_frand (n, nel, s) ;
    A = cs_transpose (AT, 1) ;
    cs_spfree (AT) ;
    cs_dropzeros (A) ;

    pargout [0] = cs_mex_put_sparse (&A) ;
}
Exemplo n.º 9
0
/* breadth-first search for coarse decomposition (C0,C1,R1 or R0,R3,C3) */
static int cs_bfs (const cs *A, int n, int *wi, int *wj, int *queue,
    const int *imatch, const int *jmatch, int mark)
{
    int *Ap, *Ai, head = 0, tail = 0, j, i, p, j2 ;
    cs *C ;
    for (j = 0 ; j < n ; j++)           /* place all unmatched nodes in queue */
    {
        if (imatch [j] >= 0) continue ; /* skip j if matched */
        wj [j] = 0 ;                    /* j in set C0 (R0 if transpose) */
        queue [tail++] = j ;            /* place unmatched col j in queue */
    }
    if (tail == 0) return (1) ;         /* quick return if no unmatched nodes */
    C = (mark == 1) ? ((cs *) A) : cs_transpose (A, 0) ;
    if (!C) return (0) ;                /* bfs of C=A' to find R3,C3 from R0 */
    Ap = C->p ; Ai = C->i ;
    while (head < tail)                 /* while queue is not empty */
    {
        j = queue [head++] ;            /* get the head of the queue */
        for (p = Ap [j] ; p < Ap [j+1] ; p++)
        {
            i = Ai [p] ;
            if (wi [i] >= 0) continue ; /* skip if i is marked */
            wi [i] = mark ;             /* i in set R1 (C3 if transpose) */
            j2 = jmatch [i] ;           /* traverse alternating path to j2 */
            if (wj [j2] >= 0) continue ;/* skip j2 if it is marked */
            wj [j2] = mark ;            /* j2 in set C1 (R3 if transpose) */
            queue [tail++] = j2 ;       /* add j2 to queue */
        }
    }
    if (mark != 1) cs_spfree (C) ;      /* free A' if it was created */
    return (1) ;
}
Exemplo n.º 10
0
// Modified version of Tim Davis's cs_qr_mex.c file for MATLAB (in CSparse)
//  Usage: [V,beta,p,R,q] = cs_qr(A) ;
SEXP dgCMatrix_QR(SEXP Ap, SEXP order)
{
    CSP A = AS_CSP__(Ap), D;
    int io = INTEGER(order)[0];
    Rboolean verbose = (io < 0);
    int m = A->m, n = A->n, ord = asLogical(order) ? 3 : 0, *p;
    R_CheckStack();

    if (m < n) error(_("A must have #{rows} >= #{columns}")) ;
    SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseQR")));
    int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
    dims[0] = m; dims[1] = n;
    css *S = cs_sqr(ord, A, 1);	/* symbolic QR ordering & analysis*/
    if (!S) error(_("cs_sqr failed"));
    if(verbose && S->m2 > m) // in ./cs.h , m2 := # of rows for QR, after adding fictitious rows
	Rprintf("Symbolic QR(): Matrix structurally rank deficient (m2-m = %d)\n",
		S->m2 - m);
    csn *N = cs_qr(A, S);		/* numeric QR factorization */
    if (!N) error(_("cs_qr failed")) ;
    cs_dropzeros(N->L);		/* drop zeros from V and sort */
    D = cs_transpose(N->L, 1); cs_spfree(N->L);
    N->L = cs_transpose(D, 1); cs_spfree(D);
    cs_dropzeros(N->U);		/* drop zeros from R and sort */
    D = cs_transpose(N->U, 1); cs_spfree(N->U) ;
    N->U = cs_transpose(D, 1); cs_spfree(D);
    m = N->L->m;		/* m may be larger now */
    // MM: m := S->m2  also counting the ficticious rows (Tim Davis, p.72, 74f)
    p = cs_pinv(S->pinv, m);	/* p = pinv' */
    SET_SLOT(ans, install("V"),
	     Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0));
    Memcpy(REAL(ALLOC_SLOT(ans, install("beta"),
			   REALSXP, n)), N->B, n);
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym,
			      INTSXP, m)), p, m);
    SET_SLOT(ans, install("R"),
	     Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0));
    if (ord)
	Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"),
				  INTSXP, n)), S->q, n);
    else
	ALLOC_SLOT(ans, install("q"), INTSXP, 0);
    cs_nfree(N);
    cs_sfree(S);
    cs_free(p);
    UNPROTECT(1);
    return ans;
}
Exemplo n.º 11
0
int *cs_counts(const cs *A, const int *parent, const int *post, int ata) {

	int i, j, k, n, m, J, s, p, q, jleaf, *ATp, *ATi, *maxfirst, *prevleaf, *ancestor,
			*head = NULL, *next = NULL, *colcount, *w, *first, *delta;
	cs *AT;
	if (!CS_CSC (A) || !parent || !post)
		return (NULL); /* check inputs */
	m = A->m;
	n = A->n;
	s = 4 * n + (ata ? (n + m + 1) : 0);
	delta = colcount = (int *) cs_malloc(n, sizeof(int)); /* allocate result */
	w = (int *) cs_malloc(s, sizeof(int)); /* get workspace */
	AT = cs_transpose(A, 0); /* AT = A' */
	if (!AT || !colcount || !w)
		return (cs_idone(colcount, AT, w, 0));
	ancestor = w;
	maxfirst = w + n;
	prevleaf = w + 2 * n;
	first = w + 3 * n;
	for (k = 0; k < s; k++)
		w[k] = -1; /* clear workspace w [0..s-1] */
	for (k = 0; k < n; k++) /* find first [j] */
	{
		j = post[k];
		delta[j] = (first[j] == -1) ? 1 : 0; /* delta[j]=1 if j is a leaf */
		for (; j != -1 && first[j] == -1; j = parent[j])
			first[j] = k;
	}
	ATp = AT->p;
	ATi = AT->i;
	if (ata)
		init_ata(AT, post, w, &head, &next);
	for (i = 0; i < n; i++)
		ancestor[i] = i; /* each node in its own set */
	for (k = 0; k < n; k++) {
		j = post[k]; /* j is the kth node in postordered etree */
		if (parent[j] != -1)
			delta[parent[j]]--; /* j is not a root */
		for (J = HEAD (k,j); J != -1; J = NEXT (J)) /* J=j for LL'=A case */
		{
			for (p = ATp[J]; p < ATp[J + 1]; p++) {
				i = ATi[p];
				q = cs_leaf(i, j, first, maxfirst, prevleaf, ancestor, &jleaf);
				if (jleaf >= 1)
					delta[j]++; /* A(i,j) is in skeleton */
				if (jleaf == 2)
					delta[q]--; /* account for overlap in q */
			}
		}
		if (parent[j] != -1)
			ancestor[j] = parent[j];
	}
	for (j = 0; j < n; j++) /* sum up delta's of each child */
	{
		if (parent[j] != -1)
			colcount[parent[j]] += colcount[j];
	}
	return (cs_idone(colcount, AT, w, 1)); /* success: free workspace */
}
Exemplo n.º 12
0
/* C = A + triu(A,1)' */
static cs *make_sym (cs *A)
{
    cs *AT, *C ;
    AT = cs_transpose (A, 1) ;          /* AT = A' */
    cs_fkeep (AT, &dropdiag, NULL) ;    /* drop diagonal entries from AT */
    C = cs_add (A, AT, 1, 1) ;          /* C = A+AT */
    cs_spfree (AT) ;
    return (C) ;
}
Exemplo n.º 13
0
/* cs_qr: sparse QR factorization */
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    css *S ;
    csn *N ;
    cs Amatrix, *A, *D ;
    csi m, n, order, *p ;
    if (nargout > 5 || nargin != 1)
    {
        mexErrMsgTxt ("Usage: [V,beta,p,R,q] = cs_qr(A)") ;
    }
    A = cs_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ;        /* get A */
    m = A->m ;
    n = A->n ;
    if (m < n) mexErrMsgTxt ("A must have # rows >= # columns") ;
    order = (nargout == 5) ? 3 : 0 ;        /* determine ordering */
    S = cs_sqr (order, A, 1) ;              /* symbolic QR ordering & analysis*/
    N = cs_qr (A, S) ;                      /* numeric QR factorization */
    if (!N) mexErrMsgTxt ("qr failed") ;
    cs_dropzeros (N->L) ;                   /* drop zeros from V and sort */
    D = cs_transpose (N->L, 1) ;
    cs_spfree (N->L) ;
    N->L = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    cs_dropzeros (N->U) ;                   /* drop zeros from R and sort */
    D = cs_transpose (N->U, 1) ;
    cs_spfree (N->U) ;
    N->U = cs_transpose (D, 1) ;
    cs_spfree (D) ;
    m = N->L->m ;                                   /* m may be larger now */
    p = cs_pinv (S->pinv, m) ;                      /* p = pinv' */
    pargout [0] = cs_mex_put_sparse (&(N->L)) ;     /* return V */
    cs_mex_put_double (n, N->B, &(pargout [1])) ;   /* return beta */
    pargout [2] = cs_mex_put_int (p, m, 1, 1) ;     /* return p */
    pargout [3] = cs_mex_put_sparse (&(N->U)) ;     /* return R */
    pargout [4] = cs_mex_put_int (S->q, n, 1, 0) ;  /* return q */
    cs_nfree (N) ;
    cs_sfree (S) ;
}
Exemplo n.º 14
0
/* Computes: y <- alpha A^T*x + beta y */
int mfiles_dgemv1(double alpha, const mxArray *A, const mxArray *x,
                  double beta, mxArray *y) {
    size_t rA = mxGetM(A);
    size_t cA = mxGetN(A);
    size_t rx = mxGetM(x);
    size_t cx = mxGetN(x);
    size_t ry = mxGetM(y);
    size_t cy = mxGetN(y);

    if (mxIsSparse(x) || mxIsSparse(y)) {
        mexErrMsgIdAndTxt("mfiles:BadType",
                          "Sparse vectors are not supported.");
    }

    if (mxIsComplex(A) || mxIsComplex(x) || mxIsComplex(y)) {
        mexErrMsgIdAndTxt("mfiles:BadType",
                          "Complex data is not supported.");
    }

    if ((rA != rx) || (cA != ry) || (cx != 1) || (cy != 1)) {
        mexErrMsgIdAndTxt("mfiles:BadDim",
                          "Dimensions of matrices do not match.");
    }

    if (mxIsSparse(A)) {
        double *px = mxGetPr(x);
        double *py = mxGetPr(y);
        double *pz = mxCalloc(ry, sizeof (double));

        cs *cs_A = cs_calloc(1, sizeof (cs));
        mfiles_mx2cs(A, cs_A);

        /* Transpose A */
        cs *cs_AT = cs_transpose(cs_A, 1);
        /* Compute z <- A^T*x */
        cs_gaxpy(cs_AT, px, pz);

        /* Compute y <- beta y */
        cblas_dscal(ry, beta, py, 1);
        /* Compute y <- alpha*z+y */
        cblas_daxpy(ry, alpha, pz, 1, py, 1);

        cs_free(cs_A); /* Check this cs_free and cs_spfree ? */
        cs_spfree(cs_AT);
        mxFree(pz);
    } else {
        double *pA = mxGetPr(A);
        double *px = mxGetPr(x);
        double *py = mxGetPr(y);
        cblas_dgemv(CblasRowMajor, CblasTrans,
                    rA, cA, alpha, pA, rA, px, 1, beta, py, 1);

    }

    return EXIT_SUCCESS;
}
Exemplo n.º 15
0
CSparseMatrix* NM_csc_trans(NumericsMatrix* A)
{
    if(!NM_sparse(A)->trans_csc)
    {
        assert(A->matrix2);
        A->matrix2->trans_csc = cs_transpose(NM_csc(A), 1); /* value = 1
                                                         * ->
                                                         * allocation */
    }
    return A->matrix2->trans_csc;
}
Exemplo n.º 16
0
/* x=A\b where A can be rectangular; b overwritten with solution */
int cs_qrsol (int order, const cs *A, double *b)
{
    double *x ;
    css *S ;
    csn *N ;
    cs *AT = NULL ;
    int k, m, n, ok ;
    if (!CS_CSC (A) || !b) return (0) ; /* check inputs */
    n = A->n ;
    m = A->m ;
    if (m >= n)
    {
        S = cs_sqr (order, A, 1) ;          /* ordering and symbolic analysis */
        N = cs_qr (A, S) ;                  /* numeric QR factorization */
        x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ;    /* get workspace */
        ok = (S && N && x) ;
        if (ok)
        {
            cs_ipvec (S->pinv, b, x, m) ;   /* x(0:m-1) = b(p(0:m-1) */
            for (k = 0 ; k < n ; k++)       /* apply Householder refl. to x */
            {
                cs_happly (N->L, k, N->B [k], x) ;
            }
            cs_usolve (N->U, x) ;           /* x = R\x */
            cs_ipvec (S->q, x, b, n) ;      /* b(q(0:n-1)) = x(0:n-1) */
        }
    }
    else
    {
        AT = cs_transpose (A, 1) ;          /* Ax=b is underdetermined */
        S = cs_sqr (order, AT, 1) ;         /* ordering and symbolic analysis */
        N = cs_qr (AT, S) ;                 /* numeric QR factorization of A' */
        x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ;    /* get workspace */
        ok = (AT && S && N && x) ;
        if (ok)
        {
            cs_pvec (S->q, b, x, m) ;       /* x(q(0:m-1)) = b(0:m-1) */
            cs_utsolve (N->U, x) ;          /* x = R'\x */
            for (k = m-1 ; k >= 0 ; k--)    /* apply Householder refl. to x */
            {
                cs_happly (N->L, k, N->B [k], x) ;
            }
            cs_pvec (S->pinv, x, b, n) ;    /* b(0:n-1) = x(p(0:n-1)) */
        }
    }
    cs_free (x) ;
    cs_sfree (S) ;
    cs_nfree (N) ;
    cs_spfree (AT) ;
    return (ok) ;
}
Exemplo n.º 17
0
/* find a maximum transveral */
int *cs_maxtrans (const cs *A, int seed)  /*[jmatch [0..m-1]; imatch [0..n-1]]*/
{
    int i, j, k, n, m, p, n2 = 0, m2 = 0, *Ap, *jimatch, *w, *cheap, *js, *is,
        *ps, *Ai, *Cp, *jmatch, *imatch, *q ;
    cs *C ;
    if (!CS_CSC (A)) return (NULL) ;                /* check inputs */
    n = A->n ; m = A->m ; Ap = A->p ; Ai = A->i ;
    w = jimatch = cs_calloc (m+n, sizeof (int)) ;   /* allocate result */
    if (!jimatch) return (NULL) ;
    for (k = 0, j = 0 ; j < n ; j++)    /* count nonempty rows and columns */
    {
        n2 += (Ap [j] < Ap [j+1]) ;
        for (p = Ap [j] ; p < Ap [j+1] ; p++)
        {
            w [Ai [p]] = 1 ;
            k += (j == Ai [p]) ;        /* count entries already on diagonal */
        }
    }
    if (k == CS_MIN (m,n))              /* quick return if diagonal zero-free */
    {
        jmatch = jimatch ; imatch = jimatch + m ;
        for (i = 0 ; i < k ; i++) jmatch [i] = i ;
        for (      ; i < m ; i++) jmatch [i] = -1 ;
        for (j = 0 ; j < k ; j++) imatch [j] = j ;
        for (      ; j < n ; j++) imatch [j] = -1 ;
        return (cs_idone (jimatch, NULL, NULL, 1)) ;
    }
    for (i = 0 ; i < m ; i++) m2 += w [i] ;
    C = (m2 < n2) ? cs_transpose (A,0) : ((cs *) A) ; /* transpose if needed */
    if (!C) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, NULL, 0)) ;
    n = C->n ; m = C->m ; Cp = C->p ;
    jmatch = (m2 < n2) ? jimatch + n : jimatch ;
    imatch = (m2 < n2) ? jimatch : jimatch + m ;
    w = cs_malloc (5*n, sizeof (int)) ;             /* get workspace */
    if (!w) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 0)) ;
    cheap = w + n ; js = w + 2*n ; is = w + 3*n ; ps = w + 4*n ;
    for (j = 0 ; j < n ; j++) cheap [j] = Cp [j] ;  /* for cheap assignment */
    for (j = 0 ; j < n ; j++) w [j] = -1 ;          /* all columns unflagged */
    for (i = 0 ; i < m ; i++) jmatch [i] = -1 ;     /* nothing matched yet */
    q = cs_randperm (n, seed) ;                     /* q = random permutation */
    for (k = 0 ; k < n ; k++)   /* augment, starting at column q[k] */
    {
        cs_augment (q ? q [k]: k, C, jmatch, cheap, w, js, is, ps) ;
    }
    cs_free (q) ;
    for (j = 0 ; j < n ; j++) imatch [j] = -1 ;     /* find row match */
    for (i = 0 ; i < m ; i++) if (jmatch [i] >= 0) imatch [jmatch [i]] = i ;
    return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 1)) ;
}
Exemplo n.º 18
0
cs *cs_rinvwishart(const cs *A, double nu, const css *As){
    
    int m, i, j, cnt;
    cs *T, *IW, *C, *W, *tC;
    csn *U;
    m = A->n;

    T = cs_spalloc (m, m, m*(m+1)/2, 1, 0) ;	 
    if (!T ) return (cs_done (T, NULL, NULL, 0));   

    double df = nu;
    cnt = 0;

    for(i = 0; i<m; i++){
      T->p[i] = cnt;  
      T->i[cnt] = i;    
      T->x[cnt] = sqrt(rchisq(df));
      cnt++;
      for(j = i+1; j<m; j++){
        T->i[cnt] = j;
        T->x[cnt] = rnorm(0.0,1.0);
        cnt++;
      } 
      df--;
    }
    T->p[m] = m*(m+1)/2;
    U = cs_chol(A, As);  
    if(U==NULL){
      PutRNGstate();
      error("ill-conditioned cross-product: can't form Cholesky factor\n");
    }

    C = cs_multiply(U->L,T);              // t(T)%*%chol(A)
    tC = cs_transpose(C, TRUE);            // t(CI)
    W  = cs_multiply(C,tC);   
    IW = cs_inv(W);                       // crossprod(t(CI))
    cs_spfree(T);
    cs_nfree(U);
    cs_spfree(C);
    cs_spfree(tC);
    cs_spfree(W);

    return (cs_done (IW, NULL, NULL, 1)) ;	/* success; free workspace, return C */

}
Exemplo n.º 19
0
/* find the strongly connected components of a square matrix */
csd *cs_scc (cs *A)     /* matrix A temporarily modified, then restored */
{
    int n, i, k, b, nb = 0, top, *xi, *pstack, *p, *r, *Ap, *ATp, *rcopy, *Blk ;
    cs *AT ;
    csd *D ;
    if (!CS_CSC (A)) return (NULL) ;                /* check inputs */
    n = A->n ; Ap = A->p ;
    D = cs_dalloc (n, 0) ;                          /* allocate result */
    AT = cs_transpose (A, 0) ;                      /* AT = A' */
    xi = cs_malloc (2*n+1, sizeof (int)) ;          /* get workspace */
    if (!D || !AT || !xi) return (cs_ddone (D, AT, xi, 0)) ;
    Blk = xi ; rcopy = pstack = xi + n ;
    p = D->p ; r = D->r ; ATp = AT->p ;
    top = n ;
    for (i = 0 ; i < n ; i++)   /* first dfs(A) to find finish times (xi) */
    {
        if (!CS_MARKED (Ap, i)) top = cs_dfs (i, A, top, xi, pstack, NULL) ;
    }
    for (i = 0 ; i < n ; i++) CS_MARK (Ap, i) ; /* restore A; unmark all nodes*/
    top = n ;
    nb = n ;
    for (k = 0 ; k < n ; k++)   /* dfs(A') to find strongly connnected comp */
    {
        i = xi [k] ;            /* get i in reverse order of finish times */
        if (CS_MARKED (ATp, i)) continue ;  /* skip node i if already ordered */
        r [nb--] = top ;        /* node i is the start of a component in p */
        top = cs_dfs (i, AT, top, p, pstack, NULL) ;
    }
    r [nb] = 0 ;                /* first block starts at zero; shift r up */
    for (k = nb ; k <= n ; k++) r [k-nb] = r [k] ;
    D->nb = nb = n-nb ;         /* nb = # of strongly connected components */
    for (b = 0 ; b < nb ; b++)  /* sort each block in natural order */
    {
        for (k = r [b] ; k < r [b+1] ; k++) Blk [p [k]] = b ;
    }
    for (b = 0 ; b <= nb ; b++) rcopy [b] = r [b] ;
    for (i = 0 ; i < n ; i++) p [rcopy [Blk [i]]++] = i ;
    return (cs_ddone (D, AT, xi, 1)) ;
}
void bi_conjugate_gradient_sparse(cs *A, double *b, double* x, int n, double itol){
   
    int i,j,iter;
     
    double rho,rho1,alpha,beta,omega;
     
    double r[n], r_t[n];
    double z[n], z_t[n];
    double q[n], q_t[n], temp_q[n];
    double p[n], p_t[n], temp_p[n];
    double res[n];                  //NA VGEI!
    double precond[n];
     
    //Initializations      
    memset(precond, 0, n*sizeof(double));
    memset(r, 0, n*sizeof(double));
    memset(r_t, 0, n*sizeof(double));
    memset(z, 0, n*sizeof(double));
    memset(z_t, 0, n*sizeof(double));
    memset(q, 0, n*sizeof(double));
    memset(q_t, 0, n*sizeof(double));
    memset(temp_q, 0, n*sizeof(double));
    memset(p, 0, n*sizeof(double));
    memset(p_t, 0, n*sizeof(double));
    memset(temp_p, 0, n*sizeof(double));
    memset(res, 0, n*sizeof(double));
     
    /* Preconditioner */
    double max;
    int pp;
    for(j = 0; j < n; ++j){
        for(pp = A->p[j], max = fabs(A->x[pp]); pp < A->p[j+1]; pp++)
            if(fabs(A->x[pp]) > max)                  //vriskei to diagonio stoixeio
                max = fabs(A->x[pp]);
        precond[j] = 1/max;    
    }  
    cs *AT = cs_transpose (A, 1) ;
 
    cblas_dcopy (n, x, 1, res, 1);
 
    //r=b-Ax
    cblas_dcopy (n, b, 1, r, 1);
    memset(p, 0, n*sizeof(double));
    cs_gaxpy (A, x, p);
    for(i=0;i<n;i++){
        r[i]=r[i]-p[i];
     
    }
     
    cblas_dcopy (n, r, 1, r_t, 1);
     
    double r_norm = cblas_dnrm2 (n, r, 1);
    double b_norm = cblas_dnrm2 (n, b, 1);
    if(!b_norm)
        b_norm = 1;
 
    iter = 0;  
   
    while( r_norm/b_norm > itol && iter < n ){
       
        iter++;
 
        cblas_dcopy (n, r, 1, z, 1);            //gia na min allaksei o r
        cblas_dcopy (n, r_t, 1, z_t, 1);        //gia na min allaksei o r_t
        for(i=0;i<n;i++){
            z[i]=precond[i]*z[i];
            z_t[i]=precond[i]*z_t[i];
        }
     
        rho = cblas_ddot (n, z, 1, r_t, 1);    
        if (fpclassify(fabs(rho)) == FP_ZERO){
            printf("RHO aborting Bi-CG due to EPS...\n");
            exit(42);
        }
         
        if (iter == 1){
            cblas_dcopy (n, z, 1, p, 1);
            cblas_dcopy (n, z_t, 1, p_t, 1);
        }
        else{      
            //p = z + beta*p;
            beta = rho/rho1;           
 
            cblas_dscal (n, beta, p, 1);        //rescale p by beta
            cblas_dscal (n, beta, p_t, 1);      //rescale p_t by beta
         
            cblas_daxpy (n, 1, z, 1, p, 1);     //p = 1*z + p
            cblas_daxpy (n, 1, z_t, 1, p_t, 1); //p_t = 1*z_t + p_t
        }
         
        rho1 = rho;
         
        //q = Ap
        //q_t = trans(A)*p_t
        memset(q, 0, n*sizeof(double));
        cs_gaxpy (A, p, q);
        memset(q_t, 0, n*sizeof(double));
        cs_gaxpy(AT, p_t, q_t);        
         
        omega = cblas_ddot (n, p_t, 1, q, 1);
        if (fpclassify(fabs(omega)) == FP_ZERO){
            printf("OMEGA aborting Bi-CG due to EPS...\n");
            exit(42);
        }
 
        alpha = rho/omega;     
 
        //x = x + aplha*p;
        cblas_dcopy (n, p, 1, temp_p, 1);
        cblas_dscal (n, alpha, temp_p, 1);//rescale by aplha
        cblas_daxpy (n, 1, temp_p, 1, res, 1);// sum x = 1*x + temp_p
 
        //R = R - aplha*Q;
        cblas_dcopy (n, q, 1, temp_q, 1);
        cblas_dscal (n, -alpha, temp_q, 1);//rescale by -aplha
        cblas_daxpy (n, 1, temp_q, 1, r, 1);// sum r = 1*r - temp_p    
 
        //~r=~r-alpha*~q
        cblas_dcopy (n, q_t, 1, temp_q, 1);
        cblas_dscal (n, -alpha, temp_q, 1);//rescale by -aplha
        cblas_daxpy (n, 1, temp_q, 1, r_t, 1);// sum r = 1*r - temp_p
 
        r_norm = cblas_dnrm2 (n, r, 1); //next step
    }
    cblas_dcopy (n, res, 1, x, 1);
 
    cs_spfree(AT);
}
Exemplo n.º 21
0
/* Cholesky update/downdate */
int demo3 (problem *Prob)
{
    cs *A, *C, *W = NULL, *WW, *WT, *E = NULL, *W2 ;
    int n, k, *Li, *Lp, *Wi, *Wp, p1, p2, *p = NULL, ok ;
    double *b, *x, *resid, *y = NULL, *Lx, *Wx, s,  t, t1 ;
    css *S = NULL ;
    csn *N = NULL ;
    if (!Prob || !Prob->sym || Prob->A->n == 0) return (0) ;
    A = Prob->A ; C = Prob->C ; b = Prob->b ; x = Prob->x ; resid = Prob->resid;
    n = A->n ;
    if (!Prob->sym || n == 0) return (1) ;
    rhs (x, b, n) ;                             /* compute right-hand side */
    printf ("\nchol then update/downdate ") ;
    print_order (1) ;
    y = cs_malloc (n, sizeof (double)) ;
    t = tic () ;
    S = cs_schol (1, C) ;                       /* symbolic Chol, amd(A+A') */
    printf ("\nsymbolic chol time %8.2f\n", toc (t)) ;
    t = tic () ;
    N = cs_chol (C, S) ;                        /* numeric Cholesky */
    printf ("numeric  chol time %8.2f\n", toc (t)) ;
    if (!S || !N || !y) return (done3 (0, S, N, y, W, E, p)) ;
    t = tic () ;
    cs_ipvec (S->pinv, b, y, n) ;               /* y = P*b */
    cs_lsolve (N->L, y) ;                       /* y = L\y */
    cs_ltsolve (N->L, y) ;                      /* y = L'\y */
    cs_pvec (S->pinv, y, x, n) ;                /* x = P'*y */
    printf ("solve    chol time %8.2f\n", toc (t)) ;
    printf ("original: ") ;
    print_resid (1, C, x, b, resid) ;           /* print residual */
    k = n/2 ;                                   /* construct W  */
    W = cs_spalloc (n, 1, n, 1, 0) ;
    if (!W) return (done3 (0, S, N, y, W, E, p)) ;
    Lp = N->L->p ; Li = N->L->i ; Lx = N->L->x ;
    Wp = W->p ; Wi = W->i ; Wx = W->x ;
    Wp [0] = 0 ;
    p1 = Lp [k] ;
    Wp [1] = Lp [k+1] - p1 ;
    s = Lx [p1] ;
    srand (1) ;
    for ( ; p1 < Lp [k+1] ; p1++)
    {
        p2 = p1 - Lp [k] ;
        Wi [p2] = Li [p1] ;
        Wx [p2] = s * rand () / ((double) RAND_MAX) ;
    }
    t = tic () ;
    ok = cs_updown (N->L, +1, W, S->parent) ;   /* update: L*L'+W*W' */
    t1 = toc (t) ;
    printf ("update:   time: %8.2f\n", t1) ;
    if (!ok) return (done3 (0, S, N, y, W, E, p)) ;
    t = tic () ;
    cs_ipvec (S->pinv, b, y, n) ;               /* y = P*b */
    cs_lsolve (N->L, y) ;                       /* y = L\y */
    cs_ltsolve (N->L, y) ;                      /* y = L'\y */
    cs_pvec (S->pinv, y, x, n) ;                /* x = P'*y */
    t = toc (t) ;
    p = cs_pinv (S->pinv, n) ;
    W2 = cs_permute (W, p, NULL, 1) ;           /* E = C + (P'W)*(P'W)' */
    WT = cs_transpose (W2,1) ;
    WW = cs_multiply (W2, WT) ;
    cs_spfree (WT) ;
    cs_spfree (W2) ;
    E = cs_add (C, WW, 1, 1) ;
    cs_spfree (WW) ;
    if (!E || !p) return (done3 (0, S, N, y, W, E, p)) ;
    printf ("update:   time: %8.2f (incl solve) ", t1+t) ;
    print_resid (1, E, x, b, resid) ;           /* print residual */
    cs_nfree (N) ;                              /* clear N */
    t = tic () ;
    N = cs_chol (E, S) ;                        /* numeric Cholesky */
    if (!N) return (done3 (0, S, N, y, W, E, p)) ;
    cs_ipvec (S->pinv, b, y, n) ;               /* y = P*b */
    cs_lsolve (N->L, y) ;                       /* y = L\y */
    cs_ltsolve (N->L, y) ;                      /* y = L'\y */
    cs_pvec (S->pinv, y, x, n) ;                /* x = P'*y */
    t = toc (t) ;
    printf ("rechol:   time: %8.2f (incl solve) ", t) ;
    print_resid (1, E, x, b, resid) ;           /* print residual */
    t = tic () ;
    ok = cs_updown (N->L, -1, W, S->parent) ;   /* downdate: L*L'-W*W' */
    t1 = toc (t) ;
    if (!ok) return (done3 (0, S, N, y, W, E, p)) ;
    printf ("downdate: time: %8.2f\n", t1) ;
    t = tic () ;
    cs_ipvec (S->pinv, b, y, n) ;               /* y = P*b */
    cs_lsolve (N->L, y) ;                       /* y = L\y */
    cs_ltsolve (N->L, y) ;                      /* y = L'\y */
    cs_pvec (S->pinv, y, x, n) ;                /* x = P'*y */
    t = toc (t) ;
    printf ("downdate: time: %8.2f (incl solve) ", t1+t) ;
    print_resid (1, C, x, b, resid) ;           /* print residual */
    return (done3 (1, S, N, y, W, E, p)) ;
} 
Exemplo n.º 22
0
/**
 * @brief Main wrapper for fitting a trendfilter model.
 * Takes as input either a sequence of lambda tuning parameters, or the number
 * of desired lambda values. In the latter case the function will also calculate
 * a lambda sequence. The user must supply allocated memory to store the output,
 * with the function itself returning only @c void. For default values, and an
 * example of how to call the function, see the function tf_admm_default.
 *
 * @param y                    a vector of responses
 * @param x                    a vector of response locations; must be in increasing order
 * @param w                    a vector of sample weights
 * @param n                    the length of y, x, and w
 * @param k                    degree of the trendfilter; i.e., k=1 linear
 * @param family               family code for the type of fit; family=0 for OLS
 * @param max_iter             maximum number of ADMM interations; ignored for k=0
 * @param lam_flag             0/1 flag for whether lambda sequence needs to be estimated
 * @param lambda               either a sequence of lambda when lam_flag=0, or empty
 *                             allocated space if lam_flag=1
 * @param nlambda              number of lambda values; need for both lam_flag=0 and 1
 * @param lambda_min_ratio     minimum ratio between min and max lambda; ignored for lam_flag=0
 * @param beta                 allocated space of size n*nlambda to store the output coefficents
 * @param obj                  allocated space of size max_iter*nlambda to store the objective
 * @param iter                 allocated space of size nlambda to store the number of iterations
 * @param status               allocated space of size nlambda to store the status of each run
 * @param rho                  tuning parameter for the ADMM algorithm
 * @param obj_tol              stopping criteria tolerance
 * @param alpha_ls             for family != 0, line search tuning parameter
 * @param gamma_ls             for family != 0, line search tuning parameter
 * @param max_iter_ls          for family != 0, max number of iterations in line search
 * @param max_iter_newton      for family != 0, max number of iterations in inner ADMM
 * @param verbose              0/1 flag for printing progress
 * @return void
 * @see tf_admm_default
 */
void tf_admm (double * y, double * x, double * w, int n, int k, int family,
              int max_iter, int lam_flag, double * lambda,
              int nlambda, double lambda_min_ratio, double * beta,
              double * obj, int * iter, int * status, double rho,
              double obj_tol, double alpha_ls, double gamma_ls,
              int max_iter_ls, int max_iter_newton, int verbose)
{
  int i;
  int j;
  double max_lam;
  double min_lam;
  double * temp_n;
  double * beta_max;
  double * alpha;
  double * u;

  cs * D;
  cs * Dt;
  cs * Dk;
  cs * Dkt;
  cs * DktDk;
  gqr * Dt_qr;
  gqr * Dkt_qr;

  beta_max = (double *) malloc(n * sizeof(double));
  temp_n   = (double *) malloc(n * sizeof(double));
  alpha    = (double *) malloc(n * sizeof(double)); /* we use extra buffer (n vs n-k) */
  u        = (double *) malloc(n * sizeof(double)); /* we use extra buffer (n vs n-k) */

  /* Assume w does not have zeros */
  for(i = 0; i < n; i++) temp_n[i] = 1/sqrt(w[i]);

  D = tf_calc_dk(n, k+1, x);
  Dk = tf_calc_dktil(n, k, x);
  Dt = cs_transpose(D, 1);
  diag_times_sparse(Dt, temp_n); /* Dt = W^{-1/2} Dt */
  Dkt = cs_transpose(Dk, 1);
  Dt_qr = glmgen_qr(Dt);
  Dkt_qr = glmgen_qr(Dkt);
  DktDk = cs_multiply(Dkt,Dk);

  /* Determine the maximum lambda in the path, and initiate the path if needed
   * using the input lambda_min_ratio and equally spaced log points.
   */
  max_lam = tf_maxlam(n, y, Dt_qr, w);
  if (!lam_flag)
  {
    min_lam = max_lam * lambda_min_ratio;
    lambda[0] = max_lam;
    for (i = 1; i < nlambda; i++)
      lambda[i] = exp((log(max_lam) * (nlambda - i -1) + log(min_lam) * i) / (nlambda-1));

  }

  rho = rho * pow( (x[n-1] - x[0])/n, (double)k);

  /* Initiate alpha and u for a warm start */
  if (lambda[0] < max_lam * 1e-5)
  {
    for (i = 0; i < n - k; i++)
    {
      alpha[i] = 0;
      u[i] = 0;
    }
  } else {

    /* beta_max */
    for (i = 0; i < n; i++) temp_n[i] = -sqrt(w[i]) * y[i];
    glmgen_qrsol (Dt_qr, temp_n);
    for (i = 0; i < n; i++) beta_max[i] = 0;
    cs_gaxpy(Dt, temp_n, beta_max);
    /* Dt has a W^{-1/2}, so in the next step divide by sqrt(w) instead of w. */
    for (i = 0; i < n; i++) beta_max[i] = y[i] - beta_max[i]/sqrt(w[i]);

    /* alpha_max */
    tf_dxtil(x, n, k, beta_max, alpha);

    /* u_max */
    switch (family)
    {
    case FAMILY_GAUSSIAN:
      for (i = 0; i < n; i++) u[i] = w[i] * (beta_max[i] - y[i]) / (rho * lambda[0]);
      break;

    case FAMILY_LOGISTIC:
      for (i = 0; i < n; i++) {
        u[i] = logi_b2(beta_max[i]) * w[i] * (beta_max[i] - y[i]) / (rho * lambda[0]);
      }
      break;

    case FAMILY_POISSON:
      for (i = 0; i < n; i++) {
        u[i] = pois_b2(beta_max[i]) * w[i] *(beta_max[i] - y[i]) / (rho * lambda[0]);
      }
      break;

    default:
      for (i = 0; i < nlambda; i++) status[i] = 2;
      return;
    }

    glmgen_qrsol (Dkt_qr, u);
  }

  /* Iterate lower level functions over all lambda values;
   * the alpha and u vectors get used each time of subsequent
   * warm starts
   */
  for (i = 0; i < nlambda; i++)
  {
    /* warm start */
    double * beta_init = (i == 0) ? beta_max : beta + (i-1)*n;
    for(j = 0; j < n; j++) beta[i*n + j] = beta_init[j];

    switch (family)
    {
      case FAMILY_GAUSSIAN:
        tf_admm_gauss(y, x, w, n, k, max_iter, lambda[i], beta+i*n, alpha,
                      u, obj+i*max_iter, iter+i, rho * lambda[i], obj_tol,
                      DktDk, verbose);
        break;

      case FAMILY_LOGISTIC:
        tf_admm_glm(y, x, w, n, k, max_iter, lambda[i], beta+i*n, alpha, u, obj+i*max_iter, iter+i,
                    rho * lambda[i], obj_tol, alpha_ls, gamma_ls, max_iter_ls, max_iter_newton,
                    DktDk, &logi_b, &logi_b1, &logi_b2, verbose);
        break;

      case FAMILY_POISSON:
        tf_admm_glm(y, x, w, n, k, max_iter, lambda[i], beta+i*n, alpha, u, obj+i*max_iter, iter+i,
                    rho * lambda[i], obj_tol, alpha_ls, gamma_ls, max_iter_ls, max_iter_newton,
                    DktDk, &pois_b, &pois_b1, &pois_b2, verbose);
        break;
    }

    /* If there any NaNs in beta: reset beta, alpha, u */
    if(has_nan(beta + i * n, n))
    {
      for(j = 0; j < n; j++) beta[i*n + j] = 0;
      for(j = 0; j < n-k; j++) { alpha[j] = 0; u[j] = 0; }
      status[i] = 1;
      printf("Numerical error in lambda[%d]=%f",i,lambda[i]);
    }
  }

  cs_spfree(D);
  cs_spfree(Dt);
  cs_spfree(Dk);
  cs_spfree(Dkt);
  cs_spfree(DktDk);
  glmgen_gqr_free(Dt_qr);
  glmgen_gqr_free(Dkt_qr);

  free(temp_n);
  free(beta_max);
  free(alpha);
  free(u);
}
Exemplo n.º 23
0
/**
 * @brief Main wrapper for fitting a trendfilter model.
 * Takes as input either a sequence of lambda tuning parameters, or the number
 * of desired lambda values. In the latter case the function will also calculate
 * a lambda sequence. The user must supply allocated memory to store the output,
 * with the function itself returning only @c void. For default values, and an
 * example of how to call the function, see the function tf_admm_default.
 *
 * @param x                    a vector of data locations; must be in increasing order
 * @param y                    a vector of responses
 * @param w                    a vector of sample weights
 * @param n                    the length of x, y, and w
 * @param k                    polynomial degree of the fitted trend; i.e., k=1 for linear
 * @param family               family code for the type of fit; family=0 for OLS
 * @param max_iter             maximum number of ADMM interations; ignored for k=0
 * @param beta0                initialization value of beta for first lambda; ignored if NULL
 * @param lam_flag             0/1 flag for whether lambda sequence needs to be estimated
 * @param lambda               either a sequence of lambda when lam_flag=0, or empty
 *                             allocated space if lam_flag=1
 * @param nlambda              number of lambda values; need for both lam_flag=0 and 1
 * @param lambda_min_ratio     minimum ratio between min and max lambda; ignored for lam_flag=0
 * @param df                   allocated space of nlambda to store the output df values
 * @param beta                 allocated space of size n*nlambda to store the output coefficents
 * @param obj                  allocated space of size max_iter*nlambda to store the objective
 * @param iter                 allocated space of size nlambda to store the number of iterations
 * @param status               allocated space of size nlambda to store the status of each run
 * @param rho                  tuning parameter for the ADMM algorithm
 * @param obj_tol              stopping criteria tolerance
 * @param obj_tol_newton       for family != 0, stopping criteria tolerance for prox Newton
 * @param alpha_ls             for family != 0, line search tuning parameter
 * @param gamma_ls             for family != 0, line search tuning parameter
 * @param max_iter_ls          for family != 0, max number of iterations in line search
 * @param max_iter_newton       for family != 0, max number of iterations in inner ADMM
 * @param verbose              0/1 flag for printing progress
 * @return void
 * @see tf_admm_default
 */
void tf_admm ( double * x, double * y, double * w, int n, int k, int family,
    int max_iter, double * beta0, int lam_flag, double * lambda,
    int nlambda, double lambda_min_ratio, int tridiag, int * df,
    double * beta, double * obj, int * iter, int * status,
    double rho, double obj_tol, double obj_tol_newton, double alpha_ls, double gamma_ls,
    int max_iter_ls, int max_iter_newton, int verbose)
{
  int i;
  int j;
  int numDualVars;
  double max_lam;
  double min_lam;
  double * temp_n;
  double * beta_max;
  double * alpha;
  double * u;
  double * A0;
  double * A1;
  double * v;

  cs * D;
  cs * Dt;
  cs * Dk;
  cs * Dkt;
  cs * DktDk;
  gqr * Dt_qr;
  gqr * Dkt_qr;

  beta_max = (double *) malloc(n * sizeof(double));
  temp_n   = (double *) malloc(n * sizeof(double));
  v        = (double *) malloc(n * sizeof(double));

  numDualVars = tridiag ? k : 1;

  /* we use extra buffer below (n vs n-k) */
  alpha    = (double *) malloc(n * numDualVars * sizeof(double)); 
  u        = (double *) malloc(n * numDualVars * sizeof(double)); 

  /* Assume w does not have zeros */
  for (i = 0; i < n; i++) temp_n[i] = 1/sqrt(w[i]);

  D 	= tf_calc_dk(n, k+1, x);
  Dk 	= tf_calc_dktil(n, k, x);
  Dt 	= cs_transpose(D, 1);

  diag_times_sparse(Dt, temp_n); /* Dt = W^{-1/2} Dt */

  Dkt 	 = cs_transpose(Dk, 1);
  Dt_qr  = glmgen_qr(Dt);
  Dkt_qr = glmgen_qr(Dkt);
  DktDk  = cs_multiply(Dkt,Dk);


  /* Determine the maximum lambda in the path */
  max_lam = tf_maxlam(n, y, Dt_qr, w);
  /* and if it is too small, return a trivial solution for Gaussian case */
  if (family == FAMILY_GAUSSIAN) {
    if (max_lam < 1e-12) {
      for (i=0; i<nlambda; i++) {
        for (j=0; j<n; j++) beta[i*n+j] = y[j];
        obj[i*(max_iter+1)] = 0;
        df[i] = n;
      }
      cs_spfree(D);
      cs_spfree(Dt);
      cs_spfree(Dk);
      cs_spfree(Dkt);
      cs_spfree(DktDk);
      glmgen_gqr_free(Dt_qr);
      glmgen_gqr_free(Dkt_qr);
      free(temp_n);
      free(beta_max);
      free(alpha);
      free(u);
      return;
    }
  }
  else {		
    max_lam += 1;
  }

  /* Initiate the path if needed using the input lambda_min_ratio and 
   * equally spaced points in log space. */
  if (!lam_flag) seq_logspace(max_lam,lambda_min_ratio,nlambda,lambda);

  /* Augmented Lagrangian parameter */
  rho = rho * pow((x[n-1] - x[0])/(double)(n-1), (double)k);
  
  /* Initiate alpha and u for a warm start */
  if (lambda[0] < max_lam * 1e-5)  
    for (i = 0; i < n - k; i++) alpha[i] = u[i] = 0;    
  else {
    /* beta_max */
    if (beta0 == NULL)
      calc_beta_max(y,w,n,Dt_qr,Dt,temp_n,beta_max);
    else
      memcpy(beta_max, beta0, n*sizeof(double));

    /* Check if beta = weighted mean(y) is better than beta */
    double yc = weighted_mean(y,w,n);
    for (i = 0; i < n; i++) temp_n[i] = yc;
    double obj1 = tf_obj(x,y,w,n,k,max_lam,family,beta_max,v);
    double obj2 = tf_obj(x,y,w,n,k,max_lam,family,temp_n,v);
    if(obj2 < obj1) memcpy(beta_max, temp_n, n*sizeof(double));

    /* alpha_max */

    if (tridiag && k>0)
    {
      tf_dx1(x, n, 1, beta_max, alpha + (n*k-n));
      for (j=k-1; j >= 1; j--)
        tf_dx1(x, n, k-j+1, alpha + (n*j), alpha + (n*j-n));      
    }
    else if (k>0)
      tf_dxtil(x, n, k, beta_max, alpha);

    /* u_max */    

    if (tridiag)
      for (j=0; j<k; j++) memset(u + (n*j), 0, (n-k+j) * sizeof(double)); 
    else {
      for (i = 0; i < n; i++) 
          u[i] = w[i] * (beta_max[i] - y[i]) / (rho * lambda[0]);

      if(family == FAMILY_LOGISTIC)
        for (i = 0; i < n; i++) u[i] *= logi_b2(beta_max[i]);
      else if(family == FAMILY_POISSON)
        for (i = 0; i < n; i++) u[i] *= pois_b2(beta_max[i]);
      glmgen_qrsol (Dkt_qr, u);
      // for (i = 0; i < n-k; i++) u[i] = 0;
    }
  }

  if (tridiag && k>0)
  {
    /* Setup tridiagonal systems */  
    A0 = (double*) malloc(n*k*sizeof(double));
    A1 = (double*) malloc(n*k*sizeof(double));

    for (j=2; j <= k; j++)
    {
      form_tridiag(x, n, k-j+2, 1, 1, A0+(n*j-n), A1+(n*j-n));
    }
  }  

  /* Iterate lower level functions over all lambda values;
   * the alpha and u vectors get used each time of subsequent
   * warm starts */
  for (i = 0; i < nlambda; i++)
  {    
    /* warm start */
    double *beta_init = (i == 0) ? beta_max : beta + (i-1)*n;
    for(j = 0; j < n; j++) beta[i*n + j] = beta_init[j];

    if (tridiag)
    {
      form_tridiag(x, n, 1, rho * lambda[i], 0, A0, A1);
      for (j=0; j < n; j++) A0[j] = A0[j] + w[j];
    }

    switch (family) {
      case FAMILY_GAUSSIAN:
        if (tridiag)        
          tf_admm_gauss_tri(x, y, w, n, k, max_iter, lambda[i], df+i, beta+i*n,
              alpha, u, obj+i*(1+max_iter), iter+i, rho * lambda[i],
              obj_tol, A0, A1, verbose);        
        else
          tf_admm_gauss(x, y, w, n, k, max_iter, lambda[i], df+i, beta+i*n,
              alpha, u, obj+i*(1+max_iter), iter+i, rho * lambda[i],
              obj_tol, DktDk, verbose);

        break;

      case FAMILY_LOGISTIC:
        tf_admm_glm(x, y, w, n, k, max_iter, lambda[i], tridiag, df+i, beta+i*n,
            alpha, u, obj+i*(1+max_iter_newton), iter+i, rho * lambda[i], obj_tol,
            obj_tol_newton, alpha_ls, gamma_ls, max_iter_ls, max_iter_newton,
            DktDk, A0, A1, &logi_b, &logi_b1, &logi_b2, verbose);
        break;

      case FAMILY_POISSON:
        tf_admm_glm(x, y, w, n, k, max_iter, lambda[i], tridiag, df+i, beta+i*n,
            alpha, u, obj+i*(1+max_iter_newton), iter+i, rho * lambda[i], obj_tol,
            obj_tol_newton, alpha_ls, gamma_ls, max_iter_ls, max_iter_newton,
            DktDk, A0, A1, &pois_b, &pois_b1, &pois_b2, verbose);
        break;

      default:
        printf("Unknown family, stopping calculation.\n");
        status[i] = 2;
    }
    

    /* If there any NaNs in beta: reset beta, alpha, u */
    if (has_nan(beta + i*n, n))
    {
      double yc = weighted_mean(y,w,n);
      switch(family) {
        case FAMILY_POISSON:
          yc = (yc > 0) ? log(yc) : -DBL_MAX;
          break;
        case FAMILY_LOGISTIC:
          yc = (yc > 0) ? ( yc < 1 ? log(yc/(1-yc)) : DBL_MAX) : -DBL_MAX;
          break;
        default: break;
      }
      for (j = 0; j < n; j++) beta[i*n + j] = yc;
      for (j = 0; j < n-k; j++) alpha[j] = 0;
      for (j = 0; j < n; j++) u[j] = w[j] * (beta[i*n+j] - y[j]) / (rho * lambda[i]);
      glmgen_qrsol (Dkt_qr, u);
      if (tridiag) for (j = 0; j < n*k; j++) alpha[j] = u[j] = 0;
      status[i] = 1;
    }
  }

  cs_spfree(D);
  cs_spfree(Dt);
  cs_spfree(Dk);
  cs_spfree(Dkt);
  cs_spfree(DktDk);
  glmgen_gqr_free(Dt_qr);
  glmgen_gqr_free(Dkt_qr);

  free(beta_max);
  free(temp_n);
  free(alpha);
  free(u);
  free(v);

  if (tridiag && k>0)
  {
    free(A0);
    free(A1);
  }
}
Exemplo n.º 24
0
/* Modified version of Tim Davis's cs_lu_mex.c file for MATLAB */
void install_lu(SEXP Ap, int order, double tol, Rboolean err_sing, Rboolean keep_dimnms)
{
    // (order, tol) == (1, 1) by default, when called from R.
    SEXP ans;
    css *S;
    csn *N;
    int n, *p, *dims;
    CSP A = AS_CSP__(Ap), D;
    R_CheckStack();

    n = A->n;
    if (A->m != n)
	error(_("LU decomposition applies only to square matrices"));
    if (order) {		/* not using natural order */
	order = (tol == 1) ? 2	/* amd(S'*S) w/dense rows or I */
	    : 1;		/* amd (A+A'), or natural */
    }
    S = cs_sqr(order, A, /*qr = */ 0);	/* symbolic ordering */
    N = cs_lu(A, S, tol);	/* numeric factorization */
    if (!N) {
	if(err_sing)
	    error(_("cs_lu(A) failed: near-singular A (or out of memory)"));
	else {
	    /* No warning: The useR should be careful :
	     * Put  NA  into  "LU" factor */
	    set_factors(Ap, ScalarLogical(NA_LOGICAL), "LU");
	    return;
	}
    }
    cs_dropzeros(N->L);		/* drop zeros from L and sort it */
    D = cs_transpose(N->L, 1);
    cs_spfree(N->L);
    N->L = cs_transpose(D, 1);
    cs_spfree(D);
    cs_dropzeros(N->U);		/* drop zeros from U and sort it */
    D = cs_transpose(N->U, 1);
    cs_spfree(N->U);
    N->U = cs_transpose(D, 1);
    cs_spfree(D);
    p = cs_pinv(N->pinv, n);	/* p=pinv' */
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseLU")));
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
    dims[0] = n; dims[1] = n;
    SEXP dn; Rboolean do_dn = FALSE;
    if(keep_dimnms) {
	dn = GET_SLOT(Ap, Matrix_DimNamesSym);
	do_dn = !isNull(VECTOR_ELT(dn, 0));
	if(do_dn) {
	    dn = PROTECT(duplicate(dn));
	    // permute rownames by p :  rn <- rn[ p ] :
	    SEXP rn = PROTECT(duplicate(VECTOR_ELT(dn, 0)));
	    for(int i=0; i < n; i++)
		SET_STRING_ELT(VECTOR_ELT(dn, 0), i, STRING_ELT(rn, p[i]));
	    UNPROTECT(1); // rn
	    SET_VECTOR_ELT(dn, 1, R_NilValue); // colnames(.) := NULL
	}
    }
    SET_SLOT(ans, install("L"),
	     Matrix_cs_to_SEXP(N->L, "dtCMatrix", 0, do_dn ? dn : R_NilValue));

    if(keep_dimnms) {
	if(do_dn) {
	    UNPROTECT(1); // dn
	    dn = GET_SLOT(Ap, Matrix_DimNamesSym);
	}
	do_dn = !isNull(VECTOR_ELT(dn, 1));
	if(do_dn) {
	    dn = PROTECT(duplicate(dn));
	    if(order) { // permute colnames by S->q :  cn <- cn[ S->q ] :
		SEXP cn = PROTECT(duplicate(VECTOR_ELT(dn, 1)));
		for(int j=0; j < n; j++)
		    SET_STRING_ELT(VECTOR_ELT(dn, 1), j, STRING_ELT(cn, S->q[j]));
		UNPROTECT(1); // cn
	    }
	    SET_VECTOR_ELT(dn, 0, R_NilValue); // rownames(.) := NULL
	}
    }
    SET_SLOT(ans, install("U"),
	     Matrix_cs_to_SEXP(N->U, "dtCMatrix", 0, do_dn ? dn : R_NilValue));
    if(do_dn) UNPROTECT(1); // dn
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, /* "p" */
			      INTSXP, n)), p, n);
    if (order)
	Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"),
				  INTSXP, n)), S->q, n);
    cs_nfree(N);
    cs_sfree(S);
    cs_free(p);
    UNPROTECT(1);
    set_factors(Ap, ans, "LU");
}
Exemplo n.º 25
0
int main ( void )
{
  cs *A;
  cs *AT;
  cs *C;
  cs *D;
  cs *Eye;
  int i;
  int m;
  cs *T;

  printf ( "\n" );
  printf ( "CS_DEMO1:\n" );
  printf ( "  Demonstration of the CSPARSE package.\n" );
/* 
  Load the triplet matrix T from standard input.
*/
  T = cs_load ( stdin );	
/*
  Print T.
*/
  printf ( "T:\n" ); 
  cs_print ( T, 0 );
/*
  A = compressed-column form of T.
*/
  A = cs_triplet ( T );
  printf ( "A:\n" ); 
  cs_print ( A, 0 );
/*
  Clear T.
*/
  cs_spfree ( T );
/*
  AT = A'.
*/ 
  AT = cs_transpose ( A, 1 );
  printf ( "AT:\n" ); 
  cs_print ( AT, 0 );
/*
  M = number of rows of A.
*/
  m = A->m;
/*
  Create triplet identity matrix.
*/
  T = cs_spalloc ( m, m, m, 1, 1 );

  for ( i = 0; i < m; i++ ) 
  {
    cs_entry ( T, i, i, 1 );
  }
/* 
  Eye = speye ( m ) 
*/
  Eye = cs_triplet ( T );
  cs_spfree ( T );
/* 
  Compute C = A * A'.
*/
  C = cs_multiply ( A, AT );		
/* 
  Compute D = C + Eye * norm (C,1).
*/
  D = cs_add ( C, Eye, 1, cs_norm ( C ) );   

  printf ( "D:\n" ); 
  cs_print ( D, 0 );
/* 
  Clear A, AT, C, D, Eye, 
*/
  cs_spfree ( A );			
  cs_spfree ( AT );
  cs_spfree ( C );
  cs_spfree ( D );
  cs_spfree ( Eye );
/*
  Terminate.
*/
  printf ( "\n" );
  printf ( "CS_DEMO1:\n" );
  printf ( "  Normal end of execution.\n" );

  return ( 0 );
}
Exemplo n.º 26
0
static int cs_fact_init_umfpack( cs_fact_t *umfd, const cs *A )
{
#ifdef USE_UMFPACK
   int ret;
   void *symbolic;
   cs *T;

   /* Create matrix and sort. */
   /* Non-symmetric case. */
   if (0) {
      T        = cs_transpose( A, 1 );
      umfd->A  = cs_transpose( T, 1 );
      cs_spfree( T );
   }
   /* Symmetric case. */
   else {
      umfd->A  = cs_transpose( A, 1 );
   }
   cs_dupl( umfd->A );

   /* Generate symbolic. */
   ret = umfpack_di_symbolic( umfd->n, umfd->n, umfd->A->p, umfd->A->i, umfd->A->x, &symbolic, NULL, NULL );
   if (ret < UMFPACK_OK)
      goto err_sym;

   /* Generate numeric. */
   ret = umfpack_di_numeric(  umfd->A->p, umfd->A->i, umfd->A->x, symbolic, &umfd->numeric, NULL, NULL );
   if (ret < UMFPACK_OK)
      goto err_num;
   else if (ret > UMFPACK_OK) {
      switch (ret) {
         case UMFPACK_WARNING_singular_matrix:
            fprintf( stderr, "UMFPACK: Matrix is singular.\n" );
            break;
         case UMFPACK_WARNING_determinant_underflow:
            fprintf( stderr, "UMFPACK: Determinant underflow.\n" );
            break;
         case UMFPACK_WARNING_determinant_overflow:
            fprintf( stderr, "UMFPACK: Determinant overflow.\n" );
            break;
      }
   }

   /* Clean up symbolic. */
   umfpack_di_free_symbolic( &symbolic );

   /* Allocate buffers. */
   umfd->wi = malloc( umfd->n * sizeof(int) );
   if (umfd->wi == NULL)
      goto err_wi;
   umfd->w  = malloc( umfd->n*5 * sizeof(double) ); /* We consider iteration refinement. */
   if (umfd->w == NULL)
      goto err_w;
   umfd->x  = calloc( umfd->n, sizeof(double) );
   if (umfd->x == NULL)
      goto err_x;

   umfd->type = CS_FACT_UMFPACK;
   return 0;
err_x:
   free( umfd->w );
err_w:
   free( umfd->wi );
err_wi:
   umfpack_di_free_numeric( &umfd->numeric );
err_num:
   umfpack_di_free_symbolic( &symbolic );
err_sym:
   cs_spfree( umfd->A );
   return -1;
#else /* USE_UMFPACK */
   (void) umfd;
   (void) A;
   return -1;
#endif /* USE_UMFPACK */
}
Exemplo n.º 27
0
/* p = amd(A+A') if symmetric is true, or amd(A'A) otherwise */
CS_INT *cs_amd (CS_INT order, const cs *A)  /* order 0:natural, 1:Chol, 2:LU, 3:QR */
{
    cs *C, *A2, *AT ;
    CS_INT *Cp, *Ci, *last, *W, *len, *nv, *next, *P, *head, *elen, *degree, *w,
        *hhead, *ATp, *ATi, d, dk, dext, lemax = 0, e, elenk, eln, i, j, k, k1,
        k2, k3, jlast, ln, dense, nzmax, mindeg = 0, nvi, nvj, nvk, mark, wnvi,
        ok, cnz, nel = 0, p, p1, p2, p3, p4, pj, pk, pk1, pk2, pn, q, n, m, t ;
    unsigned CS_INT h ;
    /* --- Construct matrix C ----------------------------------------------- */
    if (!CS_CSC (A) || order <= 0 || order > 3) return (NULL) ; /* check */
    AT = cs_transpose (A, 0) ;              /* compute A' */
    if (!AT) return (NULL) ;
    m = A->m ; n = A->n ;
    dense = CS_MAX (16, 10 * sqrt ((double) n)) ;   /* find dense threshold */
    dense = CS_MIN (n-2, dense) ;
    if (order == 1 && n == m)
    {
        C = cs_add (A, AT, 0, 0) ;          /* C = A+A' */
    }
    else if (order == 2)
    {
        ATp = AT->p ;                       /* drop dense columns from AT */
        ATi = AT->i ;
        for (p2 = 0, j = 0 ; j < m ; j++)
        {
            p = ATp [j] ;                   /* column j of AT starts here */
            ATp [j] = p2 ;                  /* new column j starts here */
            if (ATp [j+1] - p > dense) continue ;   /* skip dense col j */
            for ( ; p < ATp [j+1] ; p++) ATi [p2++] = ATi [p] ;
        }
        ATp [m] = p2 ;                      /* finalize AT */
        A2 = cs_transpose (AT, 0) ;         /* A2 = AT' */
        C = A2 ? cs_multiply (AT, A2) : NULL ;  /* C=A'*A with no dense rows */
        cs_spfree (A2) ;
    }
    else
    {
        C = cs_multiply (AT, A) ;           /* C=A'*A */
    }
    cs_spfree (AT) ;
    if (!C) return (NULL) ;
    cs_fkeep (C, &cs_diag, NULL) ;          /* drop diagonal entries */
    Cp = C->p ;
    cnz = Cp [n] ;
    P = cs_malloc (n+1, sizeof (CS_INT)) ;     /* allocate result */
    W = cs_malloc (8*(n+1), sizeof (CS_INT)) ; /* get workspace */
    t = cnz + cnz/5 + 2*n ;                 /* add elbow room to C */
    if (!P || !W || !cs_sprealloc (C, t)) return (cs_idone (P, C, W, 0)) ;
    len  = W           ; nv     = W +   (n+1) ; next   = W + 2*(n+1) ;
    head = W + 3*(n+1) ; elen   = W + 4*(n+1) ; degree = W + 5*(n+1) ;
    w    = W + 6*(n+1) ; hhead  = W + 7*(n+1) ;
    last = P ;                              /* use P as workspace for last */
    /* --- Initialize quotient graph ---------------------------------------- */
    for (k = 0 ; k < n ; k++) len [k] = Cp [k+1] - Cp [k] ;
    len [n] = 0 ;
    nzmax = C->nzmax ;
    Ci = C->i ;
    for (i = 0 ; i <= n ; i++)
    {
        head [i] = -1 ;                     /* degree list i is empty */
        last [i] = -1 ;
        next [i] = -1 ;
        hhead [i] = -1 ;                    /* hash list i is empty */
        nv [i] = 1 ;                        /* node i is just one node */
        w [i] = 1 ;                         /* node i is alive */
        elen [i] = 0 ;                      /* Ek of node i is empty */
        degree [i] = len [i] ;              /* degree of node i */
    }
    mark = cs_wclear (0, 0, w, n) ;         /* clear w */
    elen [n] = -2 ;                         /* n is a dead element */
    Cp [n] = -1 ;                           /* n is a root of assembly tree */
    w [n] = 0 ;                             /* n is a dead element */
    /* --- Initialize degree lists ------------------------------------------ */
    for (i = 0 ; i < n ; i++)
    {
        d = degree [i] ;
        if (d == 0)                         /* node i is empty */
        {
            elen [i] = -2 ;                 /* element i is dead */
            nel++ ;
            Cp [i] = -1 ;                   /* i is a root of assembly tree */
            w [i] = 0 ;
        }
        else if (d > dense)                 /* node i is dense */
        {
            nv [i] = 0 ;                    /* absorb i into element n */
            elen [i] = -1 ;                 /* node i is dead */
            nel++ ;
            Cp [i] = CS_FLIP (n) ;
            nv [n]++ ;
        }
        else
        {
            if (head [d] != -1) last [head [d]] = i ;
            next [i] = head [d] ;           /* put node i in degree list d */
            head [d] = i ;
        }
    }
    while (nel < n)                         /* while (selecting pivots) do */
    {
        /* --- Select node of minimum approximate degree -------------------- */
        for (k = -1 ; mindeg < n && (k = head [mindeg]) == -1 ; mindeg++) ;
        if (next [k] != -1) last [next [k]] = -1 ;
        head [mindeg] = next [k] ;          /* remove k from degree list */
        elenk = elen [k] ;                  /* elenk = |Ek| */
        nvk = nv [k] ;                      /* # of nodes k represents */
        nel += nvk ;                        /* nv[k] nodes of A eliminated */
        /* --- Garbage collection ------------------------------------------- */
        if (elenk > 0 && cnz + mindeg >= nzmax)
        {
            for (j = 0 ; j < n ; j++)
            {
                if ((p = Cp [j]) >= 0)      /* j is a live node or element */
                {
                    Cp [j] = Ci [p] ;       /* save first entry of object */
                    Ci [p] = CS_FLIP (j) ;  /* first entry is now CS_FLIP(j) */
                }
            }
            for (q = 0, p = 0 ; p < cnz ; ) /* scan all of memory */
            {
                if ((j = CS_FLIP (Ci [p++])) >= 0)  /* found object j */
                {
                    Ci [q] = Cp [j] ;       /* restore first entry of object */
                    Cp [j] = q++ ;          /* new pointer to object j */
                    for (k3 = 0 ; k3 < len [j]-1 ; k3++) Ci [q++] = Ci [p++] ;
                }
            }
            cnz = q ;                       /* Ci [cnz...nzmax-1] now free */
        }
        /* --- Construct new element ---------------------------------------- */
        dk = 0 ;
        nv [k] = -nvk ;                     /* flag k as in Lk */
        p = Cp [k] ;
        pk1 = (elenk == 0) ? p : cnz ;      /* do in place if elen[k] == 0 */
        pk2 = pk1 ;
        for (k1 = 1 ; k1 <= elenk + 1 ; k1++)
        {
            if (k1 > elenk)
            {
                e = k ;                     /* search the nodes in k */
                pj = p ;                    /* list of nodes starts at Ci[pj]*/
                ln = len [k] - elenk ;      /* length of list of nodes in k */
            }
            else
            {
                e = Ci [p++] ;              /* search the nodes in e */
                pj = Cp [e] ;
                ln = len [e] ;              /* length of list of nodes in e */
            }
            for (k2 = 1 ; k2 <= ln ; k2++)
            {
                i = Ci [pj++] ;
                if ((nvi = nv [i]) <= 0) continue ; /* node i dead, or seen */
                dk += nvi ;                 /* degree[Lk] += size of node i */
                nv [i] = -nvi ;             /* negate nv[i] to denote i in Lk*/
                Ci [pk2++] = i ;            /* place i in Lk */
                if (next [i] != -1) last [next [i]] = last [i] ;
                if (last [i] != -1)         /* remove i from degree list */
                {
                    next [last [i]] = next [i] ;
                }
                else
                {
                    head [degree [i]] = next [i] ;
                }
            }
            if (e != k)
            {
                Cp [e] = CS_FLIP (k) ;      /* absorb e into k */
                w [e] = 0 ;                 /* e is now a dead element */
            }
        }
        if (elenk != 0) cnz = pk2 ;         /* Ci [cnz...nzmax] is free */
        degree [k] = dk ;                   /* external degree of k - |Lk\i| */
        Cp [k] = pk1 ;                      /* element k is in Ci[pk1..pk2-1] */
        len [k] = pk2 - pk1 ;
        elen [k] = -2 ;                     /* k is now an element */
        /* --- Find set differences ----------------------------------------- */
        mark = cs_wclear (mark, lemax, w, n) ;  /* clear w if necessary */
        for (pk = pk1 ; pk < pk2 ; pk++)    /* scan 1: find |Le\Lk| */
        {
            i = Ci [pk] ;
            if ((eln = elen [i]) <= 0) continue ;/* skip if elen[i] empty */
            nvi = -nv [i] ;                      /* nv [i] was negated */
            wnvi = mark - nvi ;
            for (p = Cp [i] ; p <= Cp [i] + eln - 1 ; p++)  /* scan Ei */
            {
                e = Ci [p] ;
                if (w [e] >= mark)
                {
                    w [e] -= nvi ;          /* decrement |Le\Lk| */
                }
                else if (w [e] != 0)        /* ensure e is a live element */
                {
                    w [e] = degree [e] + wnvi ; /* 1st time e seen in scan 1 */
                }
            }
        }
        /* --- Degree update ------------------------------------------------ */
        for (pk = pk1 ; pk < pk2 ; pk++)    /* scan2: degree update */
        {
            i = Ci [pk] ;                   /* consider node i in Lk */
            p1 = Cp [i] ;
            p2 = p1 + elen [i] - 1 ;
            pn = p1 ;
            for (h = 0, d = 0, p = p1 ; p <= p2 ; p++)    /* scan Ei */
            {
                e = Ci [p] ;
                if (w [e] != 0)             /* e is an unabsorbed element */
                {
                    dext = w [e] - mark ;   /* dext = |Le\Lk| */
                    if (dext > 0)
                    {
                        d += dext ;         /* sum up the set differences */
                        Ci [pn++] = e ;     /* keep e in Ei */
                        h += e ;            /* compute the hash of node i */
                    }
                    else
                    {
                        Cp [e] = CS_FLIP (k) ;  /* aggressive absorb. e->k */
                        w [e] = 0 ;             /* e is a dead element */
                    }
                }
            }
            elen [i] = pn - p1 + 1 ;        /* elen[i] = |Ei| */
            p3 = pn ;
            p4 = p1 + len [i] ;
            for (p = p2 + 1 ; p < p4 ; p++) /* prune edges in Ai */
            {
                j = Ci [p] ;
                if ((nvj = nv [j]) <= 0) continue ; /* node j dead or in Lk */
                d += nvj ;                  /* degree(i) += |j| */
                Ci [pn++] = j ;             /* place j in node list of i */
                h += j ;                    /* compute hash for node i */
            }
            if (d == 0)                     /* check for mass elimination */
            {
                Cp [i] = CS_FLIP (k) ;      /* absorb i into k */
                nvi = -nv [i] ;
                dk -= nvi ;                 /* |Lk| -= |i| */
                nvk += nvi ;                /* |k| += nv[i] */
                nel += nvi ;
                nv [i] = 0 ;
                elen [i] = -1 ;             /* node i is dead */
            }
            else
            {
                degree [i] = CS_MIN (degree [i], d) ;   /* update degree(i) */
                Ci [pn] = Ci [p3] ;         /* move first node to end */
                Ci [p3] = Ci [p1] ;         /* move 1st el. to end of Ei */
                Ci [p1] = k ;               /* add k as 1st element in of Ei */
                len [i] = pn - p1 + 1 ;     /* new len of adj. list of node i */
                h %= n ;                    /* finalize hash of i */
                next [i] = hhead [h] ;      /* place i in hash bucket */
                hhead [h] = i ;
                last [i] = h ;              /* save hash of i in last[i] */
            }
        }                                   /* scan2 is done */
        degree [k] = dk ;                   /* finalize |Lk| */
        lemax = CS_MAX (lemax, dk) ;
        mark = cs_wclear (mark+lemax, lemax, w, n) ;    /* clear w */
        /* --- Supernode detection ------------------------------------------ */
        for (pk = pk1 ; pk < pk2 ; pk++)
        {
            i = Ci [pk] ;
            if (nv [i] >= 0) continue ;         /* skip if i is dead */
            h = last [i] ;                      /* scan hash bucket of node i */
            i = hhead [h] ;
            hhead [h] = -1 ;                    /* hash bucket will be empty */
            for ( ; i != -1 && next [i] != -1 ; i = next [i], mark++)
            {
                ln = len [i] ;
                eln = elen [i] ;
                for (p = Cp [i]+1 ; p <= Cp [i] + ln-1 ; p++) w [Ci [p]] = mark;
                jlast = i ;
                for (j = next [i] ; j != -1 ; ) /* compare i with all j */
                {
                    ok = (len [j] == ln) && (elen [j] == eln) ;
                    for (p = Cp [j] + 1 ; ok && p <= Cp [j] + ln - 1 ; p++)
                    {
                        if (w [Ci [p]] != mark) ok = 0 ;    /* compare i and j*/
                    }
                    if (ok)                     /* i and j are identical */
                    {
                        Cp [j] = CS_FLIP (i) ;  /* absorb j into i */
                        nv [i] += nv [j] ;
                        nv [j] = 0 ;
                        elen [j] = -1 ;         /* node j is dead */
                        j = next [j] ;          /* delete j from hash bucket */
                        next [jlast] = j ;
                    }
                    else
                    {
                        jlast = j ;             /* j and i are different */
                        j = next [j] ;
                    }
                }
            }
        }
        /* --- Finalize new element------------------------------------------ */
        for (p = pk1, pk = pk1 ; pk < pk2 ; pk++)   /* finalize Lk */
        {
            i = Ci [pk] ;
            if ((nvi = -nv [i]) <= 0) continue ;/* skip if i is dead */
            nv [i] = nvi ;                      /* restore nv[i] */
            d = degree [i] + dk - nvi ;         /* compute external degree(i) */
            d = CS_MIN (d, n - nel - nvi) ;
            if (head [d] != -1) last [head [d]] = i ;
            next [i] = head [d] ;               /* put i back in degree list */
            last [i] = -1 ;
            head [d] = i ;
            mindeg = CS_MIN (mindeg, d) ;       /* find new minimum degree */
            degree [i] = d ;
            Ci [p++] = i ;                      /* place i in Lk */
        }
        nv [k] = nvk ;                      /* # nodes absorbed into k */
        if ((len [k] = p-pk1) == 0)         /* length of adj list of element k*/
        {
            Cp [k] = -1 ;                   /* k is a root of the tree */
            w [k] = 0 ;                     /* k is now a dead element */
        }
        if (elenk != 0) cnz = p ;           /* free unused space in Lk */
    }
    /* --- Postordering ----------------------------------------------------- */
    for (i = 0 ; i < n ; i++) Cp [i] = CS_FLIP (Cp [i]) ;/* fix assembly tree */
    for (j = 0 ; j <= n ; j++) head [j] = -1 ;
    for (j = n ; j >= 0 ; j--)              /* place unordered nodes in lists */
    {
        if (nv [j] > 0) continue ;          /* skip if j is an element */
        next [j] = head [Cp [j]] ;          /* place j in list of its parent */
        head [Cp [j]] = j ;
    }
    for (e = n ; e >= 0 ; e--)              /* place elements in lists */
    {
        if (nv [e] <= 0) continue ;         /* skip unless e is an element */
        if (Cp [e] != -1)
        {
            next [e] = head [Cp [e]] ;      /* place e in list of its parent */
            head [Cp [e]] = e ;
        }
    }
    for (k = 0, i = 0 ; i <= n ; i++)       /* postorder the assembly tree */
    {
        if (Cp [i] == -1) k = cs_tdfs (i, k, head, next, P, w) ;
    }
    return (cs_idone (P, C, W, 1)) ;
}
Exemplo n.º 28
0
int
main (int argc, char **argv)
{
    feenableexcept(FE_INVALID   | 
                   FE_DIVBYZERO | 
                   FE_OVERFLOW  | 
                   FE_UNDERFLOW);

       struct arguments arguments;

       /* Default values. */
       arguments.silent = 0;
       arguments.verbose = 0;


       // file paths
       arguments.test_file = NULL;
       arguments.train_file = NULL;
       arguments.test_predict_file= NULL;
       arguments.train_pairs = NULL;

        // fm default parameters
        arguments.k = 8;
        arguments.n_iter = 50;
        arguments.init_var = 0.01;
        arguments.step_size = 0.01;
        arguments.l2_reg = 1;
        arguments.l2_reg_w = 0;
        arguments.l2_reg_V = 0;
        arguments.solver = "mcmc";
        arguments.task = "regression";
        arguments.rng_seed = time(NULL);

       int arg_count = 2;
       arguments.arg_count = &arg_count;

       /* Parse our arguments; every option seen by parse_opt will
          be reflected in arguments. */
       argp_parse (&argp, argc, argv, 0, 0, &arguments);

        ffm_param param = {.n_iter     = arguments.n_iter,
                           .init_sigma = arguments.init_var,
                           .k = arguments.k,
                           .stepsize   = arguments.step_size,
                            .rng_seed = arguments.rng_seed};

        // parse solver
        if (strcmp(arguments.solver,"mcmc") == 0)
            param.SOLVER = SOLVER_MCMC;
        else if(strcmp(arguments.solver,"als") == 0)
            param.SOLVER = SOLVER_ALS;
        else if(strcmp(arguments.solver,"sgd") == 0)
            param.SOLVER = SOLVER_SGD;
        else  assert(0 && "unknown solver");

        // parse task
        if (strcmp(arguments.task,"regression") == 0)
            param.TASK = TASK_REGRESSION;
        else if(strcmp(arguments.task,"classification") == 0)
            param.TASK = TASK_CLASSIFICATION;
        else if(strcmp(arguments.task,"ranking") == 0)
            param.TASK = TASK_RANKING;
        else  assert(0 && "unknown task");

       printf ("TRAIN_FILE = %s\nTEST_FILE = %s\n"
               "VERBOSE = %s\nSILENT = %s\n",
               arguments.args[0], arguments.args[1],
               arguments.verbose ? "yes" : "no",
               arguments.silent ? "yes" : "no");

       printf ("task=%s", arguments.task);
       printf (", init-var=%f", param.init_sigma);
       printf (", n-iter=%i", param.n_iter);
       if (param.TASK == TASK_RANKING)
            printf (", step-size=%f", param.stepsize);
       printf (", solver=%s", arguments.solver);
       printf (", k=%i", param.k);

       // default if no l2_reg_w specified
        param.init_lambda_w = arguments.l2_reg;
        param.init_lambda_V = arguments.l2_reg;

        if (arguments.l2_reg_w != 0.0)
            param.init_lambda_w = arguments.l2_reg_w;
        if (arguments.l2_reg_V != 0.0)
            param.init_lambda_V = arguments.l2_reg_V;

       if (strcmp(arguments.solver,"mcmc") != 0)
       {
            printf (", l2-reg-w=%f", param.init_lambda_w);
            if (arguments.k > 0)
                printf (", l2-reg-V=%f", param.init_lambda_V);
            printf("\n");
       }


        printf("\nload data\n");
        fm_data train_data = read_svm_light_file(arguments.args[0]);
        fm_data test_data = read_svm_light_file(arguments.args[1]);

        int n_features = train_data.X->n;
        ffm_vector *y_test_predict = ffm_vector_calloc(test_data.y->size);
        ffm_coef *coef =  alloc_fm_coef(n_features, arguments.k, false);


        printf("fit model\n");
    if (param.TASK == TASK_RANKING)
        {
            assert(arguments.train_pairs != NULL && "Ranking requires the option '--train-pairs'");
            ffm_matrix * train_pairs = ffm_matrix_from_file(arguments.train_pairs);
            cs *X_t = cs_transpose (train_data.X, 1);
            cs_spfree(train_data.X);
            train_data.X = X_t;
            ffm_fit_sgd_bpr(coef, train_data.X, train_pairs, param);
           //printf("c%", arguments.train_pairs);
        }
        else
            sparse_fit(coef, train_data.X, test_data.X, train_data.y, y_test_predict,
                param);

        // the predictions are calculated during the training phase for mcmc
        if (param.SOLVER != SOLVER_MCMC){
            sparse_predict(coef, test_data.X, y_test_predict);
            if (param.TASK == TASK_CLASSIFICATION)
                ffm_vector_normal_cdf(y_test_predict);
        }

        // save predictions
        if (arguments.test_predict_file){
            FILE *f = fopen(arguments.test_predict_file, "w");
            for (int i=0; i< y_test_predict->size; i++)
                fprintf(f, "%f\n", y_test_predict->data[i]);
            fclose(f);
        }

        if (param.TASK == TASK_REGRESSION)
            printf("\nr2 score: %f \n", ffm_r2_score(test_data.y, y_test_predict));
        if (param.TASK == TASK_CLASSIFICATION)
            printf("\nacc score: %f \n", ffm_vector_accuracy(test_data.y, y_test_predict));

        /*
        printf("calculate kendall tau\n");
        if (param.TASK == TASK_RANKING)
        {
            ffm_vector * true_order = ffm_vector_get_order(test_data.y);
            ffm_vector * pred_order = ffm_vector_get_order(y_test_predict);
            double kendall_tau = \
                    ffm_vector_kendall_tau(true_order, pred_order);
            printf("\nkendall tau: %f \n", kendall_tau);
        }
        */


       exit (0);
}
Exemplo n.º 29
0
void test_sparse_als_zero_order_only(TestFixture_T *pFix, gconstpointer pg) {
  int n_features = pFix->X->n;
  int k = 0;
  ffm_param param = {.n_iter = 1,
                     .warm_start = true,
                     .ignore_w = true,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_ALS,
                     .TASK = TASK_REGRESSION};

  ffm_coef *coef = alloc_fm_coef(n_features, k, true);
  param.init_lambda_w = 0;

  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  // g_assert_cmpfloat(4466.666666, ==, coef->w_0);
  g_assert_cmpfloat(fabs(4466.666666 - coef->w_0), <, 1e-6);

  free_ffm_coef(coef);
}

void test_sparse_als_first_order_only(TestFixture_T *pFix, gconstpointer pg) {
  int n_features = pFix->X->n;
  int k = 0;
  ffm_param param = {.n_iter = 1,
                     .warm_start = true,
                     .ignore_w_0 = true,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_ALS,
                     .TASK = TASK_REGRESSION};

  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  coef->w_0 = 0;
  param.init_lambda_w = 0;

  ffm_vector_set(coef->w, 0, 10);
  ffm_vector_set(coef->w, 1, 20);

  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  // hand calculated results 1660.57142857   -11.87755102
  g_assert_cmpfloat(fabs(1660.57142857 - ffm_vector_get(coef->w, 0)), <, 1e-8);
  g_assert_cmpfloat(fabs(-11.87755102 - ffm_vector_get(coef->w, 1)), <, 1e-8);

  free_ffm_coef(coef);
}

void test_sparse_als_second_order_only(TestFixture_T *pFix, gconstpointer pg) {
  int n_features = pFix->X->n;
  int k = 1;
  ffm_param param = {.n_iter = 1,
                     .warm_start = true,
                     .ignore_w_0 = true,
                     .ignore_w = true,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_ALS,
                     .TASK = TASK_REGRESSION};

  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  coef->w_0 = 0;

  param.init_lambda_w = 0;
  param.init_lambda_V = 0;

  ffm_matrix_set(coef->V, 0, 0, 300);
  ffm_matrix_set(coef->V, 0, 1, 400);

  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  // hand calculated results  0.79866412  400.
  g_assert_cmpfloat(fabs(0.79866412 - ffm_matrix_get(coef->V, 0, 0)), <, 1e-8);
  g_assert_cmpfloat(fabs(400 - ffm_matrix_get(coef->V, 0, 1)), <, 1e-8);

  free_ffm_coef(coef);
}

void test_sparse_als_all_interactions(TestFixture_T *pFix, gconstpointer pg) {
  int n_features = pFix->X->n;
  int k = 1;
  ffm_param param = {.n_iter = 1,
                     .warm_start = true,
                     .ignore_w_0 = false,
                     .ignore_w = false,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_ALS,
                     .TASK = TASK_REGRESSION};

  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  coef->w_0 = 0;

  ffm_vector_set(coef->w, 0, 10);
  ffm_vector_set(coef->w, 1, 20);

  ffm_matrix_set(coef->V, 0, 0, 300);
  ffm_matrix_set(coef->V, 0, 1, 400);

  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  // hand calculated results checked with libfm
  g_assert_cmpfloat(fabs(-1755643.33333 - coef->w_0), <, 1e-5);
  g_assert_cmpfloat(fabs(-191459.71428571 - ffm_vector_get(coef->w, 0)), <,
                    1e-6);
  g_assert_cmpfloat(fabs(30791.91836735 - ffm_vector_get(coef->w, 1)), <, 1e-6);
  g_assert_cmpfloat(fabs(253.89744249 - ffm_matrix_get(coef->V, 0, 0)), <,
                    1e-6);
  g_assert_cmpfloat(fabs(400 - ffm_matrix_get(coef->V, 0, 1)), <, 1e-6);

  param.n_iter = 99;
  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);

  g_assert_cmpfloat(fabs(210911.940403 - coef->w_0), <, 1e-7);
  g_assert_cmpfloat(fabs(-322970.68313639 - ffm_vector_get(coef->w, 0)), <,
                    1e-6);
  g_assert_cmpfloat(fabs(51927.60978978 - ffm_vector_get(coef->w, 1)), <, 1e-6);
  g_assert_cmpfloat(fabs(94.76612018 - ffm_matrix_get(coef->V, 0, 0)), <, 1e-6);
  g_assert_cmpfloat(fabs(400 - ffm_matrix_get(coef->V, 0, 1)), <, 1e-6);

  free_ffm_coef(coef);
}

void test_sparse_als_first_order_interactions(TestFixture_T *pFix,
                                              gconstpointer pg) {
  ffm_vector *y_pred = ffm_vector_calloc(5);

  int n_features = pFix->X->n;
  int k = 0;
  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_param param = {.n_iter = 500,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_ALS,
                     .TASK = TASK_REGRESSION};
  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  sparse_predict(coef, pFix->X, y_pred);

  /* reference values from sklearn LinearRegression
  y_pred:  [ 321.05084746  346.6779661   -40.15254237  321.05084746
  790.37288136]
  coef: [  69.6779661   152.16949153]
  mse: 3134.91525424 */
  g_assert_cmpfloat(fabs(321.05084746 - ffm_vector_get(y_pred, 0)), <, 1e-6);
  g_assert_cmpfloat(fabs(346.6779661 - ffm_vector_get(y_pred, 1)), <, 1e-6);
  g_assert_cmpfloat(fabs(-40.15254237 - ffm_vector_get(y_pred, 2)), <, 1e-6);
  g_assert_cmpfloat(fabs(321.05084746 - ffm_vector_get(y_pred, 3)), <, 1e-6);
  g_assert_cmpfloat(fabs(790.37288136 - ffm_vector_get(y_pred, 4)), <, 1e-6);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
}

void test_sparse_als_second_interactions(TestFixture_T *pFix,
                                         gconstpointer pg) {
  ffm_vector *y_pred = ffm_vector_calloc(5);

  int n_features = pFix->X->n;
  int k = 2;
  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_param param = {.n_iter = 1000, .init_sigma = 0.1, .SOLVER = SOLVER_ALS};
  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  sparse_predict(coef, pFix->X, y_pred);

  /* reference values from sklearn LinearRegression
  y_pred: [ 298.  266.   29.  298.  848.]
  coeff: [  9.   2.  40.]
  mse: 4.53374139449e-27 */
  g_assert_cmpfloat(fabs(298 - ffm_vector_get(y_pred, 0)), <, 1e-4);
  g_assert_cmpfloat(fabs(266 - ffm_vector_get(y_pred, 1)), <, 1e-4);
  g_assert_cmpfloat(fabs(29 - ffm_vector_get(y_pred, 2)), <, 1e-3);
  g_assert_cmpfloat(fabs(298 - ffm_vector_get(y_pred, 3)), <, 1e-4);
  g_assert_cmpfloat(fabs(848.0 - ffm_vector_get(y_pred, 4)), <, 1e-4);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
}

void test_sparse_mcmc_second_interactions(TestFixture_T *pFix,
                                          gconstpointer pg) {
  int n_features = pFix->X->n;
  int n_samples = pFix->X->m;
  int k = 2;
  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_vector *y_pred = ffm_vector_calloc(n_samples);
  ffm_param param = {.n_iter = 100,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_MCMC,
                     .TASK = TASK_REGRESSION,
                     .rng_seed = 1234};
  sparse_fit(coef, pFix->X, pFix->X, pFix->y, y_pred, param);

  g_assert_cmpfloat(ffm_r2_score(pFix->y, y_pred), >, .98);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
}

void test_sparse_mcmc_second_interactions_classification(TestFixture_T *pFix,
                                                         gconstpointer pg) {
  int n_features = pFix->X->n;
  int n_samples = pFix->X->m;
  int k = 2;
  ffm_vector_make_labels(pFix->y);
  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_vector *y_pred = ffm_vector_calloc(n_samples);
  ffm_param param = {.n_iter = 10,
                     .init_sigma = 0.1,
                     .SOLVER = SOLVER_MCMC,
                     .TASK = TASK_CLASSIFICATION};
  sparse_fit(coef, pFix->X, pFix->X, pFix->y, y_pred, param);

  g_assert_cmpfloat(ffm_vector_accuracy(pFix->y, y_pred), >=, .98);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
}

void test_train_test_of_different_size(TestFixture_T *pFix, gconstpointer pg) {
  int n_features = pFix->X->n;
  int k = 2;

  int n_samples_short = 3;
  int m = n_samples_short;
  int n = n_features;
  cs *X = cs_spalloc(m, n, m * n, 1, 1); /* create triplet identity matrix */
  cs_entry(X, 0, 0, 6);
  cs_entry(X, 0, 1, 1);
  cs_entry(X, 1, 0, 2);
  cs_entry(X, 1, 1, 3);
  cs_entry(X, 2, 0, 3);
  cs *X_csc = cs_compress(X); /* A = compressed-column form of T */
  cs *X_t = cs_transpose(X_csc, 1);
  cs_spfree(X);

  ffm_vector *y = ffm_vector_calloc(n_samples_short);
  // y [ 298 266 29 298 848 ]
  y->data[0] = 298;
  y->data[1] = 266;
  y->data[2] = 29;

  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_vector *y_pred = ffm_vector_calloc(n_samples_short);

  ffm_param param = {.n_iter = 20, .init_sigma = 0.01};
  // test: train > test

  param.SOLVER = SOLVER_ALS;
  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  sparse_predict(coef, X_csc, y_pred);
  param.TASK = TASK_CLASSIFICATION;
  sparse_fit(coef, pFix->X, NULL, pFix->y, NULL, param);
  sparse_predict(coef, X_csc, y_pred);

  param.SOLVER = SOLVER_MCMC;
  param.TASK = TASK_CLASSIFICATION;
  sparse_fit(coef, pFix->X, X_csc, pFix->y, y_pred, param);
  param.TASK = TASK_REGRESSION;
  sparse_fit(coef, pFix->X, X_csc, pFix->y, y_pred, param);

  // test: train < test
  param.SOLVER = SOLVER_MCMC;
  param.TASK = TASK_CLASSIFICATION;
  sparse_fit(coef, X_csc, pFix->X, y_pred, pFix->y, param);
  param.TASK = TASK_REGRESSION;
  sparse_fit(coef, X_csc, pFix->X, y_pred, pFix->y, param);

  param.SOLVER = SOLVER_ALS;
  sparse_fit(coef, X_csc, NULL, y_pred, NULL, param);
  sparse_predict(coef, pFix->X, pFix->y);
  param.TASK = TASK_CLASSIFICATION;
  sparse_fit(coef, X_csc, NULL, y_pred, NULL, param);
  sparse_predict(coef, pFix->X, pFix->y);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
  cs_spfree(X_t);
  cs_spfree(X_csc);
}

void test_sparse_als_generated_data(void) {
  int n_features = 10;
  int n_samples = 100;
  int k = 2;

  TestFixture_T *data = makeTestFixture(124, n_samples, n_features, k);

  ffm_vector *y_pred = ffm_vector_calloc(n_samples);

  ffm_coef *coef = alloc_fm_coef(n_features, k, false);
  ffm_param param = {.n_iter = 50, .init_sigma = 0.01, .SOLVER = SOLVER_ALS};
  param.init_lambda_w = 23.5;
  param.init_lambda_V = 23.5;
  sparse_fit(coef, data->X, NULL, data->y, NULL, param);
  sparse_predict(coef, data->X, y_pred);

  g_assert_cmpfloat(ffm_r2_score(data->y, y_pred), >, 0.85);

  ffm_vector_free(y_pred);
  free_ffm_coef(coef);
  TestFixtureDestructor(data, NULL);
}

void test_hyerparameter_sampling(void) {
  ffm_rng *rng = ffm_rng_seed(12345);

  int n_features = 20;
  int n_samples = 150;
  int k = 1;  // don't just change k, the rank is hard coded in the test
              // (ffm_vector_get(coef->lambda_V, 0);)

  int n_replication = 40;
  int n_draws = 1000;
  ffm_vector *alpha_rep = ffm_vector_calloc(n_replication);
  ffm_vector *lambda_w_rep = ffm_vector_calloc(n_replication);
  ffm_vector *lambda_V_rep = ffm_vector_calloc(n_replication);
  ffm_vector *mu_w_rep = ffm_vector_calloc(n_replication);
  ffm_vector *mu_V_rep = ffm_vector_calloc(n_replication);
  ffm_vector *err = ffm_vector_alloc(n_samples);

  for (int j = 0; j < n_replication; j++) {
    TestFixture_T *data = makeTestFixture(124, n_samples, n_features, k);
    ffm_coef *coef = data->coef;

    sparse_predict(coef, data->X, err);
    ffm_vector_scale(err, -1);
    ffm_vector_add(err, data->y);

    // make sure that distribution is converged bevore selecting
    // reference / init values
    for (int l = 0; l < 50; l++) sample_hyper_parameter(coef, err, rng);

    double alpha_init = coef->alpha;
    double lambda_w_init = coef->lambda_w;
    double lambda_V_init = ffm_vector_get(coef->lambda_V, 0);
    double mu_w_init = coef->mu_w;
    double mu_V_init = ffm_vector_get(coef->mu_V, 0);

    double alpha_count = 0;
    double lambda_w_count = 0, lambda_V_count = 0;
    double mu_w_count = 0, mu_V_count = 0;

    for (int l = 0; l < n_draws; l++) {
      sample_hyper_parameter(coef, err, rng);
      if (alpha_init > coef->alpha) alpha_count++;
      if (lambda_w_init > coef->lambda_w) lambda_w_count++;
      if (lambda_V_init > ffm_vector_get(coef->lambda_V, 0)) lambda_V_count++;
      if (mu_w_init > coef->mu_w) mu_w_count++;
      if (mu_V_init > ffm_vector_get(coef->mu_V, 0)) mu_V_count++;
    }
    ffm_vector_set(alpha_rep, j, alpha_count / (n_draws + 1));
    ffm_vector_set(lambda_w_rep, j, lambda_w_count / (n_draws + 1));
    ffm_vector_set(lambda_V_rep, j, lambda_V_count / (n_draws + 1));
    ffm_vector_set(mu_w_rep, j, mu_w_count / (n_draws + 1));
    ffm_vector_set(mu_V_rep, j, mu_V_count / (n_draws + 1));

    TestFixtureDestructor(data, NULL);
  }
  double chi_alpha = 0;
  for (int i = 0; i < n_replication; i++)
    chi_alpha +=
        ffm_pow_2(gsl_cdf_ugaussian_Qinv(ffm_vector_get(alpha_rep, i)));
  g_assert_cmpfloat(gsl_ran_chisq_pdf(chi_alpha, n_replication), <, .05);

  double chi_lambda_w = 0;
  for (int i = 0; i < n_replication; i++)
    chi_lambda_w +=
        ffm_pow_2(gsl_cdf_ugaussian_Qinv(ffm_vector_get(lambda_w_rep, i)));
  g_assert_cmpfloat(gsl_ran_chisq_pdf(chi_lambda_w, n_replication), <, .05);

  double chi_lambda_V = 0;
  for (int i = 0; i < n_replication; i++)
    chi_lambda_V +=
        ffm_pow_2(gsl_cdf_ugaussian_Qinv(ffm_vector_get(lambda_V_rep, i)));
  g_assert_cmpfloat(gsl_ran_chisq_pdf(chi_lambda_V, n_replication), <, .05);

  double chi_mu_w = 0;
  for (int i = 0; i < n_replication; i++)
    chi_mu_w += ffm_pow_2(gsl_cdf_ugaussian_Qinv(ffm_vector_get(mu_w_rep, i)));
  g_assert_cmpfloat(gsl_ran_chisq_pdf(chi_mu_w, n_replication), <, .05);

  double chi_mu_V = 0;
  for (int i = 0; i < n_replication; i++)
    chi_mu_V += ffm_pow_2(gsl_cdf_ugaussian_Qinv(ffm_vector_get(mu_V_rep, i)));
  g_assert_cmpfloat(gsl_ran_chisq_pdf(chi_mu_V, n_replication), <, .05);

  ffm_vector_free_all(alpha_rep, lambda_w_rep, lambda_V_rep, mu_w_rep, mu_V_rep,
                      err);
  ffm_rng_free(rng);
}
Exemplo n.º 30
0
Arquivo: fcmer.c Projeto: xhub/fclib
/* calculate merit function for a local problem */
double fclib_merit_local (struct fclib_local *problem, enum fclib_merit merit, struct fclib_solution *solution)
{

  struct fclib_matrix * W =  problem->W;
  struct fclib_matrix * V =  problem->V;
  struct fclib_matrix * R =  problem->R;
  
  double *mu = problem->mu;
  double *q = problem->q;
  double *s = problem->s;
  int d = problem->spacedim;          
  if (d !=3 )
  {
    printf("fclib_merit_local for space dimension = %i not yet implemented\n",d);
    return 0;
  }

  double *v = solution->v;
  double *r = solution->r;
  double *u = solution->u;
  double *l = solution->l;

  double error_l, error;
  double * tmp;

  error=0.0;
  error_l=0.0;
  int i, ic, ic3;
  if (merit == MERIT_1)
  {
    
    /* cs M_cs;  */
    /* fclib_matrix_to_cssparse(W, &M_cs); */
    /* cs V_cs;  */
    /* fclib_matrix_to_cssparse(V, &V_cs); */
    /* cs R_cs;  */
    /* fclib_matrix_to_cssparse(R, &R_cs); */
    int n_e =0;
    if (R) n_e = R->n;
    /* compute V^T {r} + R \lambda + s */
    if (n_e >0)
    {
      cs * VT = cs_transpose((cs *)V, 0) ;
      tmp = (double *)malloc(n_e*sizeof(double));
      for (i =0; i <n_e; i++) tmp[i] = s[i] ;
      cs_gaxpy(VT, r, tmp);
      cs_gaxpy((cs *)R, l, tmp);
      error_l += dnrm2(tmp,n_e)/(1.0 +  dnrm2(s,n_e) );
      free(tmp);
    }
    /* compute  \hat u = W {r}    + V\lambda  + q  */
    
    tmp = (double *)malloc(W->n*sizeof(double));
    for (i =0; i <W->n; i++) tmp[i] = q[i] ;
    cs_gaxpy((cs*)V, l, tmp);
    cs_gaxpy((cs*)W, r, tmp);

    /* Compute natural map */
    int nc = W->n/3;
    for (ic = 0, ic3 = 0 ; ic < nc ; ic++, ic3 += 3)
    {
      FrictionContact3D_unitary_compute_and_add_error(r + ic3, tmp + ic3, mu[ic], &error);
    }
          
    free(tmp);
    error = sqrt(error)/(1.0 +  sqrt(dnrm2(q,W->n)) )+error_l;  

    /* printf("error_l = %12.8e", error_l); */
    /* printf("norm of u  = %12.8e\n",  dnrm2(u,W->n)); */
    /* printf("norm of r  = %12.8e\n",  dnrm2(r,W->n)); */
    /* printf("error = %12.8e\n", error); */
  
    return error;
  }

  return 0; /* TODO */
}