RcppExport SEXP classicRcppStringVectorExample(SEXP strvec) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
RcppStringVector orig(strvec);
RcppStringVector vec(strvec);
for (int i=0; i<orig.size(); i++) {
std::transform(orig(i).begin(), orig(i).end(),
vec(i).begin(), ::tolower);
}
// Build result set to be returned as a list to R.
RcppResultSet rs;
rs.add("result", vec);
rs.add("original", orig);
// Get the list to be returned to R.
rl = rs.getReturnList();
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP CalculateNucRiseSigmaR(
SEXP R_timeFrame, SEXP R_sub_steps,
SEXP R_C, SEXP R_t_mid_nuc, SEXP R_sigma
) {
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
int sub_steps = Rcpp::as<int> (R_sub_steps);
vector<float> time_frame = Rcpp::as< vector<float> > (R_timeFrame);
float max_concentration = Rcpp::as<float> (R_C);
float t_mid_nuc = Rcpp::as<float> (R_t_mid_nuc);
float sigma = Rcpp::as<float>(R_sigma);
int my_frame_len = time_frame.size();
float *old_time_frame;
old_time_frame = new float [my_frame_len];
for (int i=0; i<my_frame_len; i++){
old_time_frame[i] = time_frame[i];
}
float *old_vb_out;
// output in frames synchronized
old_vb_out = new float [my_frame_len*sub_steps];
// use the same nucleotide rise function as the bkgmodel setup uses
int i_start;
i_start=SigmaXRiseFunction(old_vb_out,my_frame_len,old_time_frame,sub_steps,max_concentration,t_mid_nuc,sigma);
vector<double> my_vb_out;
for (int i=0; i<my_frame_len*sub_steps; i++)
my_vb_out.push_back(old_vb_out[i]);
RcppResultSet rs;
rs.add("NucConc", my_vb_out);
rs.add("IndexStart",i_start);
ret = rs.getReturnList();
delete[] old_vb_out;
delete[] old_time_frame;
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP cfamounts(SEXP params){
SEXP rl=R_NilValue;
char* exceptionMesg=NULL;
try{
RcppParams rparam(params);
QuantLib::Date maturity(dateFromR(rparam.getDateValue("Maturity")));
QuantLib::Date settle(dateFromR(rparam.getDateValue("Settle")));
QuantLib::Date issue(dateFromR(rparam.getDateValue("IssueDate")));
double rate = rparam.getDoubleValue("CouponRate");
std::vector<double> rateVec(1, rate);
double faceAmount = rparam.getDoubleValue("Face");
double period = rparam.getDoubleValue("Period");
double basis = rparam.getDoubleValue("Basis");
DayCounter dayCounter = getDayCounter(basis);
Frequency freq = getFrequency(period);
Period p(freq);
double EMR = rparam.getDoubleValue("EMR");
Calendar calendar=UnitedStates(UnitedStates::GovernmentBond);
Schedule sch(settle, maturity, p, calendar,
Unadjusted, Unadjusted, DateGeneration::Backward,
(EMR == 1)? true : false);
FixedRateBond bond(1, faceAmount, sch, rateVec, dayCounter, Following,
100, issue);
//cashflow
int numCol = 2;
std::vector<std::string> colNames(numCol);
colNames[0] = "Date";
colNames[1] = "Amount";
RcppFrame frame(colNames);
Leg bondCashFlow = bond.cashflows();
for (unsigned int i = 0; i< bondCashFlow.size(); i++){
std::vector<ColDatum> row(numCol);
Date d = bondCashFlow[i]->date();
row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
row[1].setDoubleValue(bondCashFlow[i]->amount());
frame.addRow(row);
}
RcppResultSet rs;
rs.add("cashFlow", frame);
rl = rs.getReturnList();
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP sumFractionalPart(SEXP RIonoGram)
{
vector<double> ionoGram = Rcpp::as<vector<double> >(RIonoGram);
double ssq = sum_fractional_part(ionoGram.begin(), ionoGram.end());
RcppResultSet rs;
rs.add("ssq", ssq);
return rs.getReturnList();
}
RcppExport SEXP percentPositive(SEXP RIonoGram, SEXP RCutoff)
{
vector<double> ionoGram = Rcpp::as<vector<double> >(RIonoGram);
double cutoff = Rcpp::as<double>(RCutoff);
double ppf = percent_positive(ionoGram.begin(), ionoGram.end(), cutoff);
RcppResultSet rs;
rs.add("ppf", ppf);
return rs.getReturnList();
}
RcppExport SEXP IntegrateRedFromTotalTraceR(SEXP R_purple_obs, SEXP R_blue_hydrogen, SEXP R_delta_frame, SEXP R_tau_bead, SEXP R_etb_ratio) {
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
vector<float> blue_hydrogen = Rcpp::as< vector<float> >(R_blue_hydrogen);
vector<float> purple_obs = Rcpp::as< vector<float> >(R_purple_obs);
vector<float> delta_frame = Rcpp::as< vector<float> >(R_delta_frame);
float tau_bead = Rcpp::as<float>(R_tau_bead);
float etb_ratio = Rcpp::as<float>(R_etb_ratio);
int my_frame_len = delta_frame.size();
float *old_blue_hydrogen, *old_purple_obs, *old_delta_frame;
old_blue_hydrogen = new float [my_frame_len];
old_purple_obs = new float [my_frame_len];
old_delta_frame = new float [my_frame_len];
for (int i=0; i<my_frame_len; i++){
old_blue_hydrogen[i]=blue_hydrogen[i];
old_purple_obs[i] = purple_obs[i];
old_delta_frame[i] = delta_frame[i];
}
float *old_vb_out;
old_vb_out = new float [my_frame_len];
IntegrateRedFromObservedTotalTrace(old_vb_out,old_purple_obs, old_blue_hydrogen, my_frame_len, old_delta_frame,tau_bead,etb_ratio);
vector<double> my_vb_out;
for (int i=0; i<my_frame_len; i++)
my_vb_out.push_back(old_vb_out[i]);
RcppResultSet rs;
rs.add("IntegratedRed", my_vb_out);
ret = rs.getReturnList();
delete[] old_vb_out;
delete[] old_blue_hydrogen;
delete[] old_purple_obs;
delete[] old_delta_frame;
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP fitBkgTrace(
SEXP Rsig,
SEXP RnFrame,
SEXP RnFlow
) {
SEXP rl = R_NilValue;
char *exceptionMesg = NULL;
try {
RcppMatrix<double> sig(Rsig);
int nWell = sig.rows();
int nCol = sig.cols();
int nFrame = Rcpp::as<int>(RnFrame);
int nFlow = Rcpp::as<int>(RnFlow);
if(nWell <= 0) {
std::string exception = "Empty matrix supplied, nothing to fit\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else if(nFlow*nFrame != nCol) {
std::string exception = "Number of columns in signal matrix should equal nFrame * nFlow\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else {
RcppMatrix<int> bkg(nFrame,nFlow);
for(int iFlow=0; iFlow<nFlow; iFlow++) {
for(int iFrame=0, frameIndex=iFlow*nFrame; iFrame<nFrame; iFrame++, frameIndex++) {
double sum=0;
for(int iWell=0; iWell<nWell; iWell++)
sum += sig(iWell,frameIndex);
sum /= nWell;
bkg(iFrame,iFlow) = sum;
}
}
// Build result set to be returned as a list to R.
RcppResultSet rs;
rs.add("bkg", bkg);
// Set the list to be returned to R.
rl = rs.getReturnList();
// Clear allocated memory
}
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP cfdates(SEXP params){
SEXP rl = R_NilValue;
char* exceptionMesg = NULL;
try {
RcppParams rparam(params);
double basis = rparam.getDoubleValue("dayCounter");
DayCounter dayCounter = getDayCounter(basis);
double p = rparam.getDoubleValue("period");
Frequency freq = getFrequency(p);
Period period(freq);
double emr = rparam.getDoubleValue("emr");
bool endOfMonth = false;
if (emr == 1) endOfMonth = true;
QuantLib::Date d1(dateFromR(rparam.getDateValue("settle")));
QuantLib::Date d2(dateFromR(rparam.getDateValue("maturity")));
Calendar calendar=UnitedStates(UnitedStates::GovernmentBond);
Schedule sch(d1, d2, period, calendar, Unadjusted,
Unadjusted, DateGeneration::Backward, endOfMonth);
//cfdates
int numCol = 1;
std::vector<std::string> colNames(numCol);
colNames[0] = "Date";
RcppFrame frame(colNames);
std::vector<QuantLib::Date> dates = sch.dates();
for (unsigned int i = 0; i< dates.size(); i++){
std::vector<ColDatum> row(numCol);
Date d = dates[i];
row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
frame.addRow(row);
}
RcppResultSet rs;
rs.add("", frame);
rl = rs.getReturnList();
}
catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP BlueSolveBackgroundTraceR( SEXP R_blue_hydrogen, SEXP R_delta_frame, SEXP R_tau_bead, SEXP R_etb_ratio) {
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
vector<float> blue_hydrogen = Rcpp::as< vector<float> >(R_blue_hydrogen);
vector<float> delta_frame = Rcpp::as< vector<float> >(R_delta_frame);
float tau_bead = Rcpp::as<float>(R_tau_bead);
float etb_ratio = Rcpp::as<float>(R_etb_ratio);
int my_frame_len = delta_frame.size();
float *old_blue_hydrogen, *old_delta_frame;
old_blue_hydrogen = new float [my_frame_len];
old_delta_frame = new float [my_frame_len];
for (int i=0; i<my_frame_len; i++){
old_blue_hydrogen[i] =blue_hydrogen[i];
old_delta_frame[i] = delta_frame[i];
}
float *old_vb_out;
old_vb_out = new float [my_frame_len];
BlueSolveBackgroundTrace(old_vb_out,old_blue_hydrogen, my_frame_len, old_delta_frame,tau_bead,etb_ratio); // generate the trace as seen by C++
vector<double> my_vb_out;
for (int i=0; i<my_frame_len; i++)
my_vb_out.push_back(old_vb_out[i]);
RcppResultSet rs;
rs.add("BlueTrace", my_vb_out);
ret = rs.getReturnList();
delete[] old_vb_out;
delete[] old_blue_hydrogen;
delete[] old_delta_frame;
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP LoadFlowErr(SEXP RFileName)
{
// Open the H5 file, and get to the dataset:
const char* fileName = Rcpp::as<const char*>(RFileName);
hid_t file = H5Fopen(fileName, H5F_ACC_RDONLY, H5P_DEFAULT);
assert(file >= 0);
hid_t dset = H5Dopen(file, "/dset", H5P_DEFAULT);
assert(dset >= 0);
// Get dimensions for the data set:
hid_t space = H5Dget_space(dset);
assert(space >= 0);
int ndims = H5Sget_simple_extent_ndims(space);
assert(ndims == 3);
hsize_t dims[ndims];
hsize_t maxDims[ndims];
int result = H5Sget_simple_extent_dims(space, dims, maxDims);
assert(result != 0);
if (result==0) {result=0;}; // soak up error message for never using result
int numFlows = dims[0];
int maxReadHP = dims[1];
int maxRefHP = dims[2];
// Read in the data set:
int counts[numFlows][maxReadHP][maxRefHP];
size_t nelem = numFlows * maxReadHP * maxRefHP;
herr_t status = H5Dread(dset, H5T_NATIVE_INT, H5S_ALL, H5S_ALL, H5P_DEFAULT, counts);
assert(status >= 0);
// Change to R-style column-major order:
int Rcounts[nelem];
for(int i=0; i<numFlows; ++i){
for(int j=0; j<maxReadHP; ++j){
for(int k=0; k<maxRefHP; ++k){
Rcounts[k*numFlows*maxReadHP + j*numFlows + i] = counts[i][j][k];
}
}
}
// Close file:
status = H5Dclose(dset);
assert(status >= 0);
status = H5Fclose(file);
assert(status >= 0);
// Package results for return to R:
RcppResultSet rs;
rs.add("numFlows", numFlows);
rs.add("maxReadHP", maxReadHP);
rs.add("maxRefHP", maxRefHP);
rs.add("counts", Rcounts, nelem);
return rs.getReturnList();
}
RcppExport SEXP classicRcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
RcppDateVector dv(dvsexp);
RcppDatetimeVector dtv(dtvsexp);
Rprintf("\nIn C++, seeing the following date value\n");
for (int i=0; i<dv.size(); i++) {
Rcpp::Rcout << dv(i) << std::endl;
dv(i) = dv(i) + 7; // shift a week
}
Rprintf("\nIn C++, seeing the following datetime value\n");
for (int i=0; i<dtv.size(); i++) {
Rcpp::Rcout << dtv(i) << std::endl;
dtv(i) = dtv(i) + 0.250; // shift 250 millisec
}
// Build result set to be returned as a list to R.
RcppResultSet rs;
rs.add("date", dv);
rs.add("datetime", dtv);
// Get the list to be returned to R.
rl = rs.getReturnList();
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP classicRcppMatrixExample(SEXP matrix) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
// Get parameters in params.
RcppMatrix<int> orig(matrix);
int n = orig.rows(), k = orig.cols();
RcppMatrix<double> mat(n, k); // reserve n by k matrix
for (int i=0; i<n; i++) {
for (int j=0; j<k; j++) {
mat(i,j) = sqrt_double(orig(i,j));
}
}
// Build result set to be returned as a list to R.
RcppResultSet rs;
rs.add("result", mat);
rs.add("original", orig);
// Get the list to be returned to R.
rl = rs.getReturnList();
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
RcppExport SEXP fitNormals(SEXP RPPF, SEXP RSSQ)
{
deque<float> ppf = Rcpp::as<deque<float> >(RPPF);
deque<float> ssq = Rcpp::as<deque<float> >(RSSQ);
//vec2 mean[2];
//mat22 sigma[2];
//vec2 prior;
vec mean[2];
mat sigma[2];
vec prior;
for(int i=0; i<2; ++i){
mean[i].set_size(2);
sigma[i].set_size(2,2);
}
bool converged = fit_normals(mean, sigma, prior, ppf, ssq);
// (Wrapping the results would be much simpler with RcppArmadillo.)
RcppVector<double> RCloneMean = Rcpp::wrap(mean[0]);
RcppVector<double> RMixedMean = Rcpp::wrap(mean[1]);
RcppVector<double> RPrior = Rcpp::wrap(prior);
RcppMatrix<double> RCloneSigma(2,2);
RcppMatrix<double> RMixedSigma(2,2);
for(int r=0; r<2; ++r){
for(int c=0; c<2; ++c){
RCloneSigma(r,c) = sigma[0](r,c);
RMixedSigma(r,c) = sigma[1](r,c);
}
}
RcppResultSet rs;
rs.add("converged", converged);
rs.add("cloneMean", RCloneMean);
rs.add("mixedMean", RMixedMean);
rs.add("cloneSigma", RCloneSigma);
rs.add("mixedSigma", RMixedSigma);
rs.add("prior", RPrior);
return rs.getReturnList();
}
// col, row, and flow are zero-based in this function, info read out include both borders.
RcppExport SEXP readBeadParamR(SEXP RbeadParamFile,SEXP RminCol, SEXP RmaxCol, SEXP RminRow, SEXP RmaxRow,SEXP RminFlow, SEXP RmaxFlow) {
SEXP ret = R_NilValue;
char *exceptionMesg = NULL;
try {
//vector<string> beadParamFile = Rcpp::as< vector<string> > (RbeadParamFile);
//RcppStringVector tBeadParamFile(RbeadParamFile);
string beadParamFile = Rcpp::as< string > (RbeadParamFile);
int minCol = Rcpp::as< int > (RminCol);
int maxCol = Rcpp::as< int > (RmaxCol);
int minRow = Rcpp::as< int > (RminRow);
int maxRow = Rcpp::as< int > (RmaxRow);
int minFlow = Rcpp::as< int > (RminFlow);
int maxFlow = Rcpp::as< int > (RmaxFlow);
// Outputs
unsigned int nCol = maxCol - minCol+1;
unsigned int nRow = maxRow - minRow+1;
unsigned int nFlow = maxFlow - minFlow+1;
vector<unsigned int> colOut,rowOut,flowOut;
vector< double > resErr;
colOut.reserve(nCol * nRow * nFlow);
rowOut.reserve(nCol * nRow * nFlow);
// Recast int to unsigned int
vector<unsigned int> col, row, flow;
col.resize(nCol);
for(unsigned int i=0;i<col.size();++i)
col[i] = (unsigned int)(i+minCol);
row.resize(nRow);
for(unsigned int i=0;i<row.size();++i)
row[i] = (unsigned int) (i+minRow);
flow.resize(nFlow);
for(unsigned int i=0;i<flow.size();++i)
flow[i] = (unsigned int) (i+minFlow);
H5File beadParam;
beadParam.SetFile(beadParamFile);
beadParam.Open();
H5DataSet *resErrDS = beadParam.OpenDataSet("/bead/res_error");
H5DataSet *ampMulDS = beadParam.OpenDataSet("bead/ampl_multiplier");
H5DataSet *krateMulDS = beadParam.OpenDataSet("bead/k_rate_multiplier");
H5DataSet *beadInitDS = beadParam.OpenDataSet("bead/bead_init_param");
H5DataSet *beadDCDS = beadParam.OpenDataSet("bead/fg_bead_DC");
//float tresErr[nCol * nRow * nFlow];
float *tresErr;
float *tamplMul;
float *tkrateMul;
float *tbeadInit;
float *tbeadDC;
tresErr = (float *) malloc ( sizeof(float) * nCol * nRow * nFlow);
tamplMul = (float *) malloc ( sizeof(float) * nCol * nRow * nFlow);
tkrateMul = (float *) malloc ( sizeof(float) * nCol * nRow * nFlow);
tbeadInit = (float *) malloc ( sizeof(float) * nCol * nRow * 4);
tbeadDC = (float *) malloc ( sizeof(float) * nCol * nRow * nFlow);
size_t starts[3];
size_t ends[3];
starts[0] = minCol;
starts[1] = minRow;
starts[2] = minFlow;
ends[0] = maxCol;
ends[1] = maxRow;
ends[2] = maxFlow;
resErrDS->ReadRangeData(starts, ends, sizeof(tresErr),tresErr);
ampMulDS->ReadRangeData(starts, ends, sizeof(tamplMul),tamplMul);
krateMulDS->ReadRangeData(starts, ends, sizeof(tkrateMul),tkrateMul);
beadDCDS->ReadRangeData(starts, ends, sizeof(tbeadDC),tbeadDC);
starts[2] = 0;
ends[2] = 3;
beadInitDS->ReadRangeData(starts,ends,sizeof(tbeadInit),tbeadInit);
beadParam.Close();
RcppMatrix< double > resErrMat(nRow*nCol,nFlow);
RcppMatrix< double > amplMulMat(nRow*nCol,nFlow);
RcppMatrix< double > krateMulMat(nRow*nCol,nFlow);
RcppMatrix< double > beadInitMat(nRow*nCol,4);
RcppMatrix< double > beadDCMat(nRow*nCol,nFlow);
vector<int> colOutInt,rowOutInt,flowOutInt;
int count = 0;
for(size_t icol=0;icol<nCol;++icol)
for(size_t irow=0;irow<nRow;++irow) {
for(size_t iFlow=0;iFlow<nFlow;++iFlow)
{
amplMulMat(count,iFlow) = (double) tamplMul[icol * nRow * nFlow + irow * nFlow + iFlow] ;
krateMulMat(count,iFlow) = (double) tkrateMul[icol * nRow * nFlow + irow * nFlow + iFlow];
beadDCMat(count,iFlow) = (double) tbeadDC[icol * nRow *nFlow + irow * nFlow + iFlow];
}
for(size_t ip=0;ip<4;++ip)
beadInitMat(count,ip) = (double) tbeadInit[icol * nRow * ip + irow * 4 + ip];
colOutInt.push_back(minCol+icol);
rowOutInt.push_back(minRow+irow);
count++;
}
RcppResultSet rs;
rs.add("beadParamFile", beadParamFile);
rs.add("nCol", (int)nCol);
rs.add("nRow", (int)nRow);
rs.add("minFlow",minFlow);
rs.add("maxFlow",maxFlow);
rs.add("nFlow", (int)nFlow);
rs.add("col", colOutInt);
rs.add("row",rowOutInt);
rs.add("res_error",resErrMat);
rs.add("ampl_multiplier",amplMulMat);
rs.add("krate_multiplier",krateMulMat);
rs.add("bead_init",beadInitMat);
rs.add("bead_dc",beadDCMat);
ret = rs.getReturnList();
free(tresErr);
free(tamplMul);
free(tkrateMul);
free(tbeadInit);
free(tbeadDC);
}
catch(exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch (...) {
exceptionMesg = copyMessageToR("Unknown reason");
}
if ( exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP treePhaser(SEXP Rsignal, SEXP RkeyFlow, SEXP RflowCycle, SEXP Rcf, SEXP Rie, SEXP Rdr, SEXP Rbasecaller)
{
SEXP ret = R_NilValue;
char *exceptionMesg = NULL;
try {
RcppMatrix<double> signal(Rsignal);
RcppVector<int> keyFlow(RkeyFlow);
string flowCycle = Rcpp::as<string>(RflowCycle);
double cf = Rcpp::as<double>(Rcf);
double ie = Rcpp::as<double>(Rie);
double dr = Rcpp::as<double>(Rdr);
string basecaller = Rcpp::as<string>(Rbasecaller);
unsigned int nFlow = signal.cols();
unsigned int nRead = signal.rows();
if(basecaller != "treephaser-swan" && basecaller != "dp-treephaser" && basecaller != "treephaser-adaptive") {
std::string exception = "base value for basecaller supplied: " + basecaller;
exceptionMesg = copyMessageToR(exception.c_str());
} else if (flowCycle.length() < nFlow) {
std::string exception = "Flow cycle is shorter than number of flows to solve";
exceptionMesg = copyMessageToR(exception.c_str());
} else {
// Prepare objects for holding and passing back results
RcppMatrix<double> predicted_out(nRead,nFlow);
RcppMatrix<double> residual_out(nRead,nFlow);
RcppMatrix<int> hpFlow_out(nRead,nFlow);
std::vector< std::string> seq_out(nRead);
// Set up key flow vector
int nKeyFlow = keyFlow.size();
vector <int> keyVec(nKeyFlow);
for(int iFlow=0; iFlow < nKeyFlow; iFlow++)
keyVec[iFlow] = keyFlow(iFlow);
// Iterate over all reads
vector <float> sigVec(nFlow);
string result;
for(unsigned int iRead=0; iRead < nRead; iRead++) {
for(unsigned int iFlow=0; iFlow < nFlow; iFlow++)
sigVec[iFlow] = (float) signal(iRead,iFlow);
BasecallerRead read;
read.SetDataAndKeyNormalize(&(sigVec[0]), (int)nFlow, &(keyVec[0]), nKeyFlow-1);
DPTreephaser dpTreephaser(flowCycle.c_str(), flowCycle.length(), 8);
if (basecaller == "dp-treephaser")
dpTreephaser.SetModelParameters(cf, ie, dr);
else
dpTreephaser.SetModelParameters(cf, ie, 0); // Adaptive normalization
// Execute the iterative solving-normalization routine
if (basecaller == "dp-treephaser")
dpTreephaser.NormalizeAndSolve4(read, nFlow);
else if (basecaller == "treephaser-adaptive")
dpTreephaser.NormalizeAndSolve3(read, nFlow); // Adaptive normalization
else
dpTreephaser.NormalizeAndSolve5(read, nFlow); // sliding window adaptive normalization
read.flowToString(flowCycle,seq_out[iRead]);
for(unsigned int iFlow=0; iFlow < nFlow; iFlow++) {
predicted_out(iRead,iFlow) = (double) read.prediction[iFlow];
residual_out(iRead,iFlow) = (double) read.normalizedMeasurements[iFlow] - read.prediction[iFlow];
hpFlow_out(iRead,iFlow) = (int) read.solution[iFlow];
}
// Store results
RcppResultSet rs;
rs.add("seq", seq_out);
rs.add("predicted", predicted_out);
rs.add("residual", residual_out);
rs.add("hpFlow", hpFlow_out);
ret = rs.getReturnList();
}
}
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP phaseSimulator(SEXP Rseq, SEXP RflowCycle, SEXP RnucConc, SEXP Rcf, SEXP Rie, SEXP Rdr, SEXP RhpScale, SEXP RnFlow, SEXP RmaxAdv, SEXP RdroopType, SEXP RextraTaps)
{
SEXP ret = R_NilValue;
char *exceptionMesg = NULL;
try {
string seq = Rcpp::as<string>(Rseq);
string flowCycle = Rcpp::as<string>(RflowCycle);
unsigned int nFlow = (unsigned int) Rcpp::as<int>(RnFlow);
unsigned int maxAdv = (unsigned int) Rcpp::as<int>(RmaxAdv);
unsigned int extraTaps = (unsigned int) Rcpp::as<int>(RextraTaps);
string drType = Rcpp::as<string>(RdroopType);
RcppMatrix<double> cc(RnucConc);
RcppVector<double> cf(Rcf);
RcppVector<double> ie(Rie);
RcppVector<double> dr(Rdr);
RcppVector<double> hpScale(RhpScale);
DroopType droopType;
bool badDroopType = false;
if(drType == "ONLY_WHEN_INCORPORATING") {
droopType = ONLY_WHEN_INCORPORATING;
} else if(drType == "EVERY_FLOW") {
droopType = EVERY_FLOW;
} else {
badDroopType = true;
}
if(badDroopType) {
string exception = "bad droop type supplied\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else if(cc.rows() != (int) N_NUCLEOTIDES) {
string exception = "concentration matrix should have 4 rows\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else if(cc.cols() != (int) N_NUCLEOTIDES) {
string exception = "concentration matrix should have 4 columns\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else {
weight_vec_t cfMod(cf.size());
for(int i=0; i<cf.size(); i++)
cfMod[i] = cf(i);
weight_vec_t ieMod(ie.size());
for(int i=0; i<ie.size(); i++)
ieMod[i] = ie(i);
weight_vec_t drMod(dr.size());
for(int i=0; i<dr.size(); i++)
drMod[i] = dr(i);
weight_vec_t hpScaleMod(hpScale.size());
for(int i=0; i<hpScale.size(); i++)
hpScaleMod[i] = hpScale(i);
weight_vec_t signal;
vector<weight_vec_t> hpWeight;
weight_vec_t droopWeight;
bool returnIntermediates=true;
vector<weight_vec_t> conc(cc.rows());
for(int iRow=0; iRow < cc.rows(); iRow++) {
conc[iRow].resize(cc.cols());
for(unsigned int iCol=0; iCol < N_NUCLEOTIDES; iCol++)
conc[iRow][iCol] = cc(iRow,iCol);
}
PhaseSim p;
p.setExtraTaps(extraTaps);
p.setHpScale(hpScaleMod);
p.simulate(flowCycle, seq, conc, cfMod, ieMod, drMod, nFlow, signal, hpWeight, droopWeight, returnIntermediates, droopType, maxAdv);
RcppVector<double> out_signal(nFlow);
for(unsigned int i=0; i<nFlow; i++)
out_signal(i) = signal[i];
RcppResultSet rs;
rs.add("sig", out_signal);
if(returnIntermediates) {
unsigned int nHP = hpWeight[0].size();
RcppMatrix<double> out_hpWeight(nFlow,nHP);
RcppVector<double> out_droopWeight(nFlow);
for(unsigned int iFlow=0; iFlow < nFlow; iFlow++) {
out_droopWeight(iFlow) = droopWeight[iFlow];
for(unsigned int iHP=0; iHP < nHP; iHP++) {
out_hpWeight(iFlow,iHP) = hpWeight[iFlow][iHP];
}
}
rs.add("hpWeight", out_hpWeight);
rs.add("droopWeight", out_droopWeight);
}
ret = rs.getReturnList();
}
} catch(exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP CalculateEmphasisVectorR(
SEXP R_emphasis, SEXP R_hp_length,
SEXP R_timeFrame, SEXP R_frames_per_point,
SEXP R_time_center,
SEXP R_amplitude_multiplier, SEXP R_emphasis_width, SEXP R_emphasis_amplitude
) {
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
int homopolymer_length = Rcpp::as<int> (R_hp_length);
vector<float> emphasis_params = Rcpp::as<vector <float> > (R_emphasis);
vector<int> frames_per_point = Rcpp::as<vector <int> > (R_frames_per_point);
vector<float> time_frame = Rcpp::as< vector<float> > (R_timeFrame);
float emphasis_width = Rcpp::as<float> (R_emphasis_width);
float amplitude_multiplier = Rcpp::as<float> (R_amplitude_multiplier);
float emphasis_amplitude = Rcpp::as<float> (R_emphasis_amplitude);
float time_center = Rcpp::as<float> (R_time_center);
int my_frame_len = time_frame.size();
float *old_time_frame;
old_time_frame = new float [my_frame_len];
for (int i=0; i<my_frame_len; i++){
old_time_frame[i] = time_frame[i];
}
int *old_frames_per_point;
old_frames_per_point = new int [my_frame_len];
for (int i=0; i<my_frame_len; i++){
old_frames_per_point[i] = frames_per_point[i];
}
float *old_emphasis_params;
int emphasis_len = emphasis_params.size();
old_emphasis_params = new float [emphasis_len];
for (int i=0; i<emphasis_len; i++){
old_emphasis_params[i] = emphasis_params[i];
}
float *vect_out;
vect_out = new float [my_frame_len];
// output in frames synchronized
// use the same nucleotide rise function as the bkgmodel setup uses
int my_pts = GenerateIndividualEmphasis(vect_out, homopolymer_length, old_emphasis_params, my_frame_len ,time_center,old_frames_per_point, old_time_frame, amplitude_multiplier,emphasis_width, emphasis_amplitude);
vector<double> my_vect_out;
for (int i=0; i<my_frame_len; i++)
my_vect_out.push_back(vect_out[i]);
RcppResultSet rs;
rs.add("Emphasis", my_vect_out);
rs.add("EmphasisScale", my_pts);
ret = rs.getReturnList();
delete[] vect_out;
delete[] old_time_frame;
delete[] old_frames_per_point;
delete[] old_emphasis_params;
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP readDat(
SEXP RdatFile,
SEXP Rcol,
SEXP Rrow,
SEXP RminCol,
SEXP RmaxCol,
SEXP RminRow,
SEXP RmaxRow,
SEXP RreturnSignal,
SEXP RreturnWellMean,
SEXP RreturnWellSD,
SEXP RreturnWellLag,
SEXP Runcompress,
SEXP RdoNormalize,
SEXP RnormStart,
SEXP RnormEnd,
SEXP RXTCorrect,
SEXP RchipType,
SEXP RbaselineMinTime,
SEXP RbaselineMaxTime,
SEXP RloadMinTime,
SEXP RloadMaxTime
) {
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
vector<string> datFile = Rcpp::as< vector<string> >(RdatFile);
vector<int> colInt = Rcpp::as< vector<int> >(Rcol);
vector<int> rowInt = Rcpp::as< vector<int> >(Rrow);
int minCol = Rcpp::as<int>(RminCol);
int maxCol = Rcpp::as<int>(RmaxCol);
int minRow = Rcpp::as<int>(RminRow);
int maxRow = Rcpp::as<int>(RmaxRow);
bool returnSignal = Rcpp::as<bool>(RreturnSignal);
bool returnWellMean = Rcpp::as<bool>(RreturnWellMean);
bool returnWellSD = Rcpp::as<bool>(RreturnWellSD);
bool returnWellLag = Rcpp::as<bool>(RreturnWellLag);
bool uncompress = Rcpp::as<bool>(Runcompress);
bool doNormalize = Rcpp::as<bool>(RdoNormalize);
int normStart = Rcpp::as<int>(RnormStart);
int normEnd = Rcpp::as<int>(RnormEnd);
bool XTCorrect = Rcpp::as<bool>(RXTCorrect);
string chipType = Rcpp::as<string>(RchipType);
double baselineMinTime = Rcpp::as<double>(RbaselineMinTime);
double baselineMaxTime = Rcpp::as<double>(RbaselineMaxTime);
double loadMinTime = Rcpp::as<double>(RloadMinTime);
double loadMaxTime = Rcpp::as<double>(RloadMaxTime);
// Outputs
unsigned int nCol = 0;
unsigned int nRow = 0;
unsigned int nFrame = 0;
vector<unsigned int> colOut,rowOut;
vector< vector<double> > frameStart,frameEnd;
vector< vector< vector<short> > > signal;
vector< vector<short> > mean,sd,lag;
// Recast int to unsigned int because Rcpp has no unsigned int
vector<unsigned int> col,row;
col.resize(colInt.size());
for(unsigned int i=0; i<col.size(); i++)
col[i] = (unsigned int) colInt[i];
row.resize(rowInt.size());
for(unsigned int i=0; i<row.size(); i++)
row[i] = (unsigned int) rowInt[i];
Image i;
std::cout << "Loading slice." << std::endl;
if(!i.LoadSlice(
// Inputs
datFile,
col,
row,
minCol,
maxCol,
minRow,
maxRow,
returnSignal,
returnWellMean,
returnWellSD,
returnWellLag,
uncompress,
doNormalize,
normStart,
normEnd,
XTCorrect,
chipType,
baselineMinTime,
baselineMaxTime,
loadMinTime,
loadMaxTime,
// Outputs
nCol,
nRow,
colOut,
rowOut,
nFrame,
frameStart,
frameEnd,
signal,
mean,
sd,
lag
)) {
string exception = "Problem reading dat data\n";
exceptionMesg = copyMessageToR(exception.c_str());
} else {
int nDat = datFile.size();
int nWell = colOut.size();
// Recast colOut and rowOut from int to unsigned int because Rcpp has no unsigned int
vector<int> colOutInt,rowOutInt;
colOutInt.resize(colOut.size());
for(unsigned int i=0; i<colOutInt.size(); i++)
colOutInt[i] = (int) colOut[i];
rowOutInt.resize(rowOut.size());
for(unsigned int i=0; i<rowOutInt.size(); i++)
rowOutInt[i] = (int) rowOut[i];
// Recast vectors of vectors to arrays.
vector<int> sigInt;
vector<double> sigMean,sigSD;
vector<double> sigLag;
if(returnSignal) {
sigInt.reserve( ((size_t)nDat*(size_t)nWell*(size_t)nFrame));
}
if(returnWellMean) {
sigMean.reserve((size_t)nDat*(size_t)nWell);
}
if(returnWellSD) {
sigSD.reserve((size_t)nDat*(size_t)nWell);
}
if (returnWellLag){
sigLag.reserve((size_t)nDat*(size_t)nWell);
}
for(int iDat=0; iDat < nDat; iDat++) {
if(returnSignal) {
for(unsigned int iFrame=0; iFrame < signal[iDat][0].size(); iFrame++) {
for(unsigned int iWell=0; iWell < signal[iDat].size(); iWell++) {
sigInt.push_back(signal[iDat][iWell][iFrame]);
}
}
}
if(returnWellMean || returnWellSD) {
for(int iWell=0; iWell < nWell; iWell++) {
if(returnWellMean)
sigMean.push_back(mean[iDat][iWell]);
if(returnWellSD)
sigSD.push_back(sd[iDat][iWell]);
}
}
if (returnWellLag){
for(int iWell=0; iWell<nWell; iWell++){
sigLag.push_back(lag[iDat][iWell]);
}
}
}
RcppResultSet rs;
rs.add("datFile", datFile);
rs.add("nCol", (int) nCol);
rs.add("nRow", (int) nRow);
rs.add("nFrame", (int) nFrame);
rs.add("nFlow", nDat);
rs.add("col", colOutInt);
rs.add("row", rowOutInt);
rs.add("frameStart", frameStart);
rs.add("frameEnd", frameEnd);
if(returnSignal){
rs.add("signal", sigInt);
}
if(returnWellMean)
rs.add("wellMean", sigMean);
if(returnWellSD)
rs.add("wellSD", sigSD);
if(returnWellLag)
rs.add("wellLag", sigLag);
ret = rs.getReturnList();
}
} catch(exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP SimplifyCalculateCumulativeIncorporationHydrogensR(
SEXP R_nuc_rise, SEXP R_sub_steps,
SEXP R_deltaFrame, SEXP R_my_start,
SEXP R_C, SEXP R_Amplitude, SEXP R_copies, SEXP R_krate, SEXP R_kmax, SEXP R_diffusion)
{
SEXP ret = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
vector<float> nuc_rise = Rcpp::as< vector<float> > (R_nuc_rise);
int sub_steps = Rcpp::as<int> (R_sub_steps);
vector<float> delta_frame = Rcpp::as< vector<float> > (R_deltaFrame);
int my_start_index = Rcpp::as<int> (R_my_start);
float max_concentration = Rcpp::as<float> (R_C);
float amplitude = Rcpp::as<float> (R_Amplitude);
float copies = Rcpp::as<float> (R_copies);
float krate = Rcpp::as<float> (R_krate);
float kmax = Rcpp::as<float> (R_kmax);
float diffusion = Rcpp::as<float> (R_diffusion);
int my_frame_len = delta_frame.size();
float *old_nuc_rise, *old_delta_frame;
old_nuc_rise = new float [nuc_rise.size()];
old_delta_frame = new float [my_frame_len];
float frames_per_second = 15.0f;
for (int i=0; i<my_frame_len; i++){
old_delta_frame[i] = delta_frame[i]/frames_per_second; // keep interface transparent for R as this is now in seconds
}
// may have more sub-steps than the output
int nuc_len = nuc_rise.size();
for (int i=0; i<nuc_len; i++){
old_nuc_rise[i] = nuc_rise[i];
}
float *old_vb_out;
float molecules_to_micromolar_conv = 0.000062;
// output in frames synchronized
old_vb_out = new float [my_frame_len];
// calculate cumulative hydrogens from amplitude (hp mixture), copies on bead, krate, kmax, diffusion
// and of course the rate at which nuc is available above the well
ComputeCumulativeIncorporationHydrogens(old_vb_out,my_frame_len, old_delta_frame, old_nuc_rise, sub_steps,my_start_index,
max_concentration, amplitude, copies, krate,kmax, diffusion,molecules_to_micromolar_conv, NULL,true);
vector<double> my_vb_out;
for (int i=0; i<my_frame_len; i++)
my_vb_out.push_back(old_vb_out[i]);
RcppResultSet rs;
rs.add("CumulativeRedHydrogens", my_vb_out);
ret = rs.getReturnList();
delete[] old_vb_out;
delete[] old_nuc_rise;
delete[] old_delta_frame;
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return ret;
}
RcppExport SEXP correctCafie(
SEXP measured_in,
SEXP flowOrder_in,
SEXP keyFlow_in,
SEXP nKeyFlow_in,
SEXP cafEst_in,
SEXP ieEst_in,
SEXP droopEst_in
) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
try {
// First do some annoying but necessary type casting on the input parameters.
// measured & nFlow
RcppMatrix<double> measured_temp(measured_in);
int nWell = measured_temp.rows();
int nFlow = measured_temp.cols();
// flowOrder
RcppStringVector flowOrder_temp(flowOrder_in);
char *flowOrder = strdup(flowOrder_temp(0).c_str());
int flowOrderLen = strlen(flowOrder);
// keyFlow
RcppVector<int> keyFlow_temp(keyFlow_in);
int *keyFlow = new int[keyFlow_temp.size()];
for(int i=0; i<keyFlow_temp.size(); i++) {
keyFlow[i] = keyFlow_temp(i);
}
// nKeyFlow
RcppVector<int> nKeyFlow_temp(nKeyFlow_in);
int nKeyFlow = nKeyFlow_temp(0);
// cafEst, ieEst, droopEst
RcppVector<double> cafEst_temp(cafEst_in);
double cafEst = cafEst_temp(0);
RcppVector<double> ieEst_temp(ieEst_in);
double ieEst = ieEst_temp(0);
RcppVector<double> droopEst_temp(droopEst_in);
double droopEst = droopEst_temp(0);
if(flowOrderLen != nFlow) {
exceptionMesg = copyMessageToR("Flow order and signal should be of same length");
} else if(nKeyFlow <= 0) {
exceptionMesg = copyMessageToR("keyFlow must have length > 0");
} else {
double *measured = new double[nFlow];
RcppMatrix<double> predicted(nWell,nFlow);
RcppMatrix<double> corrected(nWell,nFlow);
CafieSolver solver;
solver.SetFlowOrder(flowOrder);
solver.SetCAFIE(cafEst, ieEst);
for(int well=0; well < nWell; well++) {
// Set up the input signal for the well
for(int flow=0; flow<nFlow; flow++) {
measured[flow] = measured_temp(well,flow);
}
// Initialize the sovler object and find the best CAFIE
solver.SetMeasured(nFlow, measured);
solver.Normalize(keyFlow, nKeyFlow, droopEst, false);
solver.Solve(3, true);
// Store the predicted & corrected signals
for(int flow=0; flow<nFlow; flow++) {
predicted(well,flow) = solver.GetPredictedResult(flow);
corrected(well,flow) = solver.GetCorrectedResult(flow);
}
// Store the estimated sequence
//const double *normalized_ptr = solver.GetMeasured();
//const char *seqEstimate_ptr = solver.GetSequence();
//int seqEstimateLen = strlen(seqEstimate_ptr);
}
// Build result set to be returned as a list to R.
RcppResultSet rs;
rs.add("predicted", predicted);
rs.add("corrected", corrected);
// Get the list to be returned to R.
rl = rs.getReturnList();
delete [] measured;
}
free(flowOrder);
delete [] keyFlow;
} catch(std::exception& ex) {
exceptionMesg = copyMessageToR(ex.what());
} catch(...) {
exceptionMesg = copyMessageToR("unknown reason");
}
if(exceptionMesg != NULL)
Rf_error(exceptionMesg);
return rl;
}
