Problems with Rcpp precision - c++

Question

Consider the following C++ function in R using Rcpp:
cppFunction('long double statZn_cpp(NumericVector dat, double kn) {
double n = dat.size();
// Get total sum and sum of squares; this will be the "upper sum"
// (i.e. the sum above k)
long double s_upper, s_square_upper;
// The "lower sums" (i.e. those below k)
long double s_lower, s_square_lower;
// Get lower sums
// Go to kn - 1 to prevent double-counting in main
// loop
for (int i = 0; i < kn - 1; ++i) {
s_lower += dat[i];
s_square_lower += dat[i] * dat[i];
}
// Get upper sum
for (int i = kn - 1; i < n; ++i) {
s_upper += dat[i];
s_square_upper += dat[i] * dat[i];
}
// The maximum, which will be returned
long double M = 0;
// A candidate for the new maximum, used in a loop
long double M_candidate;
// Compute the test statistic
for (int k = kn; k <= (n - kn); ++k) {
// Update s and s_square for both lower and upper
s_lower += dat[k-1];
s_square_lower += dat[k-1] * dat[k-1];
s_upper -= dat[k-1];
s_square_upper -= dat[k-1] * dat[k-1];
// Get estimate of sd for this k
long double sdk = sqrt((s_square_lower - pow(s_lower, 2.0) / k +
s_square_upper -
pow(s_upper, 2.0) / (n - k))/n);
M_candidate = abs(s_lower / k - s_upper / (n - k)) / sdk;
// Choose new maximum
if (M_candidate > M) {
M = M_candidate;
}
}
return M * sqrt(kn);
}')
Try the command statZn_cpp(1:20,4), and you will get 6.963106, which is the correct answer. Scaling should not matter; statZn_cpp(1:20*10,4) will also yield the correct answer of 6.963106. But statZn_cpp(1:20/10,4) yields the wrong answer of 6.575959, and statZn_cpp(1:20/100,4) again gives you the obviously wrong answer of 0. More to the point (and relevant to my research, which involves simulation studies), when I try statZn_cpp(rnorm(20),4), the answer is almost always 0, which is wrong.
Clearly the problem has to do with rounding errors, but I don't know where they are or how to fix them (I am brand new to C++). I've tried to expand precision as much as possible. Is there a way to fix the rounding problem? (An R wrapper function is permissible if I should be attempting what amounts to a preprocessing step, but it needs to be robust, working for general levels of precision.)
EDIT: Here is some "equivalent" R code:
statZn <- function(dat, kn = function(n) {floor(sqrt(n))}) {
n = length(dat)
return(sqrt(kn(n))*max(sapply(
floor(kn(n)):(n - floor(kn(n))), function(k)
abs(1/k*sum(dat[1:k]) -
1/(n-k)*sum(dat[(k+1):n]))/sqrt((sum((dat[1:k] -
mean(dat[1:k]))^2)+sum((dat[(k+1):n] -
mean(dat[(k+1):n]))^2))/n))))
}
Also, the R code below basically replicates the method that should be used by the C++ code. It is capable of reaching the correct answer.
n = length(dat)
s_lower = 0
s_square_lower = 0
s_upper = 0
s_square_upper = 0
for (i in 1:(kn-1)) {
s_lower = s_lower + dat[i]
s_square_lower = s_square_lower + dat[i] * dat[i]
}
for (i in kn:n) {
s_upper = s_upper + dat[i]
s_square_upper = s_square_upper + dat[i] * dat[i]
}
M = 0
for (k in kn:(n-kn)) {
s_lower = s_lower + dat[k]
s_square_lower = s_square_lower + dat[k] * dat[k]
s_upper = s_upper - dat[k]
s_square_upper = s_square_upper - dat[k] * dat[k]
sdk = sqrt((s_square_lower - (s_lower)^2/k +
s_square_upper -
(s_upper)^2/(n-k))/n)
M_candidate = sqrt(kn) * abs(s_lower / k - s_upper / (n - k)) / sdk
cat('k', k, '\n',
"s_lower", s_lower, '\n',
's_square_lower', s_square_lower, '\n',
's_upper', s_upper, '\n',
's_square_upper', s_square_upper, '\n',
'sdk', sdk, '\n',
'M_candidate', M_candidate, '\n\n')
if (M_candidate > M) {
M = M_candidate
}
}

Answer 1

1: You should not be using long double, since R represents all numeric values in the double type. Using a more precise type for intermediate calculations is extremely unlikely to provide any benefit, and is more likely to result in strange inconsistencies between platforms.
2: You're not initializing s_upper, s_square_upper, s_lower, and s_square_lower. (You actually are initializing them in the R implementation, but you forgot in the C++ implementation.)
3: Minor point, but I would replace the pow(x,2.0) calls with x*x. Although this doesn't really matter.
4: This is what fixed it for me: You need to qualify calls to C++ standard library functions with their containing namespace. IOW, std::sqrt() instead of just sqrt(), std::abs() instead of just abs(), and std::pow() instead of just pow() if you continue to use it.
cppFunction('double statZn_cpp(NumericVector dat, double kn) {
int n = dat.size();
double s_upper = 0, s_square_upper = 0; // Get total sum and sum of squares; this will be the "upper sum" (i.e. the sum above k)
double s_lower = 0, s_square_lower = 0; // The "lower sums" (i.e. those below k)
for (int i = 0; i < kn - 1; ++i) { s_lower += dat[i]; s_square_lower += dat[i] * dat[i]; } // Get lower sums; Go to kn - 1 to prevent double-counting in main
for (int i = kn - 1; i < n; ++i) { s_upper += dat[i]; s_square_upper += dat[i] * dat[i]; } // Get upper sum
double M = 0; // The maximum, which will be returned
double M_candidate; // A candidate for the new maximum, used in a loop
// Compute the test statistic
for (int k = kn; k <= (n - kn); ++k) {
// Update s and s_square for both lower and upper
s_lower += dat[k-1];
s_square_lower += dat[k-1] * dat[k-1];
s_upper -= dat[k-1];
s_square_upper -= dat[k-1] * dat[k-1];
// Get estimate of sd for this k
double sdk = std::sqrt((s_square_lower - s_lower*s_lower / k + s_square_upper - s_upper*s_upper / (n - k))/n);
M_candidate = std::abs(s_lower / k - s_upper / (n - k)) / sdk;
if (M_candidate > M) M = M_candidate; // Choose new maximum
}
return std::sqrt(kn) * M;
}');
statZn_cpp(1:20,4); ## you will get 6.963106, which is the correct answer
## [1] 6.963106
statZn_cpp(1:20*10,4); ## Scaling should not matter; will also yield the correct answer of 6.963106
## [1] 6.963106
statZn_cpp(1:20/10,4); ## yields the wrong answer of 6.575959
## [1] 6.963106
statZn_cpp(1:20/100,4); ## again gives you the obviously wrong answer of 0.
## [1] 6.963106
set.seed(1L); statZn_cpp(rnorm(20),4); ## More to the point (and relevant to my research, which involves simulation studies), the answer is almost always 0, which is wrong.
## [1] 1.270117