tests/testthat/test_oce.R

In oce: Analysis of Oceanographic Data

# vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4

# test oce.R

library(oce)

test_that("as.oce", {
    d <- data.frame(x = seq(0, 1, length.out = 20), y = seq(0, 100, length.out = 20))
    o <- as.oce(d)
    sal <- seq(30, 35, length.out = 10)
    tem <- seq(20, 10, length.out = 10)
    pre <- seq(1, 100, length.out = 10)
    ctd1 <- as.oce(list(salinity = sal, temperature = tem, pressure = pre))
    ctd2 <- as.oce(data.frame(salinity = sal, temperature = tem, pressure = pre))
    expect_equal(ctd1[["data"]], ctd2[["data"]])
    cl <- as.oce(data.frame(longitude = c(1, 2, 1), latitude = c(0, 1, 0)))
    expect_equal(cl[["longitude"]], c(1, 2, 1))
    expect_equal(cl[["latitude"]], c(0, 1, 0))
})

test_that("head_adp", {
    data(adp)
    for (n in c(3, -3)) {
        h <- head(adp, n)
        look <- head(seq_len(dim(adp[["v"]])[1]), n)
        expect_equal(h[["time"]], adp[["time"]][look])
        expect_equal(h[["v"]], adp[["v"]][look, , ])
    }
})

test_that("head_adv", {
    data(adv)
    for (n in c(3, -3)) {
        h <- head(adv, n)
        look <- head(seq_len(dim(adv[["v"]])[1]), n)
        expect_equal(h[["time"]], adv[["time"]][look])
        expect_equal(h[["v"]], adv[["v"]][look, ])
    }
})

test_that("head_argo", {
    data(argo)
    # This test is hard to read, because it is exhaustive, and the data
    # format for argo objects is tricky, with vectors, matrices, time
    # vectors that R does not regard as vectors (why?) and character
    # strings.
    for (n in c(3, -3)) {
        h <- head(argo, n)
        for (name in names(argo@metadata)) {
            if (name %in% c("direction", "juldQc", "positionQc")) {
                ## select characters in a string
                j <- head(seq_len(nchar(argo@metadata[[name]])), n)
                expect_equal(
                    h@metadata[[name]],
                    substr(argo@metadata[[name]], j[1], tail(j, 1))
                )
            } else if (name == "flags") {
                j <- head(seq_len(dim(argo@metadata$flags[[1]])[2]), n)
                for (fname in names(argo@metadata$flags)) {
                    expect_equal(h@metadata$flags[[fname]], argo@metadata$flags[[fname]][, j])
                }
            } else if (is.vector(argo@metadata[[name]])) {
                expect_equal(h@metadata[[name]], head(argo@metadata[[name]], n))
            } else if (is.matrix(argo@metadata[[name]])) {
                j <- head(seq_len(dim(argo@metadata[[name]])[2]), n)
                expect_equal(h@metadata[[name]], argo@metadata[[name]][, j])
            }
        }
        for (name in names(argo@data)) {
            if (is.vector(argo@data[[name]])) {
                expect_equal(h@data[[name]], head(argo@data[[name]], n))
            } else if (is.matrix(argo@data[[name]])) {
                j <- head(seq_len(dim(argo@data[[name]])[2]), n)
                expect_equal(h@data[[name]], argo@data[[name]][, j])
            } else if (name == "time") {
                # NB time is not a vector
                expect_equal(h@data[[name]], head(argo@data[[name]], n))
            } else {
                warning("ignoring data item: '", name, "'")
            }
        }
    }
})

test_that("head_cm", {
    data(cm)
    for (n in c(3, -3)) {
        h <- head(cm, n)
        look <- head(seq_along(cm[["time"]]), n)
        for (n in names(cm@data)) {
            expect_equal(h[[n]], cm[[n]][look])
        }
    }
})

test_that("head_coastline", {
    data(coastlineWorld)
    for (n in c(-3, 3)) {
        h <- head(coastlineWorld, n)
        expect_equal(h[["longitude"]], head(coastlineWorld[["longitude"]], n))
        expect_equal(h[["latitude"]], head(coastlineWorld[["latitude"]], n))
    }
})

test_that("head_ctd", {
    data(section)
    ctd <- section[["station", 100]]
    for (n in c(-10, 10)) {
        h <- head(ctd, n)
        for (name in names(ctd@data)) {
            expect_equal(h@data[[name]], head(ctd@data[[name]], n))
            expect_equal(h@metadata$flags[[name]], head(ctd@metadata$flags[[name]], n))
        }
    }
})

