Nothing
# 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"))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.