// [[Rcpp::export]] NumericMatrix rectify(NumericMatrix m){ NumericMatrix out(m.nrow(), m.ncol()); for(int i = 0; i< m.ncol(); i++){ out(_, i) = clamp(0, m(_, i), INFINITY); }; return out; }
// [[Rcpp::export]] NumericMatrix sortMatrix(NumericMatrix bipartiteAdjMatrix) { int numRows = bipartiteAdjMatrix.nrow(); int numCols = bipartiteAdjMatrix.ncol(); std::vector<myPair> colSums(numCols); std::vector<myPair> rowSums(numRows); NumericMatrix sortedMatrix(bipartiteAdjMatrix.nrow(), bipartiteAdjMatrix.ncol()); //calculate row and column sums for(int rowIdx = 0; rowIdx < numRows; rowIdx++) { rowSums[rowIdx].second = rowIdx; for(int colIdx = 0; colIdx < numCols; colIdx++) { colSums[colIdx].second = colIdx; rowSums[rowIdx].first += bipartiteAdjMatrix(rowIdx,colIdx); colSums[colIdx].first += bipartiteAdjMatrix(rowIdx,colIdx); } } //sort with custom comparator method std::sort(rowSums.begin(), rowSums.end(), comparator_r); std::sort(colSums.begin(), colSums.end(), comparator_r); //create sorted matrix by cross-referencing sorted indexes for(int rowIdx = 0; rowIdx < numRows; rowIdx++) { for(int colIdx = 0; colIdx < numCols; colIdx++) { sortedMatrix(rowIdx, colIdx) = bipartiteAdjMatrix(rowSums[rowIdx].second, colSums[colIdx].second); } } return sortedMatrix; }
// [[Rcpp::export]] Rcpp::List setlogP(NumericMatrix logP,NumericVector NegLL,NumericMatrix cbars,NumericMatrix G3) { int n = logP.nrow(), k = logP.ncol(); int l1 =cbars.ncol(); // int l2=cbars.nrow(); arma::mat logP2(logP.begin(), n, k, false); NumericVector cbartemp=cbars(0,_); NumericVector G3temp=G3(0,_); Rcpp::NumericMatrix LLconst(n,1); arma::colvec cbarrow(cbartemp.begin(),l1,false); arma::colvec G3row(G3temp.begin(),l1,false); // double v = arma::as_scalar(cbarrow.t() * cbarrow); // LLconst[j]<--t(as.matrix(cbars[j,1:l1]))%*%t(as.matrix(G3[j,1:l1]))+NegLL[j] for(int i=0;i<n;i++){ cbartemp=cbars(i,_); G3temp=G3(i,_); logP(i,1)=logP(i,0)-NegLL(i)+0.5*arma::as_scalar(cbarrow.t() * cbarrow)+arma::as_scalar(G3row.t() * cbarrow); LLconst(i,0)=NegLL(i)-arma::as_scalar(G3row.t() * cbarrow); } // return logP; return Rcpp::List::create(Rcpp::Named("logP")=logP,Rcpp::Named("LLconst")=LLconst); }
// [[Rcpp::export]] NumericVector fstatsC(NumericMatrix pairMat, NumericMatrix mod, NumericMatrix mod0, NumericVector outcome) { int nrow = pairMat.nrow(); int ncol = pairMat.ncol(); double ss, ss0; int df0 = mod0.ncol(); int df = df0+1; // alternative model always has +1 column arma::mat modc(mod.begin(), mod.nrow(), mod.ncol(), false); arma::mat mod0c(mod0.begin(), mod0.nrow(), mod0.ncol(), false); arma::colvec outcomec(outcome.begin(), outcome.size(), false); arma::vec fstats(nrow); arma::vec res = arma::zeros<arma::vec>(outcome.size()); arma::vec res0 = arma::zeros<arma::vec>(outcome.size()); try{ res0 = outcomec - mod0c*arma::solve(mod0c, outcomec); // The residual for the null model remains the same ss0 = arma::as_scalar(arma::trans(res0)*res0); } catch(std::exception &ex) { stop("WTF???"); } for(int i=0; i < nrow; i++){ // loop through all rows in pairMat //modc.insert_cols(mod.ncol(), pairMat(i,_)); can try this later, it's not working for(int j=0; j < pairMat.ncol(); j++){ // this loop is for copying the ith row of pairMat into the last column of modc modc(j,modc.n_cols-1) = pairMat(i,j); // Here we add the current row to the model } try{ res = outcomec - modc*arma::solve(modc, outcomec); // Calculate the residual ss = arma::as_scalar(arma::trans(res)*res); fstats(i) = ((ss0 - ss)/(df-df0))/(ss/(ncol-df)); } catch(std::exception &ex) { fstats(i) = NA_REAL; } } return Rcpp::wrap(fstats); }
Rcpp::List setlogP_C(NumericMatrix logP,NumericVector NegLL,NumericMatrix cbars,NumericMatrix G3,NumericMatrix LLconst) { int n = logP.nrow(), k = logP.ncol(); int l1 =cbars.ncol(); arma::mat logP2(logP.begin(), n, k, false); NumericVector cbartemp=cbars(0,_); NumericVector G3temp=G3(0,_); arma::colvec cbarrow(cbartemp.begin(),l1,false); arma::colvec G3row(G3temp.begin(),l1,false); for(int i=0;i<n;i++){ cbartemp=cbars(i,_); G3temp=G3(i,_); logP(i,1)=logP(i,0)-NegLL(i)+0.5*arma::as_scalar(cbarrow.t() * cbarrow)+arma::as_scalar(G3row.t() * cbarrow); LLconst(i,0)=NegLL(i)-arma::as_scalar(G3row.t() * cbarrow); } return Rcpp::List::create(Rcpp::Named("logP")=logP,Rcpp::Named("LLconst")=LLconst); }
// [[Rcpp::export("multiKernel_cpp")]] SEXP multiKernel(NumericMatrix Yr, NumericMatrix Zr, NumericMatrix Kr, double tau) { int n = Yr.nrow(), p = Yr.ncol(), q = Zr.ncol(); arma::mat K(Kr.begin(), n, n, false); // reuses memory and avoids extra copy arma::mat Y(Yr.begin(), n, p, false); arma::mat Z(Zr.begin(), n, q, false); // Initialize matrices arma::vec tuning_vect(n); tuning_vect.fill(tau); arma::mat tuning_mat(n, n, fill::zeros); tuning_mat.diag() = tuning_vect; arma::mat weight_mat = inv(K + tuning_mat); arma::mat B = inv(trans(Z) * weight_mat * Z) * trans(Z) * weight_mat * Y; arma::mat alpha_mat = weight_mat * (Y - Z * B); double newLS = computeLeastSq(Y, K, alpha_mat, Z, B); double BIC = 2 * newLS + log(n) * as_scalar(accu(B > 0) + accu(alpha_mat > 0)); return Rcpp::List::create( Rcpp::Named("alpha") = alpha_mat, Rcpp::Named("B") = B, Rcpp::Named("LS") = newLS, Rcpp::Named("BIC") = BIC); }
// [[Rcpp::export]] NumericVector smooth_nd(const NumericMatrix& grid_in, const NumericVector& z_in, const NumericVector& w_in_, const NumericMatrix& grid_out, const NumericVector h) { if (grid_in.nrow() != z_in.size()) stop("Incompatible input lengths"); if (grid_in.ncol() != grid_out.ncol()) stop("Incompatible grid sizes"); if (h.size() != grid_in.ncol()) stop("Incorrect h length"); int n_in = grid_in.nrow(), n_out = grid_out.nrow(), d = grid_in.ncol(); NumericVector w_in = (w_in_.size() > 0) ? w_in_ : rep(NumericVector::create(1), n_in); NumericVector z_out(n_out), w_out(n_out); for (int i = 0; i < n_in; ++i) { for(int j = 0; j < n_out; ++j) { double w = 1; for (int k = 0; k < d; ++k) { double dist = (grid_in(i, k) - grid_out(j, k)) / h[k]; w *= tricube(dist); } w *= w_in[i]; w_out[j] += w; z_out[j] += z_in[i] * w; } } for(int j = 0; j < n_out; ++j) { z_out[j] /= w_out[j]; } return z_out; }
// [[Rcpp::export]] NumericVector f1_gamma(NumericMatrix b,NumericVector y,NumericMatrix x,NumericVector alpha,NumericVector wt) { // Get dimensions of x - Note: should match dimensions of // y, b, alpha, and wt (may add error checking) // May want to add method for dealing with alpha and wt when // constants instead of vectors int l1 = x.nrow(), l2 = x.ncol(); int m1 = b.ncol(); // int lalpha=alpha.nrow(); // int lwt=wt.nrow(); Rcpp::NumericMatrix b2temp(l2,1); arma::mat x2(x.begin(), l1, l2, false); arma::mat alpha2(alpha.begin(), l1, 1, false); arma::mat wt2(wt.begin(), l1, 1, false); Rcpp::NumericVector xb(l1); arma::colvec xb2(xb.begin(),l1,false); // Reuse memory - update both below // Moving Loop inside the function is key for speed NumericVector yy(l1); NumericVector res(m1); for(int i=0;i<m1;i++){ b2temp=b(Range(0,l2-1),Range(i,i)); arma::mat b2(b2temp.begin(), l2, 1, false); // mu<-t(exp(alpha+x%*%b)) // disp2<-1/wt // -sum(dgamma(y,shape=1/disp2,scale=mu*disp2,log=TRUE)) xb2=exp(alpha2+ x2 * b2); for(int j=0;j<l1;j++){ xb[j]=xb[j]/wt[j]; } yy=-dgamma_glmb(y,wt,xb,true); res(i) =std::accumulate(yy.begin(), yy.end(), 0.0); } return res; }
// Function to calculate deviation from parity from cd matrix NumericVector distParity(NumericMatrix mat, NumericVector popvec) { /* Inputs to function: mat: Matrix of congressional district assignments popvec: vector of geographic unit populations */ // Get the unique cd labels NumericVector labs = unique(mat(_,0)); // Calculate parity double parity = (double)sum(popvec) / labs.size(); // Container vector of plan deviations NumericVector plandevs(mat.ncol()); // Loop through plans for(int i = 0; i < mat.ncol(); i++){ // Get plan arma::vec plan = mat(_,i); // Loop through assignments double maxdev = 0.0; for(int j = 0; j < labs.size(); j++){ arma::uvec assignments = find(plan == labs(j)); // Loop over precincts in plan int distpop = 0; for(int k = 0; k < assignments.size(); k++){ distpop += popvec(assignments(k)); } // Get deviation from parity double plandev = std::abs((double)((double)distpop - parity) / parity); if(plandev > maxdev){ maxdev = plandev; } } // Store maxdev in plandevs plandevs(i) = maxdev; } return plandevs; }
// [[Rcpp::export]] NumericVector getLengths(NumericMatrix xs, NumericMatrix ys) { NumericVector x(xs.ncol()), y(ys.ncol()); NumericVector Lengths(xs.nrow()); for(int i = 0; i < xs.nrow(); i++){ x = xs(i,_); y = ys(i,_); Lengths[i] = getLength(x,y); } return Lengths; }
// [[Rcpp::export]] double sample_gamma_scalar(NumericVector y, List x, NumericMatrix groups, NumericMatrix beta, List gamma, NumericVector delta, NumericMatrix z, double alpha, double sigma2, List bs_beta, NumericVector sigma2_gamma, int q_id, int G_id) { double out; NumericVector params(2); double sum_term = 0.0; double sum_term2 = 0.0; double sum_term2a = 0.0; double sum_term2b = 0.0; double sum_term3 = 0.0; double sum_term4 = 0.0; for (int i = 0; i < y.size(); i++) { if (groups(i, q_id) == G_id) { double term = 0.0; for (int k = 0; k < beta.nrow(); k++) { NumericMatrix bs_beta_k = bs_beta[k]; NumericMatrix x_k = x[k]; for (int j = 0; j < x_k.ncol(); j++) { for (int p = 0; p < beta.ncol(); p++) { term += beta(k, p) * bs_beta_k(j, p) * x_k(i, j); } } } sum_term += 1; sum_term2 += y[i]; sum_term2a += alpha; sum_term2b += term; for (int k = 0; k < z.ncol(); k++) { sum_term4 += delta[k] * z(i, k); } for (int q = 0; q < gamma.size(); q++) { if (q != q_id) { NumericVector gamma_q = gamma[q]; int group_set = groups(i, q); sum_term3 += gamma_q[group_set]; } } } } //Calculate params[1] params[1] = (sigma2 * sigma2_gamma[q_id]) / (sigma2_gamma[q_id] * sum_term + sigma2); //Calculate params[0] params[0] = params[1] * (-1.0 / (2.0 * sigma2)) * (-2.0 * sum_term2 + 2.0 * sum_term2a + 2.0 * sum_term2b + 2.0 * sum_term3 + 2.0 * sum_term4); //Calculate loglik out = rnorm(1, params[0], sqrt(params[1]))[0]; return out; }
//' Fast computation of trace of matrix product //' //' @description Fast computation of the trace of the matrix product trace(t(A) %*% B) //' @param A A matrix with dimensions n*k. //' @param B A matrix with dimenions n*k. //' @return The trace of the matrix product //' @author Claus Ekstrom <claus@@rprimer.dk> //' @examples //' //' A <- matrix(1:12, ncol=3) //' tracemp(A, A) //' //' @export // [[Rcpp::export]] double tracemp(NumericMatrix A, NumericMatrix B) { if ((A.nrow() != B.nrow()) || (A.ncol() != B.ncol())) Rcpp::stop("the two matrices must have the same dimensions"); arma::mat X(A.begin(), A.nrow(), A.ncol(), false); arma::mat Y(B.begin(), B.nrow(), B.ncol(), false); double res = arma::as_scalar(accu(X % Y)); return res; }
// [[Rcpp::export]] NumericMatrix cpp_rdirichlet( const int& n, const NumericMatrix& alpha ) { if (std::min({alpha.nrow(), alpha.ncol()}) < 1) { Rcpp::warning("NAs produced"); NumericMatrix out(n, alpha.ncol()); std::fill(out.begin(), out.end(), NA_REAL); return out; } int k = alpha.ncol(); NumericMatrix x(n, k); bool throw_warning = false; if (k < 2) Rcpp::stop("number of columns in alpha should be >= 2"); double row_sum, sum_alpha; bool wrong_values; for (int i = 0; i < n; i++) { sum_alpha = 0.0; row_sum = 0.0; wrong_values = false; for (int j = 0; j < k; j++) { sum_alpha += GETM(alpha, i, j); if (GETM(alpha, i, j) <= 0.0) { wrong_values = true; break; } x(i, j) = R::rgamma(GETM(alpha, i, j), 1.0); row_sum += x(i, j); } if (ISNAN(sum_alpha) || wrong_values) { throw_warning = true; for (int j = 0; j < k; j++) x(i, j) = NA_REAL; } else { for (int j = 0; j < k; j++) x(i, j) /= row_sum; } } if (throw_warning) Rcpp::warning("NAs produced"); return x; }
//' Apply crossprod and colSums //' //' @description Fast computation of crossprod(colSums(X),Y) //' @param X A matrix with dimensions k*n. Hence the result of \code{colSums(X)} has length n. //' @param Y A matrix with dimenions n*m. Can be a matrix with dimension m*n but then \code{transposeY} should be \code{TRUE}. //' @param transposeY Logical. If \code{TRUE} transpose Y before matrix multiplication. //' @return A vector of length m. //' @author Thomas Alexander Gerds <tag@@biostat.ku.dk> //' @examples //' x <- matrix(1:8,ncol=2) //' y <- matrix(1:16,ncol=8) //' colSumsCrossprod(x,y,0) //' //' x <- matrix(1:8,ncol=2) //' y <- matrix(1:16,ncol=2) //' colSumsCrossprod(x,y,1) //' @export // [[Rcpp::export]] NumericMatrix colSumsCrossprod(NumericMatrix X, NumericMatrix Y, bool transposeY){ arma::mat A(X.begin(), X.nrow(), X.ncol(), false); arma::mat B(Y.begin(), Y.nrow(), Y.ncol(), false); arma::rowvec result; // result of colSums(A) has to be a matrix // with one row and as many columns as B has rows if (transposeY) result = arma::sum(A,0)*B.t(); else result = arma::sum(A,0)*B; return wrap(result); }
// [[Rcpp::export]] NumericVector smooth_nd_1(const NumericMatrix& grid_in, const NumericVector& z_in, const NumericVector& w_in_, const NumericMatrix& grid_out, const int var, const double h, const std::string type = "mean") { if (var < 0) stop("var < 0"); if (var >= grid_in.ncol()) stop("var too large"); if (h <= 0) stop("h <= 0"); if (grid_in.ncol() != grid_out.ncol()) stop("Incompatible grid sizes"); int n_in = grid_in.nrow(), n_out = grid_out.nrow(), d = grid_in.ncol(); NumericVector w_in = (w_in_.size() > 0) ? w_in_ : rep(NumericVector::create(1), n_in); NumericVector z_out(n_out), w_out(n_out); // Will be much more efficient to slice up by input dimension: // and most efficient way of doing that will be to bin with / bw // My data structure: sparse grids // // And once we're smoothing in one direction, with guaranteed e2venly spaced // grid can avoid many kernel evaluations and can also compute more // efficient running sum for(int j = 0; j < n_out; ++j) { boost::shared_ptr<Summary2d> summary = createSummary(type); for (int i = 0; i < n_in; ++i) { // Check that all variables (apart from var) are equal bool equiv = true; for (int k = 0; k < d; ++k) { if (k == var) continue; double in = grid_in(i, k), out = grid_out(j, k); if (in != out && !both_na(in, out)) { equiv = false; break; } }; if (!equiv) continue; double in = grid_in(i, var), out = grid_out(j, var); double dist = both_na(in, out) ? 0 : in - out; double w = tricube(dist / h) * w_in[i]; if (w == 0) continue; summary->push(dist, z_in[i], w); } z_out[j] = summary->compute(); } return z_out; }
//--------------------------------------------------------------------- // //--------------------------------------------------------------------- // [[Rcpp::export]] void numerator_trick(NumericMatrix A, NumericMatrix B) { arma::mat aA(A.begin(), A.nrow(), A.ncol(), false); arma::mat aB(B.begin(), B.nrow(), B.ncol(), false); arma::mat numerator_mat = arma::conv2(aA,arma::fliplr(arma::flipud((aB)))); arma::cx_mat res = arma::ifft2(arma::fft2(aA) % arma::fft2(arma::fliplr(arma::flipud(aB)))); res.print(); numerator_mat.print(); //return numerator_mat; }
//' Apply crossprod and rowSums //' //' @description Fast computation of crossprod(rowSums(X),Y) //' @param X A matrix with dimensions n*k. Hence the result of \code{rowSums(X)} has length n. //' @param Y A matrix with dimenions n*m. Can be a matrix with dimension m*n but then \code{transposeY} should be \code{TRUE}. //' @param transposeY Logical. If \code{TRUE} transpose Y before matrix multiplication. //' @return A vector of length m. //' @author Thomas Alexander Gerds <tag@@biostat.ku.dk> //' @examples //' x <- matrix(1:10,nrow=5) //' y <- matrix(1:20,ncol=4) //' rowSumsCrossprod(x,y,0) //' //' x <- matrix(1:10,nrow=5) //' y <- matrix(1:20,ncol=5) //' rowSumsCrossprod(x,y,1) //' @export // [[Rcpp::export]] NumericMatrix rowSumsCrossprod(NumericMatrix X, NumericMatrix Y, bool transposeY){ arma::mat A(X.begin(), X.nrow(), X.ncol(), false); arma::mat B(Y.begin(), Y.nrow(), Y.ncol(), false); arma::rowvec result; // result of colSums(A) has to be a matrix // with one row and as many columns as B has rows // since sum(A,1) is a matrix with one column // we transpose before multiplication if (transposeY) result = arma::sum(A,1).t()*B.t(); else result = arma::sum(A,1).t()*B; return wrap(result); }
// [[Rcpp::export]] NumericMatrix parallelMatrixSqrt(NumericMatrix x) { // allocate the output matrix NumericMatrix output(x.nrow(), x.ncol()); // SquareRoot functor (pass input and output matrixes) SquareRoot squareRoot(x, output); // call parallelFor to do the work parallelFor(0, x.nrow() * x.ncol(), squareRoot); // return the output matrix return output; }
// [[Rcpp::export]] List bsplitC(NumericMatrix Dmat, NumericMatrix Xmat, NumericVector parm) { int J = Dmat.ncol() - 1, nsub = Dmat.nrow(), nbeta = Xmat.ncol(), id = -1, j; NumericVector result(2, -9999999999), temp(2), xtemp(nsub); for (int i=0; i < nbeta; i++) { xtemp = Xmat(_, i); temp = splitpt(Dmat, xtemp, parm); if (temp[1] >= result[1]) { id = i; result[0] = temp[0]; result[1] = temp[1]; } } return List::create(id + 1, result); }
// Sends employed Bees void SendEmployedBees( double & GlobalMin, NumericVector & GlobalParams, NumericVector & fitness, NumericVector & f, IntegerVector & trial, Function & fun, NumericMatrix & Foods, const NumericVector & lb, const NumericVector & ub ) { int param2change, neighbour; double ObjValSol, FitnessSol; NumericVector solution(Foods.ncol()); for (int i=0;i<Foods.nrow();i++) { // Random parameter to change param2change = (int)(unif_rand()*Foods.ncol()); // Random neighbour to select neighbour = i; while (neighbour == i) neighbour = (int)(unif_rand()*Foods.nrow()); // Suggesting new solution solution = Foods(i,_); solution[param2change] = Foods(i,param2change) + (Foods(i, param2change) - Foods(neighbour, param2change))*(unif_rand()-.5)*2; // Truncating if (solution[param2change] < lb.at(param2change)) solution[param2change] = lb.at(param2change); if (solution[param2change] > ub.at(param2change)) solution[param2change] = ub.at(param2change); // Comparing current solution with new one ObjValSol = as<double>(fun(solution)); FitnessSol = CalculateFitness(ObjValSol); if (FitnessSol > fitness[i]) { Foods(i,_) = solution; fitness[i] = FitnessSol; f[i] = ObjValSol; trial[i] = 0; } else { trial[i]+=1; } } return; }
// [[Rcpp::export]] NumericVector f1_binomial_cloglog(NumericMatrix b,NumericVector y,NumericMatrix x,NumericVector alpha,NumericVector wt) { // Get dimensions of x - Note: should match dimensions of // y, b, alpha, and wt (may add error checking) // May want to add method for dealing with alpha and wt when // constants instead of vectors int l1 = x.nrow(), l2 = x.ncol(); int m1 = b.ncol(); // int lalpha=alpha.nrow(); // int lwt=wt.nrow(); Rcpp::NumericMatrix b2temp(l2,1); arma::mat x2(x.begin(), l1, l2, false); arma::mat alpha2(alpha.begin(), l1, 1, false); Rcpp::NumericVector xb(l1); arma::colvec xb2(xb.begin(),l1,false); // Reuse memory - update both below // Moving Loop inside the function is key for speed NumericVector yy(l1); NumericVector res(m1); for(int i=0;i<m1;i++){ b2temp=b(Range(0,l2-1),Range(i,i)); arma::mat b2(b2temp.begin(), l2, 1, false); xb2=alpha2+ x2 * b2; xb=exp(-exp(xb)); for(int j=0;j<l1;i++){ xb(j)=1-xb(j); } yy=-dbinom_glmb(y,wt,xb,true); res(i) =std::accumulate(yy.begin(), yy.end(), 0.0); } return res; }
NumericMatrix cbindCpp(NumericMatrix a, NumericMatrix b) { int acoln = a.ncol(); int bcoln = b.ncol(); NumericMatrix out(a.nrow(), acoln + bcoln); for (int j = 0; j < acoln + bcoln; j++) { if (j < acoln) { out(_, j) = a(_,j); } else { out(_, j) = b(_,j-acoln); } } return out; }
// [[Rcpp::export]] NumericMatrix CPP_dsm_score_dense(NumericMatrix f, NumericVector f1, NumericVector f2, double N, int am_code, int sparse, int transform_code) { if (am_code < 0 || am_code >= am_table_entries) stop("internal error -- invalid AM code"); am_func AM = am_table[am_code]; /* selected association measure */ int nr = f.nrow(), nc = f.ncol(); if (am_code != 0 && (nr != f1.size() || nc != f2.size())) stop("internal error -- marginal vectors f1 and f2 not conformable with matrix f"); NumericMatrix scores(nr, nc); NumericMatrix::iterator _f = f.begin(); NumericVector::iterator _f1 = f1.begin(); NumericVector::iterator _f2 = f2.begin(); NumericMatrix::iterator _scores = scores.begin(); int i = 0; for (int col = 0; col < nc; col++) { for (int row = 0; row < nr; row++) { /* frequeny measure (am_code == 0) is a special case, since marginals may not be available (in "reweight" mode) */ double score = (am_code == 0) ? _f[i] : AM(_f[i], _f1[row], _f2[col], N, sparse); _scores[i] = (transform_code) ? transform(score, transform_code) : score; i++; } } return scores; }
// @export // [[Rcpp::export]] NumericMatrix cpp_omitMatrix(const NumericMatrix& ExpressionSet, const NumericVector& AgeVector){ int nRows = ExpressionSet.nrow(); int nCols = ExpressionSet.ncol(); NumericMatrix ResultMatrix(nRows,nCols); NumericVector NumeratorVector(nCols); NumericVector DivisorVector(nCols); for(int stage = 0; stage < nCols; stage++) { double numerator = 0, divisor = 0; for(int gene = 0; gene < nRows; gene++) { numerator+= (double) AgeVector[gene] * ExpressionSet(gene, stage); divisor += ExpressionSet(gene, stage); } NumeratorVector[stage] = numerator; DivisorVector[stage] = divisor; } for(int stage = 0; stage < nCols; stage++){ double newNumerator = 0, newDivisor = 0; for(int gene = 0; gene < nRows; gene++){ newNumerator = (double) NumeratorVector[stage] - (AgeVector[gene] * ExpressionSet(gene, stage)); newDivisor = (double) DivisorVector[stage] - ExpressionSet(gene, stage); ResultMatrix(gene,stage) = newNumerator / newDivisor; } } return ResultMatrix; }
// [[Rcpp::export]] NumericVector calc_rr_cds(NumericVector outcome, NumericMatrix covars) { int nrow = covars.nrow(), ncol = covars.ncol(); if (outcome.length() != nrow) { stop("length of outcome should be the same as the number of rows in covars"); } NumericVector out(ncol); out.attr("names") = colnames(covars); for (int j = 0; j < ncol; j++) { double outcomes1 = 0; double outcomes0 = 0; double n1 = 0; double n0 = 0; for (int i = 0; i < nrow; i++) { double covar = covars(i,j); if (covar == 0.0) { n0 += 1; outcomes0 += outcome(i); } else { n1 += 1; outcomes1 += outcome(i); } } double prev1 = outcomes1/n1; double prev0 = outcomes0/n0; double rr = prev1/prev0; out(j) = rr; } return out; }
// @export // [[Rcpp::export]] NumericMatrix cpp_pMatrix(const NumericMatrix& ExpressionSet,const NumericVector& AgeVector) { int nRows = ExpressionSet.nrow(); int nCols = ExpressionSet.ncol(); NumericMatrix results(nRows,nCols); NumericVector DivisorVector(nCols); for(int stage = 0; stage < nCols; stage++) { double divisor = 0; for(int gene = 0; gene < nRows; gene++) { divisor += ExpressionSet(gene, stage); } DivisorVector[stage] = divisor; } for(int stage = 0; stage < nCols; stage++){ for(int gene = 0; gene < nRows; gene++){ results(gene,stage) = (double) AgeVector[gene] * (ExpressionSet(gene, stage)/DivisorVector[stage]); } } return results; }
// [[Rcpp::export]] NumericMatrix imp_neighbour_avg(NumericMatrix x, double k) { // input matrix is expected to have >= 3 columns NumericMatrix ans = clone(x); int nr = ans.nrow(), nc = ans.ncol(); for(int i = 0; i < nr; i++) { // first and last values are set to 0 if NA if (R_IsNA(ans(i, 0))) ans(i, 0) = k; if (R_IsNA(ans(i, nc-1))) ans(i, nc-1) = k; for(int j = 1; j < (nc-1); j++) { if (R_IsNA(ans(i,j))) { // if the next value is NA and all previous values are 0 // then we set to 0 if (R_IsNA(ans(i,j+1))) { NumericVector v = subset(ans.row(i), j); if (allZero(v, k)) ans(i,j) = k; } else { // next is not NA, set to mean of neighbours ans(i,j) = (ans(i,j-1) + ans(i,j+1))/2; } } } } return(ans); }
// [[Rcpp::export]] void appendRcpp( List fillVecs, NumericVector newLengths, NumericMatrix retmat, NumericVector retmatLengths ) { /* appendRcpp Fills numeric matrix Loop through rows, filling retmat in with the vectors in list then update return matrix size to index the next free */ // Declare vars NumericVector fillTmp; int sizeOld, sizeNew; // Pull out dimensions of return matrix to fill int nrow = retmat.nrow(); int ncol = retmat.ncol(); // Check that dimensions match if ( nrow != retmatLengths.size() || nrow != fillVecs.size() ) { throw std::range_error("In appendC(): dimension mismatch"); } // Traverse ddimensions for (int ii=0; ii<ncol; ii++) { throw std::range_error("In appendC(): exceeded max cols"); // Iterator for row to fill NumericMatrix::Row retRow = retmat(ii, _); // Fill row of return matrix, starting at first non-zero element std::copy( fillTmp.begin(), fillTmp.end(), retRow.begin() + sizeOld ); // Update size of return matrix retmatLengths[ii] = sizeNew; } }
// [[Rcpp::export]] NumericMatrix neighbourhood(NumericMatrix x, NumericMatrix wdist, int state) { /* x = input grid matrix y = output grid matrix wdist = weights of distance matrix state = value to check for */ int n = x.nrow(); int m = x.ncol(); int ndist = wdist.nrow(); int d = floor(ndist/2); NumericMatrix y(n,m); for (int i = 0; i < n; i++) { for (int j = 0; j < m; j++) { if(x(i,j) == state) { // abort if not occupied for (int ii = imax(-d, -i); ii <= imin(n - i, d); ii++) { for (int jj = imax(-d, -j); jj <= imin(m - j, d); jj++) { if(isInside(n,m,i+ii,j+jj)) { y((i + ii),(j + jj)) += wdist((ii + d), (jj + d)); } } } } } } return(y); }
// [[Rcpp::export]] NumericVector checktype_cpp(List rasterbands) { // out[0]: is integer // out[1]: has negative // out[2]: max abs value NumericVector out(3); out[0] = 1; double maxval = 0; int counter = 0; int nbands = rasterbands.size(); for (int i = 0; i < nbands; i++) { NumericMatrix thisband = rasterbands[i]; int size = thisband.nrow()*thisband.ncol(); for (int j = 0; j < size; j++) { double val = thisband[j]; if (fmod(val, 1) != 0) { out[0] = 0; } if ((counter == 0) || (abs(val) > maxval)) { maxval = val; } if (val < 0) { out[1] = 1; } counter++; } } out[2] = maxval; return out; }