test_that("head_echosounder", {
    data(echosounder)
    for (n in c(-10, 10)) {
        h <- head(echosounder, n = n)
        look <- head(seq_len(dim(echosounder[["a"]])[1]), n)
        expect_equal(h[["depth"]], echosounder[["depth"]])
        expect_equal(h[["latitude"]], echosounder[["latitude"]][look])
        expect_equal(h[["longitude"]], echosounder[["longitude"]][look])
        expect_equal(h[["time"]], echosounder[["time"]][look])
        expect_equal(h[["a"]], echosounder[["a"]][look, ])
    }
})

ladpText <- "Filename    = processed/025/025
Date        = 2014/ 7/ 6
Start_Time  = 19: 7:12
Start_Lat   = 48°N 58.4580'
Start_Lon   =  45°W 52.3932'
Deviation   = -17.791079
Columns     = z:u:v:ev
   9.9  0.266  0.034  0.050
  19.8  0.266  0.034  0.050
  29.6  0.266  0.034  0.049
  39.5  0.240  0.056  0.032
  49.4  0.222  0.063  0.027
  59.3  0.218  0.068  0.025
  69.2  0.227  0.079  0.025
  79.0  0.217  0.092  0.023
  88.9  0.204  0.098  0.023
  98.8  0.198  0.103  0.021
 108.7  0.182  0.103  0.020
 118.6  0.172  0.083  0.020
 128.5  0.174  0.089  0.019
 138.3  0.172  0.093  0.020
 148.2  0.165  0.098  0.019"

test_that("head_ladcp", {
    dat <- read.table(text = ladpText, skip = 7, header = FALSE, col.names = c("z", "u", "v", "ev"))
    ladp <- as.ladp(
        longitude = 48 + 58.4580 / 60, latitude = -(45 + 52.3932 / 60),
        station = 25, time = as.POSIXct("2014/7/6", tz = "UTC"),
        pressure = dat$z, u = dat$u, v = dat$v
    )
    for (n in c(3, -3)) {
        t <- head(ladp, n)
        look <- head(seq_along(ladp[["pressure"]]), n)
        for (n in names(ladp@data)) {
            expect_equal(t[[n]], ladp[[n]][look])
        }
    }
})

test_that("head_lobo", {
    data(lobo)
    for (n in c(3, -3)) {
        h <- head(lobo, n)
        look <- head(seq_along(lobo[["time"]]), n)
        for (n in names(lobo@data)) {
            expect_equal(h[[n]], lobo[[n]][look])
        }
    }
})

test_that("head_rsk", {
    data(rsk)
    for (n in c(3, -3)) {
        h <- head(rsk, n)
        look <- head(seq_along(rsk[["time"]]), n)
        expect_equal(h[["time"]], rsk[["time"]][look])
        expect_equal(h[["elevation"]], rsk[["elevation"]][look])
    }
})

test_that("head_sealevel", {
    data(sealevel)
    for (n in c(3, -3)) {
        h <- head(sealevel, n)
        look <- head(seq_along(sealevel[["time"]]), n)
        expect_equal(h[["time"]], sealevel[["time"]][look])
        expect_equal(h[["elevation"]], sealevel[["elevation"]][look])
    }
})

test_that("head_section", {
    data(section)
    for (n in c(-10, 10)) {
        h <- head(section, n)
        expect_equal(h@metadata$stationId, head(section@metadata$stationId, n))
        expect_equal(h@metadata$longitude, head(section@metadata$longitude, n))
        expect_equal(h@metadata$latitude, head(section@metadata$latitude, n))
        expect_equal(h@metadata$time, head(section@metadata$time, n))
        expect_equal(h@data$station, head(section@data$station, n))
    }
})

