// [[Rcpp::export]]
NumericVector loopC(NumericVector nodelist,int al,IntegerVector x, IntegerVector x2, List pm_lc, NumericMatrix Lix, int finind){
NumericVector::iterator k;
LogicalVector res;
IntegerVector daughter;
int temp1, temp2;
int k2;
int l = 0;
int g = 0;
int n = x.size();
LogicalVector in1(x2.size());
LogicalVector in2(x2.size());
IntegerVector indices = seq_len(n); //from 1 to n...
for(k = nodelist.begin(); k != nodelist.end(); ++k) {
k2 = nodelist[l];
res = x == k2;
daughter = x2[res];
in1 = x2==daughter[0];
in2 = x2==daughter[1];
temp1 = as<int>(indices[in1]);
temp2 = as<int>(indices[in2]);
NumericMatrix pmtmp1 = pm_lc[temp1 - 1];
NumericMatrix pmtmp2 = pm_lc[temp2 - 1];
for(g = 0; g<al; ++g){
Lix(k2 - 1, g) = sum(Lix.row(daughter[0] - 1) * pmtmp1.row(g)) *
sum(Lix.row(daughter[1] - 1) * pmtmp2.row(g));
}
l=l+1;
}
NumericVector res2 = Lix(finind,_);
return res2;
}
// [[Rcpp::export]]
List runit_Row_Column_sugar( NumericMatrix x){
NumericVector r0 = x.row(0) ;
NumericVector c0 = x.column(0) ;
return List::create(
r0,
c0,
x.row(1),
x.column(1),
x.row(1) + x.column(1)
) ;
}
// [[Rcpp::export]]
NumericMatrix max_ll_matrix(NumericMatrix x, NumericMatrix y, IntegerVector which_max) {
NumericMatrix out(x.nrow(), x.ncol());
for (int i=0; i < x.nrow(); i++) {
if (which_max[i] == 0)
out.row(i) = x.row(i);
else if (which_max[i] == 1)
out.row(i) = y.row(i);
else
std::cout << "ERROR: which_max values must be in (0, 1)" << std::endl;
}
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);
}
// [[Rcpp::export]]
NumericMatrix rcpp_js_distance(NumericMatrix mat) {
// allocate the matrix we will return
NumericMatrix rmat(mat.nrow(), mat.nrow());
for (int i = 0; i < rmat.nrow(); i++) {
for (int j = 0; j < i; j++) {
// rows we will operate on
NumericMatrix::Row row1 = mat.row(i);
NumericMatrix::Row row2 = mat.row(j);
// compute the average using std::tranform from the STL
std::vector<double> avg(row1.size());
std::transform(row1.begin(), row1.end(), // input range 1
row2.begin(), // input range 2
avg.begin(), // output range
average); // function to apply
// calculate divergences
double d1 = kl_divergence(row1.begin(), row1.end(), avg.begin());
double d2 = kl_divergence(row2.begin(), row2.end(), avg.begin());
// write to output matrix
rmat(i,j) = std::sqrt((double)(.5 * (d1 + d2)));
}
}
return rmat;
}
//' @title Calculate \eqn{L_q} distance
//' @description Calculate \eqn{L_q} distance of all vectors in a matrix to a reference
//' vector.
//' @param x A numeric matrix Missing values are allowed.
//' @param ref An integer specifying the reference row.
//' @param q An integer specifying the which norm to take the L-q distance of.
//' @return a numeric vector of length \code{nrow(x) - 1}
// [[Rcpp::export]]
NumericVector dist_q_matrix (NumericVector& x_ref, NumericMatrix& x_rest, int& q) {
int nr = x_rest.nrow();
NumericVector out(nr);
for (int k = 0; k < nr; k++) {
out[k] = dist_q(x_ref, x_rest.row(k), q);
}
return out;
}
// [[Rcpp::export]]
NumericMatrix genSizeComp(NumericMatrix VulnN, NumericVector CAL_binsmid, NumericMatrix selCurve,
double CAL_ESS, double CAL_nsamp,
NumericVector Linfs, NumericVector Ks, NumericVector t0s,
double LenCV, double truncSD) {
int nyears = VulnN.nrow();
int k = VulnN.ncol();
int nbins = CAL_binsmid.size();
NumericMatrix CAL(nyears, nbins);
double width = CAL_binsmid(1) - CAL_binsmid(0);
double origin = CAL_binsmid(0) - 0.5* width;
NumericVector temp(k);
NumericVector varAges = NumericVector::create(-0.6, -0.5, -0.4, -0.3, -0.2, -0.1, 0.0, 0.1, 0.2, 0.3, 0.4, 0.5); // monthly ages
for (int yr=0; yr < nyears; yr++) {
NumericVector Nage = (VulnN.row(yr)); // numbers of catch-at-age this year
double Ncatch = sum(Nage); // total catch this year
if (Ncatch>0) {
NumericVector Nage2 = (Nage/Ncatch) * CAL_ESS; // number-at-age effective sample
List Lens(k*12);
int count = 0;
for (int age=1; age <= k; age++) { // loop over 1:maxage
int Nage3 = round(Nage2(age-1)); // number at this age
NumericVector rands = RcppArmadillo::sample(NumericVector::create(0,1,2,3,4,5,6,7,8,9,10,11), Nage3, TRUE, NumericVector::create()) ; // assume ages are uniformly distributed across months
NumericVector subAgeVec = get_freq(rands, 1, 0, 12); // distribute n across months
// NumericVector subAgeVec = Nage3/NumericVector::create(1,2,3,4,5,6,7,8,9,10,11,12); // distribute n across months
for (int subage=0; subage<=11; subage++) { // loop over 12 months
if (subAgeVec(subage) > 0) {
double sage = varAges(subage) + age;
double mean = Linfs(yr) * (1-exp(-Ks(yr)* (sage - t0s(yr)))); // calculate mean length at sub-age;
if (mean < 0) mean = 0.01;
NumericVector dist = tdnorm((CAL_binsmid-mean)/(LenCV*mean), -truncSD, truncSD); // prob density of lengths for this age
NumericVector newdist = dist * selCurve(_,yr); // probability = dist * size-selection curve
if (sum(newdist)!=0) {
newdist = newdist/sum(newdist);
Lens(count) = RcppArmadillo::sample(CAL_binsmid, subAgeVec(subage), TRUE, newdist); // sample lengths for this sub-age class
} else {
Lens(count) = NA_INTEGER;
}
} else {
Lens(count) = NA_INTEGER;
}
count += 1;
}
}
NumericVector LenVals = combine(Lens); // unlist
NumericVector templens = get_freq(LenVals, width, origin, nbins); // calculate frequencies
double rat = CAL_nsamp/sum(templens);
templens = templens * rat; // scale to CAL_nsamp
CAL(yr,_) = templens;
} else {
NumericVector zeros(nbins);
CAL(yr,_) = zeros;
}
}
return(CAL);
}
// [[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;
}
// [[Rcpp::export]]
NumericMatrix knn(NumericMatrix train, IntegerVector group, NumericMatrix test, int kn, int disttype){
int ngroup = sort_unique(group).size();
NumericMatrix pred(test.nrow(),ngroup);
for(int i = 0; i < test.nrow(); ++i){ // For each test point
NumericVector dists(kn);
dists = dists + 1000000000.0;
IntegerVector indx(kn);
for(int j = 0; j < train.nrow(); ++j){ // Run through train points
double d = distance(train.row(j),test.row(i),disttype); // Find the distance
if(d < dists(kn-1)){ // If distance is more than the kn furthest away (so far) it can not be one of the kn nearest neighbours. Otherwise insert in list.
for (int k = 0; k < kn; ++k){ // Run trough list of neighbours
if (d < dists(k)){// If the training point is closer than the one we are looking at, it should be inserted here
for (int k1 = kn-1; k1 > k; --k1){ // All neighbours further away should move one place up in the list
dists(k1) = dists(k1 - 1);
indx(k1) = indx(k1 - 1);
}
//Finally insert the new point
dists(k) = d;
indx(k) = j;
break;
}
}
}
}
//Run through neighbours
for(int j = 0; j < indx.size(); ++j){
// Add a vote to the group it belongs to
pred(i,group(indx(j))) += 1.0/(double)kn;
}
}
return pred;
}
NumericMatrix row_erase (NumericMatrix& x, IntegerVector& rowID) {
rowID = rowID.sort();
NumericMatrix x2(Dimension(x.nrow()- rowID.size(), x.ncol()));
int iter = 0;
int del = 1; // to count deleted elements
for (int i = 0; i < x.nrow(); i++) {
if (i != rowID[del - 1]) {
x2.row(iter) = x.row(i);
iter++;
} else {
del++;
}
}
return x2;
}
// [[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;
}
// [[Rcpp::export]]
void distance(NumericVector is, NumericVector js, NumericVector xs, NumericMatrix data, Function callback) {
for (int i=0; i < is.length(); i++) {
xs[i] = sqrt(sum(pow(data.row(is[i]) - data.row(js[i]), 2)));
if (i > 0 && i % 1000 == 0) callback(1000);
}
};
// [[Rcpp::export]]
double runit_NumericMatrix_row( NumericMatrix m){
NumericMatrix::Row first_row = m.row(0) ;
return std::accumulate( first_row.begin(), first_row.end(), 0.0 ) ;
}
// [[Rcpp::export]]
NumericMatrix viterbi_ths(NumericVector &theta, NumericMatrix &data,
NumericVector &integrControl) {
// theta lambda0, lambda1, lambda2, sigma, p
// data diff of t and x
int n = data.nrow(); int dim = data.ncol() - 1;
double lambda0 = theta[0], lambda1 = theta[1], lambda2 = theta[2];
double p = theta[4];
if (lambda1 < lambda2) return NA_REAL;
double ps0 = 1. / lambda0 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps1 = p / lambda1 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps2 = (1 - p) / lambda2 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
NumericVector tt = data.column(0);
NumericMatrix x = data(Range(0, n - 1), Range(1, dim));
// result matrix: three cols stand for Viterbi prob of state 0,1,2
// at current time points. For numerical reason,
// the log-prob is returned.
NumericMatrix result(n + 1, 3);
result(0, 0) = log(ps0); result(0, 1) = log(ps1); result(0, 2) = log(ps2);
NumericVector cartV = result.row(0);
NumericVector cartW(3);
// calculate all h functions
NumericVector
hresult00 = ths_h00(x, tt, theta, integrControl),
hresult01 = ths_h01(x, tt, theta, integrControl),
hresult02 = ths_h02(x, tt, theta, integrControl),
hresult10 = ths_h10(x, tt, theta, integrControl),
hresult11 = ths_h11(x, tt, theta, integrControl),
hresult12 = ths_h12(x, tt, theta, integrControl),
hresult20 = ths_h20(x, tt, theta, integrControl),
hresult21 = ths_h21(x, tt, theta, integrControl),
hresult22 = ths_h22(x, tt, theta, integrControl);
for (int i = 0; i < n; i++) {
NumericVector crow = x.row(i);
if (is_true(all(crow == 0.))) {
hresult00[i] = 0.;
hresult01[i] = 0.;
hresult02[i] = 0.;
hresult10[i] = 0.;
hresult11[i] = exp(-lambda1 * tt[i]);
hresult12[i] = 0.;
hresult20[i] = 0.;
hresult21[i] = 0.;
hresult22[i] = exp(-lambda2 * tt[i]);
}
}
// calculate Viterbi path
for (int i = 1; i <= n; i++) {
cartW[0] = cartV[0] + log(hresult00[i - 1]);
cartW[1] = cartV[1] + log(hresult10[i - 1]);
cartW[2] = cartV[2] + log(hresult20[i - 1]);
result(i, 0) = max(cartW);
cartW[0] = cartV[0] + log(hresult01[i - 1]);
cartW[1] = cartV[1] + log(hresult11[i - 1]);
cartW[2] = cartV[2] + log(hresult21[i - 1]);
result(i, 1) = max(cartW);
cartW[0] = cartV[0] + log(hresult02[i - 1]);
cartW[1] = cartV[1] + log(hresult12[i - 1]);
cartW[2] = cartV[2] + log(hresult22[i - 1]);
result(i, 2) = max(cartW);
cartV = result.row(i);
}
return result;
}
// [[Rcpp::export]]
NumericMatrix partial_viterbi_ths(NumericVector &theta, NumericMatrix &data,
NumericVector &integrControl,
int &startpoint, int &pathlength){
// theta lambda0, lambda1, lambda2, sigma, p
// data diff of t and x
// startpoint the start time point, note that
// the first time point in data is t0
// pathlength the length of partial viterbi path
int n = data.nrow(); int dim = data.ncol() - 1;
double lambda0 = theta[0], lambda1 = theta[1], lambda2 = theta[2];
double p = theta[4];
double ps0 = 1. / lambda0 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps1 = p / lambda1 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps2 = (1 - p) / lambda2 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
NumericVector tt = data.column(0);
NumericMatrix x = data(Range(0, n - 1), Range(1, dim));
// bf_result matrix: frist three col for forward
// last three col for backward
NumericMatrix bf_result(n + 1, 6);
bf_result(0, 0) = ps0; bf_result(0, 1) = ps1; bf_result(0, 2) = ps2;
bf_result(n, 3) = 1; bf_result(n, 4) = 1; bf_result(n, 5) = 1;
NumericVector dx(n);
// result matrix: three cols stand for Viterbi prob of state 0,1,2
// at current time points. For numerical reason,
// the log-prob is returned.
NumericMatrix result(pathlength, 3);
NumericVector cartV(3);
NumericVector cartW(3);
// calculate all h functions
NumericVector
hresult00 = ths_h00(x, tt, theta, integrControl),
hresult01 = ths_h01(x, tt, theta, integrControl),
hresult02 = ths_h02(x, tt, theta, integrControl),
hresult10 = ths_h10(x, tt, theta, integrControl),
hresult11 = ths_h11(x, tt, theta, integrControl),
hresult12 = ths_h12(x, tt, theta, integrControl),
hresult20 = ths_h20(x, tt, theta, integrControl),
hresult21 = ths_h21(x, tt, theta, integrControl),
hresult22 = ths_h22(x, tt, theta, integrControl);
for (int i = 0; i < n; i++) {
NumericVector crow = x.row(i);
if (is_true(all(crow == 0.))) {
hresult00[i] = 0.;
hresult01[i] = 0.;
hresult02[i] = 0.;
hresult10[i] = 0.;
hresult11[i] = exp(-lambda1 * tt[i]);
hresult12[i] = 0.;
hresult20[i] = 0.;
hresult21[i] = 0.;
hresult22[i] = exp(-lambda2 * tt[i]);
}
}
// forward algorithm
for (int i = 0; i < n; i++) {
double sumf0 = bf_result(i, 0) * hresult00[i] + bf_result(i, 1) * hresult10[i] + bf_result(i, 2) * hresult20[i];
double sumf1 = bf_result(i, 0) * hresult01[i] + bf_result(i, 1) * hresult11[i] + bf_result(i, 2) * hresult21[i];
double sumf2 = bf_result(i, 0) * hresult02[i] + bf_result(i, 1) * hresult12[i] + bf_result(i, 2) * hresult22[i];
dx[i] = sumf0 + sumf1 + sumf2;
bf_result(i + 1, 0) = sumf0 / dx[i];
bf_result(i + 1, 1) = sumf1 / dx[i];
bf_result(i + 1, 2) = sumf2 / dx[i];
}
// backward algorithm
for (int i = 0; i < n; i++) {
double sumb0 = bf_result(n-i, 3) * hresult00[n-i-1] + bf_result(n-i, 4) * hresult01[n-i-1] + bf_result(n-i, 5) * hresult02[n-i-1];
double sumb1 = bf_result(n-i, 3) * hresult10[n-i-1] + bf_result(n-i, 4) * hresult11[n-i-1] + bf_result(n-i, 5) * hresult12[n-i-1];
double sumb2 = bf_result(n-i, 3) * hresult20[n-i-1] + bf_result(n-i, 4) * hresult21[n-i-1] + bf_result(n-i, 5) * hresult22[n-i-1];
bf_result(n-i-1, 3) = sumb0 / dx[n-i-1];
bf_result(n-i-1, 4) = sumb1 / dx[n-i-1];
bf_result(n-i-1, 5) = sumb2 / dx[n-i-1];
}
// prepare for viterbi path
result(0, 0) = log(bf_result(startpoint, 0));
result(0, 1) = log(bf_result(startpoint, 1));
result(0, 2) = log(bf_result(startpoint, 2));
cartV = result.row(0);
int ite_stop = startpoint + pathlength - 2;
// viterbi algorithm
for (int i = startpoint; i < ite_stop; i++) {
cartW[0] = cartV[0] + log(hresult00[i]);
cartW[1] = cartV[1] + log(hresult10[i]);
cartW[2] = cartV[2] + log(hresult20[i]);
result(i - startpoint + 1, 0) = max(cartW);
cartW[0] = cartV[0] + log(hresult01[i]);
cartW[1] = cartV[1] + log(hresult11[i]);
cartW[2] = cartV[2] + log(hresult21[i]);
result(i - startpoint + 1, 1) = max(cartW);
cartW[0] = cartV[0] + log(hresult02[i]);
cartW[1] = cartV[1] + log(hresult12[i]);
cartW[2] = cartV[2] + log(hresult22[i]);
result(i - startpoint + 1, 2) = max(cartW);
cartV = result.row(i - startpoint + 1);
}
// last step of viterbi algorithm
cartW[0] = cartV[0] + log(hresult00[ite_stop]) + log(bf_result(ite_stop + 1, 3));
cartW[1] = cartV[1] + log(hresult10[ite_stop]) + log(bf_result(ite_stop + 1, 3));
cartW[2] = cartV[2] + log(hresult20[ite_stop]) + log(bf_result(ite_stop + 1, 3));
result(pathlength - 1, 0) = max(cartW);
cartW[0] = cartV[0] + log(hresult01[ite_stop]) + log(bf_result(ite_stop + 1, 4));
cartW[1] = cartV[1] + log(hresult11[ite_stop]) + log(bf_result(ite_stop + 1, 4));
cartW[2] = cartV[2] + log(hresult21[ite_stop]) + log(bf_result(ite_stop + 1, 4));
result(pathlength - 1, 1) = max(cartW);
cartW[0] = cartV[0] + log(hresult02[ite_stop]) + log(bf_result(ite_stop + 1, 5));
cartW[1] = cartV[1] + log(hresult12[ite_stop]) + log(bf_result(ite_stop + 1, 5));
cartW[2] = cartV[2] + log(hresult22[ite_stop]) + log(bf_result(ite_stop + 1, 5));
result(pathlength - 1, 2) = max(cartW);
return result;
}
// [[Rcpp::export]]
NumericMatrix fwd_bwd_ths(NumericVector &theta, NumericMatrix &data,
NumericVector &integrControl) {
// theta lambda0, lambda1, lambda2, sigma, p
// data diff of t and x
int n = data.nrow(); int dim = data.ncol() - 1;
double lambda0 = theta[0], lambda1 = theta[1], lambda2 = theta[2];
double p = theta[4];
if (lambda1 < lambda2) return NA_REAL;
double ps0 = 1. / lambda0 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps1 = p / lambda1 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
double ps2 = (1 - p) / lambda2 / (1. / lambda0 + p / lambda1 + (1 - p) / lambda2);
NumericVector tt = data.column(0);
NumericMatrix x = data(Range(0, n - 1), Range(1, dim));
// result matrix: frist three col for forward
// last three col for backward
NumericMatrix result(n + 1, 6);
result(0, 0) = ps0; result(0, 1) = ps1; result(0, 2) = ps2;
result(n, 3) = 1; result(n, 4) = 1; result(n, 5) = 1;
NumericVector dx(n);
// calculate all h functions
NumericVector
hresult00 = ths_h00(x, tt, theta, integrControl),
hresult01 = ths_h01(x, tt, theta, integrControl),
hresult02 = ths_h02(x, tt, theta, integrControl),
hresult10 = ths_h10(x, tt, theta, integrControl),
hresult11 = ths_h11(x, tt, theta, integrControl),
hresult12 = ths_h12(x, tt, theta, integrControl),
hresult20 = ths_h20(x, tt, theta, integrControl),
hresult21 = ths_h21(x, tt, theta, integrControl),
hresult22 = ths_h22(x, tt, theta, integrControl);
for (int i = 0; i < n; i++) {
NumericVector crow = x.row(i);
if (is_true(all(crow == 0.))) {
hresult00[i] = 0.;
hresult01[i] = 0.;
hresult02[i] = 0.;
hresult10[i] = 0.;
hresult11[i] = exp(-lambda1 * tt[i]);
hresult12[i] = 0.;
hresult20[i] = 0.;
hresult21[i] = 0.;
hresult22[i] = exp(-lambda2 * tt[i]);
}
}
// forward algorithm
for (int i = 0; i < n; i++) {
double sumf0 = result(i, 0) * hresult00[i] + result(i, 1) * hresult10[i] + result(i, 2) * hresult20[i];
double sumf1 = result(i, 0) * hresult01[i] + result(i, 1) * hresult11[i] + result(i, 2) * hresult21[i];
double sumf2 = result(i, 0) * hresult02[i] + result(i, 1) * hresult12[i] + result(i, 2) * hresult22[i];
dx[i] = sumf0 + sumf1 + sumf2;
result(i + 1, 0) = sumf0 / dx[i];
result(i + 1, 1) = sumf1 / dx[i];
result(i + 1, 2) = sumf2 / dx[i];
}
//backward algorithm
for (int i = 0; i < n; i++) {
double sumb0 = result(n-i, 3) * hresult00[n-i-1] + result(n-i, 4) * hresult01[n-i-1] + result(n-i, 5) * hresult02[n-i-1];
double sumb1 = result(n-i, 3) * hresult10[n-i-1] + result(n-i, 4) * hresult11[n-i-1] + result(n-i, 5) * hresult12[n-i-1];
double sumb2 = result(n-i, 3) * hresult20[n-i-1] + result(n-i, 4) * hresult21[n-i-1] + result(n-i, 5) * hresult22[n-i-1];
result(n-i-1, 3) = sumb0 / dx[n-i-1];
result(n-i-1, 4) = sumb1 / dx[n-i-1];
result(n-i-1, 5) = sumb2 / dx[n-i-1];
}
return result;
}
