diff options
| author | Gertjan van den Burg <burg@ese.eur.nl> | 2016-10-14 18:35:38 +0200 |
|---|---|---|
| committer | Gertjan van den Burg <burg@ese.eur.nl> | 2016-10-14 18:35:38 +0200 |
| commit | e34123e1055c26d740148cefdb8d1b90208e424e (patch) | |
| tree | 51c62b010f4beddaa5cd8259fd420a433a8fd1b1 /src | |
| parent | documentation fixes (diff) | |
| download | gensvm-e34123e1055c26d740148cefdb8d1b90208e424e.tar.gz gensvm-e34123e1055c26d740148cefdb8d1b90208e424e.zip | |
add sparse matrices to GenSVM and reorganize update functionality
Diffstat (limited to 'src')
| -rw-r--r-- | src/GenSVMtraintest.c | 5 | ||||
| -rw-r--r-- | src/gensvm_base.c | 4 | ||||
| -rw-r--r-- | src/gensvm_init.c | 63 | ||||
| -rw-r--r-- | src/gensvm_io.c | 10 | ||||
| -rw-r--r-- | src/gensvm_optimize.c | 521 | ||||
| -rw-r--r-- | src/gensvm_sparse.c | 181 | ||||
| -rw-r--r-- | src/gensvm_update.c | 592 |
7 files changed, 877 insertions, 499 deletions
diff --git a/src/GenSVMtraintest.c b/src/GenSVMtraintest.c index f70fa97..cc0284e 100644 --- a/src/GenSVMtraintest.c +++ b/src/GenSVMtraintest.c @@ -83,7 +83,10 @@ int main(int argc, char **argv) strcpy(model->data_file, training_inputfile); // seed the random number generator - srand(time(NULL)); + //srand(time(NULL)); + // + // XXX temporary + srand(2135); // load a seed model from file if it is specified if (gensvm_check_argv_eq(argc, argv, "-s")) { diff --git a/src/gensvm_base.c b/src/gensvm_base.c index cef0a3c..e4fc20a 100644 --- a/src/gensvm_base.c +++ b/src/gensvm_base.c @@ -30,6 +30,7 @@ struct GenData *gensvm_init_data() data->Sigma = NULL; data->y = NULL; data->Z = NULL; + data->spZ = NULL; data->RAW = NULL; // set default values @@ -54,6 +55,9 @@ void gensvm_free_data(struct GenData *data) if (data == NULL) return; + if (data->spZ != NULL) + gensvm_free_sparse(data->spZ); + if (data->Z == data->RAW) { free(data->Z); } else { diff --git a/src/gensvm_init.c b/src/gensvm_init.c index aa96ca6..e0f44c1 100644 --- a/src/gensvm_init.c +++ b/src/gensvm_init.c @@ -33,30 +33,67 @@ void gensvm_init_V(struct GenModel *from_model, struct GenModel *to_model, struct GenData *data) { - long i, j, k; + long i, j, k, jj_start, jj_end, jj; double cmin, cmax, value, rnd; + double *col_min = NULL, + *col_max = NULL; long n = data->n; long m = data->m; long K = data->K; if (from_model == NULL) { - for (i=0; i<m+1; i++) { - cmin = 1e100; - cmax = -1e100; - for (k=0; k<n; k++) { - value = matrix_get(data->Z, m+1, k, i); - cmin = minimum(cmin, value); - cmax = maximum(cmax, value); + col_min = Calloc(double, m+1); + col_max = Calloc(double, m+1); + for (j=0; j<m+1; j++) { + col_min[j] = 1.0e100; + col_max[j] = -1.0e100; + } + + if (data->Z == NULL) { + // sparse matrix + int *visit_count = Calloc(int, m+1); + for (i=0; i<n; i++) { + jj_start = data->spZ->ia[i]; + jj_end = data->spZ->ia[i+1]; + for (jj=jj_start; jj<jj_end; jj++) { + j = data->spZ->ja[jj]; + value = data->spZ->values[jj]; + + col_min[j] = minimum(col_min[j], value); + col_max[j] = maximum(col_max[j], value); + visit_count[j]++; + } } - for (j=0; j<K-1; j++) { - cmin = (abs(cmin) < 1e-10) ? -1 : cmin; - cmax = (abs(cmax) < 1e-10) ? 1 : cmax; - rnd = ((double) rand()) / RAND_MAX; + // correction in case the minimum or maximum is 0 + for (j=0; j<m+1; j++) { + if (visit_count[j] < n) { + col_min[j] = minimum(col_min[j], 0.0); + col_max[j] = maximum(col_max[j], 0.0); + } + } + free(visit_count); + } else { + // dense matrix + for (i=0; i<n; i++) { + for (j=0; j<m+1; j++) { + value = matrix_get(data->Z, m+1, i, j); + col_min[j] = minimum(col_min[j], value); + col_max[j] = maximum(col_max[j], value); + } + } + } + for (j=0; j<m+1; j++) { + cmin = (fabs(col_min[j]) < 1e-10) ? -1 : col_min[j]; + cmax = (fabs(col_max[j]) < 1e-10) ? 1 : col_max[j]; + for (k=0; k<K-1; k++) { + rnd = ((double) rand()) / ((double) RAND_MAX); value = 1.0/cmin + (1.0/cmax - 1.0/cmin)*rnd; - matrix_set(to_model->V, K-1, i, j, value); + matrix_set(to_model->V, K-1, j, k, value); } } + free(col_min); + free(col_max); } else { for (i=0; i<m+1; i++) for (j=0; j<K-1; j++) { diff --git a/src/gensvm_io.c b/src/gensvm_io.c index a574654..a9ab734 100644 --- a/src/gensvm_io.c +++ b/src/gensvm_io.c @@ -12,7 +12,6 @@ */ #include <limits.h> #include "gensvm_io.h" -#include "gensvm_print.h" /** * @brief Read data from file @@ -139,6 +138,15 @@ void gensvm_read_data(struct GenData *dataset, char *data_file) dataset->K = K; dataset->Z = dataset->RAW; + if (gensvm_could_sparse(dataset->Z, n, m+1)) { + note("Converting to sparse ... "); + dataset->spZ = gensvm_dense_to_sparse(dataset->Z, n, m+1); + note("done.\n"); + free(dataset->RAW); + dataset->RAW = NULL; + dataset->Z = NULL; + } + free(uniq_y); } diff --git a/src/gensvm_optimize.c b/src/gensvm_optimize.c index e517332..e83fa47 100644 --- a/src/gensvm_optimize.c +++ b/src/gensvm_optimize.c @@ -167,395 +167,6 @@ double gensvm_get_loss(struct GenModel *model, struct GenData *data, } /** - * @brief Calculate the value of omega for a single instance - * - * @details - * This function calculates the value of the @f$ \omega_i @f$ variable for a - * single instance, where - * @f[ - * \omega_i = \frac{1}{p} \left( \sum_{j \neq y_i} h^p\left( - * \overline{q}_i^{(y_i j)} \right) \right)^{1/p-1} - * @f] - * Note that his function uses the precalculated values from GenModel::H and - * GenModel::R to speed up the computation. - * - * @param[in] model GenModel structure with the current model - * @param[in] i index of the instance for which to calculate omega - * @returns the value of omega for instance i - * - */ -double gensvm_calculate_omega(struct GenModel *model, struct GenData *data, - long i) -{ - long j; - double h, omega = 0.0, - p = model->p; - - for (j=0; j<model->K; j++) { - if (j == (data->y[i]-1)) - continue; - h = matrix_get(model->H, model->K, i, j); - omega += pow(h, p); - } - omega = (1.0/p)*pow(omega, 1.0/p - 1.0); - - return omega; -} - -/** - * @brief Check if we can do simple majorization for a given instance - * - * @details - * A simple majorization is possible if at most one of the Huberized hinge - * errors is nonzero for an instance. This is checked here. For this we - * compute the product of the Huberized error for all @f$j \neq y_i@f$ and - * check if strictly less than 2 are nonzero. See also the @ref update_math. - * - * @param[in] model GenModel structure with the current model - * @param[in] i index of the instance for which to check - * @returns whether or not we can do simple majorization - * - */ -bool gensvm_majorize_is_simple(struct GenModel *model, struct GenData *data, - long i) -{ - long j; - double h, value = 0; - for (j=0; j<model->K; j++) { - if (j == (data->y[i]-1)) - continue; - h = matrix_get(model->H, model->K, i, j); - value += (h > 0) ? 1 : 0; - if (value > 1) - return false; - } - return true; -} - -/** - * @brief Compute majorization coefficients for non-simple instance - * - * @details - * In this function we compute the majorization coefficients needed for an - * instance with a non-simple majorization (@f$\varepsilon_i = 0@f$). In this - * function, we distinguish a number of cases depending on the value of - * GenModel::p and the respective value of @f$\overline{q}_i^{(y_ij)}@f$. Note - * that the linear coefficient is of the form @f$b - a\overline{q}@f$, but - * often the second term is included in the definition of @f$b@f$, so it can - * be optimized out. The output argument \p b_aq contains this difference - * therefore in one go. More details on this function can be found in the @ref - * update_math. See also gensvm_calculate_ab_simple(). - * - * @param[in] model GenModel structure with the current model - * @param[in] i index for the instance - * @param[in] j index for the class - * @param[out] *a output argument for the quadratic coefficient - * @param[out] *b_aq output argument for the linear coefficient. - * - */ -void gensvm_calculate_ab_non_simple(struct GenModel *model, long i, long j, - double *a, double *b_aq) -{ - double q = matrix_get(model->Q, model->K, i, j); - double p = model->p; - double kappa = model->kappa; - const double a2g2 = 0.25*p*(2.0*p - 1.0)*pow((kappa+1.0)/2.0,p-2.0); - - if (2.0 - model->p < 1e-2) { - if (q <= - kappa) { - *b_aq = 0.5 - kappa/2.0 - q; - } else if ( q <= 1.0) { - *b_aq = pow(1.0 - q, 3.0)/(2.0*pow(kappa + 1.0, 2.0)); - } else { - *b_aq = 0; - } - *a = 1.5; - } else { - if (q <= (p + kappa - 1.0)/(p - 2.0)) { - *a = 0.25*pow(p, 2.0)*pow(0.5 - kappa/2.0 - q, p - 2.0); - } else if (q <= 1.0) { - *a = a2g2; - } else { - *a = 0.25*pow(p, 2.0)*pow((p/(p - 2.0))*(0.5 - - kappa/2.0 - q), p - 2.0); - *b_aq = (*a)*(2.0*q + kappa - 1.0)/(p - 2.0) + - 0.5*p*pow(p/(p - 2.0)*(0.5 - kappa/2.0 - q), - p - 1.0); - } - if (q <= -kappa) { - *b_aq = 0.5*p*pow(0.5 - kappa/2.0 - q, p - 1.0); - } else if ( q <= 1.0) { - *b_aq = p*pow(1.0 - q, 2.0*p - 1.0)/pow(2*kappa+2.0, p); - } - } -} - -/** - * @brief Compute majorization coefficients for simple instances - * - * @details - * In this function we compute the majorization coefficients needed for an - * instance with a simple majorization. This corresponds to the non-simple - * majorization for the case where GenModel::p equals 1. Due to this condition - * the majorization coefficients are quite simple to compute. Note that the - * linear coefficient of the majorization is of the form @f$b - - * a\overline{q}@f$, but often the second term is included in the definition - * of @f$b@f$, so it can be optimized out. For more details see the @ref - * update_math, and gensvm_calculate_ab_non_simple(). - * - * @param[in] model GenModel structure with the current model - * @param[in] i index for the instance - * @param[in] j index for the class - * @param[out] *a output argument for the quadratic coefficient - * @param[out] *b_aq output argument for the linear coefficient - * - */ -void gensvm_calculate_ab_simple(struct GenModel *model, long i, long j, - double *a, double *b_aq) -{ - double q = matrix_get(model->Q, model->K, i, j); - - if (q <= - model->kappa) { - *a = 0.25/(0.5 - model->kappa/2.0 - q); - *b_aq = 0.5; - } else if (q <= 1.0) { - *a = 1.0/(2.0*model->kappa + 2.0); - *b_aq = (1.0 - q)*(*a); - } else { - *a = -0.25/(0.5 - model->kappa/2.0 - q); - *b_aq = 0; - } -} - -/** - * @brief Compute the alpha_i and beta_i for an instance - * - * @details - * This computes the @f$\alpha_i@f$ value for an instance, and simultaneously - * updating the row of the B matrix corresponding to that - * instance (the @f$\boldsymbol{\beta}_i'@f$). The advantage of doing this at - * the same time is that we can compute the a and b values simultaneously in - * the gensvm_calculate_ab_simple() and gensvm_calculate_ab_non_simple() - * functions. - * - * The computation is done by first checking whether simple majorization is - * possible for this instance. If so, the @f$\omega_i@f$ value is set to 1.0, - * otherwise this value is computed. If simple majorization is possible, the - * coefficients a and b_aq are computed by gensvm_calculate_ab_simple(), - * otherwise they're computed by gensvm_calculate_ab_non_simple(). Next, the - * beta_i updated through the efficient BLAS daxpy function, and part of the - * value of @f$\alpha_i@f$ is computed. The final value of @f$\alpha_i@f$ is - * returned. - * - * @param[in] model GenModel structure with the current model - * @param[in] i index of the instance to update - * @param[out] beta beta vector of linear coefficients (assumed to - * be allocated elsewhere, initialized here) - * @returns the @f$\alpha_i@f$ value of this instance - * - */ -double gensvm_get_alpha_beta(struct GenModel *model, struct GenData *data, - long i, double *beta) -{ - bool simple; - long j, - K = model->K; - double omega, a, b_aq = 0.0, - alpha = 0.0; - double *uu_row = NULL; - const double in = 1.0/((double) model->n); - - simple = gensvm_majorize_is_simple(model, data, i); - omega = simple ? 1.0 : gensvm_calculate_omega(model, data, i); - - Memset(beta, double, K-1); - for (j=0; j<K; j++) { - // skip the class y_i = k - if (j == (data->y[i]-1)) - continue; - - // calculate the a_ijk and (b_ijk - a_ijk q_i^(kj)) values - if (simple) { - gensvm_calculate_ab_simple(model, i, j, &a, &b_aq); - } else { - gensvm_calculate_ab_non_simple(model, i, j, &a, &b_aq); - } - - // daxpy on beta and UU - // daxpy does: y = a*x + y - // so y = beta, UU_row = x, a = factor - b_aq *= model->rho[i] * omega * in; - uu_row = &model->UU[((data->y[i]-1)*K+j)*(K-1)]; - cblas_daxpy(K-1, b_aq, uu_row, 1, beta, 1); - - // increment Avalue - alpha += a; - } - alpha *= omega * model->rho[i] * in; - return alpha; -} - -/** - * @brief Perform a single step of the majorization algorithm to update V - * - * @details - * This function contains the main update calculations of the algorithm. These - * calculations are necessary to find a new update V. The calculations exist of - * recalculating the majorization coefficients for all instances and all - * classes, and solving a linear system to find V. - * - * Because the function gensvm_get_update() is always called after a call to - * gensvm_get_loss() with the same GenModel::V, it is unnecessary to calculate - * the updated errors GenModel::Q and GenModel::H here too. This saves on - * computation time. - * - * In calculating the majorization coefficients we calculate the elements of a - * diagonal matrix A with elements - * @f[ - * A_{i, i} = \frac{1}{n} \rho_i \sum_{j \neq k} \left[ - * \varepsilon_i a_{ijk}^{(1)} + (1 - \varepsilon_i) \omega_i - * a_{ijk}^{(p)} \right], - * @f] - * where @f$ k = y_i @f$. - * Since this matrix is only used to calculate the matrix @f$ Z' A Z @f$, it - * is efficient to update a matrix ZAZ through consecutive rank 1 updates with - * a single element of A and the corresponding row of Z. The BLAS function - * dsyr is used for this. - * - * The B matrix is has rows - * @f[ - * \boldsymbol{\beta}_i' = \frac{1}{n} \rho_i \sum_{j \neq k} \left[ - * \varepsilon_i \left( b_{ijk}^{(1)} - a_{ijk}^{(1)} - * \overline{q}_i^{(kj)} \right) + (1 - \varepsilon_i) - * \omega_i \left( b_{ijk}^{(p)} - a_{ijk}^{(p)} - * \overline{q}_i^{(kj)} \right) \right] - * \boldsymbol{\delta}_{kj}' - * @f] - * This is also split into two cases, one for which @f$ \varepsilon_i = 1 @f$, - * and one for when it is 0. The 3D simplex difference matrix is used here, in - * the form of the @f$ \boldsymbol{\delta}_{kj}' @f$. - * - * Finally, the following system is solved - * @f[ - * (\textbf{Z}'\textbf{AZ} + \lambda \textbf{J})\textbf{V} = - * (\textbf{Z}'\textbf{AZ}\overline{\textbf{V}} + \textbf{Z}' - * \textbf{B}) - * @f] - * solving this system is done through dposv(). - * - * @todo - * Consider using CblasColMajor everywhere - * - * @param[in,out] model model to be updated - * @param[in] data data used in model - * @param[in] work allocated workspace to use - */ -void gensvm_get_update(struct GenModel *model, struct GenData *data, - struct GenWork *work) -{ - int status; - long i, j; - double alpha, sqalpha; - - long n = model->n; - long m = model->m; - long K = model->K; - - gensvm_reset_work(work); - - // generate Z'*A*Z and Z'*B by rank 1 operations - for (i=0; i<n; i++) { - alpha = gensvm_get_alpha_beta(model, data, i, work->beta); - - // calculate row of matrix LZ, which is a scalar - // multiplication of sqrt(alpha_i) and row z_i' of Z - // Note that we use the fact that the first column of Z is - // always 1, by only computing the product for m values and - // copying the first element over. - sqalpha = sqrt(alpha); - work->LZ[i*(m+1)] = sqalpha; - cblas_daxpy(m, sqalpha, &data->Z[i*(m+1)+1], 1, - &work->LZ[i*(m+1)+1], 1); - - // rank 1 update of matrix Z'*B - // Note: LDA is the second dimension of ZB because of - // Row-Major order - cblas_dger(CblasRowMajor, m+1, K-1, 1, &data->Z[i*(m+1)], 1, - work->beta, 1, work->ZB, K-1); - } - - // calculate Z'*A*Z by symmetric multiplication of LZ with itself - // (ZAZ = (LZ)' * (LZ) - cblas_dsyrk(CblasRowMajor, CblasUpper, CblasTrans, m+1, n, 1.0, - work->LZ, m+1, 0.0, work->ZAZ, m+1); - - // Calculate right-hand side of system we want to solve - // dsymm performs ZB := 1.0 * (ZAZ) * Vbar + 1.0 * ZB - // the right-hand side is thus stored in ZB after this call - // Note: LDB and LDC are second dimensions of the matrices due to - // Row-Major order - cblas_dsymm(CblasRowMajor, CblasLeft, CblasUpper, m+1, K-1, 1, - work->ZAZ, m+1, model->V, K-1, 1.0, work->ZB, K-1); - - // Calculate left-hand side of system we want to solve - // Add lambda to all diagonal elements except the first one. Recall - // that ZAZ is of size m+1 and is symmetric. - for (i=m+2; i<=m*(m+2); i+=m+2) - work->ZAZ[i] += model->lambda; - - // Lapack uses column-major order, so we transform the ZB matrix to - // correspond to this. - for (i=0; i<m+1; i++) - for (j=0; j<K-1; j++) - work->ZBc[j*(m+1)+i] = work->ZB[i*(K-1)+j]; - - // Solve the system using dposv. Note that above the upper triangular - // part has always been used in row-major order for ZAZ. This - // corresponds to the lower triangular part in column-major order. - status = dposv('L', m+1, K-1, work->ZAZ, m+1, work->ZBc, m+1); - - // Use dsysv as fallback, for when the ZAZ matrix is not positive - // semi-definite for some reason (perhaps due to rounding errors). - // This step shouldn't be necessary but is included for safety. - if (status != 0) { - err("[GenSVM Warning]: Received nonzero status from " - "dposv: %i\n", status); - int *IPIV = Malloc(int, m+1); - double *WORK = Malloc(double, 1); - status = dsysv('L', m+1, K-1, work->ZAZ, m+1, IPIV, work->ZBc, - m+1, WORK, -1); - - int LWORK = WORK[0]; - WORK = Realloc(WORK, double, LWORK); - status = dsysv('L', m+1, K-1, work->ZAZ, m+1, IPIV, work->ZBc, - m+1, WORK, LWORK); - if (status != 0) - err("[GenSVM Warning]: Received nonzero " - "status from dsysv: %i\n", status); - free(WORK); - WORK = NULL; - free(IPIV); - IPIV = NULL; - } - - // the solution is now stored in ZBc, in column-major order. Here we - // convert this back to row-major order - for (i=0; i<m+1; i++) - for (j=0; j<K-1; j++) - work->ZB[i*(K-1)+j] = work->ZBc[j*(m+1)+i]; - - // copy the old V to Vbar and the new solution to V - for (i=0; i<m+1; i++) { - for (j=0; j<K-1; j++) { - matrix_set(model->Vbar, K-1, i, j, - matrix_get(model->V, K-1, i, j)); - matrix_set(model->V, K-1, i, j, - matrix_get(work->ZB, K-1, i, j)); - } - } -} - -/** * @brief Use step doubling * * @details @@ -644,24 +255,12 @@ void gensvm_calculate_errors(struct GenModel *model, struct GenData *data, double q, *uu_row = NULL; long n = model->n; - long m = model->m; long K = model->K; - cblas_dgemm( - CblasRowMajor, - CblasNoTrans, - CblasNoTrans, - n, - K-1, - m+1, - 1.0, - data->Z, - m+1, - model->V, - K-1, - 0, - ZV, - K-1); + if (data->spZ == NULL) + gensvm_calculate_ZV_dense(model, data, ZV); + else + gensvm_calculate_ZV_sparse(model, data, ZV); for (i=0; i<n; i++) { for (j=0; j<K; j++) { @@ -674,87 +273,41 @@ void gensvm_calculate_errors(struct GenModel *model, struct GenData *data, } } -/** - * @brief Solve AX = B where A is symmetric positive definite. - * - * @details - * Solve a linear system of equations AX = B where A is symmetric positive - * definite. This function is a wrapper for the external LAPACK routine - * dposv. - * - * @param[in] UPLO which triangle of A is stored - * @param[in] N order of A - * @param[in] NRHS number of columns of B - * @param[in,out] A double precision array of size (LDA, N). On - * exit contains the upper or lower factor of the - * Cholesky factorization of A. - * @param[in] LDA leading dimension of A - * @param[in,out] B double precision array of size (LDB, NRHS). On - * exit contains the N-by-NRHS solution matrix X. - * @param[in] LDB the leading dimension of B - * @returns info parameter which contains the status of the - * computation: - * - =0: success - * - <0: if -i, the i-th argument had - * an illegal value - * - >0: if i, the leading minor of A - * was not positive definite - * - * See the LAPACK documentation at: - * http://www.netlib.org/lapack/explore-html/dc/de9/group__double_p_osolve.html - */ -int dposv(char UPLO, int N, int NRHS, double *A, int LDA, double *B, - int LDB) +void gensvm_calculate_ZV_sparse(struct GenModel *model, + struct GenData *data, double *ZV) { - extern void dposv_(char *UPLO, int *Np, int *NRHSp, double *A, - int *LDAp, double *B, int *LDBp, int *INFOp); - int INFO; - dposv_(&UPLO, &N, &NRHS, A, &LDA, B, &LDB, &INFO); - return INFO; + long i, j, jj, jj_start, jj_end, K, + n_row = data->spZ->n_row; + double z_ij; + + K = model->K; + + int *Zia = data->spZ->ia; + int *Zja = data->spZ->ja; + double *vals = data->spZ->values; + + for (i=0; i<n_row; i++) { + jj_start = Zia[i]; + jj_end = Zia[i+1]; + + for (jj=jj_start; jj<jj_end; jj++) { + j = Zja[jj]; + z_ij = vals[jj]; + + cblas_daxpy(K-1, z_ij, &model->V[j*(K-1)], 1, + &ZV[i*(K-1)], 1); + } + } } -/** - * @brief Solve a system of equations AX = B where A is symmetric. - * - * @details - * Solve a linear system of equations AX = B where A is symmetric. This - * function is a wrapper for the external LAPACK routine dsysv. - * - * @param[in] UPLO which triangle of A is stored - * @param[in] N order of A - * @param[in] NRHS number of columns of B - * @param[in,out] A double precision array of size (LDA, N). On - * exit contains the block diagonal matrix D and - * the multipliers used to obtain the factor U or - * L from the factorization A = U*D*U**T or - * A = L*D*L**T. - * @param[in] LDA leading dimension of A - * @param[in] IPIV integer array containing the details of D - * @param[in,out] B double precision array of size (LDB, NRHS). On - * exit contains the N-by-NRHS matrix X - * @param[in] LDB leading dimension of B - * @param[out] WORK double precision array of size max(1,LWORK). On - * exit, WORK(1) contains the optimal LWORK - * @param[in] LWORK the length of WORK, can be used for determining - * the optimal blocksize for dsystrf. - * @returns info parameter which contains the status of the - * computation: - * - =0: success - * - <0: if -i, the i-th argument had an - * illegal value - * - >0: if i, D(i, i) is exactly zero, - * no solution can be computed. - * - * See the LAPACK documentation at: - * http://www.netlib.org/lapack/explore-html/d6/d0e/group__double_s_ysolve.html - */ -int dsysv(char UPLO, int N, int NRHS, double *A, int LDA, int *IPIV, - double *B, int LDB, double *WORK, int LWORK) +void gensvm_calculate_ZV_dense(struct GenModel *model, + struct GenData *data, double *ZV) { - extern void dsysv_(char *UPLO, int *Np, int *NRHSp, double *A, - int *LDAp, int *IPIV, double *B, int *LDBp, - double *WORK, int *LWORK, int *INFOp); - int INFO; - dsysv_(&UPLO, &N, &NRHS, A, &LDA, IPIV, B, &LDB, WORK, &LWORK, &INFO); - return INFO; + long n = model->n; + long m = model->m; + long K = model->K; + + cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, K-1, m+1, + 1.0, data->Z, m+1, model->V, K-1, 0, ZV, K-1); } + diff --git a/src/gensvm_sparse.c b/src/gensvm_sparse.c new file mode 100644 index 0000000..ebc2c9d --- /dev/null +++ b/src/gensvm_sparse.c @@ -0,0 +1,181 @@ +/** + * @file gensvm_sparse.c + * @author Gertjan van den Burg + * @date October 11, 2016 + * @brief Functions for dealing with sparse data matrices + * + */ + +#include "gensvm_sparse.h" + +/** + * @brief Initialize a GenSparse structure + * + * @details + * A GenSparse structure is used to hold a sparse data matrix. We work with + * Compressed Row Storage (CSR) storage, also known as old Yale format. + * + * @return initialized GenSparse instance + */ +struct GenSparse *gensvm_init_sparse() +{ + struct GenSparse *sp = Malloc(struct GenSparse, 1); + sp->nnz = 0; + sp->n_row = 0; + sp->n_col = 0; + + sp->values = NULL; + sp->ia = NULL; + sp->ja = NULL; + + return sp; +} + +/** + * @brief Free an allocated GenSparse structure + * + * @details + * Simply free a previously allocated GenSparse structure by freeing all of + * its components. Finally, the structure itself is freed, and the pointer is + * set to NULL for safety. + * + * @param[in] sp GenSparse structure to free + */ +void gensvm_free_sparse(struct GenSparse *sp) +{ + free(sp->values); + free(sp->ia); + free(sp->ja); + free(sp); + sp = NULL; +} + +/** + * @brief Count the number of nonzeros in a matrix + * + * @details + * This is a utility function to count the number of nonzeros in a dense + * matrix. This is simply done by comparing with 0.0. + * + * @param[in] A a dense matrix (RowMajor order) + * @param[in] rows the number of rows of A + * @param[in] cols the number of columns of A + * + * @return the number of nonzeros in A + */ +long gensvm_count_nnz(double *A, long rows, long cols) +{ + long i, nnz = 0; + + for (i=0; i<rows*cols; i++) + nnz += (A[i] != 0.0) ? 1 : 0; + return nnz; +} + +/** + * @brief Check if it is worthwile to convert to a sparse matrix + * + * @details + * It is only worth to convert to a sparse matrix if the amount of sparsity is + * sufficient. For this to be the case, the number of nonzeros must be + * smaller than @f$(n(m - 1) - 1)/2@f$. This is tested here. If the amount of + * nonzero entries is small enough, the function returns the number of + * nonzeros. If it is too big, it returns -1. + * + * @param[in] A matrix in dense format (RowMajor order) + * @param[in] rows number of rows of A + * @param[in] cols number of columns of A + * + * @return + */ +bool gensvm_could_sparse(double *A, long rows, long cols) +{ + long nnz = gensvm_count_nnz(A, rows, cols); + + if (nnz < (rows*(cols-1.0)-1.0)/2.0) { + return true; + } + return false; +} + + +/** + * @brief Convert a dense matrix to a GenSparse structure if advantageous + * + * @details + * This utility function can be used to convert a dense matrix to a sparse + * matrix in the form of a GenSparse struture. Note that the allocated memory + * must be freed by the caller. The user should first check whether using a + * sparse matrix is worth it by calling gensvm_could_sparse(). + * + * @param[in] A a dense matrix in RowMajor order + * @param[in] rows number of rows of the matrix A + * @param[in] cols number of columns of the matrix A + * + * @return a GenSparse struct + */ +struct GenSparse *gensvm_dense_to_sparse(double *A, long rows, long cols) +{ + double value; + int row_cnt; + long i, j, cnt, nnz = 0; + struct GenSparse *spA = NULL; + + nnz = gensvm_count_nnz(A, rows, cols); + + spA = gensvm_init_sparse(); + + spA->nnz = nnz; + spA->n_row = rows; + spA->n_col = cols; + spA->values = Calloc(double, nnz); + spA->ia = Calloc(int, rows+1); + spA->ja = Calloc(int, nnz); + + cnt = 0; + spA->ia[0] = 0; + for (i=0; i<rows; i++) { + row_cnt = 0; + for (j=0; j<cols; j++) { + value = matrix_get(A, cols, i, j); + if (value != 0) { + row_cnt++; + spA->values[cnt] = value; + spA->ja[cnt] = j; + cnt++; + } + } + spA->ia[i+1] = spA->ia[i] + row_cnt; + } + + return spA; +} + +/** + * @brief Convert a GenSparse structure to a dense matrix + * + * @details + * This function converts a GenSparse structure back to a normal dense matrix + * in RowMajor order. Note that the allocated memory must be freed by the + * caller. + * + * @param[in] A a GenSparse structure + * + * @return a dense matrix + */ +double *gensvm_sparse_to_dense(struct GenSparse *A) +{ + double value; + long i, j, jj; + double *B = Calloc(double, (A->n_row)*(A->n_col)); + for (i=0; i<A->n_row; i++) { + for (jj=A->ia[i]; jj<A->ia[i+1]; jj++) { + j = A->ja[jj]; + value = A->values[jj]; + matrix_set(B, A->n_col, i, j, value); + } + } + + return B; +} + diff --git a/src/gensvm_update.c b/src/gensvm_update.c new file mode 100644 index 0000000..289f50c --- /dev/null +++ b/src/gensvm_update.c @@ -0,0 +1,592 @@ +/** + * @file gensvm_update.c + * @author Gertjan van den Burg + * @date 2016-10-14 + * @brief Functions for getting an update of the majorization algorithm + + * Copyright (C) + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + */ + +#include "gensvm_update.h" + +/** + * @brief Calculate the value of omega for a single instance + * + * @details + * This function calculates the value of the @f$ \omega_i @f$ variable for a + * single instance, where + * @f[ + * \omega_i = \frac{1}{p} \left( \sum_{j \neq y_i} h^p\left( + * \overline{q}_i^{(y_i j)} \right) \right)^{1/p-1} + * @f] + * Note that his function uses the precalculated values from GenModel::H and + * GenModel::R to speed up the computation. + * + * @param[in] model GenModel structure with the current model + * @param[in] i index of the instance for which to calculate omega + * @returns the value of omega for instance i + * + */ +double gensvm_calculate_omega(struct GenModel *model, struct GenData *data, + long i) +{ + long j; + double h, omega = 0.0, + p = model->p; + + for (j=0; j<model->K; j++) { + if (j == (data->y[i]-1)) + continue; + h = matrix_get(model->H, model->K, i, j); + omega += pow(h, p); + } + omega = (1.0/p)*pow(omega, 1.0/p - 1.0); + + return omega; +} + +/** + * @brief Check if we can do simple majorization for a given instance + * + * @details + * A simple majorization is possible if at most one of the Huberized hinge + * errors is nonzero for an instance. This is checked here. For this we + * compute the product of the Huberized error for all @f$j \neq y_i@f$ and + * check if strictly less than 2 are nonzero. See also the @ref update_math. + * + * @param[in] model GenModel structure with the current model + * @param[in] i index of the instance for which to check + * @returns whether or not we can do simple majorization + * + */ +bool gensvm_majorize_is_simple(struct GenModel *model, struct GenData *data, + long i) +{ + long j; + double h, value = 0; + for (j=0; j<model->K; j++) { + if (j == (data->y[i]-1)) + continue; + h = matrix_get(model->H, model->K, i, j); + value += (h > 0) ? 1 : 0; + if (value > 1) + return false; + } + return true; +} + +/** + * @brief Compute majorization coefficients for non-simple instance + * + * @details + * In this function we compute the majorization coefficients needed for an + * instance with a non-simple majorization (@f$\varepsilon_i = 0@f$). In this + * function, we distinguish a number of cases depending on the value of + * GenModel::p and the respective value of @f$\overline{q}_i^{(y_ij)}@f$. Note + * that the linear coefficient is of the form @f$b - a\overline{q}@f$, but + * often the second term is included in the definition of @f$b@f$, so it can + * be optimized out. The output argument \p b_aq contains this difference + * therefore in one go. More details on this function can be found in the @ref + * update_math. See also gensvm_calculate_ab_simple(). + * + * @param[in] model GenModel structure with the current model + * @param[in] i index for the instance + * @param[in] j index for the class + * @param[out] *a output argument for the quadratic coefficient + * @param[out] *b_aq output argument for the linear coefficient. + * + */ +void gensvm_calculate_ab_non_simple(struct GenModel *model, long i, long j, + double *a, double *b_aq) +{ + double q = matrix_get(model->Q, model->K, i, j); + double p = model->p; + double kappa = model->kappa; + const double a2g2 = 0.25*p*(2.0*p - 1.0)*pow((kappa+1.0)/2.0,p-2.0); + + if (2.0 - model->p < 1e-2) { + if (q <= - kappa) { + *b_aq = 0.5 - kappa/2.0 - q; + } else if ( q <= 1.0) { + *b_aq = pow(1.0 - q, 3.0)/(2.0*pow(kappa + 1.0, 2.0)); + } else { + *b_aq = 0; + } + *a = 1.5; + } else { + if (q <= (p + kappa - 1.0)/(p - 2.0)) { + *a = 0.25*pow(p, 2.0)*pow(0.5 - kappa/2.0 - q, p - 2.0); + } else if (q <= 1.0) { + *a = a2g2; + } else { + *a = 0.25*pow(p, 2.0)*pow((p/(p - 2.0))*(0.5 - + kappa/2.0 - q), p - 2.0); + *b_aq = (*a)*(2.0*q + kappa - 1.0)/(p - 2.0) + + 0.5*p*pow(p/(p - 2.0)*(0.5 - kappa/2.0 - q), + p - 1.0); + } + if (q <= -kappa) { + *b_aq = 0.5*p*pow(0.5 - kappa/2.0 - q, p - 1.0); + } else if ( q <= 1.0) { + *b_aq = p*pow(1.0 - q, 2.0*p - 1.0)/pow(2*kappa+2.0, p); + } + } +} + +/** + * @brief Compute majorization coefficients for simple instances + * + * @details + * In this function we compute the majorization coefficients needed for an + * instance with a simple majorization. This corresponds to the non-simple + * majorization for the case where GenModel::p equals 1. Due to this condition + * the majorization coefficients are quite simple to compute. Note that the + * linear coefficient of the majorization is of the form @f$b - + * a\overline{q}@f$, but often the second term is included in the definition + * of @f$b@f$, so it can be optimized out. For more details see the @ref + * update_math, and gensvm_calculate_ab_non_simple(). + * + * @param[in] model GenModel structure with the current model + * @param[in] i index for the instance + * @param[in] j index for the class + * @param[out] *a output argument for the quadratic coefficient + * @param[out] *b_aq output argument for the linear coefficient + * + */ +void gensvm_calculate_ab_simple(struct GenModel *model, long i, long j, + double *a, double *b_aq) +{ + double q = matrix_get(model->Q, model->K, i, j); + + if (q <= - model->kappa) { + *a = 0.25/(0.5 - model->kappa/2.0 - q); + *b_aq = 0.5; + } else if (q <= 1.0) { + *a = 1.0/(2.0*model->kappa + 2.0); + *b_aq = (1.0 - q)*(*a); + } else { + *a = -0.25/(0.5 - model->kappa/2.0 - q); + *b_aq = 0; + } +} + +/** + * @brief Compute the alpha_i and beta_i for an instance + * + * @details + * This computes the @f$\alpha_i@f$ value for an instance, and simultaneously + * updating the row of the B matrix corresponding to that + * instance (the @f$\boldsymbol{\beta}_i'@f$). The advantage of doing this at + * the same time is that we can compute the a and b values simultaneously in + * the gensvm_calculate_ab_simple() and gensvm_calculate_ab_non_simple() + * functions. + * + * The computation is done by first checking whether simple majorization is + * possible for this instance. If so, the @f$\omega_i@f$ value is set to 1.0, + * otherwise this value is computed. If simple majorization is possible, the + * coefficients a and b_aq are computed by gensvm_calculate_ab_simple(), + * otherwise they're computed by gensvm_calculate_ab_non_simple(). Next, the + * beta_i updated through the efficient BLAS daxpy function, and part of the + * value of @f$\alpha_i@f$ is computed. The final value of @f$\alpha_i@f$ is + * returned. + * + * @param[in] model GenModel structure with the current model + * @param[in] i index of the instance to update + * @param[out] beta beta vector of linear coefficients (assumed to + * be allocated elsewhere, initialized here) + * @returns the @f$\alpha_i@f$ value of this instance + * + */ +double gensvm_get_alpha_beta(struct GenModel *model, struct GenData *data, + long i, double *beta) +{ + bool simple; + long j, + K = model->K; + double omega, a, b_aq = 0.0, + alpha = 0.0; + double *uu_row = NULL; + const double in = 1.0/((double) model->n); + + simple = gensvm_majorize_is_simple(model, data, i); + omega = simple ? 1.0 : gensvm_calculate_omega(model, data, i); + + Memset(beta, double, K-1); + for (j=0; j<K; j++) { + // skip the class y_i = k + if (j == (data->y[i]-1)) + continue; + + // calculate the a_ijk and (b_ijk - a_ijk q_i^(kj)) values + if (simple) { + gensvm_calculate_ab_simple(model, i, j, &a, &b_aq); + } else { + gensvm_calculate_ab_non_simple(model, i, j, &a, &b_aq); + } + + // daxpy on beta and UU + // daxpy does: y = a*x + y + // so y = beta, UU_row = x, a = factor + b_aq *= model->rho[i] * omega * in; + uu_row = &model->UU[((data->y[i]-1)*K+j)*(K-1)]; + cblas_daxpy(K-1, b_aq, uu_row, 1, beta, 1); + + // increment Avalue + alpha += a; + } + alpha *= omega * model->rho[i] * in; + return alpha; +} + +/** + * @brief Perform a single step of the majorization algorithm to update V + * + * @details + * This function contains the main update calculations of the algorithm. These + * calculations are necessary to find a new update V. The calculations exist of + * recalculating the majorization coefficients for all instances and all + * classes, and solving a linear system to find V. + * + * Because the function gensvm_get_update() is always called after a call to + * gensvm_get_loss() with the same GenModel::V, it is unnecessary to calculate + * the updated errors GenModel::Q and GenModel::H here too. This saves on + * computation time. + * + * In calculating the majorization coefficients we calculate the elements of a + * diagonal matrix A with elements + * @f[ + * A_{i, i} = \frac{1}{n} \rho_i \sum_{j \neq k} \left[ + * \varepsilon_i a_{ijk}^{(1)} + (1 - \varepsilon_i) \omega_i + * a_{ijk}^{(p)} \right], + * @f] + * where @f$ k = y_i @f$. + * Since this matrix is only used to calculate the matrix @f$ Z' A Z @f$, it + * is efficient to update a matrix ZAZ through consecutive rank 1 updates with + * a single element of A and the corresponding row of Z. The BLAS function + * dsyr is used for this. + * + * The B matrix is has rows + * @f[ + * \boldsymbol{\beta}_i' = \frac{1}{n} \rho_i \sum_{j \neq k} \left[ + * \varepsilon_i \left( b_{ijk}^{(1)} - a_{ijk}^{(1)} + * \overline{q}_i^{(kj)} \right) + (1 - \varepsilon_i) + * \omega_i \left( b_{ijk}^{(p)} - a_{ijk}^{(p)} + * \overline{q}_i^{(kj)} \right) \right] + * \boldsymbol{\delta}_{kj}' + * @f] + * This is also split into two cases, one for which @f$ \varepsilon_i = 1 @f$, + * and one for when it is 0. The 3D simplex difference matrix is used here, in + * the form of the @f$ \boldsymbol{\delta}_{kj}' @f$. + * + * Finally, the following system is solved + * @f[ + * (\textbf{Z}'\textbf{AZ} + \lambda \textbf{J})\textbf{V} = + * (\textbf{Z}'\textbf{AZ}\overline{\textbf{V}} + \textbf{Z}' + * \textbf{B}) + * @f] + * solving this system is done through dposv(). + * + * @todo + * Consider using CblasColMajor everywhere + * + * @param[in,out] model model to be updated + * @param[in] data data used in model + * @param[in] work allocated workspace to use + */ +void gensvm_get_update(struct GenModel *model, struct GenData *data, + struct GenWork *work) +{ + int status; + long i, j; + + long m = model->m; + long K = model->K; + + gensvm_get_ZAZ_ZB(model, data, work); + + // Calculate right-hand side of system we want to solve + // dsymm performs ZB := 1.0 * (ZAZ) * Vbar + 1.0 * ZB + // the right-hand side is thus stored in ZB after this call + // Note: LDB and LDC are second dimensions of the matrices due to + // Row-Major order + cblas_dsymm(CblasRowMajor, CblasLeft, CblasUpper, m+1, K-1, 1, + work->ZAZ, m+1, model->V, K-1, 1.0, work->ZB, K-1); + + // Calculate left-hand side of system we want to solve + // Add lambda to all diagonal elements except the first one. Recall + // that ZAZ is of size m+1 and is symmetric. + for (i=m+2; i<=m*(m+2); i+=m+2) + work->ZAZ[i] += model->lambda; + + // Lapack uses column-major order, so we transform the ZB matrix to + // correspond to this. + for (i=0; i<m+1; i++) + for (j=0; j<K-1; j++) + work->ZBc[j*(m+1)+i] = work->ZB[i*(K-1)+j]; + + // Solve the system using dposv. Note that above the upper triangular + // part has always been used in row-major order for ZAZ. This + // corresponds to the lower triangular part in column-major order. + status = dposv('L', m+1, K-1, work->ZAZ, m+1, work->ZBc, m+1); + + // Use dsysv as fallback, for when the ZAZ matrix is not positive + // semi-definite for some reason (perhaps due to rounding errors). + // This step shouldn't be necessary but is included for safety. + if (status != 0) { + err("[GenSVM Warning]: Received nonzero status from " + "dposv: %i\n", status); + int *IPIV = Malloc(int, m+1); + double *WORK = Malloc(double, 1); + status = dsysv('L', m+1, K-1, work->ZAZ, m+1, IPIV, work->ZBc, + m+1, WORK, -1); + + int LWORK = WORK[0]; + WORK = Realloc(WORK, double, LWORK); + status = dsysv('L', m+1, K-1, work->ZAZ, m+1, IPIV, work->ZBc, + m+1, WORK, LWORK); + if (status != 0) + err("[GenSVM Warning]: Received nonzero " + "status from dsysv: %i\n", status); + free(WORK); + WORK = NULL; + free(IPIV); + IPIV = NULL; + } + + // the solution is now stored in ZBc, in column-major order. Here we + // convert this back to row-major order + for (i=0; i<m+1; i++) + for (j=0; j<K-1; j++) + work->ZB[i*(K-1)+j] = work->ZBc[j*(m+1)+i]; + + // copy the old V to Vbar and the new solution to V + for (i=0; i<m+1; i++) { + for (j=0; j<K-1; j++) { + matrix_set(model->Vbar, K-1, i, j, + matrix_get(model->V, K-1, i, j)); + matrix_set(model->V, K-1, i, j, + matrix_get(work->ZB, K-1, i, j)); + } + } +} + +/** + * @brief Calculate Z'*A*Z and Z'*B for dense matrices + * + * @details + * This function calculates the matrices Z'*A*Z and Z'*B for the case where Z + * is stored as a dense matrix. It calculates the Z'*A*Z product by + * constructing a matrix LZ = (A^(1/2) * Z), and calculating (LZ)'*(LZ) with + * the BLAS dsyrk function. The matrix Z'*B is calculated with successive + * rank-1 updates using the BLAS dger function. These functions came out as + * the most efficient way to do these computations in several simulation + * studies. + * + * @param[in] model a GenModel holding the current model + * @param[in] data a GenData with the data + * @param[in,out] work an allocated GenWork structure, contains + * updated ZAZ and ZB matrices on exit. + */ +void gensvm_get_ZAZ_ZB_dense(struct GenModel *model, struct GenData *data, + struct GenWork *work) +{ + long i; + double alpha, sqalpha; + + long n = model->n; + long m = model->m; + long K = model->K; + + // generate Z'*A*Z and Z'*B by rank 1 operations + for (i=0; i<n; i++) { + alpha = gensvm_get_alpha_beta(model, data, i, work->beta); + + // calculate row of matrix LZ, which is a scalar + // multiplication of sqrt(alpha_i) and row z_i' of Z + // Note that we use the fact that the first column of Z is + // always 1, by only computing the product for m values and + // copying the first element over. + sqalpha = sqrt(alpha); + work->LZ[i*(m+1)] = sqalpha; + cblas_daxpy(m, sqalpha, &data->Z[i*(m+1)+1], 1, + &work->LZ[i*(m+1)+1], 1); + + // rank 1 update of matrix Z'*B + // Note: LDA is the second dimension of ZB because of + // Row-Major order + cblas_dger(CblasRowMajor, m+1, K-1, 1, &data->Z[i*(m+1)], 1, + work->beta, 1, work->ZB, K-1); + } + + // calculate Z'*A*Z by symmetric multiplication of LZ with itself + // (ZAZ = (LZ)' * (LZ) + cblas_dsyrk(CblasRowMajor, CblasUpper, CblasTrans, m+1, n, 1.0, + work->LZ, m+1, 0.0, work->ZAZ, m+1); +} + +/** + * @brief Calculate Z'*A*Z and Z'*B for sparse matrices + * + * @details + * This function calculates the matrices Z'*A*Z and Z'*B for the case where Z + * is stored as a CSR sparse matrix (GenSparse structure). It computes only + * the products of the Z'*A*Z matrix that need to be computed, and updates the + * Z'*B matrix row-wise for each non-zero element of a row of Z, using a BLAS + * daxpy call. + * + * @sa + * gensvm_get_ZAZ_ZB() + * gensvm_get_ZAZ_ZB_dense() + * + * @param[in] model a GenModel holding the current model + * @param[in] data a GenData with the data + * @param[in,out] work an allocated GenWork structure, contains + * updated ZAZ and ZB matrices on exit. + */ +void gensvm_get_ZAZ_ZB_sparse(struct GenModel *model, struct GenData *data, + struct GenWork *work) +{ + long i, j, k, jj, kk, jj_start, jj_end, K, + n_row = data->spZ->n_row, + n_col = data->spZ->n_col; + double alpha, z_ij; + + K = model->K; + + int *Zia = data->spZ->ia; + int *Zja = data->spZ->ja; + double *vals = data->spZ->values; + + for (i=0; i<n_row; i++) { + alpha = gensvm_get_alpha_beta(model, data, i, work->beta); + + jj_start = Zia[i]; + jj_end = Zia[i+1]; + + for (jj=jj_start; jj<jj_end; jj++) { + j = Zja[jj]; + z_ij = vals[jj]; + cblas_daxpy(K-1, z_ij, work->beta, 1, + &work->ZB[j*(K-1)], 1); + z_ij *= alpha; + for (kk=jj; kk<jj_end; kk++) { + k = Zja[kk]; + matrix_add(work->ZAZ, n_col, j, k, + z_ij*vals[kk]); + } + } + } +} + + +void gensvm_get_ZAZ_ZB(struct GenModel *model, struct GenData *data, + struct GenWork *work) +{ + gensvm_reset_work(work); + + if (data->spZ == NULL) { + gensvm_get_ZAZ_ZB_dense(model, data, work); + } else { + gensvm_get_ZAZ_ZB_sparse(model, data, work); + } +} + +/** + * @brief Solve AX = B where A is symmetric positive definite. + * + * @details + * Solve a linear system of equations AX = B where A is symmetric positive + * definite. This function is a wrapper for the external LAPACK routine + * dposv. + * + * @param[in] UPLO which triangle of A is stored + * @param[in] N order of A + * @param[in] NRHS number of columns of B + * @param[in,out] A double precision array of size (LDA, N). On + * exit contains the upper or lower factor of the + * Cholesky factorization of A. + * @param[in] LDA leading dimension of A + * @param[in,out] B double precision array of size (LDB, NRHS). On + * exit contains the N-by-NRHS solution matrix X. + * @param[in] LDB the leading dimension of B + * @returns info parameter which contains the status of the + * computation: + * - =0: success + * - <0: if -i, the i-th argument had + * an illegal value + * - >0: if i, the leading minor of A + * was not positive definite + * + * See the LAPACK documentation at: + * http://www.netlib.org/lapack/explore-html/dc/de9/group__double_p_osolve.html + */ +int dposv(char UPLO, int N, int NRHS, double *A, int LDA, double *B, + int LDB) +{ + extern void dposv_(char *UPLO, int *Np, int *NRHSp, double *A, + int *LDAp, double *B, int *LDBp, int *INFOp); + int INFO; + dposv_(&UPLO, &N, &NRHS, A, &LDA, B, &LDB, &INFO); + return INFO; +} + +/** + * @brief Solve a system of equations AX = B where A is symmetric. + * + * @details + * Solve a linear system of equations AX = B where A is symmetric. This + * function is a wrapper for the external LAPACK routine dsysv. + * + * @param[in] UPLO which triangle of A is stored + * @param[in] N order of A + * @param[in] NRHS number of columns of B + * @param[in,out] A double precision array of size (LDA, N). On + * exit contains the block diagonal matrix D and + * the multipliers used to obtain the factor U or + * L from the factorization A = U*D*U**T or + * A = L*D*L**T. + * @param[in] LDA leading dimension of A + * @param[in] IPIV integer array containing the details of D + * @param[in,out] B double precision array of size (LDB, NRHS). On + * exit contains the N-by-NRHS matrix X + * @param[in] LDB leading dimension of B + * @param[out] WORK double precision array of size max(1,LWORK). On + * exit, WORK(1) contains the optimal LWORK + * @param[in] LWORK the length of WORK, can be used for determining + * the optimal blocksize for dsystrf. + * @returns info parameter which contains the status of the + * computation: + * - =0: success + * - <0: if -i, the i-th argument had an + * illegal value + * - >0: if i, D(i, i) is exactly zero, + * no solution can be computed. + * + * See the LAPACK documentation at: + * http://www.netlib.org/lapack/explore-html/d6/d0e/group__double_s_ysolve.html + */ +int dsysv(char UPLO, int N, int NRHS, double *A, int LDA, int *IPIV, + double *B, int LDB, double *WORK, int LWORK) +{ + extern void dsysv_(char *UPLO, int *Np, int *NRHSp, double *A, + int *LDAp, int *IPIV, double *B, int *LDBp, + double *WORK, int *LWORK, int *INFOp); + int INFO; + dsysv_(&UPLO, &N, &NRHS, A, &LDA, IPIV, B, &LDB, WORK, &LWORK, &INFO); + return INFO; +} |