if (requireNamespace("ocedata", quietly = TRUE)) {
    test_that("oceApprox", {
        # Test for same values after rewriting the C code in C++.
        d <- data.frame(x = seq(0, 1, length.out = 20), y = seq(0, 100, length.out = 20))
        da <- oceApprox(d$x, d$y, c(0.4, 0.5, 0.6))
        expect_equal(da, c(40, 50, 60))
        data(RRprofile, package = "ocedata")
        zz <- seq(0, 2000, 2)
        a1 <- oce.approx(RRprofile$depth, RRprofile$temperature, zz, "rr")
        a2 <- oce.approx(RRprofile$depth, RRprofile$temperature, zz, "unesco")
        expect_equal(head(a1), c(2.95, 2.95, 2.95, 2.95, 2.95, 2.95))
        expect_equal(tail(a1), c(
            3.491641285, 3.490851919, 3.490063336,
            3.489275206, 3.488487181, 3.487698885
        ))
        expect_equal(head(a2), c(2.95, 2.95, 2.95, 2.95, 2.95, 2.95))
        expect_equal(tail(a2), c(
            3.517629418, 3.516250649, 3.514868001,
            3.513481474, 3.512091068, 3.487698885
        ))
    })
}

test_that("tail_adp", {
    data(adp)
    for (n in c(3, -3)) {
        t <- head(adp, n)
        look <- head(seq_len(dim(adp[["v"]])[1]), n)
        expect_equal(t[["time"]], adp[["time"]][look])
        expect_equal(t[["v"]], adp[["v"]][look, , ])
    }
})

test_that("tail_adv", {
    data(adv)
    for (n in c(3, -3)) {
        h <- head(adv, n)
        look <- head(seq_len(dim(adv[["v"]])[1]), n)
        expect_equal(h[["time"]], adv[["time"]][look])
        expect_equal(h[["v"]], adv[["v"]][look, ])
    }
})

test_that("tail_argo", {
    data(argo)
    ## This test is hard to read, because it is exhaustive, and the data
    ## format for argo objects is tricky, with vectors, matrices, time
    ## vectors that R does not regard as vectors (why?) and character
    ## strings.
    for (n in c(3, -3)) {
        t <- tail(argo, n)
        for (name in names(argo@metadata)) {
            if (name %in% c("direction", "juldQc", "positionQc")) {
                ## select characters in a string
                j <- tail(seq_len(nchar(argo@metadata[[name]])), n)
                expect_equal(
                    t@metadata[[name]],
                    substr(argo@metadata[[name]], j[1], tail(j, 1))
                )
            } else if (name == "flags") {
                j <- tail(seq_len(dim(argo@metadata$flags[[1]])[2]), n)
                for (fname in names(argo@metadata$flags)) {
                    expect_equal(t@metadata$flags[[fname]], argo@metadata$flags[[fname]][, j])
                }
            } else if (is.vector(argo@metadata[[name]])) {
                expect_equal(t@metadata[[name]], tail(argo@metadata[[name]], n))
            } else if (is.matrix(argo@metadata[[name]])) {
                j <- tail(seq_len(dim(argo@metadata[[name]])[2]), n)
                expect_equal(t@metadata[[name]], argo@metadata[[name]][, j])
            }
        }
        for (name in names(argo@data)) {
            if (is.vector(argo@data[[name]])) {
                expect_equal(t@data[[name]], tail(argo@data[[name]], n))
            } else if (is.matrix(argo@data[[name]])) {
                j <- tail(seq_len(dim(argo@data[[name]])[2]), n)
                expect_equal(t@data[[name]], argo@data[[name]][, j])
            } else if (name == "time") {
                ## for reasons unknown, time is not a vector
                expect_equal(t@data[[name]], tail(argo@data[[name]], n))
            } else {
                warning("ignoring data item: '", name, "'")
            }
        }
    }
})

test_that("tail_cm", {
    data(cm)
    for (n in c(3, -3)) {
        t <- tail(cm, n)
        look <- tail(seq_along(cm[["time"]]), n)
        for (n in names(cm@data)) {
            expect_equal(t[[n]], cm[[n]][look])
        }
    }
})

test_that("tail_coastline", {
    data(coastlineWorld)
    for (n in c(-3, 3)) {
        t <- tail(coastlineWorld, n)
        expect_equal(t[["longitude"]], tail(coastlineWorld[["longitude"]], n))
        expect_equal(t[["latitude"]], tail(coastlineWorld[["latitude"]], n))
    }
})

test_that("tail_ctd", {
    data(section)
    ctd <- section[["station", 100]]
    for (n in c(-10, 10)) {
        t <- tail(ctd, n)
        for (name in names(ctd@data)) {
            expect_equal(t@data[[name]], tail(ctd@data[[name]], n))
            expect_equal(t@metadata$flags[[name]], tail(ctd@metadata$flags[[name]], n))
        }
    }
})

