I have been using DEoptim for some time to test different parameters for a hydrology algorithm. The code is mainly written in R, but there is a function written in Rcpp. If I run DEoptim in non-parallel mode, it runs fine, but if I run in parallel mode (i.e. paralleltype=1) the code returns an error saying it can't find my Rcpp function. So the Rcpp function looks like this:
loadcppfunctions <- function() {
eastfunc <<- 'NumericMatrix eastC(NumericMatrix e, NumericMatrix zerocolmatrix, NumericMatrix zerorowmatrix) {
int ecoln = e.ncol();
int ecolnlessone = ecoln - 1;
int erown = e.nrow();
int erownlessone = erown - 1;
NumericMatrix eout(e.nrow(),e.ncol()) ;
for (int j = 0;j < ecoln;j++) {
if (j > 0) {
eout(_,j) = e(_,j-1);
} else {
eout(_,j) = e(_,0);
}
}
eout(_,0) = zerocolmatrix(_,0);
return eout;
}'
eastC <<- cppFunction(eastfunc)
}
and then I just use:
loadcppfunctions()
Later in the code I call this function as follows:
movefdrerunoff <- eastC(fdrerunoff, zerocolmatrix, zerorowmatrix)
As I say, it all works fine - but if I run DEoptim as follows:
ans <- DEoptimone(Calibrate,lower,upper,DEoptim.control(trace=TRUE,parallelType=1,parVar=c(parVarnames),packages=c("raster","rgdal","maptools","matrixcalc","Rcpp","RcppArmadillo")))
It fails saying:
Error in checkForRemoteErrors(val) :
7 nodes produced errors; first error: could not find function "eastC"
So how can I make DEoptim see this function when all the other R based functions are fine.
Thanks, Antony Walker
I found that by adding the Rcpp function inside the main DEoptim function (Calibrate) worked. The Calibrate function looked like:
Calibrate <- function(x) {
eastfunc <<- 'NumericMatrix eastC(NumericMatrix e, NumericMatrix zerocolmatrix, NumericMatrix zerorowmatrix) {
int ecoln = e.ncol();
int ecolnlessone = ecoln - 1;
int erown = e.nrow();
int erownlessone = erown - 1;
NumericMatrix eout(e.nrow(),e.ncol()) ;
for (int j = 0;j < ecoln;j++) {
if (j > 0) {
eout(_,j) = e(_,j-1);
} else {
eout(_,j) = e(_,0);
}
}
eout(_,0) = zerocolmatrix(_,0);
return eout;
}'
eastC <<- cppFunction(eastfunc)
cmax <<- x[1]
Cr <<- x[2]
Cl <<- x[3]
Crb <<- x[4]
Clb <<- x[5]
returnflowriver <<- x[6]
returnflowland <<- x[7]
kd <<- x[8]
startyear()
-NashSutcliffe
}
and then running DEoptim as:
ans <- DEoptimone(Calibrate,lower,upper,DEoptim.control(trace=TRUE,parallelType=1,parVar=c(parVarnames),packages=c("raster","rgdal","maptools","matrixcalc","Rcpp","RcppArmadillo","moveCpp")))
Related
I am writing a matrix function in cpp11, but that function crashes the RStudio session, that doesn't happen with Rcpp.
I have created a GitHub issue for my particular case (https://github.com/pachadotdev/fixest2/issues/36), where if I pass a matrix of integers I have a crash, but if I pass my matrix as is (i.e., with values such as 1,2,3,4 as doubles), then cpp11 doesn't like it and says
ℹ Loading fixest2Warning: [fenegbin] Optimization failed at iteration 1. Reason: Error : Invalid input type, expected 'integer' actual 'double'
How can I debug my functions in a consistent way? I use R mostly and I do not know much about C++, I just try to translate my statistical ideas into decent code.
I tried with simple examples and it is quite clear that both cpp11 and Rcpp do the same, like this:
cpp11
cpp11::cpp_source("multiply_by_minus_one_cpp11.cpp")
A = matrix(1:4, nrow = 2, ncol = 2)
mode(A) <- "integer"
multiply_by_minus_one(A)
#include "cpp11/matrix.hpp"
#include "cpp11/integers.hpp"
using namespace cpp11;
[[cpp11::register]] integers_matrix<> multiply_by_minus_one(writable::integers_matrix<> X) {
int i;
int j;
for (i = 0; 2; i ++) {
for (j = 0; j < i; j++) {
X(i,j) = (-1) * X(i,j);
}
}
return(X);
}
Rcpp
Rcpp::sourceCpp("multiply_by_minus_one_rcpp.cpp")
A = matrix(1:4, nrow = 2, ncol = 2)
# mode(A) <- "integer"
multiply_by_minus_one(A)
#include "Rcpp.h"
using namespace Rcpp;
// [[Rcpp::export]]
IntegerMatrix multiply_by_minus_one(IntegerMatrix X) {
int i;
int j;
for (i = 0; i <= 1; i ++) {
for (j = 0; j <= 1; j++) {
X(i,j) = (-1) * X(i,j);
}
}
return(X);
}
Suppose I have the following c++ code in a file named test.cpp
#include <Rcpp.h>
//[[Rcpp::export]]
Rcpp::NumericMatrix MyAbar (const Rcpp::NumericMatrix & x, int T){
unsigned int outrows = x.nrow(), i = 0, j = 0;
double d;
Rcpp::NumericMatrix out(outrows,outrows);
// Rcpp::LogicalVector comp;
for (i = 0; i < outrows - 1; i++){
Rcpp::NumericVector v1 = x.row(i);
Rcpp::NumericVector ans(outrows);
for (j = i + 1; j < outrows ; j ++){
d = mean(Rcpp::runif( T ) < x(i,j));
out(j,i)=d;
out(i,j)=d;
}
}
return out;
}
I know with the following command, I can have my own package
Rcpp.package.skeleton("test",cpp_files = "~/Desktop/test.cpp")
However, what if I want to combine the following R function which call the Rcpp-function into the package
random = function(A, T){
if (!is.matrix(A)){
A = Reduce("+",A)/T
}
# global constant and threshold
n = nrow(A)
B_0 = 3
w = min(sqrt(n),sqrt(T * log(n)))
q = B_0 * log(n) / (sqrt(n) * w)
A2 = MyAbar(A)
diag(A2) <- NA
K = A2 <= rowQuantiles(A2, probs=q, na.rm =TRUE)
diag(K) = FALSE
P = K %*% A * ( 1/(rowSums(K) + 1e-10))
return( (P + t(P))*0.5 )
}
How can i make it?
So you are asking how to make an R package? There are many good tutorials.
To a first approximation:
copy your file into, say, file R/random.R
deal with a help file for your function, either manually by writing man/random.Rd or by learning package roxygen2
make sure you know what NAMESPACE is for and that DESCRIPTION is right
I'm very new to Rcpp. I 'm trying to write a coordinate descent algorithm for lasso in Rcpp as a self study. The code return an error:
Mat::init(): requested size is not compatible with column vector layout
I also have some problems while writing the code.
no matching function for call to 'sign'
no matching function for call to 'ifelse'
pow(X.col(j),2) : no viable conversion
I write
(S1>0)-(S1<0) for (1) to compute the sign of S1,
a if(){}else{} statement for (2) and
X.col(j)%X.col(j) for (3).
Any suggestion, please?
Here is the code.
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat betamat(NumericMatrix Xr, NumericVector yr, NumericVector lambdar, double tol=0.0000001) {
int N = Xr.nrow(), p = Xr.ncol(), l = lambdar.size();
mat X(Xr.begin(), N, p, false);
colvec y(yr.begin(), yr.size(), false);
vec lambda(lambdar.begin(), lambdar.size(),false);
colvec ols = solve(X,y);
mat betas = zeros<mat>(p,l);
//
bool converged = false;
for (int i = 0; i < l; ++i) {
colvec b = zeros<vec>(p);
colvec r = y-X*b;
while(converged == false){
colvec beta_old = betas;
for(int j = 0; j < p; ++j){
r = r + X.col(j)*b(j);
double xr = dot(X.col(j),r);
double S1 = xr/N;
double xx = sum(X.col(j)%X.col(j))/N;
b(j) =((S1>0)-(S1<0))*(abs(S1)-lambda(i))/xx;
if(b(j)>0){
b(j)=b(j);
}else{
b(j)=0;
}
r = r - X.col(j)*b(j);
}
converged = (sum(abs(betas - beta_old)) < tol);
}
betas.col(i) = b;
}
return betas;
}
In R, I'm calling this with
library(Rcpp)
sourceCpp("filename.cpp")
set.seed(1)
X <- matrix(rnorm(100*3),100)
y <- rnorm(100)
coefficients <- betamat(X,y,seq(0,1,0.0005))
I am novice in R. I want to know how we can write the below for loop in an efficient way. I am getting correct answer by the below code for small dataset.
data <- data.frame(x1=c(rep('a',12)),
x2=c(rep('b',12)),
x3=c(rep(as.Date('2017-03-09'),4),rep(as.Date('2017-03-10'),4),rep(as.Date('2017-03-11'),4)),
value1= seq(201,212),
x4=c(as.Date('2017-03-09'),as.Date('2017-03-10'),as.Date('2017-03-11'),as.Date('2017-03-12')
,as.Date('2017-03-10'),as.Date('2017-03-11'),as.Date('2017-03-12'),as.Date('2017-03-13')
,as.Date('2017-03-11'),as.Date('2017-03-12'),as.Date('2017-03-13'),as.Date('2017-03-14')),
value2= seq(101,112), stringsAsFactors = FALSE)
Below for loop script:
for (i in 1:length(data$x3)){
print(i)
if (!is.na(data$x4[i])){
if(data$x4[i] == data$x3[i] && data$x2[i]==data$x2[i] && data$x1[i]==data$x1[i]){
data$diff[i] <- data$value1[i] - data$value2[i]
}
else{
print("I am in else")
for (j in 1:length(data$x3)){
print(c(i,j))
# print(a$y[i])
if(data$x4[i]==data$x3[j] && data$x1[i]==data$x1[j] && data$x2[i]==data$x2[j]){
# print(a$x[j])
data$diff[i] <- data$value1[j] - data$value2[i]
break
}
}
}
}
}
If you want performance, the answer is often Rcpp.
Translating your R code in Rcpp:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector f_Rcpp(List data) {
StringVector x1 = data["x1"];
StringVector x2 = data["x2"];
NumericVector x3 = data["x3"];
NumericVector x4 = data["x4"];
NumericVector value1 = data["value1"];
NumericVector value2 = data["value2"];
int n = value1.size();
NumericVector diff(n, NA_REAL);
int i, j;
for (i = 0; i < n; i++) {
Rprintf("%d\n", i);
if (x4[i] != NA_REAL) {
if (x4[i] == x3[i]) {
diff[i] = value1[i] - value2[i];
} else {
Rprintf("I am in else\n");
for (j = 0; j < n; j++) {
Rprintf("%d %d\n", i, j);
if (x4[i] == x3[j] && x1[i] == x1[j] && x2[i] == x2[j]) {
diff[i] = value1[j] - value2[i];
break;
}
}
}
}
}
return diff;
}
/*** R
f_Rcpp(data)
*/
Put that in a .cpp file and source it.
You can do this:
data$diff <- sapply(seq_along(data$x3), function(i) {
if (!is.na(data$x4[i])){
ind <- which(data$x4[i] == data$x3 & data$x1[i] == data$x1 & data$x2[i] == data$x2)
j <- `if`(i %in% ind, i, min(ind))
data$value1[j] - data$value2[i]
} else {
NA
}
})
Beware in your code, if column $diff doesn't exist yet, doing data$diff[1] <- 100 will put all the values of the column at 100.
I receive this error when running the following code aimed at producing a quicksort function. It seems to be the first while call I make that causes the problem. Can someone tell me what I'm doing wrong?
library(Rcpp)
library(inline)
body_sortCpp <- '
NumericVector arr(x);
int n = arr.size();
double tmp;
double left = arr[0];
double right = arr[n-1];
int pivot = arr[n/2];
double i = left, j = right;
while (i <= j){
while (arr[i] <= pivot)
i++;
while (arr[j] > pivot)
j--;
if (i <= j) {
tmp = arr[i];
arr[i] = arr[j];
arr[j] = tmp;
i++;
j--;
}
}
if (left < j){
sortCpp(arr, left, j);
}
if (i < right){
sortCpp(arr, i, right);
}
return wrap( arr );
'
sortCpp <- cxxfunction( signature( x = "numeric"),
body = body_sortCpp,
include = body_sortCpp,
plugin = "Rcpp")
Your use of cxxfunction() is likely wrong:
sortCpp <- cxxfunction( signature( x = "numeric"),
body = body_sortCpp,
include = body_sortCpp,
plugin = "Rcpp")
as you supply the code twice. Remove the include= and you may be good to go.
Also consider a proper editor with indenting, and look into the Rcpp Attributes vignette as a superior alternative to cxxfunction().