void WgPackList::_renderPatches( WgGfxDevice * pDevice, const WgRect& _canvas, const WgRect& _window, WgPatches * _pPatches ) { // We start by eliminating dirt outside our geometry WgPatches patches( _pPatches->Size() ); // TODO: Optimize by pre-allocating? for( const WgRect * pRect = _pPatches->Begin() ; pRect != _pPatches->End() ; pRect++ ) { if( _canvas.IntersectsWith( *pRect ) ) patches.Push( WgRect(*pRect,_canvas) ); } // Render container itself for( const WgRect * pRect = patches.Begin() ; pRect != patches.End() ; pRect++ ) _onRender(pDevice, _canvas, _window, *pRect ); // Render children WgRect dirtBounds = patches.Union(); { WgRect childGeo; WgPackListHook * p = (WgPackListHook*)_firstHookWithGeo( childGeo ); while(p) { WgRect canvas = childGeo + _canvas.Pos(); if( p->_isVisible() && canvas.IntersectsWith( dirtBounds ) ) p->_widget()->_renderPatches( pDevice, canvas, canvas, &patches ); p = (WgPackListHook*) _nextHookWithGeo( childGeo, p ); } } // Render header if( m_header.m_height != 0 ) { bool bInvertedSort = (m_sortOrder == WG_SORT_DESCENDING); WgRect canvas = _headerGeo() + _canvas.Pos(); for( const WgRect * pRect = patches.Begin() ; pRect != patches.End() ; pRect++ ) _renderHeader( pDevice, canvas, *pRect, m_header.m_pSkin, &m_header.label, &m_header.icon, &m_header.arrow, m_header.m_state, true, bInvertedSort ); } // Render Lasso if( m_pLassoSkin && m_lassoBegin != m_lassoEnd ) { WgRect lasso( m_lassoBegin, m_lassoEnd ); lasso += _canvas.Pos(); for( const WgRect * pRect = patches.Begin() ; pRect != patches.End() ; pRect++ ) m_pLassoSkin->Render( pDevice, lasso, m_state, WgRect( lasso, *pRect ) ); } }
// Select points within rectangle void FieldView::SelectPointsInRect(const CC_coord& c1, const CC_coord& c2, bool toggleSelected) { CC_lasso lasso(c1); lasso.Append(CC_coord(c1.x, c2.y)); lasso.Append(c2); lasso.Append(CC_coord(c2.x, c1.y)); lasso.End(); SelectWithLasso(&lasso, toggleSelected); }
static Rcpp::NumericMatrix refit_model(Rcpp::NumericMatrix X, Rcpp::NumericVector y, Rcpp::NumericMatrix beta_new, Rcpp::IntegerVector nk, int model, double eps, int maxiter) { int K = nk.size(); int p = X.ncol(); int n; Rcpp::NumericMatrix Xtmp(X.nrow(),p); Rcpp::NumericMatrix beta_refit(p,K); Rcpp::NumericVector lasso_result; int idx = 0; for (int k = 0; k < K; k++) { n = nk[k]; for (int i = 0; i < n; i++) { for (int j = 0; j < p; j++) { Xtmp(idx+i,j) = X(idx+i,j) * nz(beta_new(j,k),eps); } } idx += n; } idx = 0; for (int k = 0; k < K; k++) { n = nk[k]; lasso_result = lasso(Xtmp(Rcpp::Range(idx,idx+n-1),Rcpp::_), y[Rcpp::Range(idx,idx+n-1)], 0.0, model, false, eps, maxiter); for(int j = 0; j < p; j++){ beta_refit(j,k) = lasso_result[j]; } idx += n; } return beta_refit; }
// Coordinate descent for gaussian models (no active cycling) RcppExport SEXP cdfit_gaussian_nac(SEXP X_, SEXP y_, SEXP row_idx_, SEXP lambda_, SEXP nlambda_, SEXP lam_scale_, SEXP lambda_min_, SEXP alpha_, SEXP user_, SEXP eps_, SEXP max_iter_, SEXP multiplier_, SEXP dfmax_, SEXP ncore_, SEXP verbose_) { XPtr<BigMatrix> xMat(X_); double *y = REAL(y_); int *row_idx = INTEGER(row_idx_); double lambda_min = REAL(lambda_min_)[0]; double alpha = REAL(alpha_)[0]; int n = Rf_length(row_idx_); // number of observations used for fitting model int p = xMat->ncol(); int L = INTEGER(nlambda_)[0]; int lam_scale = INTEGER(lam_scale_)[0]; int user = INTEGER(user_)[0]; int verbose = INTEGER(verbose_)[0]; double eps = REAL(eps_)[0]; int max_iter = INTEGER(max_iter_)[0]; double *m = REAL(multiplier_); int dfmax = INTEGER(dfmax_)[0]; NumericVector lambda(L); NumericVector center(p); NumericVector scale(p); int p_keep = 0; int *p_keep_ptr = &p_keep; vector<int> col_idx; vector<double> z; double lambda_max = 0.0; double *lambda_max_ptr = &lambda_max; int xmax_idx = 0; int *xmax_ptr = &xmax_idx; // set up omp int useCores = INTEGER(ncore_)[0]; #ifdef BIGLASSO_OMP_H_ int haveCores = omp_get_num_procs(); if(useCores < 1) { useCores = haveCores; } omp_set_dynamic(0); omp_set_num_threads(useCores); #endif if (verbose) { char buff1[100]; time_t now1 = time (0); strftime (buff1, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now1)); Rprintf("\nPreprocessing start: %s\n", buff1); } // standardize: get center, scale; get p_keep_ptr, col_idx; get z, lambda_max, xmax_idx; standardize_and_get_residual(center, scale, p_keep_ptr, col_idx, z, lambda_max_ptr, xmax_ptr, xMat, y, row_idx, lambda_min, alpha, n, p); p = p_keep; // set p = p_keep, only loop over columns whose scale > 1e-6 if (verbose) { char buff1[100]; time_t now1 = time (0); strftime (buff1, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now1)); Rprintf("Preprocessing end: %s\n", buff1); Rprintf("\n-----------------------------------------------\n"); } // Objects to be returned to R arma::sp_mat beta = arma::sp_mat(p, L); // beta double *a = Calloc(p, double); //Beta from previous iteration NumericVector loss(L); IntegerVector iter(L); IntegerVector n_reject(L); double l1, l2, shift; double max_update, update, thresh; // for convergence check int i, j, jj, l, lstart; double *r = Calloc(n, double); for (i = 0; i < n; i++) r[i] = y[i]; double sumResid = sum(r, n); loss[0] = gLoss(r,n); thresh = eps * loss[0] / n; // set up lambda if (user == 0) { if (lam_scale) { // set up lambda, equally spaced on log scale double log_lambda_max = log(lambda_max); double log_lambda_min = log(lambda_min*lambda_max); double delta = (log_lambda_max - log_lambda_min) / (L-1); for (l = 0; l < L; l++) { lambda[l] = exp(log_lambda_max - l * delta); } } else { // equally spaced on linear scale double delta = (lambda_max - lambda_min*lambda_max) / (L-1); for (l = 0; l < L; l++) { lambda[l] = lambda_max - l * delta; } } lstart = 1; } else { lstart = 0; lambda = Rcpp::as<NumericVector>(lambda_); } // Path for (l = lstart; l < L; l++) { if(verbose) { // output time char buff[100]; time_t now = time (0); strftime (buff, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now)); Rprintf("Lambda %d. Now time: %s\n", l, buff); } if (l != 0) { // Check dfmax int nv = 0; for (j = 0; j < p; j++) { if (a[j] != 0) nv++; } if (nv > dfmax) { for (int ll=l; ll<L; ll++) iter[ll] = NA_INTEGER; Free_memo_nac(a, r); return List::create(beta, center, scale, lambda, loss, iter, n_reject, Rcpp::wrap(col_idx)); } } while(iter[l] < max_iter) { iter[l]++; max_update = 0.0; for (j = 0; j < p; j++) { jj = col_idx[j]; z[j] = crossprod_resid(xMat, r, sumResid, row_idx, center[jj], scale[jj], n, jj) / n + a[j]; l1 = lambda[l] * m[jj] * alpha; l2 = lambda[l] * m[jj] * (1-alpha); beta(j, l) = lasso(z[j], l1, l2, 1); shift = beta(j, l) - a[j]; if (shift !=0) { // compute objective update for checking convergence //update = z[j] * shift - 0.5 * (1 + l2) * (pow(beta(j, l), 2) - pow(a[j], 2)) - l1 * (fabs(beta(j, l)) - fabs(a[j])); update = pow(beta(j, l) - a[j], 2); if (update > max_update) { max_update = update; } update_resid(xMat, r, shift, row_idx, center[jj], scale[jj], n, jj); // update r sumResid = sum(r, n); //update sum of residual a[j] = beta(j, l); //update a } } // Check for convergence if (max_update < thresh) { loss[l] = gLoss(r, n); break; } } } Free_memo_nac(a, r); return List::create(beta, center, scale, lambda, loss, iter, n_reject, Rcpp::wrap(col_idx)); }
int main() { //Get Learning Dictionary GetLearningDictionary(RGBDic,LabDic); //LabDic[0].print("OK?"); //Do Saliency Detection for(int FileNode=1; FileNode<=MAXPIC; FileNode++) { //GetPic Mat SourceImage; Mat RGBImage; Mat LABImage; sprintf(FileName,"%s%d.jpg",IMGSAIM,FileNode); //get filename SourceImage=imread(FileName); //load picture from file resize(SourceImage,RGBImage,Size(PICSIZE,PICSIZE),0,0,INTER_LINEAR); cvtColor(RGBImage,LABImage,COLOR_BGR2Lab); //translate RGB into Lab imshow("Source",RGBImage); Matrix<double> RGBCannels[3]; Matrix<double> LabCanenls[3]; SpMatrix<double> SPRGB[3]; SpMatrix<double> SPLab[3]; Matrix<double> RGBSaliency; Matrix<double> LabSaliency; Matrix<double> FinalSaliency; Sparam sparam; for(int ColorSpace=1; ColorSpace<=2; ColorSpace++) { Matrix<double> *Cannels; Matrix<double> *Dic; SpMatrix<double> *Sparsecode; Matrix<double> * Saliency; //Choose Image Color Space if(ColorSpace==1) { Cannels=RGBCannels; Dic=RGBDic; Sparsecode=SPRGB; Saliency=&RGBSaliency; } else { Cannels=LabCanenls; Dic=LabDic; Sparsecode=SPLab; Saliency=&LabSaliency; } //Split picture into different cannels and transform Mat into Matrix<T> SplitCannel(RGBImage,Cannels[0],Cannels[1],Cannels[2]); //Split Picture into R,G,B cannel for(int Can=0; Can<3; Can++) { //Image into Row ImageToCol(Cannels[Can],PATCHSIZE,PATCHSIZE); //Represent picture by sparse coding Matrix<double> Result; lasso(Cannels[Can],Dic[Can],Sparsecode[Can],sparam); Dic->mult(Sparsecode[Can],Result); //Result into Image ColToImage(Result,PATCHSIZE,PATCHSIZE,PICSIZE,PICSIZE); } //Get cannnel's local saliency for(int Can=0; Can<3; Can++) { LocalSailency(Sparsecode[Can],Cannels[Can]); Normalization(Cannels[Can]); } //Composite cannels' saliency into space's saliency Saliency->resize(PATCHLEN,PATCHLEN); Saliency->setZeros(); for(int Can=0; Can<3; Can++) Saliency->add(Cannels[Can]); Normalization(*Saliency); } //Composite Lab's and RGB's saliency into finnal sailency FinalSaliency.resize(PATCHLEN,PATCHLEN); FinalSaliency.setZeros(); FinalSaliency.add(LabSaliency); FinalSaliency.add(RGBSaliency); Normalization(FinalSaliency); //transform saliency into image Mat SaliencyImage(PATCHLEN,PATCHLEN,CV_8UC1); MatrixtoMat(FinalSaliency,SaliencyImage); imshow("Final Saliency",SaliencyImage); waitKey(0); } return 0; }
// Coordinate descent for logistic models (no active set cycling) RcppExport SEXP cdfit_binomial_hsr_slores_nac(SEXP X_, SEXP y_, SEXP n_pos_, SEXP ylab_, SEXP row_idx_, SEXP lambda_, SEXP nlambda_, SEXP lam_scale_, SEXP lambda_min_, SEXP alpha_, SEXP user_, SEXP eps_, SEXP max_iter_, SEXP multiplier_, SEXP dfmax_, SEXP ncore_, SEXP warn_, SEXP safe_thresh_, SEXP verbose_) { XPtr<BigMatrix> xMat(X_); double *y = REAL(y_); int n_pos = INTEGER(n_pos_)[0]; IntegerVector ylabel = Rcpp::as<IntegerVector>(ylab_); // label vector of {-1, 1} int *row_idx = INTEGER(row_idx_); double lambda_min = REAL(lambda_min_)[0]; double alpha = REAL(alpha_)[0]; int n = Rf_length(row_idx_); // number of observations used for fitting model int p = xMat->ncol(); int L = INTEGER(nlambda_)[0]; int lam_scale = INTEGER(lam_scale_)[0]; double eps = REAL(eps_)[0]; int max_iter = INTEGER(max_iter_)[0]; double *m = REAL(multiplier_); int dfmax = INTEGER(dfmax_)[0]; int warn = INTEGER(warn_)[0]; int user = INTEGER(user_)[0]; double slores_thresh = REAL(safe_thresh_)[0]; // threshold for safe test int verbose = INTEGER(verbose_)[0]; NumericVector lambda(L); NumericVector Dev(L); IntegerVector iter(L); IntegerVector n_reject(L); // number of total rejections; IntegerVector n_slores_reject(L); // number of safe rejections; NumericVector beta0(L); NumericVector center(p); NumericVector scale(p); int p_keep = 0; // keep columns whose scale > 1e-6 int *p_keep_ptr = &p_keep; vector<int> col_idx; vector<double> z; double lambda_max = 0.0; double *lambda_max_ptr = &lambda_max; int xmax_idx = 0; int *xmax_ptr = &xmax_idx; // set up omp int useCores = INTEGER(ncore_)[0]; #ifdef BIGLASSO_OMP_H_ int haveCores = omp_get_num_procs(); if(useCores < 1) { useCores = haveCores; } omp_set_dynamic(0); omp_set_num_threads(useCores); #endif if (verbose) { char buff1[100]; time_t now1 = time (0); strftime (buff1, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now1)); Rprintf("\nPreprocessing start: %s\n", buff1); } // standardize: get center, scale; get p_keep_ptr, col_idx; get z, lambda_max, xmax_idx; standardize_and_get_residual(center, scale, p_keep_ptr, col_idx, z, lambda_max_ptr, xmax_ptr, xMat, y, row_idx, lambda_min, alpha, n, p); p = p_keep; // set p = p_keep, only loop over columns whose scale > 1e-6 if (verbose) { char buff1[100]; time_t now1 = time (0); strftime (buff1, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now1)); Rprintf("Preprocessing end: %s\n", buff1); Rprintf("\n-----------------------------------------------\n"); } arma::sp_mat beta = arma::sp_mat(p, L); //beta double *a = Calloc(p, double); //Beta from previous iteration double a0 = 0.0; //beta0 from previousiteration double *w = Calloc(n, double); double *s = Calloc(n, double); //y_i - pi_i double *eta = Calloc(n, double); // int *e1 = Calloc(p, int); //ever-active set int *e2 = Calloc(p, int); //strong set double xwr, xwx, pi, u, v, cutoff, l1, l2, shift, si; double max_update, update, thresh; // for convergence check int i, j, jj, l, violations, lstart; double ybar = sum(y, n) / n; a0 = beta0[0] = log(ybar / (1-ybar)); double nullDev = 0; double *r = Calloc(n, double); for (i = 0; i < n; i++) { r[i] = y[i]; nullDev = nullDev - y[i]*log(ybar) - (1-y[i])*log(1-ybar); s[i] = y[i] - ybar; eta[i] = a0; } thresh = eps * nullDev / n; double sumS = sum(s, n); // temp result sum of s double sumWResid = 0.0; // temp result: sum of w * r // set up lambda if (user == 0) { if (lam_scale) { // set up lambda, equally spaced on log scale double log_lambda_max = log(lambda_max); double log_lambda_min = log(lambda_min*lambda_max); double delta = (log_lambda_max - log_lambda_min) / (L-1); for (l = 0; l < L; l++) { lambda[l] = exp(log_lambda_max - l * delta); } } else { // equally spaced on linear scale double delta = (lambda_max - lambda_min*lambda_max) / (L-1); for (l = 0; l < L; l++) { lambda[l] = lambda_max - l * delta; } } Dev[0] = nullDev; lstart = 1; n_reject[0] = p; } else { lstart = 0; lambda = Rcpp::as<NumericVector>(lambda_); } // Slores variables vector<double> theta_lam; double g_theta_lam = 0.0; double prod_deriv_theta_lam = 0.0; double *g_theta_lam_ptr = &g_theta_lam; double *prod_deriv_theta_lam_ptr = &prod_deriv_theta_lam; vector<double> X_theta_lam_xi_pos; vector<double> prod_PX_Pxmax_xi_pos; vector<double> cutoff_xi_pos; int *slores_reject = Calloc(p, int); int *slores_reject_old = Calloc(p, int); for (int j = 0; j < p; j++) slores_reject_old[j] = 1; int slores; // if 0, don't perform Slores rule if (slores_thresh < 1) { slores = 1; // turn on slores theta_lam.resize(n); X_theta_lam_xi_pos.resize(p); prod_PX_Pxmax_xi_pos.resize(p); cutoff_xi_pos.resize(p); slores_init(theta_lam, g_theta_lam_ptr, prod_deriv_theta_lam_ptr, cutoff_xi_pos, X_theta_lam_xi_pos, prod_PX_Pxmax_xi_pos, xMat, y, z, xmax_idx, row_idx, col_idx, center, scale, ylabel, n_pos, n, p); } else { slores = 0; } if (slores == 1 && user == 0) n_slores_reject[0] = p; for (l = lstart; l < L; l++) { if(verbose) { // output time char buff[100]; time_t now = time (0); strftime (buff, 100, "%Y-%m-%d %H:%M:%S.000", localtime (&now)); Rprintf("Lambda %d. Now time: %s\n", l, buff); } if (l != 0) { // Check dfmax int nv = 0; for (j = 0; j < p; j++) { if (a[j] != 0) { nv++; } } if (nv > dfmax) { for (int ll=l; ll<L; ll++) iter[ll] = NA_INTEGER; Free(slores_reject); Free(slores_reject_old); Free_memo_bin_hsr_nac(s, w, a, r, e2, eta); return List::create(beta0, beta, center, scale, lambda, Dev, iter, n_reject, Rcpp::wrap(col_idx)); } cutoff = 2*lambda[l] - lambda[l-1]; } else { cutoff = 2*lambda[l] - lambda_max; } if (slores) { slores_screen(slores_reject, theta_lam, g_theta_lam, prod_deriv_theta_lam, X_theta_lam_xi_pos, prod_PX_Pxmax_xi_pos, cutoff_xi_pos, row_idx, col_idx, center, scale, xmax_idx, ylabel, lambda[l], lambda_max, n_pos, n, p); n_slores_reject[l] = sum(slores_reject, p); // update z[j] for features which are rejected at previous lambda but accepted at current one. update_zj(z, slores_reject, slores_reject_old, xMat, row_idx, col_idx, center, scale, sumS, s, m, n, p); #pragma omp parallel for private(j) schedule(static) for (j = 0; j < p; j++) { slores_reject_old[j] = slores_reject[j]; // hsr screening // if (slores_reject[j] == 0 && (fabs(z[j]) > (cutoff * alpha * m[col_idx[j]]))) { if (fabs(z[j]) > (cutoff * alpha * m[col_idx[j]])) { e2[j] = 1; } else { e2[j] = 0; } } } else { n_slores_reject[l] = 0; // hsr screening over all #pragma omp parallel for private(j) schedule(static) for (j = 0; j < p; j++) { if (fabs(z[j]) > (cutoff * alpha * m[col_idx[j]])) { e2[j] = 1; } else { e2[j] = 0; } } } n_reject[l] = p - sum(e2, p); while (iter[l] < max_iter) { while (iter[l] < max_iter) { while (iter[l] < max_iter) { iter[l]++; Dev[l] = 0.0; for (i = 0; i < n; i++) { if (eta[i] > 10) { pi = 1; w[i] = .0001; } else if (eta[i] < -10) { pi = 0; w[i] = .0001; } else { pi = exp(eta[i]) / (1 + exp(eta[i])); w[i] = pi * (1 - pi); } s[i] = y[i] - pi; r[i] = s[i] / w[i]; if (y[i] == 1) { Dev[l] = Dev[l] - log(pi); } else { Dev[l] = Dev[l] - log(1-pi); } } if (Dev[l] / nullDev < .01) { if (warn) warning("Model saturated; exiting..."); for (int ll=l; ll<L; ll++) iter[ll] = NA_INTEGER; Free(slores_reject); Free(slores_reject_old); Free_memo_bin_hsr_nac(s, w, a, r, e2, eta); return List::create(beta0, beta, center, scale, lambda, Dev, iter, n_reject, n_slores_reject, Rcpp::wrap(col_idx)); } // Intercept xwr = crossprod(w, r, n, 0); xwx = sum(w, n); beta0[l] = xwr / xwx + a0; si = beta0[l] - a0; if (si != 0) { a0 = beta0[l]; for (i = 0; i < n; i++) { r[i] -= si; //update r eta[i] += si; //update eta } } sumWResid = wsum(r, w, n); // update temp result: sum of w * r, used for computing xwr; max_update = 0.0; for (j = 0; j < p; j++) { if (e2[j]) { jj = col_idx[j]; xwr = wcrossprod_resid(xMat, r, sumWResid, row_idx, center[jj], scale[jj], w, n, jj); v = wsqsum_bm(xMat, w, row_idx, center[jj], scale[jj], n, jj) / n; u = xwr/n + v * a[j]; l1 = lambda[l] * m[jj] * alpha; l2 = lambda[l] * m[jj] * (1-alpha); beta(j, l) = lasso(u, l1, l2, v); shift = beta(j, l) - a[j]; if (shift != 0) { // update change of objective function // update = - u * shift + (0.5 * v + 0.5 * l2) * (pow(beta(j, l), 2) - pow(a[j], 2)) + l1 * (fabs(beta(j, l)) - fabs(a[j])); update = pow(beta(j, l) - a[j], 2) * v; if (update > max_update) max_update = update; update_resid_eta(r, eta, xMat, shift, row_idx, center[jj], scale[jj], n, jj); // update r sumWResid = wsum(r, w, n); // update temp result w * r, used for computing xwr; a[j] = beta(j, l); // update a } } } // Check for convergence if (max_update < thresh) break; } } // Scan for violations in rest if (slores) { violations = check_rest_set_hsr_slores_nac(e2, slores_reject, z, xMat, row_idx, col_idx, center, scale, a, lambda[l], sumS, alpha, s, m, n, p); } else { violations = check_rest_set_bin_nac(e2, z, xMat, row_idx, col_idx, center, scale, a, lambda[l], sumS, alpha, s, m, n, p); } if (violations == 0) break; if (n_slores_reject[l] <= p * slores_thresh) { slores = 0; // turn off slores screening for next iteration if not efficient } } } Free(slores_reject); Free(slores_reject_old); Free_memo_bin_hsr_nac(s, w, a, r, e2, eta); return List::create(beta0, beta, center, scale, lambda, Dev, iter, n_reject, n_slores_reject, Rcpp::wrap(col_idx)); }
// Coordinate descent for binomial models SEXP cdfit_binomial(SEXP X_, SEXP y_, SEXP penalty_, SEXP lambda, SEXP eps_, SEXP max_iter_, SEXP gamma_, SEXP multiplier, SEXP alpha_, SEXP dfmax_, SEXP user_, SEXP warn_) { // Declarations int n = length(y_); int p = length(X_)/n; int L = length(lambda); SEXP res, beta0, beta, Dev, iter; PROTECT(beta0 = allocVector(REALSXP, L)); double *b0 = REAL(beta0); for (int i=0; i<L; i++) b0[i] = 0; PROTECT(beta = allocVector(REALSXP, L*p)); double *b = REAL(beta); for (int j=0; j<(L*p); j++) b[j] = 0; PROTECT(Dev = allocVector(REALSXP, L)); PROTECT(iter = allocVector(INTSXP, L)); for (int i=0; i<L; i++) INTEGER(iter)[i] = 0; double *a = Calloc(p, double); // Beta from previous iteration for (int j=0; j<p; j++) a[j] = 0; double a0 = 0; // Beta0 from previous iteration double *X = REAL(X_); double *y = REAL(y_); const char *penalty = CHAR(STRING_ELT(penalty_, 0)); double *lam = REAL(lambda); double eps = REAL(eps_)[0]; int max_iter = INTEGER(max_iter_)[0]; double gamma = REAL(gamma_)[0]; double *m = REAL(multiplier); double alpha = REAL(alpha_)[0]; int dfmax = INTEGER(dfmax_)[0]; int user = INTEGER(user_)[0]; int warn = INTEGER(warn_)[0]; double *r = Calloc(n, double); double *w = Calloc(n, double); double *s = Calloc(n, double); double *z = Calloc(p, double); double *eta = Calloc(n, double); int *e1 = Calloc(p, int); for (int j=0; j<p; j++) e1[j] = 0; int *e2 = Calloc(p, int); for (int j=0; j<p; j++) e2[j] = 0; double xwr, xwx, pi, u, v, cutoff, l1, l2, shift, si; int converged, lstart; // Initialization double ybar = sum(y, n)/n; a0 = b0[0] = log(ybar/(1-ybar)); double nullDev = 0; for (int i=0;i<n;i++) nullDev = nullDev - y[i]*log(ybar) - (1-y[i])*log(1-ybar); for (int i=0; i<n; i++) s[i] = y[i] - ybar; for (int i=0; i<n; i++) eta[i] = a0; for (int j=0; j<p; j++) z[j] = crossprod(X, s, n, j)/n; // If lam[0]=lam_max, skip lam[0] -- closed form sol'n available if (user) { lstart = 0; } else { lstart = 1; REAL(Dev)[0] = nullDev; } // Path for (int l=lstart; l<L; l++) { if (l != 0) { // Assign a, a0 a0 = b0[l-1]; for (int j=0; j<p; j++) a[j] = b[(l-1)*p+j]; // Check dfmax int nv = 0; for (int j=0; j<p; j++) { if (a[j] != 0) nv++; } if (nv > dfmax) { for (int ll=l; ll<L; ll++) INTEGER(iter)[ll] = NA_INTEGER; res = cleanupB(s, w, a, r, e1, e2, z, eta, beta0, beta, Dev, iter); return(res); } // Determine eligible set if (strcmp(penalty, "lasso")==0) cutoff = 2*lam[l] - lam[l-1]; if (strcmp(penalty, "MCP")==0) cutoff = lam[l] + gamma/(gamma-1)*(lam[l] - lam[l-1]); if (strcmp(penalty, "SCAD")==0) cutoff = lam[l] + gamma/(gamma-2)*(lam[l] - lam[l-1]); for (int j=0; j<p; j++) if (fabs(z[j]) > (cutoff * alpha * m[j])) e2[j] = 1; } else { // Determine eligible set double lmax = 0; for (int j=0; j<p; j++) if (fabs(z[j]) > lmax) lmax = fabs(z[j]); if (strcmp(penalty, "lasso")==0) cutoff = 2*lam[l] - lmax; if (strcmp(penalty, "MCP")==0) cutoff = lam[l] + gamma/(gamma-1)*(lam[l] - lmax); if (strcmp(penalty, "SCAD")==0) cutoff = lam[l] + gamma/(gamma-2)*(lam[l] - lmax); for (int j=0; j<p; j++) if (fabs(z[j]) > (cutoff * alpha * m[j])) e2[j] = 1; } while (INTEGER(iter)[l] < max_iter) { while (INTEGER(iter)[l] < max_iter) { while (INTEGER(iter)[l] < max_iter) { INTEGER(iter)[l]++; REAL(Dev)[l] = 0; for (int i=0;i<n;i++) { if (eta[i] > 10) { pi = 1; w[i] = .0001; } else if (eta[i] < -10) { pi = 0; w[i] = .0001; } else { pi = exp(eta[i])/(1+exp(eta[i])); w[i] = pi*(1-pi); } s[i] = y[i] - pi; r[i] = s[i]/w[i]; if (y[i]==1) REAL(Dev)[l] = REAL(Dev)[l] - log(pi); if (y[i]==0) REAL(Dev)[l] = REAL(Dev)[l] - log(1-pi); } if (REAL(Dev)[l]/nullDev < .01) { if (warn) warning("Model saturated; exiting..."); for (int ll=l; ll<L; ll++) INTEGER(iter)[ll] = NA_INTEGER; res = cleanupB(s, w, a, r, e1, e2, z, eta, beta0, beta, Dev, iter); return(res); } // Intercept xwr = crossprod(w, r, n, 0); xwx = sum(w, n); b0[l] = xwr/xwx + a0; for (int i=0; i<n; i++) { si = b0[l] - a0; r[i] -= si; eta[i] += si; } // Covariates for (int j=0; j<p; j++) { if (e1[j]) { // Calculate u, v xwr = wcrossprod(X, r, w, n, j); xwx = wsqsum(X, w, n, j); u = xwr/n + (xwx/n)*a[j]; v = xwx/n; // Update b_j l1 = lam[l] * m[j] * alpha; l2 = lam[l] * m[j] * (1-alpha); if (strcmp(penalty,"MCP")==0) b[l*p+j] = MCP(u, l1, l2, gamma, v); if (strcmp(penalty,"SCAD")==0) b[l*p+j] = SCAD(u, l1, l2, gamma, v); if (strcmp(penalty,"lasso")==0) b[l*p+j] = lasso(u, l1, l2, v); // Update r shift = b[l*p+j] - a[j]; if (shift !=0) { /* for (int i=0;i<n;i++) r[i] -= shift*X[j*n+i]; */ /* for (int i=0;i<n;i++) eta[i] += shift*X[j*n+i]; */ for (int i=0;i<n;i++) { si = shift*X[j*n+i]; r[i] -= si; eta[i] += si; } } } } // Check for convergence converged = checkConvergence(b, a, eps, l, p); a0 = b0[l]; for (int j=0; j<p; j++) a[j] = b[l*p+j]; if (converged) break; } // Scan for violations in strong set int violations = 0; for (int j=0; j<p; j++) { if (e1[j]==0 & e2[j]==1) { z[j] = crossprod(X, s, n, j)/n; l1 = lam[l] * m[j] * alpha; if (fabs(z[j]) > l1) { e1[j] = e2[j] = 1; violations++; } } } if (violations==0) break; } // Scan for violations in rest int violations = 0; for (int j=0; j<p; j++) { if (e2[j]==0) { z[j] = crossprod(X, s, n, j)/n; l1 = lam[l] * m[j] * alpha; if (fabs(z[j]) > l1) { e1[j] = e2[j] = 1; violations++; } } } if (violations==0) break; } } res = cleanupB(s, w, a, r, e1, e2, z, eta, beta0, beta, Dev, iter); return(res); }
// Coordinate descent for gaussian models SEXP cdfit_gaussian(SEXP X_, SEXP y_, SEXP penalty_, SEXP lambda, SEXP eps_, SEXP max_iter_, SEXP gamma_, SEXP multiplier, SEXP alpha_, SEXP dfmax_, SEXP user_) { // Declarations int n = length(y_); int p = length(X_)/n; int L = length(lambda); SEXP res, beta, loss, iter; PROTECT(beta = allocVector(REALSXP, L*p)); double *b = REAL(beta); for (int j=0; j<(L*p); j++) b[j] = 0; PROTECT(loss = allocVector(REALSXP, L)); PROTECT(iter = allocVector(INTSXP, L)); for (int i=0; i<L; i++) INTEGER(iter)[i] = 0; double *a = Calloc(p, double); // Beta from previous iteration for (int j=0; j<p; j++) a[j]=0; double *X = REAL(X_); double *y = REAL(y_); const char *penalty = CHAR(STRING_ELT(penalty_, 0)); double *lam = REAL(lambda); double eps = REAL(eps_)[0]; int max_iter = INTEGER(max_iter_)[0]; double gamma = REAL(gamma_)[0]; double *m = REAL(multiplier); double alpha = REAL(alpha_)[0]; int dfmax = INTEGER(dfmax_)[0]; int user = INTEGER(user_)[0]; double *r = Calloc(n, double); for (int i=0; i<n; i++) r[i] = y[i]; double *z = Calloc(p, double); for (int j=0; j<p; j++) z[j] = crossprod(X, r, n, j)/n; int *e1 = Calloc(p, int); for (int j=0; j<p; j++) e1[j] = 0; int *e2 = Calloc(p, int); for (int j=0; j<p; j++) e2[j] = 0; double cutoff, l1, l2; int lstart; // If lam[0]=lam_max, skip lam[0] -- closed form sol'n available double rss = gLoss(r,n); if (user) { lstart = 0; } else { REAL(loss)[0] = rss; lstart = 1; } double sdy = sqrt(rss/n); // Path for (int l=lstart;l<L;l++) { R_CheckUserInterrupt(); if (l != 0) { // Assign a for (int j=0;j<p;j++) a[j] = b[(l-1)*p+j]; // Check dfmax int nv = 0; for (int j=0; j<p; j++) { if (a[j] != 0) nv++; } if (nv > dfmax) { for (int ll=l; ll<L; ll++) INTEGER(iter)[ll] = NA_INTEGER; res = cleanupG(a, r, e1, e2, z, beta, loss, iter); return(res); } // Determine eligible set if (strcmp(penalty, "lasso")==0) cutoff = 2*lam[l] - lam[l-1]; if (strcmp(penalty, "MCP")==0) cutoff = lam[l] + gamma/(gamma-1)*(lam[l] - lam[l-1]); if (strcmp(penalty, "SCAD")==0) cutoff = lam[l] + gamma/(gamma-2)*(lam[l] - lam[l-1]); for (int j=0; j<p; j++) if (fabs(z[j]) > (cutoff * alpha * m[j])) e2[j] = 1; } else { // Determine eligible set double lmax = 0; for (int j=0; j<p; j++) if (fabs(z[j]) > lmax) lmax = fabs(z[j]); if (strcmp(penalty, "lasso")==0) cutoff = 2*lam[l] - lmax; if (strcmp(penalty, "MCP")==0) cutoff = lam[l] + gamma/(gamma-1)*(lam[l] - lmax); if (strcmp(penalty, "SCAD")==0) cutoff = lam[l] + gamma/(gamma-2)*(lam[l] - lmax); for (int j=0; j<p; j++) if (fabs(z[j]) > (cutoff * alpha * m[j])) e2[j] = 1; } while (INTEGER(iter)[l] < max_iter) { while (INTEGER(iter)[l] < max_iter) { while (INTEGER(iter)[l] < max_iter) { // Solve over the active set INTEGER(iter)[l]++; double maxChange = 0; for (int j=0; j<p; j++) { if (e1[j]) { z[j] = crossprod(X, r, n, j)/n + a[j]; // Update beta_j l1 = lam[l] * m[j] * alpha; l2 = lam[l] * m[j] * (1-alpha); if (strcmp(penalty,"MCP")==0) b[l*p+j] = MCP(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"SCAD")==0) b[l*p+j] = SCAD(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"lasso")==0) b[l*p+j] = lasso(z[j], l1, l2, 1); // Update r double shift = b[l*p+j] - a[j]; if (shift !=0) { for (int i=0;i<n;i++) r[i] -= shift*X[j*n+i]; if (fabs(shift) > maxChange) maxChange = fabs(shift); } } } // Check for convergence for (int j=0; j<p; j++) a[j] = b[l*p+j]; if (maxChange < eps*sdy) break; } // Scan for violations in strong set int violations = 0; for (int j=0; j<p; j++) { if (e1[j]==0 & e2[j]==1) { z[j] = crossprod(X, r, n, j)/n; // Update beta_j l1 = lam[l] * m[j] * alpha; l2 = lam[l] * m[j] * (1-alpha); if (strcmp(penalty,"MCP")==0) b[l*p+j] = MCP(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"SCAD")==0) b[l*p+j] = SCAD(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"lasso")==0) b[l*p+j] = lasso(z[j], l1, l2, 1); // If something enters the eligible set, update eligible set & residuals if (b[l*p+j] !=0) { e1[j] = e2[j] = 1; for (int i=0; i<n; i++) r[i] -= b[l*p+j]*X[j*n+i]; a[j] = b[l*p+j]; violations++; } } } if (violations==0) break; } // Scan for violations in rest int violations = 0; for (int j=0; j<p; j++) { if (e2[j]==0) { z[j] = crossprod(X, r, n, j)/n; // Update beta_j l1 = lam[l] * m[j] * alpha; l2 = lam[l] * m[j] * (1-alpha); if (strcmp(penalty,"MCP")==0) b[l*p+j] = MCP(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"SCAD")==0) b[l*p+j] = SCAD(z[j], l1, l2, gamma, 1); if (strcmp(penalty,"lasso")==0) b[l*p+j] = lasso(z[j], l1, l2, 1); // If something enters the eligible set, update eligible set & residuals if (b[l*p+j] !=0) { e1[j] = e2[j] = 1; for (int i=0; i<n; i++) r[i] -= b[l*p+j]*X[j*n+i]; a[j] = b[l*p+j]; violations++; } } } if (violations==0) { break; } } REAL(loss)[l] = gLoss(r, n); } res = cleanupG(a, r, e1, e2, z, beta, loss, iter); return(res); }
SEXP grplasso(SEXP X0, SEXP y0, SEXP n0, SEXP groups0, SEXP lambda0, SEXP model0, SEXP conveps0, SEXP eps0, SEXP maxiter0,SEXP maxitersg0) { Rcpp::NumericVector lasso_result; //convert parameters to Rcpp types Rcpp::NumericMatrix X(X0); Rcpp::NumericVector y(y0); Rcpp::IntegerMatrix groups(groups0); double lambda = Rcpp::as<double>(lambda0); int model = Rcpp::as<int>(model0); double eps = Rcpp::as<double>(eps0); double conveps = Rcpp::as<double>(conveps0); int maxiter = Rcpp::as<int>(maxiter0); int maxitersg = Rcpp::as<int>(maxitersg0); Rcpp::IntegerVector n(n0); int K = 1; assert(lambda >= 0.0); assert(model >= 0); assert(model < MULTITASK_MODEL_COUNT); assert(eps > 0.0); assert(maxiter > 0); assert(maxitersg > 0); int p = groups.nrow(); int L = groups.ncol(); //initialize start values Rcpp::NumericMatrix alpha_cur(p, K); for (int i = 0; i < p * K; i++) { alpha_cur[i] = random(-0.1, 0.1); } Rcpp::NumericMatrix beta_cur = alpha_cur; Rcpp::NumericVector d_cur(L); std::fill(d_cur.begin(), d_cur.end(), 1.0); Rcpp::NumericMatrix eta_cur(L, K); std::fill(eta_cur.begin(), eta_cur.end(), 1.0); Rcpp::IntegerVector nz_cur(p*K + L); std::fill(nz_cur.begin(), nz_cur.end(), 1); Rcpp::NumericMatrix beta_new; bool converged = false; int iterations = 0; do { ++iterations; if (iterations >= maxiter && maxiter > 0) { break; } //update alpha Rcpp::NumericMatrix alpha_new(p, K); Rcpp::NumericMatrix Xtilde = x_tilde(X, n, groups, d_cur, eta_cur); lasso_result = lasso(Xtilde, y, lambda, model, false, eps, maxitersg); assert(lasso_result.size() == p); for (int j = 0; j < p; j++) { alpha_new(j,1) = lasso_result[j]; } //update d Rcpp::NumericMatrix Xtilde2 = x_tilde_2(X, n, groups, alpha_new, eta_cur); lasso_result = lasso(Xtilde2, y, 1.0, model, true, eps, maxitersg); assert(lasso_result.size() == L); Rcpp::NumericVector d_new(L); for (int i = 0; i < L; i++) { d_new[i] = lasso_result[i]/max(lasso_result); if(std::isnan(d_new[i])) d_new[i] = 0; } //update beta beta_new = next_beta(n, groups, alpha_new, d_new, eta_cur); assert(beta_new.nrow() == p); assert(beta_new.ncol() == K); //check structure convergence Rcpp::IntegerVector nz_new = nz_vec(alpha_new,d_new,eps); int nz_diff = 0; for (int i = 0; i < nz_new.length(); i++) { nz_diff += nz_cur[i] - nz_new[i]; } double max_diff = 0.0; for (int i = 0; i < p * K; i++) { double diff = fabs(beta_new[i] - beta_cur[i]); if (diff > max_diff) { max_diff = diff; } } if (max_diff < conveps && nz_diff==0) { converged = true; } alpha_cur = alpha_new; d_cur = d_new; beta_cur = beta_new; nz_cur = nz_new; } while (converged != true); Rcpp::NumericMatrix beta_refit = refit_model(X, y, beta_new, n, model, eps, maxitersg); Rcpp::List result; result["beta"] = beta_refit; result["d"] = nz(d_cur,eps); switch (model) { case MULTITASK_LINEAR: result["bic"] = bic_linear(X, y, beta_new, eps, n); break; case MULTITASK_LOGISTIC: result["bic"] = bic_logistic(X, y, beta_new, eps, n); break; default: assert(0); } result["converged"] = converged; return result; }