tests/testthat/test-derivate.R

In eliocamp/metR: Tools for Easier Analysis of Meteorological Fields

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
    })
})