// Scan a single chromosome with interactive covariates
// this version should be fast but requires more memory
// (since we first expand the genotype probabilities to probs x intcovar)
// and this one allows weights for the individuals (the same for all phenotypes)
//
// genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions)
// pheno = matrix of numeric phenotypes (individuals x phenotypes)
// (no missing data allowed)
// addcovar = additive covariates (an intercept, at least)
// intcovar = interactive covariates (should also be included in addcovar)
// weights = vector of weights
//
// output = matrix of residual sums of squares (RSS) (phenotypes x positions)
//
// [[Rcpp::export]]
NumericMatrix scan_binary_onechr_intcovar_weighted_highmem(const NumericVector& genoprobs,
const NumericMatrix& pheno,
const NumericMatrix& addcovar,
const NumericMatrix& intcovar,
const NumericVector& weights,
const int maxit=100,
const double tol=1e-6,
const double qr_tol=1e-12)
{
const int n_ind = pheno.rows();
if(Rf_isNull(genoprobs.attr("dim")))
throw std::invalid_argument("genoprobs should be a 3d array but has no dim attribute");
const Dimension d = genoprobs.attr("dim");
if(d.size() != 3)
throw std::invalid_argument("genoprobs should be a 3d array");
if(n_ind != d[0])
throw std::range_error("nrow(pheno) != nrow(genoprobs)");
if(n_ind != addcovar.rows())
throw std::range_error("nrow(pheno) != nrow(addcovar)");
if(n_ind != intcovar.rows())
throw std::range_error("nrow(pheno) != nrow(intcovar)");
if(n_ind != weights.size())
throw std::range_error("nrow(pheno) != length(weights)");
// expand genotype probabilities to include geno x interactive covariate
NumericVector genoprobs_rev = expand_genoprobs_intcovar(genoprobs, intcovar);
// genotype can
return scan_binary_onechr_weighted(genoprobs_rev, pheno, addcovar, weights, maxit, tol, qr_tol);
}
// LMM scan of a single chromosome with interactive covariates
// this version should be fast but requires more memory
// (since we first expand the genotype probabilities to probs x intcovar)
// and this one allows weights for the individuals (the same for all phenotypes)
//
// genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions)
// pheno = matrix with one column of numeric phenotypes
// (no missing data allowed)
// addcovar = additive covariates (an intercept, at least)
// intcovar = interactive covariates (should also be included in addcovar)
// eigenvec = matrix of transposed eigenvectors of variance matrix
// weights = vector of weights (really the SQUARE ROOT of the weights)
//
// output = vector of log likelihood values
//
// [[Rcpp::export]]
NumericVector scan_pg_onechr_intcovar_highmem(const NumericVector& genoprobs,
const NumericMatrix& pheno,
const NumericMatrix& addcovar,
const NumericMatrix& intcovar,
const NumericMatrix& eigenvec,
const NumericVector& weights,
const double tol=1e-12)
{
const unsigned int n_ind = pheno.rows();
if(pheno.cols() != 1)
throw std::range_error("ncol(pheno) != 1");
const Dimension d = genoprobs.attr("dim");
const unsigned int n_pos = d[2];
if(n_ind != d[0])
throw std::range_error("nrow(pheno) != nrow(genoprobs)");
if(n_ind != addcovar.rows())
throw std::range_error("nrow(pheno) != nrow(addcovar)");
if(n_ind != intcovar.rows())
throw std::range_error("nrow(pheno) != nrow(intcovar)");
if(n_ind != weights.size())
throw std::range_error("nrow(pheno) != length(weights)");
if(n_ind != eigenvec.rows())
throw std::range_error("ncol(pheno) != nrow(eigenvec)");
if(n_ind != eigenvec.cols())
throw std::range_error("ncol(pheno) != ncol(eigenvec)");
// expand genotype probabilities to include geno x interactive covariate
NumericVector genoprobs_rev = expand_genoprobs_intcovar(genoprobs, intcovar);
// pre-multiply everything by eigenvectors
genoprobs_rev = matrix_x_3darray(eigenvec, genoprobs_rev);
NumericMatrix addcovar_rev = matrix_x_matrix(eigenvec, addcovar);
NumericMatrix pheno_rev = matrix_x_matrix(eigenvec, pheno);
// multiply everything by the (square root) of the weights
// (weights should ALREADY be the square-root of the real weights)
addcovar_rev = weighted_matrix(addcovar_rev, weights);
pheno_rev = weighted_matrix(pheno_rev, weights);
genoprobs_rev = weighted_3darray(genoprobs_rev, weights);
// regress out the additive covariates
genoprobs_rev = calc_resid_linreg_3d(addcovar_rev, genoprobs_rev, tol);
pheno_rev = calc_resid_linreg(addcovar_rev, pheno_rev, tol);
// now the scan, return RSS
NumericMatrix rss = scan_hk_onechr_nocovar(genoprobs_rev, pheno_rev, tol);
// 0.5*sum(log(weights)) [since these are sqrt(weights)]
double sum_logweights = sum(log(weights));
// calculate log likelihood
NumericVector result(n_pos);
for(unsigned int pos=0; pos<n_pos; pos++)
result[pos] = -(double)n_ind/2.0*log(rss[pos]) + sum_logweights;
return result;
}
// LMM scan of a single chromosome with interactive covariates
// this version uses less memory but will be slower
// (since we need to work with each position, one at a time)
// and this one allows weights for the individuals (the same for all phenotypes)
//
// genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions)
// pheno = matrix with one column of numeric phenotypes
// (no missing data allowed)
// addcovar = additive covariates (an intercept, at least)
// intcovar = interactive covariates (should also be included in addcovar)
// eigenvec = matrix of transposed eigenvectors of variance matrix
// weights = vector of weights (really the SQUARE ROOT of the weights)
//
// output = vector of log likelihood values
//
// [[Rcpp::export]]
NumericVector scan_pg_onechr_intcovar_lowmem(const NumericVector& genoprobs,
const NumericMatrix& pheno,
const NumericMatrix& addcovar,
const NumericMatrix& intcovar,
const NumericMatrix& eigenvec,
const NumericVector& weights,
const double tol=1e-12)
{
const unsigned int n_ind = pheno.rows();
if(pheno.cols() != 1)
throw std::range_error("ncol(pheno) != 1");
const Dimension d = genoprobs.attr("dim");
const unsigned int n_pos = d[2];
if(n_ind != d[0])
throw std::range_error("nrow(pheno) != nrow(genoprobs)");
if(n_ind != addcovar.rows())
throw std::range_error("nrow(pheno) != nrow(addcovar)");
if(n_ind != intcovar.rows())
throw std::range_error("nrow(pheno) != nrow(intcovar)");
if(n_ind != weights.size())
throw std::range_error("ncol(pheno) != length(weights)");
if(n_ind != eigenvec.rows())
throw std::range_error("ncol(pheno) != nrow(eigenvec)");
if(n_ind != eigenvec.cols())
throw std::range_error("ncol(pheno) != ncol(eigenvec)");
NumericVector result(n_pos);
// multiply pheno by eigenvectors and then by weights
NumericMatrix pheno_rev = matrix_x_matrix(eigenvec, pheno);
pheno_rev = weighted_matrix(pheno_rev, weights);
// 0.5*sum(log(weights)) [since these are sqrt(weights)]
double sum_logweights = sum(log(weights));
for(unsigned int pos=0; pos<n_pos; pos++) {
Rcpp::checkUserInterrupt(); // check for ^C from user
// form X matrix
NumericMatrix X = formX_intcovar(genoprobs, addcovar, intcovar, pos, true);
// multiply by eigenvectors
X = matrix_x_matrix(eigenvec, X);
// multiply by weights
X = weighted_matrix(X, weights);
// do regression
NumericVector rss = calc_rss_linreg(X, pheno_rev, tol);
result[pos] = -(double)n_ind/2.0*log(rss[0]) + sum_logweights;
}
return result;
}
NumericVector WithDoubleFun(NumericMatrix x, double (*CombineFun)(double, double)) {
NumericVector result(1);
for (int i = 0; i < x.rows(); i++) {
result = result + CombineFun(x(i,0), x(i,1));
}
return result;
}
NumericVector WithMatrixFun(NumericMatrix x, double (*CombineFun)(NumericMatrix, int)) {
NumericVector result(1);
for (int i = 0; i < x.rows(); i++) {
result = result + CombineFun(x, i);
}
return result;
}
// Scan a single chromosome with additive covariates and weights
//
// genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions)
// pheno = matrix of numeric phenotypes (individuals x phenotypes)
// (no missing data allowed, values should be in [0,1])
// addcovar = additive covariates (an intercept, at least)
// weights = vector of weights
//
// output = matrix of (weighted) residual sums of squares (RSS) (phenotypes x positions)
//
// [[Rcpp::export]]
NumericMatrix scan_binary_onechr_weighted(const NumericVector& genoprobs,
const NumericMatrix& pheno,
const NumericMatrix& addcovar,
const NumericVector& weights,
const int maxit=100,
const double tol=1e-6,
const double qr_tol=1e-12,
const double eta_max=30.0)
{
const int n_ind = pheno.rows();
if(Rf_isNull(genoprobs.attr("dim")))
throw std::invalid_argument("genoprobs should be a 3d array but has no dim attribute");
const Dimension d = genoprobs.attr("dim");
if(d.size() != 3)
throw std::invalid_argument("genoprobs should be a 3d array");
if(n_ind != d[0])
throw std::range_error("nrow(pheno) != nrow(genoprobs)");
if(n_ind != addcovar.rows())
throw std::range_error("nrow(pheno) != nrow(addcovar)");
if(n_ind != weights.size())
throw std::range_error("nrow(pheno) != length(weights)");
const int n_pos = d[2];
const int n_gen = d[1];
const int n_add = addcovar.cols();
const int g_size = n_ind * n_gen;
const int n_phe = pheno.cols();
NumericMatrix result(n_phe, n_pos);
NumericMatrix X(n_ind, n_gen+n_add);
if(n_add > 0) // paste in covariates, if present
std::copy(addcovar.begin(), addcovar.end(), X.begin() + g_size);
for(int pos=0, offset=0; pos<n_pos; pos++, offset += g_size) {
Rcpp::checkUserInterrupt(); // check for ^C from user
// copy genoprobs for this pos into a matrix
std::copy(genoprobs.begin() + offset, genoprobs.begin() + offset + g_size, X.begin());
for(int phe=0; phe<n_phe; phe++) {
// calc rss and paste into ith column of result
result(phe,pos) = calc_ll_binreg_weighted(X, pheno(_,phe), weights, maxit, tol, qr_tol, eta_max);
}
}
return result;
}
// calculate distance between two lists of points
//
// pt1 and pt2 are each matrices with two columns
// [[Rcpp::export]]
NumericMatrix calc_dist_pt2pt(NumericMatrix pt1, NumericMatrix pt2)
{
int nr1 = pt1.rows(), nr2 = pt2.rows();
int nc1 = pt1.cols(), nc2 = pt2.cols();
if(nc1 != 2) throw std::invalid_argument("pt1 should have two columns");
if(nc2 != 2) throw std::invalid_argument("pt2 should have two columns");
NumericMatrix result(nr1,nr2);
for(int i=0; i<nr1; i++) {
for(int j=0; j<nr2; j++) {
result(i,j) = calc_dist_pt2pt_one(pt1(i,_), pt2(j,_));
}
}
return result;
}
// [[Rcpp::export]]
NumericVector Raw(NumericMatrix x) {
NumericVector result(1);
for (int i = 0; i < x.rows(); i++) {
// It's the allocation of a new numeric vector, not the function
// pointer, that slows down the other one.
//NumericVector y = x(i, _);
result = result + (x(i, 0) * x(i, 1));
}
return result;
}
// logistic regression by Qr decomposition with column pivoting
// return just the log likelihood
// [[Rcpp::export]]
double calc_ll_binreg_eigenqr(const NumericMatrix& X, const NumericVector& y,
const int maxit=100, const double tol=1e-6,
const double qr_tol=1e-12)
{
const int n_ind = y.size();
#ifndef RQTL2_NODEBUG
if(n_ind != X.rows())
throw std::invalid_argument("nrow(X) != length(y)");
#endif
double curllik = 0.0;
NumericVector pi(n_ind), wt(n_ind), nu(n_ind), z(n_ind);
for(int ind=0; ind<n_ind; ind++) {
pi[ind] = (y[ind] + 0.5)/2;
wt[ind] = sqrt(pi[ind] * (1-pi[ind]));
nu[ind] = log(pi[ind]) - log(1-pi[ind]);
z[ind] = nu[ind]*wt[ind] + (y[ind] - pi[ind])/wt[ind];
curllik += y[ind] * log10(pi[ind]) + (1.0-y[ind])*log10(1.0-pi[ind]);
}
NumericMatrix XX = weighted_matrix(X, wt);
bool converged=false;
double llik=0.0;
for(int it=0; it<maxit; it++) {
Rcpp::checkUserInterrupt(); // check for ^C from user
// fitted values using weighted XX; will need to divide by previous weights
nu = calc_fitted_linreg_eigenqr(XX, z, qr_tol);
llik = 0.0;
for(int ind=0; ind<n_ind; ind++) {
nu[ind] /= wt[ind]; // need to divide by previous weights
pi[ind] = exp(nu[ind])/(1.0 + exp(nu[ind]));
wt[ind] = sqrt(pi[ind] * (1.0 - pi[ind]));
z[ind] = nu[ind]*wt[ind] + (y[ind] - pi[ind])/wt[ind];
llik += y[ind] * log10(pi[ind]) + (1.0-y[ind])*log10(1.0-pi[ind]);
}
if(fabs(llik - curllik) < tol) { // converged
converged = true;
break;
}
XX = weighted_matrix(X, wt);
curllik = llik;
} // end iterations
if(!converged) r_warning("binreg didn't converge");
return llik;
}
//[[Rcpp::export]]
SEXP do_getcq_dense( NumericMatrix X, const IntegerVector& mcs0idx){
List vnl = clone(List(X.attr("dimnames")));
CharacterVector vn=vnl[0];
int nrX = X.rows(), i, ii, j, k, l, past;
IntegerVector pas( nrX ), vec_s( nrX ), vec2_s( nrX );
IntegerVector ggg( nrX );
// pas.setZero();
for (i=0; i<nrX; ++i){
j = mcs0idx[i]; // Rprintf("i=%d, j=%d, past=%d\n", i, j, past);
vec_s = X(_, j );
vec2_s = vec_s * pas ;
past = sum( vec2_s );
pas[i] = 1;
ggg[ mcs0idx[i] ] = past;
}
// // cout << vec_s.transpose() << endl; cout << pas.transpose() << endl;
IntegerVector ladder( nrX );
for (i=0; i<nrX-1; ++i){
if( ggg[i]+1>ggg[i+1]) ladder[i] = 1;
}
ladder[nrX-1]=1; //Rprintf("ladder: "); Rf_PrintValue( ladder );
int ncq = sum( ladder );
List cqlist(ncq);
for (i=0; i<nrX; ++i) pas[i]=0;
// pas.setZero();
l=0;
for (i=0; i<nrX; ++i){
if (ladder[i]>0){
j = mcs0idx[i];
vec_s = X(_, j );
vec2_s = vec_s * pas;
past = sum( vec2_s ) ; //Rprintf("i=%d, j=%d, past=%d\n", i, j, past);
IntegerVector cq(past+1);
//cout << "vec2_s " << vec2_s.transpose() << endl; Rf_PrintValue( cq );
k=0;
for (ii=0; ii<nrX; ++ii){
if (vec2_s[ii] != 0)
cq[k++] = ii;
}
cq[past] = j;
CharacterVector cq2(past+1);
for (k=0; k<past+1;++k) cq2[k]=vn[cq[k]];
cqlist[l++] = cq2; //Rf_PrintValue( cq );
}
pas[i] = 1;
}
return cqlist; //List::create( cqlist );
//return List::create(1);
}
// [[Rcpp::export]]
NumericVector row_kth(NumericMatrix toSort, int k) {
int n = toSort.rows();
NumericVector meds = NumericVector(n);
for (int i = 0; i < n; i++) {
NumericVector curRow = toSort.row(i);
std::nth_element(curRow.begin(), curRow.begin() + k, curRow.end());
meds[i] = curRow[k];
}
return meds;
}
// Scan a single chromosome with interactive covariates
// this version uses less memory but will be slower
// (since we need to work with each position, one at a time)
// and this one allows weights for the individuals (the same for all phenotypes)
//
// genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions)
// pheno = matrix of numeric phenotypes (individuals x phenotypes)
// (no missing data allowed)
// addcovar = additive covariates (an intercept, at least)
// intcovar = interactive covariates (should also be included in addcovar)
// weights = vector of weights
//
// output = matrix of residual sums of squares (RSS) (phenotypes x positions)
//
// [[Rcpp::export]]
NumericMatrix scan_binary_onechr_intcovar_weighted_lowmem(const NumericVector& genoprobs,
const NumericMatrix& pheno,
const NumericMatrix& addcovar,
const NumericMatrix& intcovar,
const NumericVector& weights,
const int maxit=100,
const double tol=1e-6,
const double qr_tol=1e-12,
const double eta_max=30.0)
{
const int n_ind = pheno.rows();
if(Rf_isNull(genoprobs.attr("dim")))
throw std::invalid_argument("genoprobs should be a 3d array but has no dim attribute");
const Dimension d = genoprobs.attr("dim");
if(d.size() != 3)
throw std::invalid_argument("genoprobs should be a 3d array");
const int n_pos = d[2];
const int n_phe = pheno.cols();
if(n_ind != d[0])
throw std::range_error("nrow(pheno) != nrow(genoprobs)");
if(n_ind != addcovar.rows())
throw std::range_error("nrow(pheno) != nrow(addcovar)");
if(n_ind != intcovar.rows())
throw std::range_error("nrow(pheno) != nrow(intcovar)");
NumericMatrix result(n_phe, n_pos);
for(int pos=0; pos<n_pos; pos++) {
Rcpp::checkUserInterrupt(); // check for ^C from user
// form X matrix
NumericMatrix X = formX_intcovar(genoprobs, addcovar, intcovar, pos, true);
for(int phe=0; phe<n_phe; phe++) {
// do regression
result(phe,pos) = calc_ll_binreg_weighted(X, pheno(_,phe), weights, maxit, tol, qr_tol, eta_max);
}
}
return result;
}
// use calc_resid_linreg for a 3-dim array
// [[Rcpp::export]]
NumericVector calc_resid_linreg_3d(const NumericMatrix& X, const NumericVector& P)
{
int nrowx = X.rows();
int sizep = P.size();
NumericMatrix pr(nrowx, sizep/nrowx);
std::copy(P.begin(), P.end(), pr.begin()); // FIXME I shouldn't need to copy
NumericMatrix result = calc_resid_linreg(X, pr);
result.attr("dim") = P.attr("dim");
return result;
}
// use calc_resid_linreg for a 3-dim array
// [[Rcpp::export]]
NumericVector calc_resid_linreg_3d(const NumericMatrix& X, const NumericVector& P,
const double tol=1e-12)
{
const unsigned int nrowx = X.rows();
const Dimension d = P.attr("dim");
if(d[0] != nrowx)
throw std::range_error("nrow(X) != nrow(P)");
NumericMatrix pr(nrowx, d[1]*d[2]);
std::copy(P.begin(), P.end(), pr.begin()); // FIXME I shouldn't need to copy
NumericMatrix result = calc_resid_eigenqr(X, pr, tol);
result.attr("dim") = d;
return result;
}
// [[Rcpp::export]]
NumericMatrix term_score(NumericMatrix beta) {
// calculate term score (Blei and Lafferty 2009)
int W = beta.rows();
int K = beta.cols();
NumericMatrix term_score(W, K);
for (int w = 0; w < W; w++) {
double product = 0.0;
for (int k = 0; k < K; k++) {
product *= beta(w, k);
}
for (int k = 0; k < K; k++) {
term_score(w, k) = beta(w, k) * log(beta(w, k) / pow(product, (1 / K)));
}
}
return term_score;
}
// [[Rcpp::export]]
NumericVector row_medians(NumericMatrix toSort) {
int n = toSort.rows();
int medN = toSort.cols();
NumericVector meds = NumericVector(n);
for (int i = 0; i < n; i++) {
NumericVector curRow = toSort.row(i);
std::nth_element(curRow.begin(), curRow.begin() + curRow.size()/2 - 1, curRow.end());
double med1 = curRow[curRow.size()/2 - 1];
if (medN % 2 == 0) {
std::nth_element(curRow.begin(), curRow.begin() + curRow.size()/2, curRow.end());
double med2 = curRow[curRow.size()/2];
meds[i] = (med1 + med2)/2.0;
} else {
meds[i] = med1;
}
}
return meds;
}
// use calc_resid_linreg for a 3-dim array
// [[Rcpp::export]]
NumericVector calc_resid_linreg_3d(const NumericMatrix& X, const NumericVector& P,
const double tol=1e-12)
{
const int nrowx = X.rows();
if(Rf_isNull(P.attr("dim")))
throw std::invalid_argument("P should be a 3d array but has no dim attribute");
const Dimension d = P.attr("dim");
if(d.size() != 3)
throw std::invalid_argument("P should be a 3d array");
if(d[0] != nrowx)
throw std::range_error("nrow(X) != nrow(P)");
NumericMatrix pr(nrowx, d[1]*d[2]);
std::copy(P.begin(), P.end(), pr.begin()); // FIXME I shouldn't need to copy
NumericMatrix result = calc_resid_eigenqr(X, pr, tol);
result.attr("dim") = d;
return result;
}
// [[Rcpp::export]]
NumericVector calc_coherence(List ctot, NumericMatrix top_words_topics) {
int K = top_words_topics.cols();
int M = top_words_topics.rows();
NumericMatrix cond_topic_count = ctot["cond_topic_count"];
NumericVector coherence_scores(K);
NumericVector composer_id = ctot["composer_id"];
for (int k = 0; k < K; k++) {
for (int m = 2; m < M; m++) {
for (int l = 0; l < m-1; l++) {
double doc_freq = 0.0;
double co_doc_freq = 0.0;
for (int i = 0; i < composer_id.size(); i++) {
doc_freq += (double) (composer_id[i] == top_words_topics(l, k));
co_doc_freq += (double) (composer_id[i] == top_words_topics(m, k) &&
composer_id[i] == top_words_topics(l, k));
}
coherence_scores[k] += log((co_doc_freq + 1.0) / doc_freq);
}
}
}
return coherence_scores;
}
// logistic regression
// return llik, fitted probabilities, coef, SE
// [[Rcpp::export]]
List fit_binreg_eigenqr(const NumericMatrix& X,
const NumericVector& y,
const bool se=true, // whether to include SEs
const int maxit=100,
const double tol=1e-6,
const double qr_tol=1e-12)
{
const int n_ind = y.size();
#ifndef RQTL2_NODEBUG
if(n_ind != X.rows())
throw std::invalid_argument("nrow(X) != length(y)");
#endif
double curllik = 0.0;
NumericVector pi(n_ind), wt(n_ind), nu(n_ind), z(n_ind);
for(int ind=0; ind<n_ind; ind++) {
pi[ind] = (y[ind] + 0.5)/2;
wt[ind] = sqrt(pi[ind] * (1-pi[ind]));
nu[ind] = log(pi[ind]) - log(1-pi[ind]);
z[ind] = nu[ind]*wt[ind] + (y[ind] - pi[ind])/wt[ind];
curllik += y[ind] * log10(pi[ind]) + (1.0-y[ind])*log10(1.0-pi[ind]);
}
NumericMatrix XX = weighted_matrix(X, wt); // to store weighted matrix
bool converged=false;
double llik=0.0;
for(int it=0; it<maxit; it++) {
Rcpp::checkUserInterrupt(); // check for ^C from user
// fitted values using weighted XX; will need to divide by previous weights
nu = calc_fitted_linreg_eigenqr(XX, z, qr_tol);
llik = 0.0;
for(int ind=0; ind<n_ind; ind++) {
nu[ind] /= wt[ind]; // need to divide by previous weights
pi[ind] = exp(nu[ind])/(1.0 + exp(nu[ind]));
wt[ind] = sqrt(pi[ind] * (1.0 - pi[ind]));
z[ind] = nu[ind]*wt[ind] + (y[ind] - pi[ind])/wt[ind];
llik += y[ind] * log10(pi[ind]) + (1.0-y[ind])*log10(1.0-pi[ind]);
}
XX = weighted_matrix(X, wt);
if(fabs(llik - curllik) < tol) { // converged
converged = true;
break;
}
curllik = llik;
} // end iterations
if(!converged) r_warning("binreg didn't converge");
// now get coefficients, SEs, etc.
List fit = fit_linreg_eigenqr(XX, z, true, qr_tol);
NumericVector coef = fit[0];
if(se) {
// SE scaled by sigma; need to unscale
NumericVector sigma = fit[4];
NumericVector SE = fit[7];
for(int i=0; i<SE.size(); i++) SE[i] /= sigma[0];
return List::create(Named("log10lik") = llik,
Named("fitted_probs") = pi,
Named("coef") = coef,
Named("SE") = SE);
}
else { // no need for SEs
return List::create(Named("log10lik") = llik,
Named("fitted_probs") = pi,
Named("coef") = coef);
}
}
SEXP eigenanatomyCppHelper(
NumericMatrix X,
SEXP r_mask,
RealType sparseness,
IntType nvecs,
IntType its,
IntType cthresh,
RealType z,
RealType smooth,
// NumericMatrix initializationMatrix,
Rcpp::List initializationList,
IntType covering,
RealType ell1,
IntType verbose,
IntType powerit,
RealType priorWeight )
{
enum { Dimension = ImageType::ImageDimension };
typename ImageType::RegionType region;
typedef typename ImageType::PixelType PixelType;
typedef typename ImageType::Pointer ImagePointerType;
typedef double Scalar;
typedef itk::ants::antsSCCANObject<ImageType, Scalar> SCCANType;
typedef typename SCCANType::MatrixType vMatrix;
typename SCCANType::Pointer sccanobj = SCCANType::New();
typename ImageType::Pointer mask = Rcpp::as<ImagePointerType>( r_mask );
bool maskisnull = mask.IsNull();
// deal with the initializationList, if any
unsigned int nImages = initializationList.size();
if ( ( nImages > 0 ) && ( !maskisnull ) )
{
itk::ImageRegionIteratorWithIndex<ImageType> it( mask,
mask->GetLargestPossibleRegion() );
vMatrix priorROIMat( nImages , X.cols() );
priorROIMat.fill( 0 );
for ( unsigned int i = 0; i < nImages; i++ )
{
typename ImageType::Pointer init =
Rcpp::as<ImagePointerType>( initializationList[i] );
unsigned long ct = 0;
it.GoToBegin();
while ( !it.IsAtEnd() )
{
PixelType pix = it.Get();
if ( pix >= 0.5 )
{
pix = init->GetPixel( it.GetIndex() );
priorROIMat( i, ct ) = pix;
ct++;
}
++it;
}
}
sccanobj->SetMatrixPriorROI( priorROIMat );
nvecs = nImages;
}
sccanobj->SetPriorWeight( priorWeight );
sccanobj->SetLambda( priorWeight );
// cast hack from Rcpp type to sccan type
std::vector<double> xdat =
Rcpp::as< std::vector<double> >( X );
const double* _xdata = &xdat[0];
vMatrix vnlX( _xdata , X.cols(), X.rows() );
vnlX = vnlX.transpose();
sccanobj->SetGetSmall( false );
vMatrix priorROIMat;
// sccanobj->SetMatrixPriorROI( priorROIMat);
// sccanobj->SetMatrixPriorROI2( priorROIMat );
sccanobj->SetCovering( covering );
sccanobj->SetSilent( ! verbose );
if( ell1 > 0 )
{
sccanobj->SetUseL1( true );
}
else
{
sccanobj->SetUseL1( false );
}
sccanobj->SetGradStep( vnl_math_abs( ell1 ) );
sccanobj->SetMaximumNumberOfIterations( its );
sccanobj->SetRowSparseness( z );
sccanobj->SetSmoother( smooth );
if ( sparseness < 0 ) sccanobj->SetKeepPositiveP(false);
sccanobj->SetSCCANFormulation( SCCANType::PQ );
sccanobj->SetFractionNonZeroP( fabs( sparseness ) );
sccanobj->SetMinClusterSizeP( cthresh );
sccanobj->SetMatrixP( vnlX );
// sccanobj->SetMatrixR( r ); // FIXME
sccanobj->SetMaskImageP( mask );
RealType truecorr = 0;
if( powerit == 1 )
{
truecorr = sccanobj->SparseReconHome( nvecs );
}
else if ( priorWeight > 1.e-12 )
truecorr = sccanobj->SparseReconPrior( nvecs, true );
else truecorr = sccanobj->SparseRecon(nvecs);
/*
else if( powerit != 0 )
{
truecorr = sccanobj->SparseArnoldiSVD(nvecs);
}
else if( svd_option == 4 )
{
truecorr = sccanobj->NetworkDecomposition( nvecs );
}
else if( svd_option == 5 )
{
truecorr = sccanobj->LASSO( nvecs );
}
else if( svd_option == 2 )
{
truecorr = sccanobj->CGSPCA(nvecs); // cgspca
}
else if( svd_option == 6 )
{
truecorr = sccanobj->SparseRecon(nvecs); // sparse (default)
}
else if( svd_option == 7 )
{
// sccanobj->SetPriorScaleMat( priorScaleMat);
sccanobj->SetMatrixPriorROI( priorROIMat);
sccanobj->SetFlagForSort();
sccanobj->SetLambda(sccanparser->Convert<double>( option->GetFunction( 0 )->GetParameter( 3 ) ) );
truecorr = sccanobj->SparseReconPrior(nvecs, true); // Prior
}
else
{
truecorr = sccanobj->SparseArnoldiSVDGreedy( nvecs ); // sparse (default)
}
*/
// solutions should be much smaller so may not be a big deal to copy
// FIXME - should not copy, should map memory
vMatrix solV = sccanobj->GetVariatesP();
NumericMatrix eanatMat( solV.cols(), solV.rows() );
unsigned long rows = solV.rows();
for( unsigned long c = 0; c < solV.cols(); c++ )
{
for( unsigned int r = 0; r < rows; r++ )
{
eanatMat( c, r ) = solV( r, c );
}
}
vMatrix solU = sccanobj->GetMatrixU();
NumericMatrix eanatMatU( solU.rows(), solU.cols() );
rows = solU.rows();
for( unsigned long c = 0; c < solU.cols(); c++ )
{
for( unsigned int r = 0; r < rows; r++ )
{
eanatMatU( r, c) = solU( r, c);
}
}
return(
Rcpp::List::create(
Rcpp::Named("eigenanatomyimages") = eanatMat,
Rcpp::Named("umatrix") = eanatMatU,
Rcpp::Named("varex") = truecorr )
);
}
SEXP sccanCppHelper(
NumericMatrix X,
NumericMatrix Y,
SEXP r_maskx,
SEXP r_masky,
RealType sparsenessx,
RealType sparsenessy,
IntType nvecs,
IntType its,
IntType cthreshx,
IntType cthreshy,
RealType z,
RealType smooth,
Rcpp::List initializationListx,
Rcpp::List initializationListy,
IntType covering,
RealType ell1,
IntType verbose,
RealType priorWeight )
{
enum { Dimension = ImageType::ImageDimension };
typename ImageType::RegionType region;
typedef typename ImageType::PixelType PixelType;
typedef typename ImageType::Pointer ImagePointerType;
typedef double Scalar;
typedef itk::ants::antsSCCANObject<ImageType, Scalar> SCCANType;
typedef typename SCCANType::MatrixType vMatrix;
typename SCCANType::Pointer sccanobj = SCCANType::New();
typename ImageType::Pointer maskx = Rcpp::as<ImagePointerType>( r_maskx );
typename ImageType::Pointer masky = Rcpp::as<ImagePointerType>( r_masky );
bool maskxisnull = maskx.IsNull();
bool maskyisnull = masky.IsNull();
// deal with the initializationList, if any
unsigned int nImagesx = initializationListx.size();
if ( ( nImagesx > 0 ) && ( !maskxisnull ) )
{
itk::ImageRegionIteratorWithIndex<ImageType> it( maskx,
maskx->GetLargestPossibleRegion() );
vMatrix priorROIMatx( nImagesx , X.cols() );
priorROIMatx.fill( 0 );
for ( unsigned int i = 0; i < nImagesx; i++ )
{
typename ImageType::Pointer init =
Rcpp::as<ImagePointerType>( initializationListx[i] );
unsigned long ct = 0;
it.GoToBegin();
while ( !it.IsAtEnd() )
{
PixelType pix = it.Get();
if ( pix >= 0.5 )
{
pix = init->GetPixel( it.GetIndex() );
priorROIMatx( i, ct ) = pix;
ct++;
}
++it;
}
}
sccanobj->SetMatrixPriorROI( priorROIMatx );
nvecs = nImagesx;
}
unsigned int nImagesy = initializationListy.size();
if ( ( nImagesy > 0 ) && ( !maskyisnull ) )
{
itk::ImageRegionIteratorWithIndex<ImageType> it( masky,
masky->GetLargestPossibleRegion() );
vMatrix priorROIMaty( nImagesy , Y.cols() );
priorROIMaty.fill( 0 );
for ( unsigned int i = 0; i < nImagesy; i++ )
{
typename ImageType::Pointer init =
Rcpp::as<ImagePointerType>( initializationListy[i] );
unsigned long ct = 0;
it.GoToBegin();
while ( !it.IsAtEnd() )
{
PixelType pix = it.Get();
if ( pix >= 0.5 )
{
pix = init->GetPixel( it.GetIndex() );
priorROIMaty( i, ct ) = pix;
ct++;
}
++it;
}
}
sccanobj->SetMatrixPriorROI2( priorROIMaty );
nvecs = nImagesy;
}
sccanobj->SetPriorWeight( priorWeight );
sccanobj->SetLambda( priorWeight );
// cast hack from Rcpp type to sccan type
std::vector<double> xdat =
Rcpp::as< std::vector<double> >( X );
const double* _xdata = &xdat[0];
vMatrix vnlX( _xdata , X.cols(), X.rows() );
vnlX = vnlX.transpose();
std::vector<double> ydat =
Rcpp::as< std::vector<double> >( Y );
const double* _ydata = &ydat[0];
vMatrix vnlY( _ydata , Y.cols(), Y.rows() );
vnlY = vnlY.transpose();
// cast hack done
sccanobj->SetGetSmall( false );
sccanobj->SetCovering( covering );
sccanobj->SetSilent( ! verbose );
if( ell1 > 0 )
{
sccanobj->SetUseL1( true );
}
else
{
sccanobj->SetUseL1( false );
}
sccanobj->SetGradStep( vnl_math_abs( ell1 ) );
sccanobj->SetMaximumNumberOfIterations( its );
sccanobj->SetRowSparseness( z );
sccanobj->SetSmoother( smooth );
if ( sparsenessx < 0 ) sccanobj->SetKeepPositiveP(false);
if ( sparsenessy < 0 ) sccanobj->SetKeepPositiveQ(false);
sccanobj->SetSCCANFormulation( SCCANType::PQ );
sccanobj->SetFractionNonZeroP( fabs( sparsenessx ) );
sccanobj->SetFractionNonZeroQ( fabs( sparsenessy ) );
sccanobj->SetMinClusterSizeP( cthreshx );
sccanobj->SetMinClusterSizeQ( cthreshy );
sccanobj->SetMatrixP( vnlX );
sccanobj->SetMatrixQ( vnlY );
// sccanobj->SetMatrixR( r ); // FIXME
sccanobj->SetMaskImageP( maskx );
sccanobj->SetMaskImageQ( masky );
sccanobj->SparsePartialArnoldiCCA( nvecs );
// FIXME - should not copy, should map memory
vMatrix solP = sccanobj->GetVariatesP();
NumericMatrix eanatMatp( solP.cols(), solP.rows() );
unsigned long rows = solP.rows();
for( unsigned long c = 0; c < solP.cols(); c++ )
{
for( unsigned int r = 0; r < rows; r++ )
{
eanatMatp( c, r ) = solP( r, c );
}
}
vMatrix solQ = sccanobj->GetVariatesQ();
NumericMatrix eanatMatq( solQ.cols(), solQ.rows() );
rows = solQ.rows();
for( unsigned long c = 0; c < solQ.cols(); c++ )
{
for( unsigned int r = 0; r < rows; r++ )
{
eanatMatq( c, r ) = solQ( r, c );
}
}
return(
Rcpp::List::create(
Rcpp::Named("eig1") = eanatMatp,
Rcpp::Named("eig2") = eanatMatq )
);
}
RcppExport SEXP robustMatrixTransform( SEXP r_matrix )
{
try
{
typedef double RealType;
NumericMatrix M = as< NumericMatrix >( r_matrix );
NumericMatrix outMat( M.rows(), M.cols() );
unsigned long rows = M.rows();
for( unsigned long j = 0; j < M.cols(); j++ )
{
NumericVector Mvec = M(_, j);
NumericVector rank = M(_, j);
for( unsigned int i = 0; i < rows; i++ )
{
RealType rankval = 0;
RealType xi = Mvec(i);
for( unsigned int k = 0; k < rows; k++ )
{
RealType yi = Mvec(k);
RealType diff = fabs(xi - yi);
if( diff > 0 )
{
RealType val = (xi - yi) / diff;
rankval += val;
}
}
rank(i) = rankval / rows;
}
outMat(_, j) = rank;
}
// this passes rcpp data to vnl matrix ... safely?
if ( 1 == 0 )
{
// Further notes on this:
// 1. see multiChannel cpp for how to pass image list
// 2. separate implementation for eanat and sccan
// 3. deal with output as only matrix?
// 4. .... ?
std::vector<RealType> dat =
Rcpp::as< std::vector<RealType> >( outMat );
const double* _data = &dat[0];
vnl_matrix<RealType> vnlmat( _data , M.cols(), M.rows() );
vnlmat = vnlmat.transpose();
}
return wrap( outMat );
}
catch( itk::ExceptionObject & err )
{
Rcpp::Rcout << "ITK ExceptionObject caught !" << std::endl;
forward_exception_to_r( err );
}
catch( const std::exception& exc )
{
Rcpp::Rcout << "STD ExceptionObject caught !" << std::endl;
forward_exception_to_r( exc );
}
catch(...)
{
Rcpp::stop("c++ exception (unknown reason)");
}
return Rcpp::wrap(NA_REAL); //not reached
}
// [[Rcpp::export]]
SEXP HandMadeKalmanFilterConstantCoeffCpp(NumericVector a0
, NumericMatrix P0, NumericMatrix T, NumericMatrix Z , NumericMatrix HH, NumericMatrix GG, NumericMatrix yt)
{
// convert data to Eigen class
Eigen::Map<Eigen::VectorXd > a0e(&a0[0], (size_t)(a0.size()));
Eigen::Map<Eigen::VectorXd > P0e(&P0[0], P0.rows(), P0.cols());
Eigen::Map<Eigen::MatrixXd > Te(&T[0], T.rows(), T.cols());
Eigen::Map<Eigen::MatrixXd > Ze(&Z[0], Z.rows(), Z.cols());
Eigen::Map<Eigen::MatrixXd > HHe(&HH[0], HH.rows(), HH.cols());
Eigen::Map<Eigen::MatrixXd > GGe(&GG[0], GG.rows(), GG.cols());
// HMKF initialization block
cout << T.rows() << " " << Z.rows() << " " << HH.rows() << " " << GG.rows() << endl;
HMKF kf = HMKF(T.rows(), Z.rows());
kf.setModel(Te, Ze, HHe, GGe);
kf.initialize(a0e, P0e);
// filtering steps
NumericVector x(yt.cols()), xp(yt.cols()), V(yt.cols());
for(int i=0; i!=yt.cols(); ++i){
kf.predict();
NumericMatrix::Column col = yt(_,i);
// std::cout << "y:" << col[0] << std::endl;
kf.filter(Map<Eigen::VectorXd >(&col[0], col.size()));
// xp[i]= (kf.getxp())(0);
x[i] = (kf.getx())(0);
// V[i] = (kf.getV())(0,0);
}
return List::create(_("x") = x, _("xp") = xp, _("V") = V);
}
