# tests/testthat/test_Cddist.R In circmax: Circular Regression with Maximum Likelihood Estimation and Regression Trees

```context("C routines for ddist")

## Small helper function
compare_times <- function(t_R, t_C, label = "R vs C", output = c("text", "numeric")) {
output <- match.arg(output)
t_R <- as.numeric(t_R[3L], units = "secs")
t_C <- as.numeric(t_C[3L], units = "secs")
inc <- 100 * (t_R/t_C - 1);
if(output == "text"){
cat(sprintf("\nTiming for \"%s\"\n", label))
cat(sprintf("   R:  %10.5f sek   C: %10.5f sek   (%4.1f percent %s)\n",
t_R, t_C, inc, ifelse(inc < 0, "slower in C", "faster in C")))
} else {
inc
}
}

dR <-  dist_vonmises(useC = FALSE, ncores = 1)
dC <-  dist_vonmises(useC = TRUE, ncores = 1)
dC2 <- dist_vonmises(useC = TRUE, ncores = 2)
dC5 <- dist_vonmises(useC = TRUE, ncores = 5)

## Test results
set.seed(111)
eta <- c(tan(0.8/2), log(0.8))
n <- 1000000
y <- rnorm(n)

dR_out <- dR\$ddist(y, eta)
dC_out <- dC\$ddist(y, eta)
C2_out <- dC2\$ddist(y, eta)
C5_out <- dC5\$ddist(y, eta)

test_that("scores (sum = FALSE) are the same", {
expect_equal(
dR_out,
dC_out,
tolerance = 1e-6
)
expect_equal(
dC_out,
C2_out,
tolerance = 1e-6
)
expect_equal(
C2_out,
C5_out,
tolerance = 1e-6
)
})

dR_out <- dR\$ddist(y, eta, sum = TRUE)
dC_out <- dC\$ddist(y, eta, sum = TRUE)
C2_out <- dC2\$ddist(y, eta, sum = TRUE)
C5_out <- dC5\$ddist(y, eta, sum = TRUE)

test_that("scores (sum = TRUE) are the same", {
expect_equal(
dR_out,
dC_out,
tolerance = 1e-6
)
expect_equal(
dC_out,
C2_out,
tolerance = 1e-6
)
expect_equal(
C2_out,
C5_out,
tolerance = 1e-6
)
})

dR_out <- dR\$ddist(y, eta, log = FALSE)
dC_out <- dC\$ddist(y, eta, log = FALSE)
C2_out <- dC2\$ddist(y, eta, log = FALSE)
C5_out <- dC5\$ddist(y, eta, log = FALSE)

test_that("scores (sum = TRUE) are the same", {
expect_equal(
dR_out,
dC_out,
tolerance = 1e-6
)
expect_equal(
dC_out,
C2_out,
tolerance = 1e-6
)
expect_equal(
C2_out,
C5_out,
tolerance = 1e-6
)
})

## Test performance
t_R  <- system.time(dR\$ddist(y, eta))
t_C  <- system.time(dC\$ddist(y, eta))
t_C2 <- system.time(dC2\$ddist(y, eta))
t_C5 <- system.time(dC5\$ddist(y, eta))

test_that("time for c-routines are faster", {
expect_true(compare_times(t_R, t_C, output = "numeric") > -20)
expect_true(compare_times(t_R, t_C2, output = "numeric") > -20)
expect_true(compare_times(t_R, t_C5, output = "numeric") > -20)
})

#compare_times(t_R, t_C, "ddist one core")
#compare_times(t_R, t_C2, "ddist 2 cores")
#compare_times(t_R, t_C5, "ddist 5 cores")
```

## Try the circmax package in your browser

Any scripts or data that you put into this service are public.

circmax documentation built on May 2, 2019, 5:16 p.m.