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;
}