test_that("tail_echosounder", {
    data(echosounder)
    for (n in c(-10, 10)) {
        t <- tail(echosounder, n = n)
        look <- tail(seq_len(dim(echosounder[["a"]])[1]), n)
        expect_equal(t[["depth"]], echosounder[["depth"]])
        expect_equal(t[["latitude"]], echosounder[["latitude"]][look])
        expect_equal(t[["longitude"]], echosounder[["longitude"]][look])
        expect_equal(t[["time"]], echosounder[["time"]][look])
        expect_equal(t[["a"]], echosounder[["a"]][look, ])
    }
})

test_that("tail_ladcp", {
    dat <- read.table(text = ladpText, skip = 7, header = FALSE, col.names = c("z", "u", "v", "ev"))
    ladp <- as.ladp(
        longitude = 48 + 58.4580 / 60, latitude = -(45 + 52.3932 / 60),
        station = 25, time = as.POSIXct("2014/ 7/ 6", tz = "UTC"),
        pressure = dat$z, u = dat$u, v = dat$v
    )
    for (n in c(3, -3)) {
        t <- tail(ladp, n)
        look <- tail(seq_along(ladp[["pressure"]]), n)
        for (n in names(ladp@data)) {
            expect_equal(t[[n]], ladp[[n]][look])
        }
    }
})

test_that("tail_lobo", {
    data(lobo)
    for (n in c(3, -3)) {
        t <- tail(lobo, n)
        look <- tail(seq_along(lobo[["time"]]), n)
        for (n in names(lobo@data)) {
            expect_equal(t[[n]], lobo[[n]][look])
        }
    }
})

test_that("tail_rsk", {
    data(rsk)
    for (n in c(3, -3)) {
        t <- tail(rsk, n)
        look <- tail(seq_along(rsk[["time"]]), n)
        expect_equal(t[["time"]], rsk[["time"]][look])
        expect_equal(t[["elevation"]], rsk[["elevation"]][look])
    }
})

test_that("tail_sealevel", {
    data(sealevel)
    for (n in c(3, -3)) {
        t <- tail(sealevel, n)
        look <- tail(seq_along(sealevel[["time"]]), n)
        expect_equal(t[["time"]], sealevel[["time"]][look])
        expect_equal(t[["elevation"]], sealevel[["elevation"]][look])
    }
})

test_that("tail_section", {
    data(section)
    for (n in c(-10, 10)) {
        t <- tail(section, n)
        expect_equal(t@metadata$stationId, tail(section@metadata$stationId, n))
        expect_equal(t@metadata$longitude, tail(section@metadata$longitude, n))
        expect_equal(t@metadata$latitude, tail(section@metadata$latitude, n))
        expect_equal(t@metadata$time, tail(section@metadata$time, n))
        expect_equal(t@data$station, tail(section@data$station, n))
    }
})

test_that("trim_ts", {
    x <- seq(0, 10, 0.1)
    xlim <- c(2.0, 2.9)
    expect_equal(oce:::trimTs(x, xlim, 0), list(from = 20, to = 31))
})

test_that("concatenate adp", {
    data(adp)
    t0 <- median(adp[["time"]])
    a <- subset(adp, time <= t0)
    b <- subset(adp, time > t0)
    ab <- concatenate(a, b)
    for (n in c("time", "v", "a", "distance")) {
        expect_equal(ab[[n]], adp[[n]])
    }
})

test_that("concatenate adv", {
    data(adv)
    t0 <- median(adv[["time"]])
    a <- subset(adv, time <= t0)
    b <- subset(adv, time > t0)
    ab <- concatenate(a, b)
    for (n in c("time", "v", "a", "distance")) {
        expect_equal(ab[[n]], adv[[n]])
    }
})

test_that("concatenate ctd", {
    data(ctd)
    scan0 <- median(ctd[["scan"]])
    a <- subset(ctd, scan <= scan0)
    b <- subset(ctd, scan > scan0)
    ab <- concatenate(a, b)
    for (n in c("scan", "pressure", "salinity", "temperature")) {
        expect_equal(ab[[n]], ctd[[n]])
    }
})

test_that("times", {
    jd <- julianDay(as.POSIXct("2018-07-01 12:00:00", tz = "UTC"))
    t <- numberAsPOSIXct(cbind(jd, 1e3 * 1 * 3600), type = "epic", tz = "UTC")
    expect_equal(t, as.POSIXct("2018-07-01 01:00:00", tz = "UTC"))
})