context("Derivate internals")
test_derv <- function(y, cyclical = FALSE, fill = FALSE, equispaced = TRUE) {
y <- sort(y)
x <- sin(y)
dx <- cos(y)
ddx <- -sin(y)
dx_num <- .derv(x, y, cyclical = cyclical, fill = fill,
equispaced = equispaced)
nas <- 2*(!fill) * (!cyclical)
expect_numeric(dx_num)
expect_equal(sum(is.na(dx_num)), nas)
expect_true(sd(dx_num - dx, na.rm = TRUE) < 0.0001)
ddx_num <- .derv(x, y, 2, cyclical = cyclical, fill = fill,
equispaced = equispaced)
nas <- nas*2
expect_numeric(ddx_num)
expect_equal(sum(is.na(ddx_num)), nas)
expect_true(sd(ddx_num - ddx, na.rm = TRUE) < 0.01)
ddx2_num <- .derv(dx_num, y, 1, cyclical = cyclical, fill = fill,
equispaced = equispaced)
expect_equal(sum(ddx_num - ddx2_num, na.rm = TRUE), 0)
}
test_that("Works with equal grid", {
y <- seq(0, 2*pi, length.out = 500)[-1]
test_derv(y)
test_derv(y, fill = TRUE)
test_derv(y, cyclical = TRUE)
expect_error(.derv(x, y, cyclical = TRUE, equispaced = FALSE))
})
test_that("Works with unequal grid", {
y <- runif(500, 0, 2*pi)
test_derv(y)
test_derv(y, fill = TRUE)
expect_error(.derv(x, y, cyclical = TRUE))
})
context("Derivate interface")
test_that("Derivative works", {
expect_equal({
x <- 1:10
y <- 1:10
Derivate(x ~ y, cyclical = FALSE)[[1]][2]
}, 1)
expect_equal({
x <- 1:10
y <- x^2
Derivate(y ~ x, order = 2, fill = TRUE, cyclical = FALSE)[[1]][2]
}, 2)
expect_equal({
data <- data.frame(x = 1:10, y = 1:10)
Derivate(x ~ y, data = data, cyclical = FALSE)[[1]][2]
}, 1)
})
test_that("Derivative fills edges", {
expect_equal({
x <- 1:10
y <- x^3
is.na(Derivate(y ~ x, order = 3, cyclical = FALSE, fill = TRUE)[[1]][1])
}, FALSE)
})
test_that("Derivative checks boundary conditions", {
expect_error({
x <- 1:10
y <- 1:10
z <- 1:10
Derivate(x ~ y + z + x, cyclical = c(TRUE, FALSE))
})
})
test_that("Derivative uses spherical coords", {
expect_equal(Derivate(gh ~ lon + lat, data = geopotential[date == date[1]],
sphere = TRUE),
{
g <- Derivate(gh ~ lon + lat, data = geopotential[date == date[1]])
g[[1]] <- g[[1]]*180/pi/(6371000*cos(geopotential[date == date[1]]$lat*pi/180))
g[[2]] <- g[[2]]*180/pi/6371000
g
})
})
test_that("Divergence returns divergence", {
expect_equal({
grid <- expand.grid(x = 1:10, y = 1:10)
grid$v <- rnorm(100)
grid$u <- rnorm(100)
Divergence(u + v ~ x + y, data = grid)
},
{
d <- Derivate(u + v ~ x + y, data = grid)
d$u.dx + d$v.dy})
})
test_that("Laplacian returns laplacian", {
expect_equal({
grid <- expand.grid(x = 1:10, y = 1:10)
grid$v <- rnorm(100)
grid$u <- rnorm(100)
Laplacian(u + v ~ x + y, data = grid)$u.lap
},
{
d <- Derivate(u + v ~ x + y, data = grid, order = 2)
d$u.ddx + d$u.ddy})
})
test_that("Vorticity returns vorticidy", {
expect_equal({
grid <- expand.grid(x = 1:10, y = 1:10)
grid$v <- rnorm(100)
grid$u <- rnorm(100)
Vorticity(u + v ~ x + y, data = grid)
},
{
d <- Derivate(u + v ~ x + y, data = grid)
d$v.dx - d$u.dy
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.