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 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 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 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 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 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;
}
