How do I add a progress indicator in Shiny from Rcpp - r

I know how to add a progress indicator in a Shiny app using withProgress() (as described here). However, given that my long running computation code calls from a package (that I've written) in which most of the code is written using Rcpp, I don't know how to return a progress value that Shiny can understand from within the Rcpp code. In my Rcpp code, I'm currently using the ones provided in RcppProgress (as described here), but I'm unsure how RcppProgress can communicate with Shiny's withProgress(). If anyone has any alternative suggestions, it'd be much appreciated!

Print out your progress and carriage return to the beginning of the same line. Here's a short example that prints out how much progress you've made:
#include <chrono>
#include <thread>
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
void test(size_t loop_size) {
std::cout.precision(4);
for(size_t i=0; i<loop_size; ++i) {
std::this_thread::sleep_for(std::chrono::milliseconds(1));
if(i == loop_size - 1) {
std::cout << "100.0%" << std::endl;
} else if(i % 33 == 0) {
std::cout << static_cast<double>(i+1) / static_cast<double>(loop_size) * 100.0 << "%";
std::cout << "\r";
}
}
}
/*** R
test(10000)
*/

Related

Rcpp no matching function for call to abs

when using Rcpp, I want to use function abs, I just write Rcpp::abs(-1), but always an error:
no matching function for call to abs
Actually when I write Rcpp:ab, there are some hint that there exists Rcpp::abs(). I have tried some other function Rcpp::NumericVector, it works. I know I can use std::abs(-1), I just wonder why Rcpp::abs(-1) do not work, my system is windows, and I install Rtools.
Rcpp::abs() requires an Rcpp object, e.g. *Vector and *Matrix.
Unfortunately, -1 is of a primitive type, e.g. not an Rcpp object.
So, the following would work:
#include <Rcpp.h>
// [[Rcpp::export]]
void show_rcpp_abs() {
Rcpp::NumericVector A = NumericVector::create(-1);
Rcpp::Rcout << "A" << Rcpp::abs(A) << std::endl;
double B = std::abs(-1.0);
Rcpp::Rcout << "B" << B << std::endl;
}

In-memory file to intercept stdout on function call

I've inherited this function that I have to call from my code. The function is
from a bizzare library in an arcane programming language -- so I cannot assume
almost anything about it, except for the fact that it prints some useful
infomation to stdout.
Let me simulate its effect with
void black_box(int n)
{
for(int i=0; i<n; i++) std::cout << "x";
std::cout << "\n";
}
I want to intercept and use the stuff it outputs. To that end I redirect stdout
to a temporary file, call the black_box, then restore the stdout and read the
stuff from the temporary file:
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <unistd.h>
#include <iostream>
int main(void){
int fd = open( "outbuff", O_RDWR | O_TRUNC | O_CREAT, 0600);
// Redirect stdout to fd
int tmp = dup(1);
dup2( fd, 1);
// Execute
black_box(100);
std::cout << std::flush;
// Restore old stdout
dup2(tmp, 1);
// Read output from the outbuff flie
struct stat st;
fstat(fd, &st);
std::string buf;
buf.resize(st.st_size);
lseek(fd, 0, SEEK_SET);
read(fd, &buf[0], st.st_size);
close(fd);
std::cout << "Captured: " << buf << "\n";
return 0;
}
This works. But creating a file on disk for such a task is not something I'm
proud of. Can I make something like a file, but in-memory?
Before suggesting a pipe, please consider what would happen if
black_box overflows its buffer. And no, I need it single-threaded --
starting an extra process/thread defeats the whole purpose ot what I'm trying
to achieve.
I want to intercept and use the stuff it outputs.
[...] please consider what would happen if black_box overflows its buffer.
I see two alternatives.
If you know the maximum size of the output, and the size is not too excessive, use the socketpair instead of pipe. Unlike pipes, sockets allow to change the size of the egress/ingress buffers.
Use a temporary file on /tmp. In normal case it will not touch disk (unless system is swapping). There are few functions for the purpose, for example mkstemp (or tmpfile).

How to print an R object to stderr in Rcpp?

I implemented a Python-style dictionary for R, but did not find a good way to raise an error when a given key does not have a value in the dictionary. Calling stop is easy enough, but I would like to tell the user which key has not been found by printing the R object. Right now I have:
Rcpp::Rcout << "Key not found: ";
Rcpp::print(key); # <-- how can I get this on stderr?
Rcpp::stop("Key error!");
This prints the message to stdout, but I'd rather have it on stderr. Probably I'm just missing a function that Rcpp provides?
Here's a MWE:
library(Rcpp)
sourceCpp(code='
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
void test(SEXP key) {
Rcpp::print(key);
Rcpp::Rcerr << "This does not work: " << key << std::endl;
}
/*** R
test("x")
test(c(1,2,3))
*/
')
This works just fine:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
std::string test(std::string key) {
Rcpp::Rcerr << "Key not found: "<< key << std::endl;
Rcpp::stop("Key error!");
return key;
}
/*** R
test("x")
*/
Output:
Key not found: x
Error in eval(expr, envir, enclos) : Key error!
Edit:
OK, so you pass a SEXP that can be a single value or vector. I would suggest to cast that to a character vector:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
void test(SEXP key) {
CharacterVector key1 = as<CharacterVector>(key);
Rcpp::Rcerr << "This does not work: " << key1 << std::endl;
}
/*** R
test(c("x", "y"))
test(1:3)
*/
Output:
> Rcpp::sourceCpp('E:/temp/ttt.cpp')
> test(c("x", "y"))
This does not work: "x" "y"
> test(1:3)
This does not work: "1" "2" "3"
At the moment, it seems that this hack is the only way to go. It's not very efficient, as we go back from C++ to R to get the value as a nice string.
library(Rcpp)
sourceCpp(code='
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
void test(SEXP key, Function generate_error) {
std::string s = as<std::string>(generate_error(key));
stop(s);
}
/*** R
generate_error <- function(key) {
paste("Key not found:", capture.output(print(key)))
}
try( test("x", generate_error) )
try( test(c(1,2,3), generate_error) )
*/
')
Rcpp calls Rf_PrintValue internally. I've glanced at R source and it seems like this function is in turn implemented using printfs.
So, the problem is how to redirect external printf calls to stderr. Depending on your platform you have multiple options like dup/freopen/CreatePipe etc. Arguably, redirecting stdout back and forth is a hack.

RCppParallel Programming Error Crashing R

I have been trying to parallelize one of my Rcpp routines. In doing so I have been trying to follow the Parallel Distance Calculation example from jjalaire. Unfortunately, once I got everything coded up and started to play around, my R session would crash. Sometimes after the first execution, sometimes after the third. To be honest, it was a crap shoot as to when R would crash when I ran the routine. So, I have paired down my code to a small reproducible example to play with.
Rcpp File (mytest.cpp)
#include <Rcpp.h>
// [[Rcpp::depends(RcppParallel)]]
#include <RcppParallel.h>
using namespace std;
using namespace Rcpp;
using namespace RcppParallel;
struct MyThing : public Worker {
RVector<double> _pc;
RVector<double> _pcsd;
MyThing(Rcpp::NumericVector _pc, Rcpp::NumericVector _pcsd) : _pc(_pc), _pcsd(_pcsd){}
void operator()(std::size_t begin, std::size_t end) {
for(int j = begin; j <= end; j++) {
_pc[j] = 1;
// _pcsd[j] = 1;
}
}
};
// [[Rcpp::export]]
void calculateMyThingParallel() {
NumericVector _pc(100);
NumericVector _pcsd(100);
MyThing mt(_pc, _pcsd);
parallelFor(0, 100, mt);
}
R Compilation and Execution Script (mytest.R)
library(Rcpp)
library(inline)
sourceCpp('mytest.cpp')
testmything = function() {
calculateMyThingParallel()
}
if(TRUE) {
for(i in 1:20) {
testmything()
}
}
The error seems to be directly related to my setting of the _pc and _pcsd variables in the operator() method. If I take those out things dramatically improve. Based on the Parallel Distance Calculation example, I am not sure what it is that I have done wrong here. I was under the impression that RVector was thread safe. Although that is my impression, I know this is an issue with threads somehow. Can anybody help me to understand why the above code randomly crashes my R sessions?
For information I am running the following:
Windows 7
R: 3.1.2
Rtools: 3.1
Rcpp: 0.11.3
inline: 0.3.13
RStudio: 0.99.62
After cross-posting this question on the rcpp-devel list, a user responded and infomed me that my loop over j in the operator() method should go between begin <= j < end and not begin <= j <= end which is what I had.
I made that change and sure nuff, everything seems to be working right now.
seems like overextending ones reach past allocated memory spaces still results in unintended consequences...

Retrieve parameters from List using Rcpp

New to Rcpp I am testing how to retrieve and use a nested list from R with a known structure without copying parts of the list again. The small code example (with embedded R code) seems to work (cout is used for debugging).
The list rL retrieved from R may be very big so I do not want to reallocate memory (copy parts of rL). Do the current code copy parts of rL?
Best Lars
#include <Rcpp.h>
#include <iostream>
using namespace Rcpp;
using namespace std;
// [[Rcpp::export]]
SEXP testing(const List rL) {
List L(rL);
SEXP sL2(L["L2"]);
List L2(sL2);
SEXP sStateGrpL2(L2["stateGroups"]);
List stateGrpL2(sStateGrpL2);
SEXP sStateAllocL2(L2["stateAlloc"]);
CharacterVector stateAllocL2(sStateAllocL2);
SEXP sActionGrpL2(L2["actionGroups"]);
List actionGrpL2(sActionGrpL2);
SEXP sActionAllocL2(L2["actionAlloc"]);
List actionAllocL2(sActionAllocL2);
vector<string> stateLabels;
vector<string> actionLabels;
CharacterVector actionNames;
for(int n2 = 0; n2< as<int>(L2["stages"]); n2++) {
stateLabels = as< vector<string> >(stateGrpL2[as<string>(stateAllocL2[n2])]);
int s2Size = stateLabels.size();
SEXP sAllocA(actionAllocL2[n2]);
List allocA(sAllocA);
actionNames = as<CharacterVector>(allocA[0]);
cout << "stage:" << n2 << " sN:" << as<string>(stateAllocL2[n2]) << "\n";
for (int s2=0; s2<s2Size; ++s2) {
cout << " s:" << stateLabels[s2] << " aN:" << actionNames[s2] << "\n";
actionLabels = as< vector<string> >(actionGrpL2[ as<string>(actionNames[s2]) ]);
int a2Size = actionLabels.size();
for (int a2=0; a2<a2Size; ++a2) {
cout << " a:" << actionLabels[a2] << "\n";
}
}
}
return wrap(0);
}
/*** R
L <- list( L2=list(stages=2,
stateGroups=list(s1Grp=c("a","b","c"),s2Grp=c("d","e")),
stateAlloc = c(rep("s1Grp",1),rep("s2Grp",1)),
actionGroups = list(a1Grp=c("terminate","keep"), a2Grp=c("finish")),
actionAlloc = list(list( rep("a1Grp",3) ),
list( c("a1Grp","a2Grp") )
)
)
)
testing(L)
*/
You write:
The list rL may be very big so I do not want to use new memory (copy
parts of rL). Is this the way to do it?
Pretty much (as far as I can tell from a glance at your code).
All exchange with R uses SEXP types where the P stands for pointer -- these are shallow proxy objects which will not be copied. It uses / reuses the R object memory.
So if you profile / memory-profile this it should behave similarly for N=10 and N=1e5. But the proof is in the pudding...
A few things :
The loop test n2< as<int>(L2["stages"]) is both hard to read and
inefficient as it is calculated at each iteration. You should
definitely do it just once.
All of your as< vector<string> > create deep copies and does not
take advantage of the R's string cache. Can't you use a
CharacterVector instead ?

Resources