Kolomogorov-Smirnov test: C to R translation issue

Question

I am having difficulty translating an algorithm from C to R. It's about Kolmogorov Smirnov test, and more specifically the KS probability function

In 'Numerical Recipes in C', 'probks', it's coded as

#include <math.h>
#define EPS1 0.001
#define EPS2 1.0e-8
float probks(float alam)
/*Kolmogorov-Smirnov probability function.*/
{
   int j;
   float a2,fac=2.0,sum=0.0,term,termbf=0.0;

   a2 = -2.0*alam*alam;
   for (j=1;j<=100;j++) {
      term=fac*exp(a2*j*j);
      sum += term;
      if (fabs(term) <= EPS1*termbf || fabs(term) <= EPS2*sum) return sum;
      fac = -fac; /*Alternating signs in sum.*/
      termbf=fabs(term);
   }
   return 1.0; /* Get here only by failing to converge. */
}

I don't know how to handle the translation in R of the few last lines, all I have nowe is

PROBKS <- function(lambda) {

  EPS1 <- 0.001; EPS2 <- 1.0e-8;
  sum <- 0.0; fac <- 2.0; termbf <- 0.0; 
  a2 <- -2*lambda*lambda 

  for (j in 1:100) {
    term <- fac * exp(a2*j*j)
    sum <- sum + term
    if ( (abs(term) <= EPS1*termbf) || (abs(term) <= EPS2*sum) ) {
      break
    } else {
      fac <- -fac
    }
  }
  termbf <- abs(term)
  return(sum)
}

but this produces a non-monotonic probability function

where it should be $Q_KS(0) = 1$ and $Q_KS(\infty) = 0$. Obviously, it's about how to interpret/encode the last 'if' statement.

Any help would be very appreciated. M

EDIT 1: Here my session info

> sessionInfo()
R version 3.4.4 (2018-03-15)
Platform: i386-w64-mingw32/i386 (32-bit)
Running under: Windows >= 8 x64 (build 9200)

Matrix products: default

locale:
[1] LC_COLLATE=English_United Kingdom.1252 
[2] LC_CTYPE=English_United Kingdom.1252   
[3] LC_MONETARY=English_United Kingdom.1252
[4] LC_NUMERIC=C                           
[5] LC_TIME=English_United Kingdom.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] reshape2_1.4.3  forcats_0.3.0   stringr_1.3.1   dplyr_0.7.7    
 [5] purrr_0.2.5     readr_1.1.1     tidyr_0.8.1     tibble_1.4.2   
 [9] ggplot2_3.1.0   tidyverse_1.2.1

loaded via a namespace (and not attached):
 [1] withr_2.1.2      rvest_0.3.2      tidyselect_0.2.5 lattice_0.20-35 
 [5] pkgconfig_2.0.2  xml2_1.2.0       compiler_3.4.4   readxl_1.1.0    
 [9] Rcpp_0.12.19     cli_1.0.1        plyr_1.8.4       cellranger_1.1.0
[13] httr_1.3.1       tools_3.4.4      nlme_3.1-131.1   broom_0.5.0     
[17] R6_2.3.0         bindrcpp_0.2.2   bindr_0.1.1      scales_1.0.0    
[21] assertthat_0.2.0 gtable_0.2.0     stringi_1.1.7    rstudioapi_0.8  
[25] backports_1.1.2  hms_0.4.2        munsell_0.5.0    grid_3.4.4      
[29] colorspace_1.3-2 glue_1.3.0       lubridate_1.7.4  rlang_0.3.0.1   
[33] magrittr_1.5     lazyeval_0.2.1   yaml_2.2.0       crayon_1.3.4    
[37] haven_1.1.2      modelr_0.1.2     pillar_1.3.0     jsonlite_1.5    

EDIT 2 Using Konrad's function ks_cdf and

x = seq(0, 1, by = 0.01)
plot(x, ks_cdf(x))

still gives 0 at 0

EDIT 3 After upgrading to 3.6.1

> sessionInfo()
R version 3.6.1 (2019-07-05)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)
...

I still get the same plot as above, i.e. ks_cdf(0)=0 while it should be ks_sdf(0)=1

Answer 1

The code can be translated into R almost literally — it’s not clear why you diverged from the C code without reason. Here’s a literal, slightly cleaned up translation:

ks_cdf = function (lambda) {
  EPS1 = 0.001
  EPS2 = 1.0e-8
  sum = 0
  fac = 2
  termbf = 0
  a2 = -2 * lambda ^ 2

  for (j in 1 : 100) {
    term = fac * exp(a2 * j ^ 2)
    sum = sum + term
    if ((abs(term) <= EPS1 * termbf) || (abs(term) <= EPS2 * sum)) {
      return(sum)
    } else {
      fac = -fac
      termbf = abs(term)
    }
  }
  1 # Failed to converge.
}

This code works but isn’t vectorised, which is something I’d change for a real implementation (but, by doing so, we’d lose the early exit).

Here’s an idiomatic R implementation using vectorised arithmetic and matrix multiplication:

ks_cdf = function (λ) {
  eps1 = 0.001
  eps2 = 1E-8

  range = seq(1, 100)
  terms = (-1) ^ (range - 1) * exp(-2 * range ^ 2 %*% t(λ ^ 2))
  sums = 2 * colSums(terms)
  pterms = abs(terms)
  prev_pterms = rbind(0, pterms[-nrow(pterms), , drop = FALSE])
  converged = apply(pterms <= eps1 * prev_pterms | pterms <= eps2 * sums, 2L, any)
  sums[! converged] = 1
  sums
}

And to show how nicely it vectorises, and that this is in fact a big deal:

x = seq(0, 1, by = 0.01)
plot(x, ks_cdf(x))