//--------------------------------------------------------------------- // //--------------------------------------------------------------------- // [[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; }
// **********************************************************// // Calculate mu matrix for document d // // **********************************************************// // [[Rcpp::export]] NumericVector mu_vec(arma::vec p_d, NumericMatrix xi) { int nIP = xi.ncol(); NumericVector muvec(xi.nrow()); for (int IP = 0; IP < nIP; IP++) { double pdIP = p_d[IP]; for (int i = 0; i < xi.nrow(); i++) { if (pdIP > 0) { muvec[i] += p_d[IP]*xi(i,IP); } } } return muvec; }
// [[Rcpp::export]] NumericMatrix rcpp_parallel_js_distance(NumericMatrix mat) { // allocate the matrix we will return NumericMatrix rmat(mat.nrow(), mat.nrow()); // create the worker JsDistance jsDistance(mat, rmat); // call it with parallelFor parallelFor(0, mat.nrow(), jsDistance); return rmat; }
// [[Rcpp::export]] NumericMatrix residLm(NumericMatrix Yr, NumericMatrix Xr) { int nX = Xr.nrow(), nY = Yr.nrow(); arma::mat Y(Yr.begin(), nY, nX, false); // reuses memory and avoids extra copy arma::mat X(Xr.begin(), nX, 2, false); arma::mat resid(nX,nY); arma::colvec y; for(int i = 0; i < nY; i++){ y = Y.row(i).t(); resid.col(i) = y - X*arma::solve(X, y); } return wrap(resid.t()); }
// [[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 gemmFitRcppI(int n, NumericMatrix betas, NumericMatrix data, int p, NumericVector kCor, CharacterVector correction, bool isTauB) { NumericVector fit; NumericVector fitR(betas.nrow()), fitTauA(betas.nrow()), fitTauB(betas.nrow()), fitBIC(betas.nrow()), fitBICr(betas.nrow()), fitAIC(betas.nrow()), fitAICr(betas.nrow()); NumericVector fitTauPairs(betas.nrow()), fitTauTies1(betas.nrow()), fitTauTies2(betas.nrow()); NumericVector fitTauTiesBoth(betas.nrow()), fitTauDis(betas.nrow()), fitTauCon(betas.nrow()); NumericMatrix data2(clone(data)); bool corType; /*std::string s_targetname = as<std::string>(targetname) */ (as<std::string>(correction)=="knp") ? (corType=true) : (corType=false); for (int i=0; i < betas.nrow(); i++) { fit = gemmFitRcpp(n, betas(i,_), data2, p, kCor(i), corType, isTauB); fitBIC(i) = fit[1]; fitBICr(i) = fit[2]; fitR(i) = fit[0]; fitAIC(i) = fit[4]; fitAICr(i) = fit[5]; fitTauA(i) = fit[6]; fitTauB(i) = fit[7]; fitTauPairs(i) = fit[8]; fitTauTies1(i) = fit[9]; fitTauTies2(i) = fit[10]; fitTauTiesBoth(i) = fit[11]; fitTauDis(i) = fit[12]; fitTauCon(i) = fit[13]; } return Rcpp::List::create(Rcpp::Named("r") = fitR, Rcpp::Named("bic") = fitBIC, Rcpp::Named("tau.a") = fitTauA, Rcpp::Named("tau.b") = fitTauB, Rcpp::Named("tau.n.pairs") = fitTauPairs, Rcpp::Named("tau.n.ties.1") = fitTauTies1, Rcpp::Named("tau.n.ties.2") = fitTauTies2, Rcpp::Named("tau.n.ties.both") = fitTauTiesBoth, Rcpp::Named("tau.n.dis") = fitTauDis, Rcpp::Named("tau.n.con") = fitTauCon, Rcpp::Named("bic.r") = fitBICr, Rcpp::Named("aic") = fitAIC, Rcpp::Named("aic.r") = fitAICr); }
// 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; }
//' 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); }
void CalculateProbabilities( NumericMatrix & Foods, NumericVector & fitness, NumericVector & prob ) { double maxfit = fitness[0]; for (int i=0;i<Foods.nrow();i++) if (fitness[i] > maxfit) maxfit = fitness[i]; for (int i=0;i<Foods.nrow();i++) prob[i] = (0.9*((fitness[i] + 1e-40)/(maxfit + 1e-40))) + 0.1; return; }
// **********************************************************// // Multiply list of matrix X and list of vector B // // **********************************************************// // [[Rcpp::export]] List MultiplyXB(List X, NumericMatrix B){ List XB(B.nrow()); for (int IP = 0; IP < B.nrow(); IP++) { arma::mat XB_IP(X.size(), X.size()); arma::vec B_IP = B(IP, _); for (unsigned int n = 0; n < X.size(); n++) { List X_n = X[n]; arma::mat X_n_IP = X_n[IP]; arma::vec rows = X_n_IP*B_IP; XB_IP.row(n) = rows.t(); } XB[IP] = XB_IP; } return XB; }
// [[Rcpp::export]] NumericVector hazr(double t, double m, double bm, double bt, NumericMatrix dat){ // MAKE SURE dat IS SORTED BY TIME OR THIS FUNCTION WILL NOT WORK!!! // bm should be on marker scale // bt should be on time scale // --------------------------------------------------------------------------- NumericVector out(2); // Collect subset of observations in marker trip in mstrip // --------------------------------------------------------------------------- int j = 0; // number of values in marker strip NumericMatrix mstrip(dat.nrow(), 2); // put obsevations in marker strip here for (int i = 0; i < dat.nrow(); i++){ // populate mstrip with observations if ((dat(i, 2) < m+bm) && (dat(i,2) > m-bm)){ mstrip(j, 0) = dat(i, 0); mstrip(j, 1) = dat(i, 1); j += 1; } } if (j == 0) return(out); // - Do the local-in-marker hazard and N-A calculations // --------------------------------------------------------------------------- NumericVector na(j); // create vector for local N-A estimates double nac = 0; // holder for N-A contributions na[0] = mstrip(0, 1)/j; // N-A estimate at earliest time in strip if (fabs(t - mstrip(0, 0)) <= bt){ // if first value is close enough to t, include in hazard calculation out[0] = na[0]; out[1] = na[0]; // set N-A estimator } for (int i = 1; i < j; i++){ // include rest of qualified observations into hazard calculation // calculate remaining N-A estimates nac = (mstrip(i, 1)/(j - i)); // censoring indicat. divided by risk set size na[i] = na[i-1] + nac; if (fabs(t - mstrip(i, 0)) <= bt){ // if close enough to t, include in hazard calculation out[0] += nac; } if (t >= mstrip(i, 0)){ // if we have reached t, return this for N-A estimate out[1] = na[i]; } } out[0] = out[0]/(2*bt); return(out); }
// [[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); }
// @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]] 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; } }
void Chain_Factorial::update_mu(NumericMatrix Y){ double alpha0 = 1.0/K; //fit_linear_model(X, y, n, K, mu); //fit_Bayesian_linear_model(X, y, n, K, mu, sigma); NumericVector w_i, u_i, y_i; for(int i=0; i<Y.nrow(); i++){ w_i = w(i, _); u_i = u(i, _); y_i = Y(i, _); lambdas = calculate_mean_for_all_t(X, w_i, h, K, n); double logprob_current = calculate_posterior_prob(y_i, lambdas, w_i, alpha0, K, n); // propose a new alpha // double alpha_proposed = random_walk_log_scale(alpha0, 0.3); // propose a new w NumericVector w_unnorm_proposed = RWMH(u_i, K, 0.5); NumericVector w_proposed = w_unnorm_proposed / sum(w_unnorm_proposed); NumericVector lambdas_proposed = calculate_mean_for_all_t(X, w_proposed, h, K, n); double logprob_proposed = calculate_posterior_prob(y_i, lambdas_proposed, w_proposed, alpha0, K, n); //printf("current %f, proposed %f, accept prob: %f\n\n", logprob_current, logprob_proposed, exp(logprob_proposed - logprob_current)); // accept or reject if(R::runif(0, 1) < exp(logprob_proposed - logprob_current)){ u(i, _) = clone(w_unnorm_proposed); w(i, _) = clone(w_proposed); } } }
//[[Rcpp::export]] NumericMatrix sigmoid(NumericMatrix mat) { int m = mat.nrow(); int n = mat.ncol(); NumericMatrix res(m, n); double x; double z; for (int i = 0; i < m; i++) for (int j = 0; j < n; j++) { x = mat(i, j); if (x >= 0) { z = exp(-x); res(i, j) = 1 / (1 + z); } else { z = exp(x); res(i, j) = z / (1 + z); } } return res; }
// [[Rcpp::export]] List getFractionOfPointsNearBoundingBoxCPP(NumericMatrix coords, double distanceFraction) { std::vector<double> range_x = computeRangeForDimension(coords, 0); std::vector<double> range_y = computeRangeForDimension(coords, 1); double distance_x = (range_x[1] - range_x[0]) * distanceFraction; double distance_y = (range_y[1] - range_y[0]) * distanceFraction; double x_min = range_x[0] + distance_x; double y_min = range_y[0] + distance_y; double x_max = range_x[1] - distance_x; double y_max = range_y[1] - distance_y; int n_cities = coords.nrow(); double n_out_of_bounds = 0; for (int i = 0; i < n_cities; ++i) { if (coords(i, 0) < x_min || coords(i, 0) > x_max || coords(i, 1) < y_min || coords(i, 1) > y_max) { n_out_of_bounds += 1; } } // ugly old-school C++ way to convert double to string std::ostringstream os; os << distanceFraction; std::string distanceFractionString = os.str(); std::string feature_name = "fraction_of_nodes_outside_near_bounding_box_" + distanceFractionString; return List::create( _[feature_name] = NumericVector::create(n_out_of_bounds / n_cities) ); }
MaxoutUnit(NumericMatrix activations, NumericMatrix derivatives, const int poolSize, const NumericVector dropoutMask) : activations(activations), derivatives(derivatives), dropoutMask(dropoutMask), poolSize(poolSize) { colLength = activations.nrow(); }
void apply_repulsion(const NumericMatrix &lay, NumericMatrix &dvec, const NumericVector &mass, const NumericVector &nodes_size, double krep, bool prevent_overlap) { unsigned int nrow = lay.nrow(); for(unsigned int i = 0; i < (nrow - 1); i++) for(unsigned int j = i + 1; j < nrow; j++) { float square_dist = (lay(i, 0) - lay(j, 0)) * (lay(i, 0) - lay(j, 0)) + (lay(i, 1) - lay(j, 1)) * (lay(i, 1) - lay(j, 1)); float mass_prod = mass[i] * mass[j]; float f_rep = krep * (mass_prod / square_dist); if(prevent_overlap) { float dist = sqrt(square_dist) - (nodes_size[i] + nodes_size[j]); if(dist < 0) f_rep = 100 * krep * mass_prod; else f_rep = krep * (mass_prod / (dist * dist)); } dvec(i, 0) += (lay(i, 0) - lay(j, 0)) * f_rep; dvec(i, 1) += (lay(i, 1) - lay(j, 1)) * f_rep; dvec(j, 0) += (lay(j, 0) - lay(i, 0)) * f_rep; dvec(j, 1) += (lay(j, 1) - lay(i, 1)) * f_rep; } }
NumericMatrix prepara_J (NumericMatrix x){ int i, j, k, V; V = x.nrow(); NumericMatrix J = clone(x); NumericVector K(V); double m = 0; for(i = 0; i < V; i++) for(j = 0; j < V; j++){ K[i] = 0; } for (i = 0; i < V; i++) for( j = 0; j < V; j++) J(i,j) /= sqrt(J(i,i)*J(j,j)); for(i = 0; i < V; i++){ for(j = 0; j < V; j++){ J(i,i) = 0; J(j,j) = 0; K[i] += J(i,j); } m += K[i]; } for( i = 0; i < V; i++){ for( j = 0; j < V; j++){ J(i,j) = J(i,j) - (K[i]*K[j])/(2*m); } } return J; }
// Function to calculate squared distance matrix (written by Jonathan Olmsted, NPD Group) // [[Rcpp::export]] NumericMatrix calcPWDh (NumericMatrix x) { int nrows = x.nrow() ; int ncols = x.nrow() ; NumericMatrix out(nrows, ncols) ; double rad = 3963.1676 ; double pi = 3.141592653589793238463 ; for(int arow = 0; arow < nrows; arow++) { for(int acol = 0; acol < ncols; acol++) { double phi1 = x(arow, 0) * pi / 180 ; double phi2 = x(acol, 0) * pi / 180 ; double lambda1 = x(arow, 1) * pi / 180 ; double lambda2 = x(acol, 1) * pi / 180; double q1 = 2 * rad ; double q2 = pow(sin((phi1 - phi2) / 2), 2) ; double q3 = pow(sin((lambda1 - lambda2) / 2), 2) ; double q4 = cos(phi1) * cos(phi2) ; out(arow, acol) = q1 * asin(sqrt(q2 + q4 * q3)) ; } } return out; }
// [[Rcpp::export]] void max_iter_brute_force(NumericMatrix xPoints_mat, int k, std::string solver_dir, std::string log_dir) { const int nPoints = xPoints_mat.ncol(); const int n = xPoints_mat.nrow(); user_function_data ui_data; ui_data.k = k; ui_data.param_prefix = "max_iter"; ui_data.solver_dir = solver_dir; ui_data.log_dir = log_dir; NumericVector row = xPoints_mat(0, _); double min_f = std::numeric_limits<double>::infinity(); int min_x = 0; double this_f; for (int j = 0; j < nPoints; ++j) { this_f = cv_error_function(n, &row[j], NULL, &ui_data); std::cout << "x = " << row[j] << ": f = " << this_f << std::endl; if (this_f < min_f) { min_x = row[j]; min_f = this_f; } } std::cout << "min x = " << min_x <<": achieves f = " << min_f << std::endl; }
// **********************************************************// // Calculate xi over the entire corpus // // **********************************************************// // [[Rcpp::export]] List xi_all(NumericMatrix timemat, NumericMatrix eta1,NumericMatrix eta2, IntegerVector edgetrim) { List xi(timemat.nrow()); for (IntegerVector::iterator it = edgetrim.begin(); it != edgetrim.end(); ++it) { xi[*it-1] = ximat(timemat(*it-2, _), eta1, eta2); } return xi; }
// [[Rcpp::export(name = ".doBilinear")]] NumericVector doBilinear(NumericMatrix xy, NumericMatrix x, NumericMatrix y, NumericMatrix v) { size_t len = v.nrow(); NumericVector result(len); for (size_t i = 0; i < len; i++) { double left = x(0,i); double right = x(1,i); double top = y(1,i); double bottom = y(0,i); double horiz = xy(i,0); double vert = xy(i,1); double denom = (right - left) * (top - bottom); double bottomLeftValue = v(i,0) / denom; double topLeftValue = v(i,1) / denom; double topRightValue = v(i,3) / denom; double bottomRightValue = v(i,2) / denom; result[i] = bottomLeftValue*(right-horiz)*(top-vert) + bottomRightValue*(horiz-left)*(top-vert) + topLeftValue*(right-horiz)*(vert-bottom) + topRightValue*(horiz-left)*(vert-bottom); } return result; }
// @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 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; }
// [[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; }
// [[Rcpp::export]] NumericVector gradlikCD(NumericVector parm, NumericMatrix Dmat, NumericVector x) { int nsub = Dmat.nrow(), J = Dmat.ncol() - 1, i, j; NumericVector Deriv(J + 1), parm1(J+1); double denom, temp; parm1[0] = parm[0]; parm1[1] = parm[1]; for (i = 2; i < J +1; i++) { parm1[i] = parm1[i-1] + parm[i]; } for (i = 0; i < nsub; ++i) { denom = Dmat(i, 0); for (j = 1; j < J+1; ++j) { denom += Dmat(i, j)*exp(-exp(x[i]*parm1[0] + parm1[j])); } for (j = 1; j < J+1; ++j) { temp = Dmat(i, j)*exp(-exp(x[i]*parm1[0] + parm1[j]))*exp(x[i]*parm1[0] + parm1[j]); Deriv[0] += temp*x[i]/denom; Deriv[j] += temp/denom; } } for (j=J-1; j>0; j--) { Deriv[j] = Deriv[j] + Deriv[j+1]; } return Deriv; }
// [[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; }
// [[Rcpp::export]] NumericVector row_weights(NumericMatrix x, NumericVector weight) { int nX = x.ncol(); int nY = x.nrow(); NumericVector v = no_init(nY); #pragma omp parallel for schedule(static) for (int i=0; i < nY; i++) { NumericMatrix::Row row = x(i, _); double w = 0; for (int j=0; j < nX; j++) { if(row[j]!=0 && !R_IsNA(row[j])) { w += weight[j]; } } double o = 0; if (w!=0) { for(int j=0; j < nX; j++) { if(row[j]!=0 && !R_IsNA(row[j])) { o += row[j]*weight[j] / w; } } } v[i] = o; } v.attr("names") = rownames(x); return v; }