diff --git a/.Rbuildignore b/.Rbuildignore index 05eea9c..26c174d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,4 +9,7 @@ ^docs$ ^README\.md$ ^_pkgdown.yml$ - +^.lintr$ +^check_package.R$ +^codemeta\.json$ +^revdep$ diff --git a/.gitignore b/.gitignore index 5435d34..0965bdb 100644 --- a/.gitignore +++ b/.gitignore @@ -51,3 +51,4 @@ rsconnect/ *.txt *~ *.cdl +^revdep$ diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..a9cda7d --- /dev/null +++ b/.lintr @@ -0,0 +1,9 @@ +linters:linters_with_defaults( + indentation_linter=NULL, + line_length_linter(150), + object_name_linter=NULL, + infix_spaces_linter=NULL, + brace_linter=NULL, + commented_code_linter=NULL, + object_length_linter(length=40L), + cyclocomp_linter(complexity_limit=400L)) diff --git a/DESCRIPTION b/DESCRIPTION index ef4ba6d..dd69251 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,19 +1,22 @@ Package: ocencdf -Title: Provide Netcdf Interface for Oce -Version: 0.0.3 +Title: NetCDF Interface for Oce Objects +Version: 0.0.4 Authors@R: c( - person(given="Dan", family="Kelley", email="Dan.Kelley@Dal.Ca", role=c("aut", "cre"), comment=c(ORCID="https://orcid.org/0000-0001-7808-5911"))) -Description: This provides a way to export `oce` objects to `netcdf` format, perhaps for data archiving, or perhaps for secondary analysis outside R. + person(given="Dan", family="Kelley", email="Dan.Kelley@Dal.Ca", role=c("aut", "cre"), comment=c(ORCID="https://orcid.org/0000-0001-7808-5911")), + person(given="Clark", family="Richards", email="clark.richards@gmail.com", role=c("ctb"), comment=c(ORCID="https://orcid.org/0000-0002-7833-206X"))) +Description: This provides a way to export `oce` objects to `NetCDF` format, perhaps for data archiving, or perhaps for secondary analysis outside R. Depends: R (>= 4.00), oce (>= 1.8.0) Imports: jsonlite, ncdf4, methods, yaml License: GPL (>= 2) Encoding: UTF-8 +URL: https://dankelley.github.io/ocencdf/ Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: knitr, rmarkdown, testthat (>= 3.0.0) +BugReports: https://github.com/dankelley/ocencdf/issues Config/testthat/edition: 3 BuildVignettes: true VignetteBuilder: knitr diff --git a/NEWS.md b/NEWS.md index 33bd8a6..92838f6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# ocencdf 0.0.4 + +* Specify `force_v4` in all conversions to NetCDF, which permits the handling + of large files. + # ocencdf 0.0.3 * Handle ADV data with `adv2ncdf()` and `ncdf2adv()`. diff --git a/R/adp.R b/R/adp.R index 9e655c0..7cc7ed9 100644 --- a/R/adp.R +++ b/R/adp.R @@ -1,7 +1,7 @@ -#' Save an adp object to a netcdf file +#' Save an ADP object to a NetCDF file #' #' Given an `adp` object created by the `oce` package, this function -#' creates a netcdf file that can later by read by [ncdf2adp()] to approximately +#' creates a NetCDF file that can later by read by [ncdf2adp()] to approximately #' reproduce the original contents. #' #' Note that [adp2ncdf()] defaults `varTable` to `"adp"`. @@ -21,97 +21,103 @@ #' and #' `"oceCoordinate"`. #' -#' @param x an oce object of class `adp`, as created by e.g. [oce::read.adp()]. +#' @param x an `oce` object of class `adp`, as created by e.g. [oce::read.adp()]. #' #' @inheritParams oce2ncdf #' #' @examples #' library(ocencdf) #' -#' # Example with an adp file from oce package -#' data(adp, package="oce") +#' # Example with an ADP file from `oce` package +#' data(adp, package = "oce") #' summary(adp) #' plot(adp) -#' # Transfer to netcdf and back to see if results make sense -#' oce2ncdf(adp, ncfile="adp.nc") -#' ADP <- ncdf2adp("adp.nc") +#' # Transfer to NetCDF and back to see if results make sense. +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "adp", fileext = ".nc") +#' oce2ncdf(adp, ncfile = ncfile) +#' ADP <- ncdf2adp(ncfile) #' summary(ADP) #' plot(ADP) -#' -#' # Remove temporary file -#' file.remove("adp.nc") +#' file.remove(ncfile) #' #' @family things related to adp data #' #' @author Dan Kelley and Clark Richards #' #' @export -adp2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) -{ +adp2ncdf <- function(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) { dmsg(debug, "adp2ncdf(..., ncfile=\"", ncfile, "\") {\n") - if (!inherits(x, "adp")) + if (!inherits(x, "adp")) { stop("'x' must be a adp object") + } if (is.null(varTable)) { varTable <- "adp" - #message("Defaulting varTable to \"", varTable, "\".") + # message("Defaulting varTable to \"", varTable, "\".") } if (is.null(ncfile)) { ncfile <- "adp.nc" - #message("Will save adp object to \"", ncfile, "\".") + # message("Will save adp object to \"", ncfile, "\".") } varTableOrig <- varTable varTable <- read.varTable(varTable) vdim <- dim(x@data$v) extant <- list() - for (item in c("v", "a", "g", "q")) + for (item in c("v", "a", "g", "q")) { extant[[item]] <- item %in% names(x@data) - if (!extant$v) + } + if (!extant$v) { stop("there is no data item named 'v', which is mandatory for an oce adp object") - #time <- ncdim_def(name="TIME", units="s", vals=as.numeric(x@data$time)) - time <- ncdim_def(name="TIME", units="", vals=seq_len(vdim[1]), create_dimvar=FALSE, - longname="seconds since 1970-01-01 UTC") - #cell <- ncdim_def(name="DISTANCE", units="m", vals=x@data$distance, longname="Distance to cell") - distance <- ncdim_def(name="DISTANCE", units="", vals=seq_len(vdim[2]), create_dimvar=FALSE, - longname="Distance to cell") - beam <- ncdim_def(name="BEAM", units="", vals=seq_len(vdim[3])) + } + # time <- ncdim_def(name="TIME", units="s", vals=as.numeric(x@data$time)) + time <- ncdim_def( + name = "TIME", units = "", vals = seq_len(vdim[1]), create_dimvar = FALSE, + longname = "seconds since 1970-01-01 UTC" + ) + # cell <- ncdim_def(name="DISTANCE", units="m", vals=x@data$distance, longname="Distance to cell") + distance <- ncdim_def( + name = "DISTANCE", units = "", vals = seq_len(vdim[2]), create_dimvar = FALSE, + longname = "Distance to cell" + ) + beam <- ncdim_def(name = "BEAM", units = "", vals = seq_len(vdim[3])) vars <- list() - FillValue <- getVarInfo("-", varTable=varTable)$FillValue + FillValue <- getVarInfo("-", varTable = varTable)$FillValue # time and distance (do they show up as n$var now?) dmsg(debug, " time (length ", vdim[1], ")\n") - vars[["time"]] <- ncvar_def(name="time", units="seconds since 1970-01-01 UTC", dim=time, prec="double") + vars[["time"]] <- ncvar_def(name = "time", units = "seconds since 1970-01-01 UTC", dim = time, prec = "double") dmsg(debug, " distance (length ", vdim[2], ")\n") - vars[["distance"]] <- ncvar_def(name="distance", units="m", dim=distance) - dmsg(debug, " Setting up variable dimensions for ", paste(vdim, collapse="x"), " arrays:\n") + vars[["distance"]] <- ncvar_def(name = "distance", units = "m", dim = distance) + dmsg(debug, " Setting up variable dimensions for ", paste(vdim, collapse = "x"), " arrays:\n") # array data dmsg(debug, " v\n") - vars[["v"]] <- ncvar_def(name="v", units="m/s", dim=list(time, distance, beam)) + vars[["v"]] <- ncvar_def(name = "v", units = "m/s", dim = list(time, distance, beam)) if (extant$a) { dmsg(debug, " a\n") - vars[["a"]] <- ncvar_def("a", units="", dim=list(time, distance, beam)) + vars[["a"]] <- ncvar_def("a", units = "", dim = list(time, distance, beam)) } if (extant$g) { dmsg(debug, " g\n") - vars[["g"]] <- ncvar_def("g", units="", dim=list(time, distance, beam)) + vars[["g"]] <- ncvar_def("g", units = "", dim = list(time, distance, beam)) } if (extant$q) { dmsg(debug, " q\n") - vars[["q"]] <- ncvar_def("q", units="", dim=list(time, distance, beam)) + vars[["q"]] <- ncvar_def("q", units = "", dim = list(time, distance, beam)) } # time-series data dmsg(debug, " Setting up dimensions for time-series vectors of length ", vdim[1], ":\n") - #cat("NEXT: names in @data:\n");print(sort(names(x@data))) + # cat("NEXT: names in @data:\n");print(sort(names(x@data))) for (item in names(x@data)) { if (item != "time" && item != "distance" && is.vector(x@data[[item]])) { dmsg(debug, " ", item, "\n") - vars[[item]] <- ncvar_def(item, units="", dim=time) + vars[[item]] <- ncvar_def(item, units = "", dim = time) } } - nc <- nc_create(ncfile, vars, force_v4=force_v4) + nc <- nc_create(ncfile, vars, force_v4 = force_v4) dmsg(debug, " Storing time and distance\n") dmsg(debug, " time\n") ncvar_put(nc, "time", as.numeric(x@data$time)) - #message("first 3 times: ", paste(x@data$time[1:3], collapse=" ")) - #message("first 3 times: ", paste(as.numeric(x@data$time)[1:3], collapse=" ")) + # message("first 3 times: ", paste(x@data$time[1:3], collapse=" ")) + # message("first 3 times: ", paste(as.numeric(x@data$time)[1:3], collapse=" ")) dmsg(debug, " distance\n") ncvar_put(nc, "distance", as.numeric(x@data[["distance"]])) dmsg(debug, " Storing arrays:\n") @@ -132,33 +138,37 @@ adp2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) dmsg(debug, " metadata_explanation\n") explanation <- paste("This file was created with adp2ncdf from the ocencdf R package,\n", "available at www.github.com/dankelley/ocencdf.\n", - readLines(system.file("extdata", "ncdf_explanation.md", package="ocencdf")), collapse="\n") + readLines(system.file("extdata", "ncdf_explanation.md", package = "ocencdf")), + collapse = "\n" + ) ncatt_put(nc, 0, "metadata_explanation", explanation) dmsg(debug, " metadata\n") ncatt_put(nc, 0, "metadata", metadata2json(x@metadata)) # Store some individual metadata items, for simple access - for (item in c("beamAngle", "frequency", - "instrumentType", "instrumentSubtype", - "numberOfBeams", "numberOfBeams", - "oceCoordinate")) { + for (item in c( + "beamAngle", "frequency", + "instrumentType", "instrumentSubtype", + "numberOfBeams", "numberOfBeams", + "oceCoordinate" + )) { dmsg(debug, " ", item, "\n") - storeNetcdfAttribute(x, item, nc, item) + storeNetCDFAttribute(x, item, nc, item) } dmsg(debug, " varTable\n") - ncatt_put(nc=nc, varid=0, attname="varTable", attval=varTableOrig) + ncatt_put(nc = nc, varid = 0, attname = "varTable", attval = varTableOrig) dmsg(debug, " class\n") - ncatt_put(nc=nc, varid=0, attname="class", attval=as.character(class(x))) + ncatt_put(nc = nc, varid = 0, attname = "class", attval = as.character(class(x))) dmsg(debug, " creator\n") - ncatt_put(nc=nc, varid=0, attname="creator", attval=paste0("ocencdf version ", packageVersion("ocencdf"))) + ncatt_put(nc = nc, varid = 0, attname = "creator", attval = paste0("ocencdf version ", packageVersion("ocencdf"))) nc_close(nc) dmsg(debug, paste0("} # adp2ncdf created file \"", ncfile, "\"\n")) } -#' Read a netcdf file and create an adp object +#' Read a NetCDF file and create an ADP object #' #' This works by calling [ncdf2oce()] and then using [class()] on #' the result to make it be of subclass `"adp"`. This is intended -#' to work with Netcdf files created with [adp2ncdf()], which embeds +#' to work with NetCDF files created with [adp2ncdf()], which embeds #' sufficient information in the file to permit [ncdf2adp()] to #' reconstruct the original adp object. See the documentation #' for [adp2ncdf()] to learn more about what it stores, and therefore @@ -173,25 +183,26 @@ adp2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) #' @examples #' library(ocencdf) #' -#' # Example with an adp file from oce package -#' data(adp, package="oce") +#' # Example with an ADP file from `oce` package +#' data(adp, package = "oce") #' summary(adp) #' plot(adp) -#' # Transfer to netcdf and back to see if results make sense -#' oce2ncdf(adp, ncfile="adp.nc") -#' ADP <- ncdf2adp("adp.nc") +#' # Transfer to NetCDF and back to see if results make sense +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "adp", fileext = ".nc") +#' oce2ncdf(adp, ncfile = ncfile) +#' ADP <- ncdf2adp(ncfile) #' summary(ADP) #' plot(ADP) +#' file.remove(ncfile) #' -#' # Remove temporary file -#' file.remove("adp.nc") +#' @family things related to adp data #' #' @author Dan Kelley #' #' @export -ncdf2adp <- function(ncfile=NULL, varTable=NULL, debug=0) -{ - adp <- ncdf2oce(ncfile=ncfile, varTable=varTable, debug=debug) +ncdf2adp <- function(ncfile = NULL, varTable = NULL, debug = 0) { + adp <- ncdf2oce(ncfile = ncfile, varTable = varTable, debug = debug) class(adp) <- "adp" adp } diff --git a/R/adv.R b/R/adv.R index 40d84a2..84ad688 100644 --- a/R/adv.R +++ b/R/adv.R @@ -1,7 +1,7 @@ -#' Save an adv object to a netcdf file +#' Save an adv object to a NetCDF file #' #' Given an `adv` object created by the `oce` package, this function -#' creates a netcdf file that can later by read by [ncdf2adv()] to approximately +#' creates a NetCDF file that can later by read by [ncdf2adv()] to approximately #' reproduce the original contents. #' #' Note that [adv2ncdf()] defaults `varTable` to `"adv"`. @@ -19,122 +19,136 @@ #' library(ocencdf) #' #' # Example with an adv file from oce package -#' data(adv, package="oce") +#' data(adv, package = "oce") #' summary(adv) #' plot(adv) -#' # Transfer to netcdf and back to see if results make sense -#' oce2ncdf(adv, ncfile="adv.nc") -#' ADV <- ncdf2adv("adv.nc") +#' # Transfer to NetCDF and back to see if results make sense +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "adv", fileext = ".nc") +#' oce2ncdf(adv, ncfile = ncfile) +#' ADV <- ncdf2adv(ncfile) #' summary(ADV) #' plot(ADV) -#' -#' # Remove temporary file -#' file.remove("adv.nc") +#' file.remove(ncfile) #' #' @family things related to adv data #' #' @author Dan Kelley and Clark Richards #' #' @export -adv2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) -{ +adv2ncdf <- function(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) { dmsg(debug, "adv2ncdf(..., ncfile=\"", ncfile, "\") {\n") - if (!inherits(x, "adv")) + if (!inherits(x, "adv")) { stop("'x' must be a adv object") + } if (is.null(varTable)) { varTable <- "adv" - #message("Defaulting varTable to \"", varTable, "\".") + # message("Defaulting varTable to \"", varTable, "\".") } if (is.null(ncfile)) { ncfile <- "adv.nc" - #message("Will save adv object to \"", ncfile, "\".") + # message("Will save adv object to \"", ncfile, "\".") } varTableOrig <- varTable varTable <- read.varTable(varTable) dataNames <- names(x@data) - if (!"v" %in% dataNames) + if (!"v" %in% dataNames) { stop("there is no data item named 'v', which is mandatory for an oce adv object") + } vdim <- dim(x@data$v) timeFastLen <- vdim[1] - dmsg(debug, " Defining overall variables:\n") + dmsg(debug, " Define dimensions:\n") dmsg(debug, " timeFastLen: ", timeFastLen, "\n") slowIndices <- grep("Slow$", dataNames) anySlow <- length(slowIndices) > 0L timeSlowLen <- if (anySlow) length(x@data[[slowIndices[1]]]) else 0 dmsg(debug, " timeSlowLen: ", timeSlowLen, "\n") - timeFast <- ncdim_def(name="TIME_FAST", units="", vals=seq_len(timeFastLen), create_dimvar=FALSE, - longname="seconds since 1970-01-01 UTC") - if (anySlow) - timeSlow <- ncdim_def(name="TIME_SLOW", units="", vals=seq_len(timeSlowLen), create_dimvar=FALSE, - longname="seconds since 1970-01-01 UTC") - beam <- ncdim_def(name="BEAM", units="", vals=seq_len(vdim[2])) + timeFast <- ncdim_def( + name = "TIME_FAST", units = "", vals = seq_len(timeFastLen), create_dimvar = FALSE, + longname = "seconds since 1970-01-01 UTC" + ) + if (anySlow) { + timeSlow <- ncdim_def( + name = "TIME_SLOW", units = "", vals = seq_len(timeSlowLen), create_dimvar = FALSE, + longname = "seconds since 1970-01-01 UTC" + ) + } + beam <- ncdim_def(name = "BEAM", units = "", vals = seq_len(vdim[2])) vars <- list() - #FIXME: use this : FillValue <- getVarInfo("-", varTable=varTable)$FillValue + # FIXME: use this : FillValue <- getVarInfo("-", varTable=varTable)$FillValue # Set up space for each item dmsg(debug, " Set up space for data items:\n") for (name in dataNames) { - dmsg(debug, " name: \"", name, "\"\n") + type <- typeNcdf(x@data[[name]]) + dmsg(debug, " ", name, " (storage type: ", type, ")\n") item <- x@data[[name]] if (is.matrix(item)) { - if (!identical(dim(item), vdim)) - stop("dimension of \"", name, "\" (", - paste(dim(item), collapse="x"), ") does not match dimension of \"v\" (", - paste(vdim, collapse="x"), ")") + if (!identical(dim(item), vdim)) { + stop( + "dimension of \"", name, "\" (", + paste(dim(item), collapse = "x"), ") does not match dimension of \"v\" (", + paste(vdim, collapse = "x"), ")" + ) + } if (identical(name, "v")) { - dmsg(debug, " a matrix storing velocity, so given units m/s\n") - vars[[name]] <- ncvar_def(name, units="m/s", dim=list(timeFast, beam)) + dmsg(debug, " a matrix holding velocity, so given units m/s\n") + vars[[name]] <- ncvar_def(name, units = "m/s", dim = list(timeFast, beam), prec = type) } else { dmsg(debug, " a matrix of unknown units\n") - vars[[name]] <- ncvar_def(name, units="", dim=list(timeFast, beam)) + vars[[name]] <- ncvar_def(name, units = "", dim = list(timeFast, beam), prec = type) } } else { - isTime <- grepl("time", name, ignore.case=TRUE) + isTime <- grepl("time", name, ignore.case = TRUE) if (length(item) == timeSlowLen) { if (isTime) { dmsg(debug, " slow time\n") - vars[[name]] <- ncvar_def(name, units="seconds since 1970-01-01 UTC", dim=list(timeSlow), prec="double") + vars[[name]] <- ncvar_def(name, units = "seconds since 1970-01-01 UTC", dim = list(timeSlow), prec = type) } else if (grepl("records", name)) { - vars[[name]] <- ncvar_def(name, units="", dim=list(timeSlow), prec="integer") dmsg(debug, " a record-count item at the slow time scale\n") + vars[[name]] <- ncvar_def(name, units = "", dim = list(timeSlow), prec = type) } else { dmsg(debug, " an item at the slow time scale\n") - vars[[name]] <- ncvar_def(name, units="", dim=list(timeSlow)) + vars[[name]] <- ncvar_def(name, units = "", dim = list(timeSlow), prec = type) } } else if (length(item) == timeFastLen) { if (isTime) { dmsg(debug, " fast time\n") - vars[[name]] <- ncvar_def(name, units="seconds since 1970-01-01 UTC", dim=list(timeFast), prec="double") + vars[[name]] <- ncvar_def(name, units = "seconds since 1970-01-01 UTC", dim = list(timeFast), prec = typeNcdf(x@data[[name]])) } else if (grepl("records", name)) { - vars[[name]] <- ncvar_def(name, units="", dim=list(timeFast), prec="integer") dmsg(debug, " a record-count item at the fast time scale\n") + vars[[name]] <- ncvar_def(name, units = "", dim = list(timeFast), prec = type) } else { dmsg(debug, " an item at the fast time scale\n") - vars[[name]] <- ncvar_def(name, units="", dim=list(timeFast)) + vars[[name]] <- ncvar_def(name, units = "", dim = list(timeFast), prec = type) } } else { - stop("item \"", name, "\" has length ", length(item), " but it should be either ", timeSlowLen, - " or ", timeFastLen) + stop( + "item \"", name, "\" has length ", length(item), " but it should be either ", timeSlowLen, + " or ", timeFastLen + ) } } } - nc <- nc_create(ncfile, vars, force_v4=force_v4) + nc <- nc_create(ncfile, vars, force_v4 = force_v4) dmsg(debug, " Storing data:\n") for (name in dataNames) { item <- x@data[[name]] dmsg(debug, " ", name, "\n") if (is.matrix(item)) { - #message(" matrix") + # message(" matrix") ncvar_put(nc, name, as.numeric(item)) } else { if (length(item) == timeSlowLen) { - #message(" slow vector") + # message(" slow vector") ncvar_put(nc, name, item) } else if (length(item) == timeFastLen) { - #message(" fast vector") + # message(" fast vector") ncvar_put(nc, name, item) } else { - stop("item \"", name, "\" has length ", length(item), " but it should be either ", timeSlowLen, - " or ", timeFastLen) + stop( + "item \"", name, "\" has length ", length(item), " but it should be either ", timeSlowLen, + " or ", timeFastLen + ) } } } @@ -142,27 +156,28 @@ adv2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) dmsg(debug, " metadata_explanation\n") explanation <- paste("This file was created with adv2ncdf from the ocencdf R package,\n", "available at www.github.com/dankelley/ocencdf.\n\n", - paste(readLines(system.file("extdata", "ncdf_explanation.md", package="ocencdf")), collapse="\n"), - collapse="\n") + paste(readLines(system.file("extdata", "ncdf_explanation.md", package = "ocencdf")), collapse = "\n"), + collapse = "\n" + ) ncatt_put(nc, 0, "metadata_explanation", explanation) dmsg(debug, " metadata\n") ncatt_put(nc, 0, "metadata", metadata2json(x@metadata)) # FIXME: perhaps store some individual metadata items, for simple access dmsg(debug, " varTable\n") - ncatt_put(nc=nc, varid=0, attname="varTable", attval=varTableOrig) + ncatt_put(nc = nc, varid = 0, attname = "varTable", attval = varTableOrig) dmsg(debug, " class\n") - ncatt_put(nc=nc, varid=0, attname="class", attval=as.character(class(x))) + ncatt_put(nc = nc, varid = 0, attname = "class", attval = as.character(class(x))) dmsg(debug, " creator\n") - ncatt_put(nc=nc, varid=0, attname="creator", attval=paste0("ocencdf version ", packageVersion("ocencdf"))) + ncatt_put(nc = nc, varid = 0, attname = "creator", attval = paste0("ocencdf version ", packageVersion("ocencdf"))) nc_close(nc) dmsg(debug, paste0("} # adv2ncdf created file \"", ncfile, "\"\n")) } -#' Read a netcdf file and create an adv object +#' Read a NetCDF file and create an adv object #' #' This works by calling [ncdf2oce()] and then using [class()] on #' the result to make it be of subclass `"adv"`. This is intended -#' to work with Netcdf files created with [adv2ncdf()], which embeds +#' to work with NetCDF files created with [adv2ncdf()], which embeds #' sufficient information in the file to permit [ncdf2adv()] to #' reconstruct the original adv object. See the documentation #' for [adv2ncdf()] to learn more about what it stores, and therefore @@ -178,34 +193,53 @@ adv2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) #' library(ocencdf) #' #' # Example with an adv file from oce package -#' data(adv, package="oce") +#' data(adv, package = "oce") #' summary(adv) #' plot(adv) -#' # Transfer to netcdf and back to see if results make sense -#' oce2ncdf(adv, ncfile="adv.nc") -#' ADV <- ncdf2adv("adv.nc") +#' # Transfer to NetCDF and back to see if results make sense +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "adv", fileext = ".nc") +#' oce2ncdf(adv, ncfile = ncfile) +#' ADV <- ncdf2adv(ncfile) #' summary(ADV) #' plot(ADV) +#' file.remove(ncfile) #' -#' # Remove temporary file -#' file.remove("adv.nc") +#' @family things related to adv data #' #' @author Dan Kelley #' #' @export -ncdf2adv <- function(ncfile=NULL, varTable=NULL, debug=0) -{ - adv <- ncdf2oce(ncfile=ncfile, varTable=varTable, debug=debug) - # Need to tailor the types of some things that were not stored properly - # in the Netcdf. I think it's clearer to do this here, as opposed to +ncdf2adv <- function(ncfile = NULL, varTable = NULL, debug = 0) { + adv <- ncdf2oce(ncfile = ncfile, varTable = varTable, debug = debug) + dataNames <- names(adv@data) + # Recast 'a' and 'q' as raw values (called byte in NetCDF) + for (item in c("a", "q")) { + if (item %in% dataNames) { + dim <- dim(adv@data[[item]]) + adv@data[[item]] <- as.raw(adv@data[[item]]) + dim(adv@data[[item]]) <- dim + } + } + # Time-related variables need to be made POSIXct. + for (item in c("time", "timeBurst", "timeSlow")) { + if (item %in% dataNames) { + adv@data[[item]] <- as.POSIXct(adv@data[[item]], tz = "UTC") + } + } + # Tailor the types of some things that were not stored properly + # in the NetCDF. I think it's clearer to do this here, as opposed to # in ncdf2oce(). mnames <- names(adv@metadata) - if ("measurementStart" %in% mnames) - adv@metadata$measurementStart <- as.POSIXct(adv@metadata$measurementStart, tz="UTC") - if ("measurementEnd" %in% mnames) - adv@metadata$measurementEnd <- as.POSIXct(adv@metadata$measurementEnd, tz="UTC") - if ("hardwareConfiguration" %in% mnames) + if ("measurementStart" %in% mnames) { + adv@metadata$measurementStart <- as.POSIXct(adv@metadata$measurementStart, tz = "UTC") + } + if ("measurementEnd" %in% mnames) { + adv@metadata$measurementEnd <- as.POSIXct(adv@metadata$measurementEnd, tz = "UTC") + } + if ("hardwareConfiguration" %in% mnames) { adv@metadata$hardwareConfiguration <- as.raw(paste0("0x", adv@metadata$hardwareConfiguration)) + } class(adv) <- "adv" adv } diff --git a/R/ctd.R b/R/ctd.R index 5148983..9be6a70 100644 --- a/R/ctd.R +++ b/R/ctd.R @@ -1,15 +1,15 @@ -#' Save a ctd object to a netcdf file +#' Save a ctd object to a NetCDF file #' -#' This creates a netcdf file in a convention that permits later reading by +#' This creates a NetCDF file in a convention that permits later reading by #' [ncdf2ctd()], and that may be convenient for other purposes as well. #' #' Note that [ctd2ncdf()] defaults `varTable` to `"argo"`. #' -#' The contents of the `data` slot of the oce object `x` are as netcdf +#' The contents of the `data` slot of the oce object `x` are as NetCDF #' data items. If flags are present in the `metadata` slot, they are #' also saved as data, with names ending in `_QC`. #' -#' In addition to storage in the netcdf data section, several attributes +#' In addition to storage in the NetCDF data section, several attributes #' are saved as well. These include units for the data, which are tied #' to the corresponding variables. The entire `metadata` slot is stored #' as a global attribute named `metadata`, so that a later call to @@ -29,84 +29,89 @@ #' library(ocencdf) #' #' # example 1: a ctd file without per-variable QC flags -#' data(ctd, package="oce") -#' oce2ncdf(ctd, ncfile="ctd.nc") -#' CTD <- as.ctd(ncdf2oce("ctd.nc")) +#' data(ctd, package = "oce") +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "ctd", fileext = ".nc") +#' oce2ncdf(ctd, ncfile = ncfile) +#' CTD <- as.ctd(ncdf2oce(ncfile)) +#' file.remove(ncfile) #' summary(CTD) #' plot(CTD) #' #' # example 2: a ctd file with per-variable QC flags -#' data(section, package="oce") +#' data(section, package = "oce") #' stn <- section[["station", 100]] -#' oce2ncdf(stn, ncfile="stn.nc") -#' STN <- as.ctd(ncdf2oce("stn.nc")) +#' # Use a temporary nc file to let package pass CRAN checks. +#' ncfile <- tempfile(pattern = "ctd", fileext = ".nc") +#' oce2ncdf(stn, ncfile = ncfile) +#' STN <- as.ctd(ncdf2oce(ncfile)) +#' file.remove(ncfile) #' summary(STN) #' plot(STN) #' -#' # Remove temporary files -#' file.remove("ctd.nc") -#' file.remove("stn.nc") -#' #' @family things related to CTD data #' #' @author Dan Kelley and Clark Richards #' #' @export -ctd2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) -{ +ctd2ncdf <- function(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) { dmsg(debug, "ctd2ncdf(..., ncfile=\"", ncfile, "\") {\n") - if (!inherits(x, "ctd")) + if (!inherits(x, "ctd")) { stop("'x' must be a ctd object") + } if (is.null(varTable)) { varTable <- "argo" - #message("Defaulting varTable to \"", varTable, "\".") + # message("Defaulting varTable to \"", varTable, "\".") } if (is.null(ncfile)) { ncfile <- "ctd.nc" - #message("Will save ctd object to \"", ncfile, "\".") + # message("Will save ctd object to \"", ncfile, "\".") } varTableOrig <- varTable varTable <- read.varTable(varTable) # Set up variable dimensions etc, using an argo file # (~/data/argo/D4901788_045.nc) as a pattern. NLEVEL <- length(x@data[[1]]) - NLEVELdim <- ncdim_def(name="N_LEVEL", units="", vals=seq_len(NLEVEL), create_dimvar=FALSE) - NPROFILEdim <- ncdim_def(name="N_PROFILE", units="", vals=1L, create_dimvar=FALSE) - STRING16dim <- ncdim_def(name="STRING16", units="", vals=seq.int(1, 16), create_dimvar=FALSE) - STRING32dim <- ncdim_def(name="STRING32", units="", vals=seq.int(1, 32), create_dimvar=FALSE) + NLEVELdim <- ncdim_def(name = "N_LEVEL", units = "", vals = seq_len(NLEVEL), create_dimvar = FALSE) + NPROFILEdim <- ncdim_def(name = "N_PROFILE", units = "", vals = 1L, create_dimvar = FALSE) + STRING16dim <- ncdim_def(name = "STRING16", units = "", vals = seq.int(1, 16), create_dimvar = FALSE) + STRING32dim <- ncdim_def(name = "STRING32", units = "", vals = seq.int(1, 32), create_dimvar = FALSE) # create vars, using varmap for known items, and using just names otherwise # TO DO: determine whether we ought to examine the units in the oce object vars <- list() standardNames <- list() # called STANDARD_NAME in argo files - dmsg(debug, " Defining netcdf structure.\n") + dmsg(debug, " Defining NetCDF structure.\n") dmsg(debug, " defining variable properties\n") for (name in names(x@data)) { dmsg(debug, " ", name, "\n") - varInfo <- getVarInfo(oce=x, name=name, varTable=varTable) + varInfo <- getVarInfo(oce = x, name = name, varTable = varTable) units <- varInfo$unit # For the "argo" case, use "psu" as a unit for salinity. - if (grepl("salinity", name) && varTable$type$name == "argo") + if (grepl("salinity", name) && varTable$type$name == "argo") { units <- "psu" + } vars[[name]] <- ncvar_def( - name=varInfo$name, - units=units, - longname=varInfo$long_name, - dim=NLEVELdim, - prec="float") + name = varInfo$name, + units = units, + longname = varInfo$long_name, + dim = NLEVELdim, + prec = "float" + ) standardNames[[name]] <- varInfo$standard_name } dmsg(debug, " defining flag (QC) properties (if any exist)\n") flagnames <- names(x@metadata$flags) for (flagname in flagnames) { - varInfo <- getVarInfo(oce=x, name=flagname, varTable=varTable) + varInfo <- getVarInfo(oce = x, name = flagname, varTable = varTable) flagnameNCDF <- paste0(varInfo$name, "_QC") dmsg(debug, " ", flagname, " -> ", flagnameNCDF, "\n") vars[[flagnameNCDF]] <- ncvar_def( - name=flagnameNCDF, - units="", - longname=paste("QC for ", flagname), - dim=NLEVELdim, - prec="float") + name = flagnameNCDF, + units = "", + longname = paste("QC for ", flagname), + dim = NLEVELdim, + prec = "float" + ) } dmsg(debug, " defining variables for selected @metadata items\n") # location may be in data or metadata. If the former, store in @@ -115,82 +120,87 @@ ctd2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) locationInMetadata <- !is.null(x@metadata$longitude) && !is.null(x@metadata$latitude) if (locationInData) { # assume one value per profile vars[["longitude"]] <- ncvar_def( - name=getVarInfo(name="longitude", varTable=varTable)$name, - units="degree_east", - longname="Longitude of the station, best estimate", - dim=NPROFILEdim, - prec="float") + name = getVarInfo(name = "longitude", varTable = varTable)$name, + units = "degree_east", + longname = "Longitude of the station, best estimate", + dim = NPROFILEdim, + prec = "float" + ) standardNames[["longitude"]] <- "longitude" dmsg(debug, " longitude\n") vars[["latitude"]] <- ncvar_def( - name=getVarInfo(name="latitude", varTable=varTable)$name, - units="degree_north", - longname="Latitude of the station, best estimate", - dim=NPROFILEdim, - prec="float") + name = getVarInfo(name = "latitude", varTable = varTable)$name, + units = "degree_north", + longname = "Latitude of the station, best estimate", + dim = NPROFILEdim, + prec = "float" + ) standardNames[["latitude"]] <- "latitude" dmsg(debug, " latitude\n") } - nc <- nc_create(ncfile, vars, force_v4=force_v4) + nc <- nc_create(ncfile, vars, force_v4 = force_v4) dmsg(debug, " Storing data.\n") for (name in names(x@data)) { dmsg(debug, " ", name, " (", NLEVEL, " values)\n") vals <- x@data[[name]] - #vals[is.na(vals)] <- varTable$values$missing_value - if (grepl("temperature", name, ignore.case=TRUE)) { + # vals[is.na(vals)] <- varTable$values$missing_value + if (grepl("temperature", name, ignore.case = TRUE)) { scale <- x[[paste0(name, "Unit")]]$scale - if (grepl("IPTS-68", scale, ignore.case=TRUE)) { + if (grepl("IPTS-68", scale, ignore.case = TRUE)) { message("Converting temperature from IPTS-68 scale to ITS-90 scale.") vals <- oce::T90fromT68(vals) - } else if (grepl("ITS-48", scale, ignore.case=TRUE)) { + } else if (grepl("ITS-48", scale, ignore.case = TRUE)) { message("Converting temperature from IPTS-48 scale to ITS-90 scale.") vals <- oce::T90fromT48(vals) } - } else if (grepl("salinity", name, ignore.case=TRUE)) { + } else if (grepl("salinity", name, ignore.case = TRUE)) { scale <- x[[paste0(name, "Unit")]]$scale - if (grepl("PSS-68", scale, ignore.case=TRUE)) { + if (grepl("PSS-68", scale, ignore.case = TRUE)) { warning("cannot convert from PSS-68, so saving it unaltered") } } - ncvar_put(nc=nc, varid=vars[[name]], vals=vals) + ncvar_put(nc = nc, varid = vars[[name]], vals = vals) sn <- standardNames[[name]] - if (!is.null(sn)) - ncatt_put(nc=nc, varid=vars[[name]], attname="standard_name", attval=sn) + if (!is.null(sn)) { + ncatt_put(nc = nc, varid = vars[[name]], attname = "standard_name", attval = sn) + } } dmsg(debug, " Storing QC values.\n") for (flagname in names(x@metadata$flags)) { - varInfo <- getVarInfo(oce=x, name=flagname, varTable=varTable) + varInfo <- getVarInfo(oce = x, name = flagname, varTable = varTable) vals <- x@metadata$flags[[flagname]] flagnameNCDF <- paste0(varInfo$name, "_QC") dmsg(debug, " ", flagname, "Flag -> ", flagnameNCDF, "\n") - ncvar_put(nc=nc, varid=vars[[flagnameNCDF]], vals=vals) + ncvar_put(nc = nc, varid = vars[[flagnameNCDF]], vals = vals) } dmsg(debug, " Storing global attributes.\n") dmsg(debug, " metadata_explanation\n") explanation <- paste("This file was created with ctd2ncdf from the ocencdf R package,\n", "available at www.github.com/dankelley/ocencdf.\n", - readLines(system.file("extdata", "ncdf_explanation.md", package="ocencdf")), collapse="\n") + readLines(system.file("extdata", "ncdf_explanation.md", package = "ocencdf")), + collapse = "\n" + ) ncatt_put(nc, 0, "metadata_explanation", explanation) dmsg(debug, " metadata\n") ncatt_put(nc, 0, "metadata", metadata2json(x@metadata)) # Store some individual metadata items, for simple access for (item in c("station", "latitude", "longitude")) { dmsg(debug, " ", item, "\n") - storeNetcdfAttribute(x, item, nc, item) + storeNetCDFAttribute(x, item, nc, item) } dmsg(debug, " varTable\n") - ncatt_put(nc=nc, varid=0, attname="varTable", attval=varTableOrig) + ncatt_put(nc = nc, varid = 0, attname = "varTable", attval = varTableOrig) dmsg(debug, " class\n") - ncatt_put(nc=nc, varid=0, attname="class", attval=as.character(class(x))) + ncatt_put(nc = nc, varid = 0, attname = "class", attval = as.character(class(x))) dmsg(debug, " creator\n") - ncatt_put(nc=nc, varid=0, attname="creator", attval=paste0("ocencdf version ", packageVersion("ocencdf"))) - dmsg(debug, " Closing netcdf file.\n") + ncatt_put(nc = nc, varid = 0, attname = "creator", attval = paste0("ocencdf version ", packageVersion("ocencdf"))) + dmsg(debug, " Closing NetCDF file.\n") nc_close(nc) dmsg(debug, paste0("} # ctd2ncdf created file \"", ncfile, "\"\n")) } -#' Read a netcdf file and create a ctd object +#' Read a NetCDF file and create a ctd object #' #' @inheritParams ncdf2oce #' @@ -204,7 +214,6 @@ ctd2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) #' @author Dan Kelley #' #' @export -ncdf2ctd <- function(ncfile=NULL, varTable=NULL, debug=0) -{ - as.ctd(ncdf2oce(ncfile=ncfile, varTable=varTable, debug=debug)) +ncdf2ctd <- function(ncfile = NULL, varTable = NULL, debug = 0) { + as.ctd(ncdf2oce(ncfile = ncfile, varTable = varTable, debug = debug)) } diff --git a/R/json.R b/R/json.R index 0b58a83..95bc398 100644 --- a/R/json.R +++ b/R/json.R @@ -28,11 +28,11 @@ #' the \dQuote{Details} section. #' #' @examples -#' # Example 1: ctd data +#' # Example 1: CTD data #' data("ctd") #' metadata2json(ctd@metadata) #' -#' # Example 2: adp data +#' # Example 2: ADP data #' data("adp") #' metadata2json(adp@metadata) #' @@ -41,8 +41,7 @@ #' @author Dan Kelley #' #' @export -metadata2json <- function(m, digits=15) -{ +metadata2json <- function(m, digits = 15) { if ("units" %in% names(m)) { for (item in names(m$units)) { m$units[[item]]$unit <- as.character(m$units[[item]]$unit) @@ -54,7 +53,7 @@ metadata2json <- function(m, digits=15) dim(Cnew) <- dim(C) m$codes <- Cnew } - jsonlite::toJSON(m, digits=digits, pretty=TRUE, raw="hex") + jsonlite::toJSON(m, digits = digits, pretty = TRUE, raw = "hex") } #' Convert a JSON string to an oce metadata slot @@ -74,14 +73,15 @@ metadata2json <- function(m, digits=15) #' @author Dan Kelley #' #' @export -json2metadata <- function(j) -{ +json2metadata <- function(j) { m <- jsonlite::fromJSON(j) - for (item in names(m$units)) - m$units[[item]]$unit <- parse(text=m$units[[item]]$unit, keep.source=FALSE) + for (item in names(m$units)) { + m$units[[item]]$unit <- parse(text = m$units[[item]]$unit, keep.source = FALSE) + } for (t in c("date", "endTime", "startTime", "systemUploadTime")) { - if (!is.null(m[[t]])) - m[[t]] <- as.POSIXct(m[[t]], tz="UTC") + if (!is.null(m[[t]])) { + m[[t]] <- as.POSIXct(m[[t]], tz = "UTC") + } } C <- m$codes if (is.matrix(m$codes)) { @@ -91,4 +91,3 @@ json2metadata <- function(j) } m } - diff --git a/R/misc.R b/R/misc.R index bb163b4..7a0809a 100644 --- a/R/misc.R +++ b/R/misc.R @@ -1,5 +1,4 @@ -makeNumeric <- function(debug, x) -{ +makeNumeric <- function(debug, x) { if (!is.numeric(x)) { if (is.array(x)) { dim <- dim(x) @@ -12,18 +11,28 @@ makeNumeric <- function(debug, x) x } -dmsg <- function(debug, ...) -{ - if (debug > 0) - cat(..., sep="") +typeNcdf <- function(x) { + Rtype <- typeof(x) + switch(Rtype, + double = "double", + integer = "integer", + raw = "byte", + character = "char" + ) } -storeNetcdfAttribute <- function(x, ocename, nc, ncname) -{ - if (missing(ncname)) +dmsg <- function(debug, ...) { + if (debug > 0) { + cat(..., sep = "") + } +} + +storeNetCDFAttribute <- function(x, ocename, nc, ncname) { + if (missing(ncname)) { ncname <- ocename + } item <- x@metadata[[ocename]] - if (!is.null(item)) + if (!is.null(item)) { ncatt_put(nc, 0, ncname, item) + } } - diff --git a/R/ncdf2oce.R b/R/ncdf2oce.R index b6aee4b..40de731 100644 --- a/R/ncdf2oce.R +++ b/R/ncdf2oce.R @@ -1,15 +1,15 @@ # See e.g. ctd.R for ncdf2ctd(). -#' Read a netcdf file and create a general oce object +#' Read a NetCDF file and create a general `oce` object #' -#' Read a netcdf file such as are created with e.g. [oce2ncdf()], +#' Read a NetCDF file such as are created with e.g. [oce2ncdf()], #' interpreting variable names according to `varTable` (if provided). -#' This is intended to work with netcdf files created by -#' [oce2ncdf()], but it may also handle some other netcdf files. +#' This is intended to work with NetCDF files created by +#' [oce2ncdf()], but it may also handle some other NetCDF files. #' (Try [oce::read.netcdf()] if this fails. If that also fails, #' you will need to work with the `ncdf4` library directly.) -#' Note that the returned object does *not* get a specialized oce class, -#' because this is not known within netcdf files. For ctd data, +#' Note that the returned object does *not* get a specialized `oce` class, +#' because this is not known within NetCDF files. For ctd data, #' try [ncdf2ctd()] instead of [ncdf2oce()], or wrap the result #' of calling the latter in [oce::as.ctd()]. #' @@ -27,14 +27,16 @@ #' @author Dan Kelley #' #' @export -ncdf2oce <- function(ncfile=NULL, varTable=NULL, debug=0) -{ - if (is.null(ncfile)) +ncdf2oce <- function(ncfile = NULL, varTable = NULL, debug = 0) { + if (is.null(ncfile)) { stop("must supply ncfile") - if (!is.character(ncfile)) + } + if (!is.character(ncfile)) { stop("ncfile must be a character value") - if (!file.exists(ncfile)) + } + if (!file.exists(ncfile)) { stop("ncfile \"", ncfile, "\" not found") + } dmsg(debug, "ncdf2oce() {\n") f <- nc_open(ncfile) res <- new("oce") @@ -42,8 +44,9 @@ ncdf2oce <- function(ncfile=NULL, varTable=NULL, debug=0) data <- list() for (name in names) { dmsg(debug, " handling \"", name, "\"\n") - if (grepl("^history_", name, ignore.case=TRUE)) + if (grepl("^history_", name, ignore.case = TRUE)) { next + } units <- ncatt_get(f, name, "units") if (units$hasatt) { res@metadata$units[[name]] <- oce::as.unit(units$value) @@ -74,19 +77,20 @@ ncdf2oce <- function(ncfile=NULL, varTable=NULL, debug=0) # metadata tmp <- ncatt_get(f, 0, "metadata") if (tmp$hasatt) { - #res@metadata <- eval(parse(text=tmp$value)) + # res@metadata <- eval(parse(text=tmp$value)) res@metadata <- json2metadata(tmp$value) dmsg(debug, " handling metadata\n") } # Update naming convention, if varTable was provided. if (!is.null(varTable)) { - names(res@data) <- ncdfNames2oceNames(names=names(res@data), varTable=varTable, debug=debug) - if ("units" %in% names(res@metadata)) - names(res@metadata$units) <- ncdfNames2oceNames(names=names(res@metadata$units), varTable=varTable, debug=debug) - if ("flags" %in% names(res@metadata)) - names(res@metadata$flags) <- ncdfNames2oceNames(names=names(res@metadata$flags), varTable=varTable, debug=debug) + names(res@data) <- ncdfNames2oceNames(names = names(res@data), varTable = varTable, debug = debug) + if ("units" %in% names(res@metadata)) { + names(res@metadata$units) <- ncdfNames2oceNames(names = names(res@metadata$units), varTable = varTable, debug = debug) + } + if ("flags" %in% names(res@metadata)) { + names(res@metadata$flags) <- ncdfNames2oceNames(names = names(res@metadata$flags), varTable = varTable, debug = debug) + } } dmsg(debug, "} # ncdf2oce()\n") res } - diff --git a/R/oce2ncdf.R b/R/oce2ncdf.R index 9c721d2..eb9604f 100644 --- a/R/oce2ncdf.R +++ b/R/oce2ncdf.R @@ -1,4 +1,4 @@ -#' Save an oce-class object as a netcdf file. +#' Save an oce-class object as a NetCDF file. #' #' `oce2ncdf()` works by determining the class of its first argument, #' and then dispatching to an internal function, as appropriate. @@ -13,12 +13,12 @@ #' for a file name to be created automatically (e.g. `ctd.nc` for #' a CTD object). #' -#' @param force_v4 logical value which controls the netCDF file version during +#' @param force_v4 logical value which controls the NetCDF file version during #' the \link[ncdf4]{nc_create} step. The default here is TRUE, whereas the -#' \link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the netCDF -#' file is compatible with netCDF v3). Some features, including large data +#' \link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the NetCDF +#' file is compatible with NetCDF v3). Some features, including large data #' sizes, may require v4. -#' +#' #' @param debug integer, 0 (the default) for quiet action apart #' from messages and warnings, or any larger value to see more #' output that describes the processing steps. @@ -32,16 +32,15 @@ #' @author Dan Kelley and Clark Richards #' #' @export -oce2ncdf <- function(x, varTable=NULL, ncfile=NULL, force_v4=TRUE, debug=0) -{ - if (!inherits(x, "oce")) +oce2ncdf <- function(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) { + if (!inherits(x, "oce")) { stop("'x' must be an oce object") + } xclass <- as.character(class(x)) switch(xclass, - ctd=ctd2ncdf(x, varTable=varTable, ncfile=ncfile, force_v4=force_v4, debug=debug), - adp=adp2ncdf(x, varTable=varTable, ncfile=ncfile, force_v4=force_v4, debug=debug), - adv=adv2ncdf(x, varTable=varTable, ncfile=ncfile, force_v4=force_v4, debug=debug), + ctd = ctd2ncdf(x, varTable = varTable, ncfile = ncfile, force_v4 = force_v4, debug = debug), + adp = adp2ncdf(x, varTable = varTable, ncfile = ncfile, force_v4 = force_v4, debug = debug), + adv = adv2ncdf(x, varTable = varTable, ncfile = ncfile, force_v4 = force_v4, debug = debug), stop("oce2ncdf() cannot handle \"", xclass, "\" objects") ) } - diff --git a/R/ocencdf.R b/R/ocencdf.R index 0f504d3..2277de5 100644 --- a/R/ocencdf.R +++ b/R/ocencdf.R @@ -1,24 +1,25 @@ # vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4 -#' ocencdf: Save oce Objects in Netcdf Files +#' ocencdf: Save `oce` Objects in NetCDF Files #' #' @description #' The ocencdf package provides functions for saving objects -#' created by the oce package into Netcdf files. +#' created by the oce package into NetCDF files. #' -#' Oce objects have two main components, named 'data' and 'metadata'. +#' Objects of the `oce` have two slots, 'data' and 'metadata', +#' that are very significant to the `ocencdf` package. #' #' The 'data' contents take the form of vector and array data, and hence can be -#' stored in the DATA section of the Netcdf file. Since these items can be -#' accessed easily by standard means of reading Netcdf files, nothing special need +#' stored in the DATA section of the NetCDF file. Since these items can be +#' accessed easily by standard means of reading NetCDF files, nothing special need #' be explained here. #' #' However, the 'metadata' contents of oce objects take the form of a tree-like -#' structure that cannot be stored in the DATA section of a Netcdf file, which is +#' structure that cannot be stored in the DATA section of a NetCDF file, which is #' designed for vectors and arrays. For this reason, the 'metadata' contents are -#' stored in a global attribute of the Netcdf file, named "metadata". It is in +#' stored in a global attribute of the NetCDF file, named "metadata". It is in #' JSON format, for ease of parsing in many languages. In R, for example, this can -#' be converted using the json2metadata() function of the 'ocencdf' package. This +#' be converted using [json2metadata()]. This #' does more than just translate, however, because JSON format lacks the ability to #' handle some R structures (notably, the 'expression' class). The following #' explains the changes that are involved in expanding the JSON contents into a @@ -39,6 +40,6 @@ #' to get the original values, a conversion will be required. #' #' @docType package -#' -#' @name ocencdf +#' @keywords internal +"_PACKAGE" NULL diff --git a/R/vartable.R b/R/vartable.R index 6886e40..26a8505 100644 --- a/R/vartable.R +++ b/R/vartable.R @@ -2,7 +2,7 @@ #' #' This function, meant for internal use by the package, uses #' [yaml::yaml.load_file()] to read YAML files that describe the -#' output netcdf format created by e.g. [ctd2ncdf()]. Users wishing +#' output NetCDF format created by e.g. [ctd2ncdf()]. Users wishing #' to define such files for their own use should follow the pattern #' of the source directory `inst/extdata/argo.yml`. #' @@ -16,7 +16,7 @@ #' 3. Otherwise, `".yml"` is appended to `varTable` and a file with that #' name is sought in the `inst/ext_data` source directory. #' At the moment, there are two such built-in files, named -#' `"argo.yml"` and `"whp.yml". +#' `"argo.yml"` and `"whp.yml"`. #' #' @param varTable character value indicating the name of the table #' (see \sQuote{Details}). @@ -24,7 +24,7 @@ #' @template debugTemplate #' #' @return [read.varTable()] returns a list that specifies some information -#' to be stored in netcdf files created by e.g. [ctd2ncdf()]. +#' to be stored in NetCDF files created by e.g. [ctd2ncdf()]. #' #' @examples #' library(ocencdf) @@ -33,21 +33,26 @@ #' @export #' #' @author Dan Kelley -read.varTable <- function(varTable="argo", debug=0) -{ - if (!is.character(varTable)) +read.varTable <- function(varTable = "argo", debug = 0) { + if (!is.character(varTable)) { stop("varTable must be a character value") - if (varTable == "-") - return(list(name=NULL, units=NULL, values=NULL, variables=NULL)) - if (!is.numeric(debug)) + } + if (varTable == "-") { + return(list(name = NULL, units = NULL, values = NULL, variables = NULL)) + } + if (!is.numeric(debug)) { stop("debug must be a numeric value, but is ", debug) + } varTableOrig <- varTable - if (!grepl(".yml$", varTable)) - varTable <- system.file("extdata", paste0(varTable, ".yml"), package="ocencdf") - if (nchar(varTable) < 1L) - stop("file there is no \"", varTableOrig, ".yml\" file in ", system.file(package="ocencdf")) - if (!file.exists(varTable)) + if (!grepl(".yml$", varTable)) { + varTable <- system.file("extdata", paste0(varTable, ".yml"), package = "ocencdf") + } + if (nchar(varTable) < 1L) { + stop("file there is no \"", varTableOrig, ".yml\" file in ", system.file(package = "ocencdf")) + } + if (!file.exists(varTable)) { stop("file \"", varTableOrig, "\" does not exist") + } dmsg(debug, "read.varTable(\"", varTable, "\") {\n") rval <- yaml::yaml.load_file(varTable) # Fill in empty units and longnames with defaults that at least permit @@ -59,14 +64,17 @@ read.varTable <- function(varTable="argo", debug=0) for (i in seq_along(variableNames)) { name <- variableNames[i] dmsg(debug, " handling \"", name, "\"\n") - #if (is.null(rval$variables[[i]]$units)) + # if (is.null(rval$variables[[i]]$units)) # rval$variables[[i]]$units <- "" - if (is.null(rval$variables[[i]]$long_name)) + if (is.null(rval$variables[[i]]$long_name)) { rval$variables[[i]]$long_name <- name - if (is.null(rval$variables[[i]]$standard_name)) + } + if (is.null(rval$variables[[i]]$standard_name)) { rval$variables[[i]]$standard_name <- name - if (is.null(rval$variables[[i]]$missing_value)) + } + if (is.null(rval$variables[[i]]$missing_value)) { rval$variables[[i]]$missing_value <- 99999.0 + } } dmsg(debug, "} # read.varTable()\n") rval @@ -75,7 +83,7 @@ read.varTable <- function(varTable="argo", debug=0) #' Get information on a variable, using varTable #' #' This is used by e.g. [ctd2ncdf()] to determine how to describe the variable in a -#' particular flavour of netcdf file, as specified by [read.varTable()]. +#' particular flavour of NetCDF file, as specified by [read.varTable()]. #' #' @param name character value naming the variable. If `name` is #' not the name of a chemical species, then trailing digits are removed, @@ -95,8 +103,8 @@ read.varTable <- function(varTable="argo", debug=0) #' @template debugTemplate #' #' @return [getVarInfo()] returns a list containing `name` (the -#' name as used in argo netcdf files), `long_name` (again, as used in -#' Argo netcdf files, although the usefulness of this is debatable), +#' name as used in Argo NetCDF files), `long_name` (again, as used in +#' Argo NetCDF files, although the usefulness of this is debatable), #' `standard_name` (not used by [ctd2ncdf()] as of now), `FillValue` #' (used by [ctd2ncdf()] for missing values) and, if `oce` is provided #' and it can be determined, `unit` (a character string specifying @@ -113,22 +121,27 @@ read.varTable <- function(varTable="argo", debug=0) #' @author Dan Kelley #' #' @export -getVarInfo <- function(name=NULL, varTable=NULL, oce=NULL, debug=0) -{ +getVarInfo <- function(name = NULL, varTable = NULL, oce = NULL, debug = 0) { # Error checking. - if (!is.null(oce) && !inherits(oce, "oce")) + if (!is.null(oce) && !inherits(oce, "oce")) { stop("oce must be an 'oce' object, e.g. made by read.oce()") - if (is.null(name)) + } + if (is.null(name)) { stop("must supply name") - if (!is.character(name)) + } + if (!is.character(name)) { stop("name must be a character value") - if (is.null(varTable)) + } + if (is.null(varTable)) { stop("must supply varTable") + } dmsg(debug, "getVarInfo(name=\"", name, "\", varTable=\"", varTable, "\")\n") - if (is.character(varTable)) + if (is.character(varTable)) { varTable <- read.varTable(varTable) - if (!is.list(varTable)) + } + if (!is.list(varTable)) { stop("varTable must be a character value, or the output of read.varTable()") + } # Remove trailing numbers e.g. temperature2, but not in e.g. NO2. suffix <- "" dmsg(debug, " name=\"", name, "\"\n") @@ -139,18 +152,21 @@ getVarInfo <- function(name=NULL, varTable=NULL, oce=NULL, debug=0) } FillValue <- varTable$values$missing_value # Establish a default return value. - rval <- list(name=name, long_name=name, FillValue=FillValue, unit="") + rval <- list(name = name, long_name = name, FillValue = FillValue, unit = "") # Fill in variable names and fill value, if they can be determined. if (name %in% names(varTable$variables)) { tmp <- varTable$variables[[name]]$name - if (!is.null(tmp)) + if (!is.null(tmp)) { rval$name <- tmp + } tmp <- varTable$variables[[name]]$long_name - if (!is.null(tmp)) + if (!is.null(tmp)) { rval$long_name <- tmp + } tmp <- varTable$variables[[name]]$standard_name - if (!is.null(tmp)) + if (!is.null(tmp)) { rval$standard_name <- tmp + } } rval$name <- paste0(rval$name, suffix) # Fill in units, if they can be determined. @@ -160,17 +176,18 @@ getVarInfo <- function(name=NULL, varTable=NULL, oce=NULL, debug=0) # but we could special-case this in ctd2ncdf(). if (!is.null(oce)) { unit <- as.character(oce[[paste0(name, "Unit")]]$unit) - if (length(unit) && (unit %in% names(varTable$units))) + if (length(unit) && (unit %in% names(varTable$units))) { rval$unit <- varTable$units[[unit]]$name + } } dmsg(debug, "} # getVarInfo()\n") rval } # getVarInfo() -#' Translate netcdf names to oce names +#' Translate NetCDF names to oce names #' #' @param names vector of character values in oce convention (e.g. "TEMP" -#' for temperature, if varTable is "argo"). +#' for temperature, if `varTable` equals `"argo"`). #' #' @template varTableTemplate #' @@ -179,24 +196,25 @@ getVarInfo <- function(name=NULL, varTable=NULL, oce=NULL, debug=0) #' @author Dan Kelley #' #' @export -ncdfNames2oceNames <- function(names, varTable=NULL, debug=0) -{ +ncdfNames2oceNames <- function(names, varTable = NULL, debug = 0) { vt <- read.varTable(varTable) synonyms <- lapply(vt$variables, function(v) v$name) translation <- data.frame( - oce=names(synonyms), - ncdf=unlist(unname(synonyms))) - dmsg(debug, "input: ", paste(names, collapse=" "), "\n") + oce = names(synonyms), + ncdf = unlist(unname(synonyms)) + ) + dmsg(debug, "input: ", paste(names, collapse = " "), "\n") for (name in names) { w <- which(name == translation$ncdf) - if (length(w) > 0L) + if (length(w) > 0L) { names <- gsub(translation[w, "ncdf"], translation[w, "oce"], names) + } } - dmsg(debug, "returning: ", paste(names, collapse=" "), "\n") + dmsg(debug, "returning: ", paste(names, collapse = " "), "\n") names } -#' Translate netcdf names to oce names +#' Translate NetCDF names to oce names #' #' @param names vector of character values in oce convention (e.g. "temperature" #' for temperature). @@ -208,20 +226,20 @@ ncdfNames2oceNames <- function(names, varTable=NULL, debug=0) #' @author Dan Kelley #' #' @export -oceNames2ncdfNames <- function(names, varTable=NULL, debug=0) -{ +oceNames2ncdfNames <- function(names, varTable = NULL, debug = 0) { vt <- read.varTable(varTable) synonyms <- lapply(vt$variables, function(v) v$name) translation <- data.frame( - oce=names(synonyms), - ncdf=unlist(unname(synonyms))) - dmsg(debug, "input: ", paste(names, collapse=" "), "\n") + oce = names(synonyms), + ncdf = unlist(unname(synonyms)) + ) + dmsg(debug, "input: ", paste(names, collapse = " "), "\n") for (name in names) { w <- which(name == translation$oce) - if (length(w) > 0L) + if (length(w) > 0L) { names <- gsub(translation[w, "oce"], translation[w, "ncdf"], names) + } } - dmsg(debug, "returning: ", paste(names, collapse=" "), "\n") + dmsg(debug, "returning: ", paste(names, collapse = " "), "\n") names } - diff --git a/README.md b/README.md index 4dc777f..60d9d24 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,14 @@ -This package provides an interface from the internal representation used by the -oce package to the Netcdf file format. It is in an early stage of development, -with work focussed on CTD, ADCP and ADV data, to set up coding patterns that can -be used on other data. The order of tackling oce objects will be guided by the -needs of the author's immediate colleagues, and by convincing arguments made in -the issues tab of the project website. + + +[![GitHub last commit](https://img.shields.io/github/last-commit/dankelley/ocencdf)](https://img.shields.io/github/last-commit/dankelley/ocencdf) +[![R-CMD-check](https://github.com/dankelley/ocencdf/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/dankelley/ocencdf/actions/workflows/R-CMD-check.yaml) + + + +This package provides an interface from the internal representation used +by the `oce` package to the NetCDF file format. It is in an early stage +of development, with work focused on CTD, ADCP and ADV data, to set up +coding patterns that can be used on other data. The order of tackling +`oce` objects will be guided by the needs of the author's immediate +colleagues, and by convincing arguments made in the issues tab of the +project website. diff --git a/_pkgdown.yml b/_pkgdown.yml index 28c9b7d..6ef5f5a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,6 +1 @@ -articles: - - title: Articles - navbar: ~ - contents: - - introduction - - built_in_vartables +destination: docs diff --git a/check_package.R b/check_package.R new file mode 100644 index 0000000..fef5c88 --- /dev/null +++ b/check_package.R @@ -0,0 +1,47 @@ +# for a checklist see e.g. https://github.com/dankelley/oce/issues/2068 +requireNamespace(c("codemetar", "devtools", "urlchecker", "rhub", "revdepcheck")) +# codemeta changes a timestamp, so requiring a commit after every call. That is +# senseless, so I only run the false part of the following conditional in the +# run-up to a release. +if (FALSE) { + codemetar::write_codemeta() +} else { + message("run 'codemetar::write_codemeta()' and then git push") +} +t <- devtools::spell_check() +stopifnot(t == "No spelling errors found.") +urlchecker::url_check() + +# devtools checks. +# These are reliable, and useful, in contrast to the rhub checks that follow. +devtools::check_mac_release() +devtools::check_win_release() +devtools::check_win_devel() +devtools::check_win_oldrelease() + +# Rhub checks. +# [2023-03-26] The next two checks are not very reliable. Quite often, +# a run gets to the end with no problems but the system reports a PREPERROR. +# More rarely, but certainly not uncommonly, the test system dies +# before it gets to the stage of actually trying to build oce. And, +# even when these tests (and all others) pass, sometimes the CRAN machines +# report other problems. Given that the above block always seems +# to be useful, and that the next one is so unreliable, I don't know +# if there is any point in keeping the next. Oh, and bonus: the +# tests in the next block often don't report for half a day. +if (FALSE) { + rhub::check_for_cran(email="Dan.Kelley@Dal.Ca", show_status=FALSE) + rhub::check(platform="debian-clang-devel", show_status=FALSE) +} +#> rhub::platforms() +#debian-clang-devel: +# Debian Linux, R-devel, clang, ISO-8859-15 locale +#> rhub::check_rhub() + +# Reverse dependency checks. +# remotes::install_github("r-lib/revdepcheck") +if (FALSE) { + revdepcheck::revdep_reset() + revdepcheck::revdep_check(num_workers=4) +} +message("run following if desired: pkgdown::build_site()") diff --git a/codemeta.json b/codemeta.json new file mode 100644 index 0000000..33c56bf --- /dev/null +++ b/codemeta.json @@ -0,0 +1,151 @@ +{ + "@context": "https://doi.org/10.5063/schema/codemeta-2.0", + "@type": "SoftwareSourceCode", + "identifier": "ocencdf", + "description": "This provides a way to export `oce` objects to `NetCDF` format, perhaps for data archiving, or perhaps for secondary analysis outside R.", + "name": "ocencdf: NetCDF Interface for oce Objects", + "codeRepository": "https://github.com/dankelley/ocencdf", + "issueTracker": "https://github.com/dankelley/ocencdf/issues", + "license": "https://spdx.org/licenses/GPL-2.0", + "version": "0.0.4", + "programmingLanguage": { + "@type": "ComputerLanguage", + "name": "R", + "url": "https://r-project.org" + }, + "runtimePlatform": "R version 4.3.2 (2023-10-31)", + "author": [ + { + "@type": "Person", + "givenName": "Dan", + "familyName": "Kelley", + "email": "Dan.Kelley@Dal.Ca", + "@id": "https://orcid.org/0000-0001-7808-5911" + } + ], + "contributor": [ + { + "@type": "Person", + "givenName": "Clark", + "familyName": "Richards", + "email": "clark.richards@gmail.com", + "@id": "https://orcid.org/0000-0002-7833-206X" + } + ], + "maintainer": [ + { + "@type": "Person", + "givenName": "Dan", + "familyName": "Kelley", + "email": "Dan.Kelley@Dal.Ca", + "@id": "https://orcid.org/0000-0001-7808-5911" + } + ], + "softwareSuggestions": [ + { + "@type": "SoftwareApplication", + "identifier": "knitr", + "name": "knitr", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=knitr" + }, + { + "@type": "SoftwareApplication", + "identifier": "rmarkdown", + "name": "rmarkdown", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=rmarkdown" + }, + { + "@type": "SoftwareApplication", + "identifier": "testthat", + "name": "testthat", + "version": ">= 3.0.0", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=testthat" + } + ], + "softwareRequirements": { + "1": { + "@type": "SoftwareApplication", + "identifier": "R", + "name": "R", + "version": ">= 4.00" + }, + "2": { + "@type": "SoftwareApplication", + "identifier": "oce", + "name": "oce", + "version": ">= 1.8.0", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=oce" + }, + "3": { + "@type": "SoftwareApplication", + "identifier": "jsonlite", + "name": "jsonlite", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=jsonlite" + }, + "4": { + "@type": "SoftwareApplication", + "identifier": "ncdf4", + "name": "ncdf4", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=ncdf4" + }, + "5": { + "@type": "SoftwareApplication", + "identifier": "methods", + "name": "methods" + }, + "6": { + "@type": "SoftwareApplication", + "identifier": "yaml", + "name": "yaml", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=yaml" + }, + "SystemRequirements": null + }, + "fileSize": "251.974KB", + "relatedLink": "https://dankelley.github.io/ocencdf/", + "releaseNotes": "https://github.com/dankelley/ocencdf/blob/master/NEWS.md", + "readme": "https://github.com/dankelley/ocencdf/blob/main/README.md", + "contIntegration": "https://github.com/dankelley/ocencdf/actions/workflows/R-CMD-check.yaml" +} diff --git a/docs/404.html b/docs/404.html index 76c5559..f497fab 100644 --- a/docs/404.html +++ b/docs/404.html @@ -32,7 +32,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -49,10 +49,10 @@ @@ -60,7 +60,14 @@ Changelog - + @@ -96,7 +103,7 @@

Page not found (404)

-

Site built with pkgdown 2.0.7.

+

Site built with pkgdown 2.0.7.9000.

diff --git a/docs/articles/built_in_vartables.html b/docs/articles/built_in_vartables.html index 14c104e..13b3398 100644 --- a/docs/articles/built_in_vartables.html +++ b/docs/articles/built_in_vartables.html @@ -33,7 +33,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -50,10 +50,10 @@ @@ -61,7 +61,14 @@ Changelog - + @@ -77,9 +84,9 @@

Built-in varTables

Dan Kelley (https://orcid.org/0000-0001-7808-5911)

-

2023-06-11

- +

2024-01-26

+ Source: vignettes/built_in_vartables.Rmd @@ -100,11 +107,108 @@

IntroductionThe built-in tables

-

argo +

+adp +

+

This table is stored in a file that may be accessed with

+
+system.file("extdata", "adp.yml", package="ocencdf")
+

and the contents are as follows.

+
type: 
+  comment: A varTable for adp data. 
+  date: '2022-06-28' 
+  name: adp 
+  version: 1 
+units: 
+  1/m: 
+    name: m-1 
+  dbar: 
+    name: decibar 
+  degree * C: 
+    name: degree_Celcius 
+  degree * E: 
+    name: degree_east 
+  degree * N: 
+    name: degree_north 
+  m / s: 
+    name: meters_per_second 
+values: 
+  missing_value: 99999.0 
+variables: 
+  v: 
+    name: v 
+    standard_name: velocity 
+  pressure: 
+    name: pressure 
+    long_name: Sea water pressure, equals 0 at sea-level 
+    standard_name: sea_water_pressure 
+  salinity: 
+    name: PSAL 
+    long_name: Practical Salinity 
+    standard_name: sea_water_salinity 
+  temperature: 
+    name: TEMP 
+    long_name: Sea temperature in-situ ITS-90 scale 
+    standard_name: sea_water_temperature 
+ 
+
+
+

+adv +

+

This table is stored in a file that may be accessed with

+
+system.file("extdata", "adv.yml", package="ocencdf")
+

and the contents are as follows.

+
type: 
+  comment: A varTable for adv data. 
+  date: '2022-06-28' 
+  name: adv 
+  version: 1 
+units: 
+  1/m: 
+    name: m-1 
+  dbar: 
+    name: decibar 
+  degree * C: 
+    name: degree_Celcius 
+  degree * E: 
+    name: degree_east 
+  degree * N: 
+    name: degree_north 
+  m / s: 
+    name: meters_per_second 
+values: 
+  missing_value: 99999.0 
+variables: 
+  v: 
+    name: v 
+    standard_name: velocity 
+  pressure: 
+    name: pressure 
+    long_name: Sea water pressure, equals 0 at sea-level 
+    standard_name: sea_water_pressure 
+  pitchSlow: 
+    name: pitchSlow 
+    long_name: Pitch in degrees 
+    standard_name: pitch 
+  salinity: 
+    name: PSAL 
+    long_name: Practical Salinity 
+    standard_name: sea_water_salinity 
+  temperature: 
+    name: TEMP 
+    long_name: Sea temperature in-situ ITS-90 scale 
+    standard_name: sea_water_temperature 
+ 
+
+
+

+argo

This table, patterned on naming conventions in the Argo ocean float program, is stored in a file that may be accessed with

-
+
 system.file("extdata", "argo.yml", package="ocencdf")

and the contents are as follows.

type: 
@@ -186,11 +290,12 @@ 

argo standard_name: upwelling_radiance_in_sea_water

-

yhp +

+yhp

This table, patterned on naming conventions in the World Hydrographic Program, is stored in a file that may be accessed with

-
+
 system.file("extdata", "yhp.yml", package="ocencdf")

and the contents are as follows.

type: 
@@ -272,7 +377,7 @@ 

yhp

-

Site built with pkgdown 2.0.7.

+

Site built with pkgdown 2.0.7.9000.

diff --git a/docs/articles/index.html b/docs/articles/index.html index 2355fc2..bccee65 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4

@@ -32,16 +32,22 @@
  • Changelog
  • -
    +
    @@ -54,12 +60,12 @@

    Articles

    -

    Articles

    +

    All vignettes

    -
    Introduction to ocencdf
    +
    Built-in varTables
    -
    Built-in varTables
    +
    Introduction to ocencdf
    @@ -71,7 +77,7 @@

    Articles

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/articles/introduction.html b/docs/articles/introduction.html index d75ecfb..1652dca 100644 --- a/docs/articles/introduction.html +++ b/docs/articles/introduction.html @@ -33,7 +33,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -50,10 +50,10 @@ @@ -61,7 +61,14 @@ Changelog - + @@ -77,9 +84,9 @@

    Introduction to ocencdf

    Dan Kelley (https://orcid.org/0000-0001-7808-5911)

    -

    2023-06-11

    - +

    2024-01-26

    + Source: vignettes/introduction.Rmd @@ -106,38 +113,38 @@

    2023-06-11

    Purpose

    The ocencdf package provides a way to store approximate -forms of oce objects as Netcdf files, and to translate those files back -into oce objects. This is useful because Netcdf format is handled in a +forms of oce objects as NetCDF files, and to translate those files back +into oce objects. This is useful because NetCDF format is handled in a wide variety of computing languages, and is commonly used in data archives.

    The package provides both “forward” and “reverse” functions. The -former translate oce objects to Netcdf, and the latter transfer Netcdf +former translate oce objects to NetCDF, and the latter transfer NetCDF files (made by the package) back into oce objects.

    It should be noted that the reverse functions are designed to work -with Netcdf files created by the forward functions, with -e.g. ncdf2ctd() handling Netcdf files created by +with NetCDF files created by the forward functions, with +e.g. ncdf2ctd() handling NetCDF files created by ctd2ncdf() based on oce objects. The reverse functions may -be able to handle the data portions of other Netcdf files, but they do -not parse the attribute portions of those Netcdf files in a useful way. +be able to handle the data portions of other NetCDF files, but they do +not parse the attribute portions of those NetCDF files in a useful way. This is because there is no way for the code to know what conventions -were used in creating an arbitrary Netcdf file. For example, a CTD +were used in creating an arbitrary NetCDF file. For example, a CTD dataset might record the ship name, the name of the research program, etc., but whether these things are recorded in the data section of the -Netcdf file, or in attributes, or not at all, cannot be known a -priori, and guessing is a risky proposition.

    +NetCDF file, or in attributes, or not at all, cannot be known before the +fact, and guessing is a risky proposition.

    -

    Limitations of Netcdf format +

    Limitations of NetCDF format

    -

    Unfortunately, direct transferral of R information to Netcdf is not -possible. This is because Netcdf is an array-oriented format that is not +

    Unfortunately, direct transferal of R information to NetCDF is not +possible. This is because NetCDF is an array-oriented format that is not designed to hold tree-oriented data such as R lists (which are used throughout oce). It is possible to flatten simple lists, but the process gets complicated for nested lists, which are common in oce. Other -difficulties with the Netcdf format include its lack of basic elements +difficulties with the NetCDF format include its lack of basic elements programming elements such as user-defined classes and variable-length character strings in the data portion of the files.

    -

    This package is in early development, and efforts are focussed on a +

    This package is in early development, and efforts are focused on a single oce class, the ctd object. This focus is intended to permit coding practices to gel, in preparation for the addition of other classes. Given the anticipated needs of users, the next planned item for @@ -155,7 +162,7 @@

    Focus elements
  • The metadata slot (saved in a string form as a global attribute).
  • -
  • An approximate form of units, as strings (to fit Netcdf +
  • An approximate form of units, as strings (to fit NetCDF conventions).
  • Information on the conversion process.
  • @@ -173,7 +180,7 @@

    Renaming elements +Hydrographic Program system. These are available as "argo" and "whp", respectively. They are stored in the inst/extdata directory of the package source tree. Users seeking to define new naming systems must copy the formats of those @@ -187,7 +194,7 @@

    Example with CTD datasection dataset. Note the variable names, units, and flag values in the summary.

    -

    Now, save as a netcdf file, using (say) the Argo convention for +

    Now, save as a NetCDF file, using (say) the Argo convention for variable names.

    -oce2ncdf(stn, varTable="argo", ncfile="stn.nc")
    +ncfile <- tempfile(pattern = "argo", fileext = ".nc")
    +oce2ncdf(stn, varTable = "argo", ncfile = ncfile)
     #> Converting temperature from IPTS-68 scale to ITS-90 scale.
    -

    The stn.nc file may be examined in various ways, but we +

    The temporary NetCDF file may be examined in various ways, but we leave that up to the reader. Note that the column names are -e.g. TEMP in the Netcdf file, because the varTable named +e.g. TEMP in the NetCDF file, because the varTable named "argo" establishes that nickname.

    -

    In R, we can read stn.nc into a ctd object and get a +

    We can read the temporary NetCDF file into a ctd object and get a summary with the following.

    +
    #> [1] TRUE

    @@ -312,7 +321,7 @@

    Example with CTD data

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/authors.html b/docs/authors.html index 50c1681..fbe8ddc 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -32,16 +32,22 @@
  • Changelog
  • - + @@ -59,24 +65,29 @@

    Authors

    Dan Kelley. Author, maintainer.

    +
  • +

    Clark Richards. Contributor. +

    +
  • Citation

    - + Source: DESCRIPTION
    -

    Kelley D (2023). -ocencdf: Provide Netcdf Interface for Oce. -R package version 0.0.2. +

    Kelley D (2024). +ocencdf: NetCDF Interface for Oce Objects. +R package version 0.0.4, https://dankelley.github.io/ocencdf/.

    @Manual{,
    -  title = {ocencdf: Provide Netcdf Interface for Oce},
    +  title = {ocencdf: NetCDF Interface for Oce Objects},
       author = {Dan Kelley},
    -  year = {2023},
    -  note = {R package version 0.0.2},
    +  year = {2024},
    +  note = {R package version 0.0.4},
    +  url = {https://dankelley.github.io/ocencdf/},
     }
    @@ -90,7 +101,7 @@

    Citation

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/index.html b/docs/index.html index a662f8f..cc9ea0b 100644 --- a/docs/index.html +++ b/docs/index.html @@ -5,14 +5,14 @@ -Provide Netcdf Interface for Oce • ocencdf +NetCDF Interface for Oce Objects • ocencdf - - + + @@ -73,11 +80,22 @@
    -

    This package provides an interface from the internal representation used by the oce package to the Netcdf file format. It is in an early stage of development, with work focussed on CTD and ADCP data, to set up coding patterns that can be used on other data. The order of tackling oce objects will be determined by needs within the author’s research circle, and also by convincing arguments made in the issues tab of the project website.

    + + +

    This package provides an interface from the internal representation used by the oce package to the NetCDF file format. It is in an early stage of development, with work focused on CTD, ADCP and ADV data, to set up coding patterns that can be used on other data. The order of tackling oce objects will be guided by the needs of the author’s immediate colleagues, and by convincing arguments made in the issues tab of the project website.

    +
    @@ -112,7 +137,7 @@

    Developers

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/news/index.html b/docs/news/index.html index bf42042..1d227d2 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4
    @@ -32,16 +32,22 @@
  • Changelog
  • - + @@ -51,9 +57,19 @@
    +
    + +
    • Specify force_v4 in all conversions to NetCDF, which permits the handling of large files.
    • +
    +
    + +
    • Handle ADV data with adv2ncdf() and ncdf2adv().
    • +
    • Change metadata from YAML to JSON format.
    • +
    • Add a global attribute explaining how to use metadata.
    • +
    diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 27c8741..f6effa7 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,8 +1,8 @@ pandoc: 3.1.1 -pkgdown: 2.0.7 -pkgdown_sha: ~ +pkgdown: 2.0.7.9000 +pkgdown_sha: 548a9493b72ff93d3ed8392d4ad30b77d8b15fa5 articles: built_in_vartables: built_in_vartables.html introduction: introduction.html -last_built: 2023-06-11T11:48Z +last_built: 2024-01-26T13:39Z diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png index f14e0f0..321898d 100644 Binary files a/docs/reference/Rplot002.png and b/docs/reference/Rplot002.png differ diff --git a/docs/reference/adp2ncdf-1.png b/docs/reference/adp2ncdf-1.png index e38309c..aa335e8 100644 Binary files a/docs/reference/adp2ncdf-1.png and b/docs/reference/adp2ncdf-1.png differ diff --git a/docs/reference/adp2ncdf-2.png b/docs/reference/adp2ncdf-2.png index e38309c..aa335e8 100644 Binary files a/docs/reference/adp2ncdf-2.png and b/docs/reference/adp2ncdf-2.png differ diff --git a/docs/reference/adp2ncdf.html b/docs/reference/adp2ncdf.html index 20bfaea..fed9f94 100644 --- a/docs/reference/adp2ncdf.html +++ b/docs/reference/adp2ncdf.html @@ -1,6 +1,6 @@ -Save an adp object to a netcdf file — adp2ncdf • ocencdfSave an ADP object to a NetCDF file — adp2ncdf • ocencdf +
    @@ -52,25 +58,25 @@

    Given an adp object created by the oce package, this function -creates a netcdf file that can later by read by ncdf2adp() to approximately +creates a NetCDF file that can later by read by ncdf2adp() to approximately reproduce the original contents.

    -
    adp2ncdf(x, varTable = NULL, ncfile = NULL, debug = 0)
    +
    adp2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0)

    Arguments

    x
    -

    an oce object of class adp, as created by e.g. oce::read.adp().

    +

    an oce object of class adp, as created by e.g. oce::read.adp().

    varTable
    @@ -85,6 +91,14 @@

    Arguments

    a CTD object).

    +
    force_v4
    +

    logical value which controls the NetCDF file version during +the nc_create step. The default here is TRUE, whereas the +ncdf4-package defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data +sizes, may require v4.

    + +
    debug

    integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -93,12 +107,12 @@

    Arguments

    Details

    -

    Note that oce2ncdf() defaults varTable to "-", -meaning that no variable-name translation is done; the names used in -oce are retained in the file.

    +

    Note that adp2ncdf() defaults varTable to "adp".

    The entire contents of the metadata slot are saved in the global attribute named -"metadata". This permits reconstitution with eval(parse(text=)) in R, -or something similar in another language. In addition, the following metadata +"metadata", in a JSON format. The JSON material is developed with +metadata2json(), which yields a value that can be decoded with +json2metadata(). +In addition, the following metadata items are saved as individual global attributes: "beamAngle", "frequency", @@ -116,26 +130,28 @@

    See also

    Author

    -

    Dan Kelley

    +

    Dan Kelley and Clark Richards

    Examples

    -
    library(ocencdf)
    +    
    library(ocencdf)
     
    -# Example with an adp file from oce package
    -data(adp, package="oce")
    +# Example with an ADP file from `oce` package
    +data(adp, package = "oce")
     summary(adp)
     #> ADP Summary
     #> -----------
     #> 
    -#> * Filename:      "(redacted)"
    -#> * Instrument:    adcp
    -#> * Manufacturer:  teledyne rdi
    -#> * Serial number: (redacted)
    -#> * Firmware:      16.28
    -#> * Location:      47.88126 N, -69.73433 E
    -#> * Frequency:     600 kHz
    +#> * Filename:          "(redacted)"
    +#> * Instrument:        adcp
    +#> * Manufacturer:      teledyne rdi
    +#> * Serial number:     (redacted)
    +#> * Firmware:          16.28
    +#> * Cell Size:         0.50 m
    +#> * Beam Angle:        20 deg
    +#> * Location:          47.88126 N, -69.73433 E
    +#> * Frequency:         600 kHz
     #> * Ensemble Numbers:   5041, 5401, ..., 13321, 13681
     #> * Transformation matrix::
     #>      1.462  -1.462   0.000   0.000
    @@ -147,9 +163,9 @@ 

    Examples

    #> #> Min. Mean Max. Dim. NAs #> v [m/s] -0.97553 0.071645 1.4917 25x84x4 332 -#> q 24 113.49 248 25x84x4 0 -#> a 52 95.313 211 25x84x4 0 -#> g 0 95.352 100 25x84x4 0 +#> q NA NA NA 25x84x4 0 +#> a NA NA NA 25x84x4 0 +#> g NA NA NA 25x84x4 0 #> distance [m] 2.23 22.98 43.73 84 0 #> time 2008-06-26 2008-06-26 12:00:00 2008-06-27 25 0 #> pressure [dbar] 37.786 39.05 40.315 25 0 @@ -180,21 +196,24 @@

    Examples

    #> - 2019-08-12 15:29:36 UTC: `xyzToEnuAdp(x, declination=-18.1, debug=0)` plot(adp) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adp, ncfile="adp.nc") -#> Defaulting varTable to "-". -ADP <- ncdf2adp("adp.nc") +# Transfer to NetCDF and back to see if results make sense. +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adp", fileext = ".nc") +oce2ncdf(adp, ncfile = ncfile) +ADP <- ncdf2adp(ncfile) summary(ADP) #> ADP Summary #> ----------- #> -#> * Filename: "(redacted)" -#> * Instrument: adcp -#> * Manufacturer: teledyne rdi -#> * Serial number: (redacted) -#> * Firmware: 16.28 -#> * Location: 47.88126 N, -69.73433 E -#> * Frequency: 600 kHz +#> * Filename: "(redacted)" +#> * Instrument: adcp +#> * Manufacturer: teledyne rdi +#> * Serial number: (redacted) +#> * Firmware: 16.28 +#> * Cell Size: 0.50 m +#> * Beam Angle: 20 deg +#> * Location: 47.88126 N, -69.73433 E +#> * Frequency: 600 kHz #> * Ensemble Numbers: 5041, 5401, ..., 13321, 13681 #> * Transformation matrix:: #> 1.462 -1.462 0.000 0.000 @@ -234,12 +253,10 @@

    Examples

    #> #> * Processing Log #> -#> - 2023-06-11 11:48:55 UTC: `Create oce object` +#> - 2024-01-26 13:39:08 UTC: `Create oce object` plot(ADP) - -# Remove temporary file -file.remove("adp.nc") +file.remove(ncfile) #> [1] TRUE
    @@ -256,7 +273,7 @@

    Examples

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/adv2ncdf-1.png b/docs/reference/adv2ncdf-1.png new file mode 100644 index 0000000..77605bb Binary files /dev/null and b/docs/reference/adv2ncdf-1.png differ diff --git a/docs/reference/adv2ncdf-2.png b/docs/reference/adv2ncdf-2.png new file mode 100644 index 0000000..aa84215 Binary files /dev/null and b/docs/reference/adv2ncdf-2.png differ diff --git a/docs/reference/adv2ncdf.html b/docs/reference/adv2ncdf.html new file mode 100644 index 0000000..c94e1cc --- /dev/null +++ b/docs/reference/adv2ncdf.html @@ -0,0 +1,231 @@ + +Save an adv object to a NetCDF file — adv2ncdf • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    Given an adv object created by the oce package, this function +creates a NetCDF file that can later by read by ncdf2adv() to approximately +reproduce the original contents.

    +
    + +
    +
    adv2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0)
    +
    + +
    +

    Arguments

    +
    x
    +

    an oce object of class adv, as created by e.g. oce::read.adv().

    + + +
    varTable
    +

    character value indicating the variable-naming +scheme to be used, which is passed to read.varTable() to set +up variable names, units, etc.

    + + +
    ncfile
    +

    character value naming the output file. Use NULL +for a file name to be created automatically (e.g. ctd.nc for +a CTD object).

    + + +
    force_v4
    +

    logical value which controls the NetCDF file version during +the nc_create step. The default here is TRUE, whereas the +ncdf4-package defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data +sizes, may require v4.

    + + +
    debug
    +

    integer, 0 (the default) for quiet action apart +from messages and warnings, or any larger value to see more +output that describes the processing steps.

    + +
    +
    +

    Details

    +

    Note that adv2ncdf() defaults varTable to "adv".

    +

    The entire contents of the metadata slot are saved in the global attribute named +"metadata", in a JSON format. The JSON material is developed with +metadata2json(), which yields a value that can be decoded with +json2metadata().

    +
    +
    +

    See also

    +

    Other things related to adv data: +ncdf2adv()

    +
    +
    +

    Author

    +

    Dan Kelley and Clark Richards

    +
    + +
    +

    Examples

    +
    library(ocencdf)
    +
    +# Example with an adv file from oce package
    +data(adv, package = "oce")
    +summary(adv)
    +#> ADV Summary
    +#> -----------
    +#> 
    +#> * Instrument:    vector, serial number ``(serial number redacted)``
    +#> * Filename:      `(file name redacted)`
    +#> * Location:      47.87943 N ,  -69.72533 E 
    +#> * Time:          2008-07-01 00:00:00 to 2008-07-01 00:00:59 (480 samples, mean increment 0.1250001 s)
    +#> * Data Overview
    +#> 
    +#>                                         Min.                Mean                Max.  Dim. NAs
    +#>     v [m/s]                        -0.080871          0.00069514            0.057789 480x3   0
    +#>     a                                     NA                  NA                  NA 480x3   0
    +#>     q                                     NA                  NA                  NA 480x3   0
    +#>     time                 2008-07-01 00:00:00 2008-07-01 00:00:30 2008-07-01 00:00:59   480   0
    +#>     pressure [dbar]                    16.85              16.866              16.879   480   0
    +#>     timeBurst                             NA                  NA                  NA   480 480
    +#>     recordsBurst                          NA                  NA                  NA   480 480
    +#>     voltageSlow                          9.7                9.71                 9.8    60   0
    +#>     timeSlow                      1214870401          1214870430          1214870460    60   0
    +#>     headingSlow [°]                   -23.39              -23.39              -23.39    60   0
    +#>     pitchSlow [°]                        0.4                 0.5                 0.6    60   0
    +#>     rollSlow [°]                        -6.2              -6.145                -6.1    60   0
    +#>     temperatureSlow [°C]                6.47              6.4997                6.51    60   0
    +#> 
    +#> * Processing Log
    +#> 
    +#>     - 2015-12-23 17:53:39 UTC: `read.oce(file = "/data/archive/sleiwex/2008/moorings/m05/adv/nortek_1943/raw/adv_nortek_1943.vec",     from = as.POSIXct("2008-06-25 00:00:00", tz = "UTC"), to = as.POSIXct("2008-07-06 00:00:00",         tz = "UTC"), latitude = 47.87943, longitude = -69.72533)`
    +#>     - 2015-12-23 17:53:54 UTC: `retime(x = m05VectorBeam, a = 0.58, b = 6.3892e-07, t0 = as.POSIXct("2008-07-01 00:00:00",     tz = "UTC"))`
    +#>     - 2015-12-23 17:53:55 UTC: `subset(x, subset=as.POSIXct("2008-06-25 13:00:00", tz = "UTC") <= time & time <=      as.POSIXct("2008-07-03 00:50:00", tz = "UTC"))`
    +#>     - 2015-12-23 17:53:55 UTC: `oceEdit(x = m05VectorBeam, item = "transformationMatrix", value = rbind(c(11033,     -5803, -5238), c(347, -9622, 9338), c(-1418, -1476, -1333))/4096,     reason = "Nortek email 2011-02-14", person = "DEK")`
    +#>     - 2015-12-23 17:53:55 UTC: `use aquadoppHR heading; despike own pitch and roll`
    +#>     - 2015-12-23 17:54:11 UTC: `beamToXyzAdv(x = x)`
    +#>     - 2015-12-23 17:54:34 UTC: `xyzToEnu(x, declination=-18.099, horizontalCase=TRUE, sensorOrientiation=upward, debug=0)`
    +plot(adv)
    +
    +# Transfer to NetCDF and back to see if results make sense
    +# Use a temporary nc file to let package pass CRAN checks.
    +ncfile <- tempfile(pattern = "adv", fileext = ".nc")
    +oce2ncdf(adv, ncfile = ncfile)
    +ADV <- ncdf2adv(ncfile)
    +summary(ADV)
    +#> ADV Summary
    +#> -----------
    +#> 
    +#> * Instrument:    vector, serial number ``(serial number redacted)``
    +#> * Filename:      `(file name redacted)`
    +#> * Location:      47.87943 N ,  -69.72533 E 
    +#> * Time:          2008-07-01 00:00:00 to 2008-07-01 00:00:59 (480 samples, mean increment 0.1250001 s)
    +#> * Data Overview
    +#> 
    +#>                                         Min.                Mean                Max.  Dim. NAs
    +#>     v [m/s]                        -0.080871          0.00069514            0.057789 480x3   0
    +#>     a                                     NA                  NA                  NA 480x3   0
    +#>     q                                     NA                  NA                  NA 480x3   0
    +#>     time                 2008-07-01 00:00:00 2008-07-01 00:00:30 2008-07-01 00:00:59   480   0
    +#>     pressure [dbar]                    16.85              16.866              16.879   480   0
    +#>     timeBurst                             NA                  NA                  NA   480 480
    +#>     recordsBurst                          NA                  NA                  NA   480 480
    +#>     voltageSlow                          9.7                9.71                 9.8    60   0
    +#>     timeSlow                      1214870401          1214870430          1214870460    60   0
    +#>     headingSlow [°]                   -23.39              -23.39              -23.39    60   0
    +#>     pitchSlow [°]                        0.4                 0.5                 0.6    60   0
    +#>     rollSlow [°]                        -6.2              -6.145                -6.1    60   0
    +#>     temperatureSlow [°C]                6.47              6.4997                6.51    60   0
    +#> 
    +#> * Processing Log
    +#> 
    +#>     - 2024-01-26 13:39:11 UTC: `Create oce object`
    +plot(ADV)
    +
    +file.remove(ncfile)
    +#> [1] TRUE
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.9000.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/ctd2ncdf.html b/docs/reference/ctd2ncdf.html index 3b4be33..505694a 100644 --- a/docs/reference/ctd2ncdf.html +++ b/docs/reference/ctd2ncdf.html @@ -1,5 +1,5 @@ -Save a ctd object to a netcdf file — ctd2ncdf • ocencdfSave a ctd object to a NetCDF file — ctd2ncdf • ocencdf +
    @@ -51,18 +57,18 @@
    -

    This creates a netcdf file in a convention that permits later reading by +

    This creates a NetCDF file in a convention that permits later reading by ncdf2ctd(), and that may be convenient for other purposes as well.

    -
    ctd2ncdf(x, varTable = NULL, ncfile = NULL, debug = 0)
    +
    ctd2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0)
    @@ -84,6 +90,14 @@

    Arguments

    a CTD object).

    +
    force_v4
    +

    logical value which controls the NetCDF file version during +the nc_create step. The default here is TRUE, whereas the +ncdf4-package defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data +sizes, may require v4.

    + +
    debug

    integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -92,11 +106,11 @@

    Arguments

    Details

    -

    Note that oce2ncdf() defaults varTable to "argo".

    -

    The contents of the data slot of the oce object x are as netcdf +

    Note that ctd2ncdf() defaults varTable to "argo".

    +

    The contents of the data slot of the oce object x are as NetCDF data items. If flags are present in the metadata slot, they are also saved as data, with names ending in _QC.

    -

    In addition to storage in the netcdf data section, several attributes +

    In addition to storage in the NetCDF data section, several attributes are saved as well. These include units for the data, which are tied to the corresponding variables. The entire metadata slot is stored as a global attribute named metadata, so that a later call to @@ -113,19 +127,22 @@

    See also

    Author

    -

    Dan Kelley

    +

    Dan Kelley and Clark Richards

    Examples

    -
    library(ocencdf)
    +    
    library(ocencdf)
     
     # example 1: a ctd file without per-variable QC flags
    -data(ctd, package="oce")
    -oce2ncdf(ctd, ncfile="ctd.nc")
    -#> Defaulting varTable to "argo".
    +data(ctd, package = "oce")
    +# Use a temporary nc file to let package pass CRAN checks.
    +ncfile <- tempfile(pattern = "ctd", fileext = ".nc")
    +oce2ncdf(ctd, ncfile = ncfile)
     #> Converting temperature from IPTS-68 scale to ITS-90 scale.
    -CTD <- as.ctd(ncdf2oce("ctd.nc"))
    +CTD <- as.ctd(ncdf2oce(ncfile))
    +file.remove(ncfile)
    +#> [1] TRUE
     summary(CTD)
     #> CTD Summary
     #> -----------
    @@ -149,18 +166,21 @@ 

    Examples

    #> #> * Processing Log #> -#> - 2023-06-11 11:48:56 UTC: `create 'ctd' object` -#> - 2023-06-11 11:48:56 UTC: `as.ctd(salinity = ncdf2oce("ctd.nc"))` +#> - 2024-01-26 13:39:12 UTC: `create 'ctd' object` +#> - 2024-01-26 13:39:12 UTC: `as.ctd(salinity = ncdf2oce(ncfile))` plot(CTD) # example 2: a ctd file with per-variable QC flags -data(section, package="oce") +data(section, package = "oce") stn <- section[["station", 100]] -oce2ncdf(stn, ncfile="stn.nc") -#> Defaulting varTable to "argo". +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "ctd", fileext = ".nc") +oce2ncdf(stn, ncfile = ncfile) #> Converting temperature from IPTS-68 scale to ITS-90 scale. -STN <- as.ctd(ncdf2oce("stn.nc")) +STN <- as.ctd(ncdf2oce(ncfile)) +file.remove(ncfile) +#> [1] TRUE summary(STN) #> CTD Summary #> ----------- @@ -185,8 +205,8 @@

    Examples

    #> * Data-quality Flag Scheme #> #> name "WHP bottle" -#> mapping list(no_information=1, no_problems_noted=2, leaking=3, did_not_trip=4, not_reported=5, discrepency=6, unknown_problem=7, did_not_trip=8, no_sample=9) -#> default c(1, 3, 4, 5, 6, 7, 8, 9) +#> mapping list(no_information=1L, no_problems_noted=2L, leaking=3L, did_not_trip=4L, not_reported=5L, discrepency=6L, unknown_problem=7L, did_not_trip.1=8L, no_sample=9L) +#> default c(1L, 3L, 4L, 5L, 6L, 7L, 8L, 9L) #> #> * Data-quality Flags #> @@ -201,17 +221,11 @@

    Examples

    #> #> * Processing Log #> -#> - 2023-06-11 11:48:57 UTC: `create 'ctd' object` -#> - 2023-06-11 11:48:57 UTC: `as.ctd(salinity = ncdf2oce("stn.nc"))` +#> - 2024-01-26 13:39:13 UTC: `create 'ctd' object` +#> - 2024-01-26 13:39:13 UTC: `as.ctd(salinity = ncdf2oce(ncfile))` plot(STN) -# Remove temporary files -file.remove("ctd.nc") -#> [1] TRUE -file.remove("stn.nc") -#> [1] TRUE -
    @@ -226,7 +240,7 @@

    Examples

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/getVarInfo.html b/docs/reference/getVarInfo.html index 92b4933..10bba6d 100644 --- a/docs/reference/getVarInfo.html +++ b/docs/reference/getVarInfo.html @@ -1,6 +1,6 @@ Get information on a variable, using varTable — getVarInfo • ocencdf @@ -18,7 +18,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -33,16 +33,22 @@
  • Changelog
  • - + @@ -52,13 +58,13 @@

    This is used by e.g. ctd2ncdf() to determine how to describe the variable in a -particular flavour of netcdf file, as specified by read.varTable().

    +particular flavour of NetCDF file, as specified by read.varTable().

    @@ -99,8 +105,8 @@

    Value

    getVarInfo() returns a list containing name (the -name as used in argo netcdf files), long_name (again, as used in -Argo netcdf files, although the usefulness of this is debatable), +name as used in Argo NetCDF files), long_name (again, as used in +Argo NetCDF files, although the usefulness of this is debatable), standard_name (not used by ctd2ncdf() as of now), FillValue

    @@ -115,7 +121,7 @@

    Author

    Examples

    -
    library(ocencdf)
    +    
    library(ocencdf)
     
     # Example
     data(ctd)
    @@ -151,7 +157,7 @@ 

    Examples

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/index.html b/docs/reference/index.html index 318fc47..9de6bb8 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4
    @@ -32,16 +32,22 @@
  • Changelog
  • -
    +
    @@ -60,39 +66,55 @@

    All functions

    adp2ncdf()

    -

    Save an adp object to a netcdf file

    +

    Save an ADP object to a NetCDF file

    + +

    adv2ncdf()

    + +

    Save an adv object to a NetCDF file

    ctd2ncdf()

    -

    Save a ctd object to a netcdf file

    +

    Save a ctd object to a NetCDF file

    getVarInfo()

    Get information on a variable, using varTable

    + +

    json2metadata()

    + +

    Convert a JSON string to an oce metadata slot

    + +

    metadata2json()

    + +

    Convert an oce metadata slot to JSON

    ncdf2adp()

    -

    Read a netcdf file and create an adp object

    +

    Read a NetCDF file and create an ADP object

    + +

    ncdf2adv()

    + +

    Read a NetCDF file and create an adv object

    ncdf2ctd()

    -

    Read a netcdf file and create a ctd object

    +

    Read a NetCDF file and create a ctd object

    ncdf2oce()

    -

    Read a netcdf file and create a general oce object

    +

    Read a NetCDF file and create a general oce object

    ncdfNames2oceNames()

    -

    Translate netcdf names to oce names

    +

    Translate NetCDF names to oce names

    oce2ncdf()

    -

    Save an oce-class object as a netcdf file.

    +

    Save an oce-class object as a NetCDF file.

    oceNames2ncdfNames()

    -

    Translate netcdf names to oce names

    +

    Translate NetCDF names to oce names

    read.varTable()

    @@ -110,7 +132,7 @@

    All functions
    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/json2metadata.html b/docs/reference/json2metadata.html new file mode 100644 index 0000000..c012110 --- /dev/null +++ b/docs/reference/json2metadata.html @@ -0,0 +1,126 @@ + +Convert a JSON string to an oce metadata slot — json2metadata • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    This is the reverse of metadata2json(), and is used by +ncdf2oce() and related functions. See metadata2json() +for some conversions that are done by that function and +then reversed here.

    +
    + +
    +
    json2metadata(j)
    +
    + +
    +

    Arguments

    +
    j
    +

    character value, typically the output from metadata2json().

    + +
    +
    +

    Value

    + + +

    json2metadata returns a list in the format of a metadata

    + + +

    slot from an oce object.

    +
    +
    +

    See also

    +

    Other things relating to serialization: +metadata2json()

    +
    +
    +

    Author

    +

    Dan Kelley

    +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.9000.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/metadata2json.html b/docs/reference/metadata2json.html new file mode 100644 index 0000000..894c738 --- /dev/null +++ b/docs/reference/metadata2json.html @@ -0,0 +1,357 @@ + +Convert an oce metadata slot to JSON — metadata2json • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    This converts the contents of an object's metadata slot +into JSON format, using the toJSON() function from the +jsonlite library. Some conversion is required, and this +is also handled if the results are reconstituted using +json2metadata(). See “Details”.

    +
    + +
    +
    metadata2json(m, digits = 15)
    +
    + +
    +

    Arguments

    +
    m
    +

    contents of the metadata slot of an oce object.

    + + +
    digits
    +

    integer, the number of digits to store in the JSON +representation.

    + +
    +
    +

    Value

    + + +

    metadata2json returns a character value holding +the metadata slot in JSON, transformed as indicated in +the “Details” section.

    +
    +
    +

    Details

    +

    Some metadata items cannot be handled by jsonlite::toJSON(), so +these are transformed as follows before storage in the return value +NOTE: the reverse function, json2metadata(), reverses all of these +transformations, so that the original metadata can be recovered.

    1. Oce uses expression objects to store units, and these are converted +to character values using as.character() before converting to JSON.

    2. +
    3. Oce stores a raw matrix called codes for adp objects created from +RDI/Teledyne files, and so this is converted to an integer matrix +before converting to JSON.

    4. +
    5. The following items are converted from POSIXct values to character +values: date, endTime, startTime, and systemUploadTime.

    6. +
    +
    +

    See also

    +

    Other things relating to serialization: +json2metadata()

    +
    +
    +

    Author

    +

    Dan Kelley

    +
    + +
    +

    Examples

    +
    # Example 1: CTD data
    +data("ctd")
    +metadata2json(ctd@metadata)
    +#> {
    +#>   "units": {
    +#>     "scan": {
    +#>       "unit": [],
    +#>       "scale": [""]
    +#>     },
    +#>     "timeS": {
    +#>       "unit": ["s"],
    +#>       "scale": [""]
    +#>     },
    +#>     "pressure": {
    +#>       "unit": ["dbar"],
    +#>       "scale": [""]
    +#>     },
    +#>     "depth": {
    +#>       "unit": ["m"],
    +#>       "scale": [""]
    +#>     },
    +#>     "temperature": {
    +#>       "unit": ["degree * C"],
    +#>       "scale": ["IPTS-68"]
    +#>     },
    +#>     "salinity": {
    +#>       "unit": [],
    +#>       "scale": ["PSS-78"]
    +#>     },
    +#>     "flag": {
    +#>       "unit": [],
    +#>       "scale": [""]
    +#>     }
    +#>   },
    +#>   "flags": [],
    +#>   "pressureType": ["sea"],
    +#>   "deploymentType": ["unknown"],
    +#>   "waterDepth": [null],
    +#>   "dataNamesOriginal": {
    +#>     "scan": ["scan"],
    +#>     "timeS": ["timeS"],
    +#>     "pressure": ["pr"],
    +#>     "depth": ["depS"],
    +#>     "temperature": ["t068"],
    +#>     "salinity": ["sal00"],
    +#>     "flag": ["flag"]
    +#>   },
    +#>   "model": ["25"],
    +#>   "header": ["* Sea-Bird SBE 25 Data File:", "* FileName = C:\\SEASOFT3\\BASIN\\BED0302.HEX", "* Software Version 4.230a", "* Temperature SN = 1140", "* Conductivity SN = 832", "* System UpLoad Time = Oct 15 2003 11:38:38", "* Command Line = seasave ", "** Ship:      Divcom3", "** Cruise:    Halifax Harbour", "** Station:   Stn 2", "** Latitude:  N44 41.056", "** Longitude: w63 38.633", "* Real-Time Sample Interval = 1.000 seconds", "# nquan = 7", "# nvalues = 773                     ", "# units = metric", "# name 0 = scan: scan number", "# name 1 = timeS: time [s]", "# name 2 = pr: pressure [db]", "# name 3 = depS: depth, salt water [m]", "# name 4 = t068: temperature, IPTS-68 [deg C]", "# name 5 = sal00: salinity, PSS-78 [PSU]", "# name 6 = flag:  0.000e+00", "# span 0 = 1, 773                       ", "# span 1 = 0.000, 772.000               ", "# span 2 = -0.378, 163.899              ", "# span 3 = -0.375, 162.504              ", "# span 4 = 2.3237, 99.0000              ", "# span 5 = 0.3276, 99.0000              ", "# span 6 = 0.000e+00, 0.000e+00         ", "# interval = seconds: 1                           ", "# start_time = Oct 15 1903 11:38:38", "# bad_flag = -9.990e-29", "# sensor 0 = Frequency 0  temperature, 1140, 13 Mar 03", "# sensor 1 = Frequency 1  conductivity, 832, 13 Mar 03, cpcor = -9.5700e-08", "# sensor 2 = Pressure Voltage, 145033, 17 Mar 03, cpcor = -9.5700e-08", "# sensor 3 = Stored Volt  0  transmissometer", "# datcnv_date = Oct 15 2003 13:46:47, 4.230a", "# datcnv_in = BED0302.HEX BED0301.CON", "# datcnv_skipover = 0", "# file_type = ascii", "*END*"],
    +#>   "type": ["SBE"],
    +#>   "hexfilename": ["c:\\seasoft3\\basin\\bed0302.hex"],
    +#>   "serialNumber": [""],
    +#>   "serialNumberTemperature": ["1140"],
    +#>   "serialNumberConductivity": ["832"],
    +#>   "systemUploadTime": ["2003-10-15 11:38:38"],
    +#>   "ship": ["Divcom3"],
    +#>   "scientist": [""],
    +#>   "institute": [""],
    +#>   "address": [""],
    +#>   "cruise": ["Halifax Harbour"],
    +#>   "station": ["Stn 2"],
    +#>   "date": ["2003-10-15 11:38:38"],
    +#>   "startTime": ["2003-10-15 15:38:38"],
    +#>   "recoveryTime": [null],
    +#>   "latitude": [44.684266666666666],
    +#>   "longitude": [-63.643883333333335],
    +#>   "sampleInterval": [1],
    +#>   "sampleIntervalUnits": ["s"],
    +#>   "filename": ["/Users/kelley/git/oce/create_data/ctd/ctd.cnv"]
    +#> } 
    +
    +# Example 2: ADP data
    +data("adp")
    +metadata2json(adp@metadata)
    +#> {
    +#>   "units": {
    +#>     "v": {
    +#>       "unit": ["m/s"],
    +#>       "scale": [""]
    +#>     },
    +#>     "distance": {
    +#>       "unit": ["m"],
    +#>       "scale": [""]
    +#>     },
    +#>     "pressure": {
    +#>       "unit": ["dbar"],
    +#>       "scale": [""]
    +#>     },
    +#>     "salinity": {
    +#>       "unit": [],
    +#>       "scale": ["PSS-78"]
    +#>     },
    +#>     "temperature": {
    +#>       "unit": ["degree * C"],
    +#>       "scale": ["ITS-90"]
    +#>     },
    +#>     "soundSpeed": {
    +#>       "unit": ["m/s"],
    +#>       "scale": [""]
    +#>     },
    +#>     "heading": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "pitch": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "roll": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "headingStd": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "pitchStd": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "rollStd": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "attitude": {
    +#>       "unit": ["degree"],
    +#>       "scale": [""]
    +#>     },
    +#>     "depth": {
    +#>       "unit": ["m"],
    +#>       "scale": [""]
    +#>     }
    +#>   },
    +#>   "flags": [],
    +#>   "oceCoordinate": ["enu"],
    +#>   "orientation": ["upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward", "upward"],
    +#>   "instrumentType": ["adcp"],
    +#>   "instrumentSubtype": ["workhorse"],
    +#>   "firmwareVersionMajor": [16],
    +#>   "firmwareVersionMinor": [28],
    +#>   "firmwareVersion": ["16.28"],
    +#>   "bytesPerEnsemble": [1832],
    +#>   "systemConfiguration": ["11001011-01000001"],
    +#>   "frequency": [600],
    +#>   "beamAngle": [20],
    +#>   "beamPattern": ["convex"],
    +#>   "beamConfig": ["janus"],
    +#>   "numberOfDataTypes": [6],
    +#>   "dataOffset": [18, 77, 142, 816, 1154, 1492],
    +#>   "codes": [
    +#>     [127, 127],
    +#>     [0, 0],
    +#>     [128, 0],
    +#>     [0, 1],
    +#>     [0, 2],
    +#>     [0, 3],
    +#>     [0, 4]
    +#>   ],
    +#>   "numberOfBeams": [4],
    +#>   "numberOfCells": [84],
    +#>   "pingsPerEnsemble": [20],
    +#>   "cellSize": [0.5],
    +#>   "transducerDepth": [0],
    +#>   "profilingMode": [1],
    +#>   "lowCorrThresh": [0],
    +#>   "numberOfCodeReps": [2],
    +#>   "percentGdMinimum": [0],
    +#>   "errorVelocityMaximum": [5000],
    +#>   "coordTransform": ["00000111"],
    +#>   "originalCoordinate": ["beam"],
    +#>   "tiltUsed": [true],
    +#>   "threeBeamUsed": [true],
    +#>   "binMappingUsed": [true],
    +#>   "headingAlignment": [0],
    +#>   "headingBias": [0],
    +#>   "sensorSource": ["01111111"],
    +#>   "sensorsAvailable": ["00111101"],
    +#>   "bin1Distance": [2.23],
    +#>   "xmitPulseLength": [1.35],
    +#>   "wpRefLayerAverage": [1281],
    +#>   "falseTargetThresh": [50],
    +#>   "transmitLagDistance": [86],
    +#>   "cpuBoardSerialNumber": [158, 0, 0, 3, 1, 160, 95, 9],
    +#>   "systemBandwidth": [0],
    +#>   "serialNumber": ["(redacted)"],
    +#>   "haveActualData": [true],
    +#>   "ensembleNumber": [5041, 5401, 5761, 6121, 6481, 6841, 7201, 7561, 7921, 8281, 8641, 9001, 9361, 9721, 10081, 10441, 10801, 11161, 11521, 11881, 12241, 12601, 12961, 13321, 13681],
    +#>   "manufacturer": ["teledyne rdi"],
    +#>   "filename": ["(redacted)"],
    +#>   "longitude": [-69.73433],
    +#>   "latitude": [47.881259999999997],
    +#>   "ensembleInFile": [9243361, 9903601, 10563841, 11224081, 11884321, 12544561, 13204801, 13865041, 14525281, 15185521, 15845761, 16506001, 17166241, 17826481, 18486721, 19146961, 19807201, 20467441, 21127681, 21787921, 22448161, 23108401, 23768641, 24428881, 25089121],
    +#>   "velocityResolution": [0.001],
    +#>   "velocityMaximum": [32.768000000000001],
    +#>   "numberOfSamples": [25],
    +#>   "oceBeamUnspreaded": [false],
    +#>   "depthMean": [38.792000000000002],
    +#>   "transformationMatrix": [
    +#>     [1.461902200081544, -1.461902200081544, 0, 0],
    +#>     [0, 0, -1.461902200081544, 1.461902200081544],
    +#>     [0.266044443118978, 0.266044443118978, 0.266044443118978, 0.266044443118978],
    +#>     [1.033720959109192, 1.033720959109192, -1.033720959109192, -1.033720959109192]
    +#>   ],
    +#>   "headSerialNumber": ["(redacted)"],
    +#>   "deploymentName": ["(redacted)"],
    +#>   "comments": ["sample ADP file"]
    +#> } 
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.9000.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/ncdf2adp-1.png b/docs/reference/ncdf2adp-1.png index e38309c..aa335e8 100644 Binary files a/docs/reference/ncdf2adp-1.png and b/docs/reference/ncdf2adp-1.png differ diff --git a/docs/reference/ncdf2adp-2.png b/docs/reference/ncdf2adp-2.png index e38309c..aa335e8 100644 Binary files a/docs/reference/ncdf2adp-2.png and b/docs/reference/ncdf2adp-2.png differ diff --git a/docs/reference/ncdf2adp.html b/docs/reference/ncdf2adp.html index e738eb3..876672c 100644 --- a/docs/reference/ncdf2adp.html +++ b/docs/reference/ncdf2adp.html @@ -1,7 +1,7 @@ -Read a netcdf file and create an adp object — ncdf2adp • ocencdf ocencdf - 0.0.2 + 0.0.4 @@ -38,16 +38,22 @@
  • Changelog
  • - + @@ -56,15 +62,15 @@

    This works by calling ncdf2oce() and then using class() on the result to make it be of subclass "adp". This is intended -to work with Netcdf files created with adp2ncdf(), which embeds +to work with NetCDF files created with adp2ncdf(), which embeds sufficient information in the file to permit ncdf2adp() to reconstruct the original adp object. See the documentation for adp2ncdf() to learn more about what it stores, and therefore @@ -102,6 +108,8 @@

    Value

    See also

    Other things related to adp data: +adp2ncdf()

    +

    Other things related to adp data: adp2ncdf()

    @@ -111,21 +119,23 @@

    Author

    Examples

    -
    library(ocencdf)
    +    
    library(ocencdf)
     
    -# Example with an adp file from oce package
    -data(adp, package="oce")
    +# Example with an ADP file from `oce` package
    +data(adp, package = "oce")
     summary(adp)
     #> ADP Summary
     #> -----------
     #> 
    -#> * Filename:      "(redacted)"
    -#> * Instrument:    adcp
    -#> * Manufacturer:  teledyne rdi
    -#> * Serial number: (redacted)
    -#> * Firmware:      16.28
    -#> * Location:      47.88126 N, -69.73433 E
    -#> * Frequency:     600 kHz
    +#> * Filename:          "(redacted)"
    +#> * Instrument:        adcp
    +#> * Manufacturer:      teledyne rdi
    +#> * Serial number:     (redacted)
    +#> * Firmware:          16.28
    +#> * Cell Size:         0.50 m
    +#> * Beam Angle:        20 deg
    +#> * Location:          47.88126 N, -69.73433 E
    +#> * Frequency:         600 kHz
     #> * Ensemble Numbers:   5041, 5401, ..., 13321, 13681
     #> * Transformation matrix::
     #>      1.462  -1.462   0.000   0.000
    @@ -137,9 +147,9 @@ 

    Examples

    #> #> Min. Mean Max. Dim. NAs #> v [m/s] -0.97553 0.071645 1.4917 25x84x4 332 -#> q 24 113.49 248 25x84x4 0 -#> a 52 95.313 211 25x84x4 0 -#> g 0 95.352 100 25x84x4 0 +#> q NA NA NA 25x84x4 0 +#> a NA NA NA 25x84x4 0 +#> g NA NA NA 25x84x4 0 #> distance [m] 2.23 22.98 43.73 84 0 #> time 2008-06-26 2008-06-26 12:00:00 2008-06-27 25 0 #> pressure [dbar] 37.786 39.05 40.315 25 0 @@ -170,21 +180,24 @@

    Examples

    #> - 2019-08-12 15:29:36 UTC: `xyzToEnuAdp(x, declination=-18.1, debug=0)` plot(adp) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adp, ncfile="adp.nc") -#> Defaulting varTable to "-". -ADP <- ncdf2adp("adp.nc") +# Transfer to NetCDF and back to see if results make sense +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adp", fileext = ".nc") +oce2ncdf(adp, ncfile = ncfile) +ADP <- ncdf2adp(ncfile) summary(ADP) #> ADP Summary #> ----------- #> -#> * Filename: "(redacted)" -#> * Instrument: adcp -#> * Manufacturer: teledyne rdi -#> * Serial number: (redacted) -#> * Firmware: 16.28 -#> * Location: 47.88126 N, -69.73433 E -#> * Frequency: 600 kHz +#> * Filename: "(redacted)" +#> * Instrument: adcp +#> * Manufacturer: teledyne rdi +#> * Serial number: (redacted) +#> * Firmware: 16.28 +#> * Cell Size: 0.50 m +#> * Beam Angle: 20 deg +#> * Location: 47.88126 N, -69.73433 E +#> * Frequency: 600 kHz #> * Ensemble Numbers: 5041, 5401, ..., 13321, 13681 #> * Transformation matrix:: #> 1.462 -1.462 0.000 0.000 @@ -224,12 +237,10 @@

    Examples

    #> #> * Processing Log #> -#> - 2023-06-11 11:48:59 UTC: `Create oce object` +#> - 2024-01-26 13:39:17 UTC: `Create oce object` plot(ADP) - -# Remove temporary file -file.remove("adp.nc") +file.remove(ncfile) #> [1] TRUE
    @@ -246,7 +257,7 @@

    Examples

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/ncdf2adv-1.png b/docs/reference/ncdf2adv-1.png new file mode 100644 index 0000000..77605bb Binary files /dev/null and b/docs/reference/ncdf2adv-1.png differ diff --git a/docs/reference/ncdf2adv-2.png b/docs/reference/ncdf2adv-2.png new file mode 100644 index 0000000..aa84215 Binary files /dev/null and b/docs/reference/ncdf2adv-2.png differ diff --git a/docs/reference/ncdf2adv.html b/docs/reference/ncdf2adv.html new file mode 100644 index 0000000..1b78c73 --- /dev/null +++ b/docs/reference/ncdf2adv.html @@ -0,0 +1,225 @@ + +Read a NetCDF file and create an adv object — ncdf2adv • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    This works by calling ncdf2oce() and then using class() on +the result to make it be of subclass "adv". This is intended +to work with NetCDF files created with adv2ncdf(), which embeds +sufficient information in the file to permit ncdf2adv() to +reconstruct the original adv object. See the documentation +for adv2ncdf() to learn more about what it stores, and therefore +what ncdf2adv() attempts to read.

    +
    + +
    +
    ncdf2adv(ncfile = NULL, varTable = NULL, debug = 0)
    +
    + +
    +

    Arguments

    +
    ncfile
    +

    character value naming the input file.

    + + +
    varTable
    +

    character value indicating the variable-naming +scheme to be used, which is passed to read.varTable() to set +up variable names, units, etc.

    + + +
    debug
    +

    integer, 0 (the default) for quiet action apart +from messages and warnings, or any larger value to see more +output that describes the processing steps.

    + +
    +
    +

    Value

    + + +

    ncdf2adv() returns an adv object.

    +
    +
    +

    See also

    +

    Other things related to adv data: +adv2ncdf()

    +

    Other things related to adv data: +adv2ncdf()

    +
    +
    +

    Author

    +

    Dan Kelley

    +
    + +
    +

    Examples

    +
    library(ocencdf)
    +
    +# Example with an adv file from oce package
    +data(adv, package = "oce")
    +summary(adv)
    +#> ADV Summary
    +#> -----------
    +#> 
    +#> * Instrument:    vector, serial number ``(serial number redacted)``
    +#> * Filename:      `(file name redacted)`
    +#> * Location:      47.87943 N ,  -69.72533 E 
    +#> * Time:          2008-07-01 00:00:00 to 2008-07-01 00:00:59 (480 samples, mean increment 0.1250001 s)
    +#> * Data Overview
    +#> 
    +#>                                         Min.                Mean                Max.  Dim. NAs
    +#>     v [m/s]                        -0.080871          0.00069514            0.057789 480x3   0
    +#>     a                                     NA                  NA                  NA 480x3   0
    +#>     q                                     NA                  NA                  NA 480x3   0
    +#>     time                 2008-07-01 00:00:00 2008-07-01 00:00:30 2008-07-01 00:00:59   480   0
    +#>     pressure [dbar]                    16.85              16.866              16.879   480   0
    +#>     timeBurst                             NA                  NA                  NA   480 480
    +#>     recordsBurst                          NA                  NA                  NA   480 480
    +#>     voltageSlow                          9.7                9.71                 9.8    60   0
    +#>     timeSlow                      1214870401          1214870430          1214870460    60   0
    +#>     headingSlow [°]                   -23.39              -23.39              -23.39    60   0
    +#>     pitchSlow [°]                        0.4                 0.5                 0.6    60   0
    +#>     rollSlow [°]                        -6.2              -6.145                -6.1    60   0
    +#>     temperatureSlow [°C]                6.47              6.4997                6.51    60   0
    +#> 
    +#> * Processing Log
    +#> 
    +#>     - 2015-12-23 17:53:39 UTC: `read.oce(file = "/data/archive/sleiwex/2008/moorings/m05/adv/nortek_1943/raw/adv_nortek_1943.vec",     from = as.POSIXct("2008-06-25 00:00:00", tz = "UTC"), to = as.POSIXct("2008-07-06 00:00:00",         tz = "UTC"), latitude = 47.87943, longitude = -69.72533)`
    +#>     - 2015-12-23 17:53:54 UTC: `retime(x = m05VectorBeam, a = 0.58, b = 6.3892e-07, t0 = as.POSIXct("2008-07-01 00:00:00",     tz = "UTC"))`
    +#>     - 2015-12-23 17:53:55 UTC: `subset(x, subset=as.POSIXct("2008-06-25 13:00:00", tz = "UTC") <= time & time <=      as.POSIXct("2008-07-03 00:50:00", tz = "UTC"))`
    +#>     - 2015-12-23 17:53:55 UTC: `oceEdit(x = m05VectorBeam, item = "transformationMatrix", value = rbind(c(11033,     -5803, -5238), c(347, -9622, 9338), c(-1418, -1476, -1333))/4096,     reason = "Nortek email 2011-02-14", person = "DEK")`
    +#>     - 2015-12-23 17:53:55 UTC: `use aquadoppHR heading; despike own pitch and roll`
    +#>     - 2015-12-23 17:54:11 UTC: `beamToXyzAdv(x = x)`
    +#>     - 2015-12-23 17:54:34 UTC: `xyzToEnu(x, declination=-18.099, horizontalCase=TRUE, sensorOrientiation=upward, debug=0)`
    +plot(adv)
    +
    +# Transfer to NetCDF and back to see if results make sense
    +# Use a temporary nc file to let package pass CRAN checks.
    +ncfile <- tempfile(pattern = "adv", fileext = ".nc")
    +oce2ncdf(adv, ncfile = ncfile)
    +ADV <- ncdf2adv(ncfile)
    +summary(ADV)
    +#> ADV Summary
    +#> -----------
    +#> 
    +#> * Instrument:    vector, serial number ``(serial number redacted)``
    +#> * Filename:      `(file name redacted)`
    +#> * Location:      47.87943 N ,  -69.72533 E 
    +#> * Time:          2008-07-01 00:00:00 to 2008-07-01 00:00:59 (480 samples, mean increment 0.1250001 s)
    +#> * Data Overview
    +#> 
    +#>                                         Min.                Mean                Max.  Dim. NAs
    +#>     v [m/s]                        -0.080871          0.00069514            0.057789 480x3   0
    +#>     a                                     NA                  NA                  NA 480x3   0
    +#>     q                                     NA                  NA                  NA 480x3   0
    +#>     time                 2008-07-01 00:00:00 2008-07-01 00:00:30 2008-07-01 00:00:59   480   0
    +#>     pressure [dbar]                    16.85              16.866              16.879   480   0
    +#>     timeBurst                             NA                  NA                  NA   480 480
    +#>     recordsBurst                          NA                  NA                  NA   480 480
    +#>     voltageSlow                          9.7                9.71                 9.8    60   0
    +#>     timeSlow                      1214870401          1214870430          1214870460    60   0
    +#>     headingSlow [°]                   -23.39              -23.39              -23.39    60   0
    +#>     pitchSlow [°]                        0.4                 0.5                 0.6    60   0
    +#>     rollSlow [°]                        -6.2              -6.145                -6.1    60   0
    +#>     temperatureSlow [°C]                6.47              6.4997                6.51    60   0
    +#> 
    +#> * Processing Log
    +#> 
    +#>     - 2024-01-26 13:39:18 UTC: `Create oce object`
    +plot(ADV)
    +
    +file.remove(ncfile)
    +#> [1] TRUE
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.9000.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/ncdf2ctd.html b/docs/reference/ncdf2ctd.html index 2de026b..81dec1c 100644 --- a/docs/reference/ncdf2ctd.html +++ b/docs/reference/ncdf2ctd.html @@ -1,5 +1,5 @@ -Read a netcdf file and create a ctd object — ncdf2ctd • ocencdfRead a NetCDF file and create a ctd object — ncdf2ctd • ocencdf @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4
    @@ -32,16 +32,22 @@
  • Changelog
  • -
    +
    @@ -50,13 +56,13 @@
    -

    Read a netcdf file and create a ctd object

    +

    Read a NetCDF file and create a ctd object

    @@ -109,7 +115,7 @@

    Author

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/ncdf2oce.html b/docs/reference/ncdf2oce.html index 096e96e..22288c0 100644 --- a/docs/reference/ncdf2oce.html +++ b/docs/reference/ncdf2oce.html @@ -1,12 +1,12 @@ -Read a netcdf file and create a general oce object — ncdf2oce • ocencdfRead a NetCDF file and create a general oce object — ncdf2oce • ocencdf +
    @@ -59,20 +65,20 @@
    -

    Read a netcdf file such as are created with e.g. oce2ncdf(), +

    Read a NetCDF file such as are created with e.g. oce2ncdf(), interpreting variable names according to varTable (if provided). -This is intended to work with netcdf files created by -oce2ncdf(), but it may also handle some other netcdf files. +This is intended to work with NetCDF files created by +oce2ncdf(), but it may also handle some other NetCDF files. (Try oce::read.netcdf() if this fails. If that also fails, you will need to work with the ncdf4 library directly.) -Note that the returned object does not get a specialized oce class, -because this is not known within netcdf files. For ctd data, +Note that the returned object does not get a specialized oce class, +because this is not known within NetCDF files. For ctd data, try ncdf2ctd() instead of ncdf2oce(), or wrap the result of calling the latter in oce::as.ctd().

    @@ -122,7 +128,7 @@

    Author

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/ncdfNames2oceNames.html b/docs/reference/ncdfNames2oceNames.html index 4b03919..02bc9cf 100644 --- a/docs/reference/ncdfNames2oceNames.html +++ b/docs/reference/ncdfNames2oceNames.html @@ -1,5 +1,5 @@ -Translate netcdf names to oce names — ncdfNames2oceNames • ocencdfTranslate NetCDF names to oce names — ncdfNames2oceNames • ocencdf @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -32,16 +32,22 @@
  • Changelog
  • - + @@ -50,13 +56,13 @@
    -

    Translate netcdf names to oce names

    +

    Translate NetCDF names to oce names

    @@ -67,7 +73,7 @@

    Translate netcdf names to oce names

    Arguments

    names

    vector of character values in oce convention (e.g. "TEMP" -for temperature, if varTable is "argo").

    +for temperature, if varTable equals "argo").

    varTable
    @@ -99,7 +105,7 @@

    Author

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/oce2ncdf.html b/docs/reference/oce2ncdf.html index 544ab1b..8a0d87e 100644 --- a/docs/reference/oce2ncdf.html +++ b/docs/reference/oce2ncdf.html @@ -1,5 +1,5 @@ -Save an oce-class object as a netcdf file. — oce2ncdf • ocencdfSave an oce-class object as a NetCDF file. — oce2ncdf • ocencdf +
    @@ -51,18 +57,18 @@
    -

    oce1ncdf() works by determining the class of its first argument, +

    oce2ncdf() works by determining the class of its first argument, and then dispatching to an internal function, as appropriate.

    -
    oce2ncdf(x, varTable = NULL, ncfile = NULL, debug = 0)
    +
    oce2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0)
    @@ -85,6 +91,14 @@

    Arguments

    a CTD object).

    +
    force_v4
    +

    logical value which controls the NetCDF file version during +the nc_create step. The default here is TRUE, whereas the +ncdf4-package defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data +sizes, may require v4.

    + +
    debug

    integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -93,7 +107,7 @@

    Arguments

    Author

    -

    Dan Kelley

    +

    Dan Kelley and Clark Richards

    @@ -108,7 +122,7 @@

    Author

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/oceNames2ncdfNames.html b/docs/reference/oceNames2ncdfNames.html index c04bf46..b83578b 100644 --- a/docs/reference/oceNames2ncdfNames.html +++ b/docs/reference/oceNames2ncdfNames.html @@ -1,5 +1,5 @@ -Translate netcdf names to oce names — oceNames2ncdfNames • ocencdfTranslate NetCDF names to oce names — oceNames2ncdfNames • ocencdf @@ -17,7 +17,7 @@ ocencdf - 0.0.2 + 0.0.4 @@ -32,16 +32,22 @@
  • Changelog
  • - + @@ -50,13 +56,13 @@
    -

    Translate netcdf names to oce names

    +

    Translate NetCDF names to oce names

    @@ -99,7 +105,7 @@

    Author

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/reference/ocencdf-package.html b/docs/reference/ocencdf-package.html new file mode 100644 index 0000000..78c8f97 --- /dev/null +++ b/docs/reference/ocencdf-package.html @@ -0,0 +1,163 @@ + +ocencdf: Save oce Objects in NetCDF Files — ocencdf-package • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    The ocencdf package provides functions for saving objects +created by the oce package into NetCDF files.

    +

    Objects of the oce have two slots, 'data' and 'metadata', +that are very significant to the ocencdf package.

    +

    The 'data' contents take the form of vector and array data, and hence can be +stored in the DATA section of the NetCDF file. Since these items can be +accessed easily by standard means of reading NetCDF files, nothing special need +be explained here.

    +

    However, the 'metadata' contents of oce objects take the form of a tree-like +structure that cannot be stored in the DATA section of a NetCDF file, which is +designed for vectors and arrays. For this reason, the 'metadata' contents are +stored in a global attribute of the NetCDF file, named "metadata". It is in +JSON format, for ease of parsing in many languages. In R, for example, this can +be converted using json2metadata(). This +does more than just translate, however, because JSON format lacks the ability to +handle some R structures (notably, the 'expression' class). The following +explains the changes that are involved in expanding the JSON contents into a +'metadata' object that mimics that used in the 'oce' package.

    1. In 'oce', the 'units' structure is broken down into variables (e.g. +'temperature'), and for each variable there are two quantities stored, one +called 'units' and the other called 'scale'. Both are textual in the JSON +representation, which does not match the 'oce' format, which uses the +'expression' class for the first of these. In R, the expression may be +recovered with the 'parse()' function; similar functions exist in +other analysis languages, if there is a need to e.g. label plot +axes with subscripts, etc.

    2. +
    3. For 'adp' data created from Teledyne-RDI files, the metadata contains a +matrix named 'codes' that are in 'raw' (byte-level) format. These are +converted to integers for the JSON representation, and so if there is a need +to get the original values, a conversion will be required.

    4. +
    + + + +
    +

    Author

    +

    Maintainer: Dan Kelley Dan.Kelley@Dal.Ca (ORCID)

    +

    Other contributors:

    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.9000.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/ocencdf.html b/docs/reference/ocencdf.html new file mode 100644 index 0000000..5a8d1ca --- /dev/null +++ b/docs/reference/ocencdf.html @@ -0,0 +1,150 @@ + +ocencdf: Save oce Objects in NetCDF Files — ocencdf • ocencdf + + +
    +
    + + + +
    +
    + + +
    +

    The ocencdf package provides functions for saving objects +created by the oce package into NetCDF files.

    +

    Oce objects have two main components, named 'data' and 'metadata'.

    +

    The 'data' contents take the form of vector and array data, and hence can be +stored in the DATA section of the NetCDF file. Since these items can be +accessed easily by standard means of reading NetCDF files, nothing special need +be explained here.

    +

    However, the 'metadata' contents of oce objects take the form of a tree-like +structure that cannot be stored in the DATA section of a NetCDF file, which is +designed for vectors and arrays. For this reason, the 'metadata' contents are +stored in a global attribute of the NetCDF file, named "metadata". It is in +JSON format, for ease of parsing in many languages. In R, for example, this can +be converted using the json2metadata() function of the 'ocencdf' package. This +does more than just translate, however, because JSON format lacks the ability to +handle some R structures (notably, the 'expression' class). The following +explains the changes that are involved in expanding the JSON contents into a +'metadata' object that mimics that used in the 'oce' package.

    1. In 'oce', the 'units' structure is broken down into variables (e.g. +'temperature'), and for each variable there are two quantities stored, one +called 'units' and the other called 'scale'. Both are textual in the JSON +representation, which does not match the 'oce' format, which uses the +'expression' class for the first of these. In R, the expression may be +recovered with the 'parse()' function; similar functions exist in +other analysis languages, if there is a need to e.g. label plot +axes with subscripts, etc.

    2. +
    3. For 'adp' data created from Teledyne-RDI files, the metadata contains a +matrix named 'codes' that are in 'raw' (byte-level) format. These are +converted to integers for the JSON representation, and so if there is a need +to get the original values, a conversion will be required.

    4. +
    + + + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/read.varTable.html b/docs/reference/read.varTable.html index 25bd412..00b5f25 100644 --- a/docs/reference/read.varTable.html +++ b/docs/reference/read.varTable.html @@ -1,7 +1,7 @@ Read a variable-information table — read.varTable • ocencdf +
    @@ -55,14 +61,14 @@

    This function, meant for internal use by the package, uses yaml::yaml.load_file() to read YAML files that describe the -output netcdf format created by e.g. ctd2ncdf(). Users wishing +output NetCDF format created by e.g. ctd2ncdf(). Users wishing to define such files for their own use should follow the pattern of the source directory inst/extdata/argo.yml.

    @@ -89,7 +95,7 @@

    Value

    read.varTable() returns a list that specifies some information -to be stored in netcdf files created by e.g. ctd2ncdf().

    +to be stored in NetCDF files created by e.g. ctd2ncdf().

    Details

    @@ -102,7 +108,7 @@

    Details

  • Otherwise, ".yml" is appended to varTable and a file with that name is sought in the inst/ext_data source directory. At the moment, there are two such built-in files, named -"argo.yml" and `"whp.yml".

  • +"argo.yml" and "whp.yml".

    Author

    @@ -111,7 +117,7 @@

    Author

    Examples

    -
    library(ocencdf)
    +    
    library(ocencdf)
     str(read.varTable("whp"))
     #> List of 4
     #>  $ type     :List of 3
    @@ -250,7 +256,7 @@ 

    Examples

    -

    Site built with pkgdown 2.0.7.

    +

    Site built with pkgdown 2.0.7.9000.

    diff --git a/docs/sitemap.xml b/docs/sitemap.xml index 2b4d934..ee0a03b 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -27,6 +27,9 @@ /reference/adp2ncdf.html + + /reference/adv2ncdf.html + /reference/ctd2ncdf.html @@ -36,9 +39,18 @@ /reference/index.html + + /reference/json2metadata.html + + + /reference/metadata2json.html + /reference/ncdf2adp.html + + /reference/ncdf2adv.html + /reference/ncdf2ctd.html @@ -54,6 +66,12 @@ /reference/oceNames2ncdfNames.html + + /reference/ocencdf-package.html + + + /reference/ocencdf.html + /reference/read.varTable.html diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..a324654 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,21 @@ +ADCP +CMD +CTD +Hydrographic +JSON +NetCDF +ORCID +Oce +Oce +POSIXct +RDI +Teledyne +YAML +adp +ctd +flavour +oce +oce +varTable +varTables +yhp diff --git a/inst/extdata/ncdf_explanation.md b/inst/extdata/ncdf_explanation.md index c4a72a3..43cd581 100644 --- a/inst/extdata/ncdf_explanation.md +++ b/inst/extdata/ncdf_explanation.md @@ -1,14 +1,14 @@ Oce objects have two main components, named 'data' and 'metadata'. The 'data' contents take the form of vector and array data, and hence can be -stored in the DATA section of this Netcdf file. Since these items can be -accessed easily by standard means of reading Netcdf files, nothing special need +stored in the DATA section of this NetCDF file. Since these items can be +accessed easily by standard means of reading NetCDF files, nothing special need be explained here. However, the 'metadata' contents of oce objects take the form of a tree-like -structure that cannot be stored in the DATA section of a Netcdf file, which is +structure that cannot be stored in the DATA section of a NetCDF file, which is designed for vectors and arrays. For this reason, the 'metadata' contents are -stored in a global attribute of the Netcdf file, named "metadata". It is in +stored in a global attribute of the NetCDF file, named "metadata". It is in JSON format, for ease of parsing in many languages. In R, for example, this can be converted using the json2metadata() function of the 'ocencdf' package. This does more than just translate, however, because JSON format lacks the ability to diff --git a/man/adp2ncdf.Rd b/man/adp2ncdf.Rd index 26e99e6..5edeb1b 100644 --- a/man/adp2ncdf.Rd +++ b/man/adp2ncdf.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/adp.R \name{adp2ncdf} \alias{adp2ncdf} -\title{Save an adp object to a netcdf file} +\title{Save an ADP object to a NetCDF file} \usage{ adp2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) } \arguments{ -\item{x}{an oce object of class \code{adp}, as created by e.g. \code{\link[oce:read.adp]{oce::read.adp()}}.} +\item{x}{an \code{oce} object of class \code{adp}, as created by e.g. \code{\link[oce:read.adp]{oce::read.adp()}}.} \item{varTable}{character value indicating the variable-naming scheme to be used, which is passed to \code{\link[=read.varTable]{read.varTable()}} to set @@ -17,10 +17,10 @@ up variable names, units, etc.} for a file name to be created automatically (e.g. \code{ctd.nc} for a CTD object).} -\item{force_v4}{logical value which controls the netCDF file version during +\item{force_v4}{logical value which controls the NetCDF file version during the \link[ncdf4]{nc_create} step. The default here is TRUE, whereas the -\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the netCDF -file is compatible with netCDF v3). Some features, including large data +\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data sizes, may require v4.} \item{debug}{integer, 0 (the default) for quiet action apart @@ -29,7 +29,7 @@ output that describes the processing steps.} } \description{ Given an \code{adp} object created by the \code{oce} package, this function -creates a netcdf file that can later by read by \code{\link[=ncdf2adp]{ncdf2adp()}} to approximately +creates a NetCDF file that can later by read by \code{\link[=ncdf2adp]{ncdf2adp()}} to approximately reproduce the original contents. } \details{ @@ -53,18 +53,18 @@ and \examples{ library(ocencdf) -# Example with an adp file from oce package -data(adp, package="oce") +# Example with an ADP file from `oce` package +data(adp, package = "oce") summary(adp) plot(adp) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adp, ncfile="adp.nc") -ADP <- ncdf2adp("adp.nc") +# Transfer to NetCDF and back to see if results make sense. +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adp", fileext = ".nc") +oce2ncdf(adp, ncfile = ncfile) +ADP <- ncdf2adp(ncfile) summary(ADP) plot(ADP) - -# Remove temporary file -file.remove("adp.nc") +file.remove(ncfile) } \seealso{ diff --git a/man/adv2ncdf.Rd b/man/adv2ncdf.Rd index 9425f87..d748a17 100644 --- a/man/adv2ncdf.Rd +++ b/man/adv2ncdf.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/adv.R \name{adv2ncdf} \alias{adv2ncdf} -\title{Save an adv object to a netcdf file} +\title{Save an adv object to a NetCDF file} \usage{ adv2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) } @@ -17,10 +17,10 @@ up variable names, units, etc.} for a file name to be created automatically (e.g. \code{ctd.nc} for a CTD object).} -\item{force_v4}{logical value which controls the netCDF file version during +\item{force_v4}{logical value which controls the NetCDF file version during the \link[ncdf4]{nc_create} step. The default here is TRUE, whereas the -\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the netCDF -file is compatible with netCDF v3). Some features, including large data +\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data sizes, may require v4.} \item{debug}{integer, 0 (the default) for quiet action apart @@ -29,7 +29,7 @@ output that describes the processing steps.} } \description{ Given an \code{adv} object created by the \code{oce} package, this function -creates a netcdf file that can later by read by \code{\link[=ncdf2adv]{ncdf2adv()}} to approximately +creates a NetCDF file that can later by read by \code{\link[=ncdf2adv]{ncdf2adv()}} to approximately reproduce the original contents. } \details{ @@ -44,17 +44,17 @@ The entire contents of the metadata slot are saved in the global attribute named library(ocencdf) # Example with an adv file from oce package -data(adv, package="oce") +data(adv, package = "oce") summary(adv) plot(adv) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adv, ncfile="adv.nc") -ADV <- ncdf2adv("adv.nc") +# Transfer to NetCDF and back to see if results make sense +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adv", fileext = ".nc") +oce2ncdf(adv, ncfile = ncfile) +ADV <- ncdf2adv(ncfile) summary(ADV) plot(ADV) - -# Remove temporary file -file.remove("adv.nc") +file.remove(ncfile) } \seealso{ diff --git a/man/ctd2ncdf.Rd b/man/ctd2ncdf.Rd index bc9a972..53d567b 100644 --- a/man/ctd2ncdf.Rd +++ b/man/ctd2ncdf.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ctd.R \name{ctd2ncdf} \alias{ctd2ncdf} -\title{Save a ctd object to a netcdf file} +\title{Save a ctd object to a NetCDF file} \usage{ ctd2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) } @@ -18,10 +18,10 @@ up variable names, units, etc.} for a file name to be created automatically (e.g. \code{ctd.nc} for a CTD object).} -\item{force_v4}{logical value which controls the netCDF file version during +\item{force_v4}{logical value which controls the NetCDF file version during the \link[ncdf4]{nc_create} step. The default here is TRUE, whereas the -\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the netCDF -file is compatible with netCDF v3). Some features, including large data +\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data sizes, may require v4.} \item{debug}{integer, 0 (the default) for quiet action apart @@ -29,17 +29,17 @@ from messages and warnings, or any larger value to see more output that describes the processing steps.} } \description{ -This creates a netcdf file in a convention that permits later reading by +This creates a NetCDF file in a convention that permits later reading by \code{\link[=ncdf2ctd]{ncdf2ctd()}}, and that may be convenient for other purposes as well. } \details{ Note that \code{\link[=ctd2ncdf]{ctd2ncdf()}} defaults \code{varTable} to \code{"argo"}. -The contents of the \code{data} slot of the oce object \code{x} are as netcdf +The contents of the \code{data} slot of the oce object \code{x} are as NetCDF data items. If flags are present in the \code{metadata} slot, they are also saved as data, with names ending in \verb{_QC}. -In addition to storage in the netcdf data section, several attributes +In addition to storage in the NetCDF data section, several attributes are saved as well. These include units for the data, which are tied to the corresponding variables. The entire \code{metadata} slot is stored as a global attribute named \code{metadata}, so that a later call to @@ -53,24 +53,26 @@ individual global attributes: \code{"latitude"}, \code{"longitude"}, library(ocencdf) # example 1: a ctd file without per-variable QC flags -data(ctd, package="oce") -oce2ncdf(ctd, ncfile="ctd.nc") -CTD <- as.ctd(ncdf2oce("ctd.nc")) +data(ctd, package = "oce") +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "ctd", fileext = ".nc") +oce2ncdf(ctd, ncfile = ncfile) +CTD <- as.ctd(ncdf2oce(ncfile)) +file.remove(ncfile) summary(CTD) plot(CTD) # example 2: a ctd file with per-variable QC flags -data(section, package="oce") +data(section, package = "oce") stn <- section[["station", 100]] -oce2ncdf(stn, ncfile="stn.nc") -STN <- as.ctd(ncdf2oce("stn.nc")) +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "ctd", fileext = ".nc") +oce2ncdf(stn, ncfile = ncfile) +STN <- as.ctd(ncdf2oce(ncfile)) +file.remove(ncfile) summary(STN) plot(STN) -# Remove temporary files -file.remove("ctd.nc") -file.remove("stn.nc") - } \seealso{ Other things related to CTD data: diff --git a/man/getVarInfo.Rd b/man/getVarInfo.Rd index c627094..cdb8578 100644 --- a/man/getVarInfo.Rd +++ b/man/getVarInfo.Rd @@ -28,8 +28,8 @@ output that describes the processing steps.} } \value{ \code{\link[=getVarInfo]{getVarInfo()}} returns a list containing \code{name} (the -name as used in argo netcdf files), \code{long_name} (again, as used in -Argo netcdf files, although the usefulness of this is debatable), +name as used in Argo NetCDF files), \code{long_name} (again, as used in +Argo NetCDF files, although the usefulness of this is debatable), \code{standard_name} (not used by \code{\link[=ctd2ncdf]{ctd2ncdf()}} as of now), \code{FillValue} (used by \code{\link[=ctd2ncdf]{ctd2ncdf()}} for missing values) and, if \code{oce} is provided and it can be determined, \code{unit} (a character string specifying @@ -37,7 +37,7 @@ the unit). } \description{ This is used by e.g. \code{\link[=ctd2ncdf]{ctd2ncdf()}} to determine how to describe the variable in a -particular flavour of netcdf file, as specified by \code{\link[=read.varTable]{read.varTable()}}. +particular flavour of NetCDF file, as specified by \code{\link[=read.varTable]{read.varTable()}}. } \examples{ library(ocencdf) diff --git a/man/metadata2json.Rd b/man/metadata2json.Rd index 42ca60a..f5c0ebd 100644 --- a/man/metadata2json.Rd +++ b/man/metadata2json.Rd @@ -40,11 +40,11 @@ values: \code{date}, \code{endTime}, \code{startTime}, and \code{systemUploadTim } } \examples{ -# Example 1: ctd data +# Example 1: CTD data data("ctd") metadata2json(ctd@metadata) -# Example 2: adp data +# Example 2: ADP data data("adp") metadata2json(adp@metadata) diff --git a/man/ncdf2adp.Rd b/man/ncdf2adp.Rd index 5685a68..b375209 100644 --- a/man/ncdf2adp.Rd +++ b/man/ncdf2adp.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/adp.R \name{ncdf2adp} \alias{ncdf2adp} -\title{Read a netcdf file and create an adp object} +\title{Read a NetCDF file and create an ADP object} \usage{ ncdf2adp(ncfile = NULL, varTable = NULL, debug = 0) } @@ -23,7 +23,7 @@ output that describes the processing steps.} \description{ This works by calling \code{\link[=ncdf2oce]{ncdf2oce()}} and then using \code{\link[=class]{class()}} on the result to make it be of subclass \code{"adp"}. This is intended -to work with Netcdf files created with \code{\link[=adp2ncdf]{adp2ncdf()}}, which embeds +to work with NetCDF files created with \code{\link[=adp2ncdf]{adp2ncdf()}}, which embeds sufficient information in the file to permit \code{\link[=ncdf2adp]{ncdf2adp()}} to reconstruct the original adp object. See the documentation for \code{\link[=adp2ncdf]{adp2ncdf()}} to learn more about what it stores, and therefore @@ -32,21 +32,24 @@ what \code{\link[=ncdf2adp]{ncdf2adp()}} attempts to read. \examples{ library(ocencdf) -# Example with an adp file from oce package -data(adp, package="oce") +# Example with an ADP file from `oce` package +data(adp, package = "oce") summary(adp) plot(adp) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adp, ncfile="adp.nc") -ADP <- ncdf2adp("adp.nc") +# Transfer to NetCDF and back to see if results make sense +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adp", fileext = ".nc") +oce2ncdf(adp, ncfile = ncfile) +ADP <- ncdf2adp(ncfile) summary(ADP) plot(ADP) - -# Remove temporary file -file.remove("adp.nc") +file.remove(ncfile) } \seealso{ +Other things related to adp data: +\code{\link{adp2ncdf}()} + Other things related to adp data: \code{\link{adp2ncdf}()} } diff --git a/man/ncdf2adv.Rd b/man/ncdf2adv.Rd index 8b0d163..db3ae7e 100644 --- a/man/ncdf2adv.Rd +++ b/man/ncdf2adv.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/adv.R \name{ncdf2adv} \alias{ncdf2adv} -\title{Read a netcdf file and create an adv object} +\title{Read a NetCDF file and create an adv object} \usage{ ncdf2adv(ncfile = NULL, varTable = NULL, debug = 0) } @@ -23,7 +23,7 @@ output that describes the processing steps.} \description{ This works by calling \code{\link[=ncdf2oce]{ncdf2oce()}} and then using \code{\link[=class]{class()}} on the result to make it be of subclass \code{"adv"}. This is intended -to work with Netcdf files created with \code{\link[=adv2ncdf]{adv2ncdf()}}, which embeds +to work with NetCDF files created with \code{\link[=adv2ncdf]{adv2ncdf()}}, which embeds sufficient information in the file to permit \code{\link[=ncdf2adv]{ncdf2adv()}} to reconstruct the original adv object. See the documentation for \code{\link[=adv2ncdf]{adv2ncdf()}} to learn more about what it stores, and therefore @@ -33,20 +33,23 @@ what \code{\link[=ncdf2adv]{ncdf2adv()}} attempts to read. library(ocencdf) # Example with an adv file from oce package -data(adv, package="oce") +data(adv, package = "oce") summary(adv) plot(adv) -# Transfer to netcdf and back to see if results make sense -oce2ncdf(adv, ncfile="adv.nc") -ADV <- ncdf2adv("adv.nc") +# Transfer to NetCDF and back to see if results make sense +# Use a temporary nc file to let package pass CRAN checks. +ncfile <- tempfile(pattern = "adv", fileext = ".nc") +oce2ncdf(adv, ncfile = ncfile) +ADV <- ncdf2adv(ncfile) summary(ADV) plot(ADV) - -# Remove temporary file -file.remove("adv.nc") +file.remove(ncfile) } \seealso{ +Other things related to adv data: +\code{\link{adv2ncdf}()} + Other things related to adv data: \code{\link{adv2ncdf}()} } diff --git a/man/ncdf2ctd.Rd b/man/ncdf2ctd.Rd index 7ca81fe..f37e767 100644 --- a/man/ncdf2ctd.Rd +++ b/man/ncdf2ctd.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ctd.R \name{ncdf2ctd} \alias{ncdf2ctd} -\title{Read a netcdf file and create a ctd object} +\title{Read a NetCDF file and create a ctd object} \usage{ ncdf2ctd(ncfile = NULL, varTable = NULL, debug = 0) } @@ -21,7 +21,7 @@ output that describes the processing steps.} \code{\link[=ncdf2ctd]{ncdf2ctd()}} returns an \linkS4class{ctd} object. } \description{ -Read a netcdf file and create a ctd object +Read a NetCDF file and create a ctd object } \seealso{ Other things related to CTD data: diff --git a/man/ncdf2oce.Rd b/man/ncdf2oce.Rd index faa466f..efabfd9 100644 --- a/man/ncdf2oce.Rd +++ b/man/ncdf2oce.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ncdf2oce.R \name{ncdf2oce} \alias{ncdf2oce} -\title{Read a netcdf file and create a general oce object} +\title{Read a NetCDF file and create a general \code{oce} object} \usage{ ncdf2oce(ncfile = NULL, varTable = NULL, debug = 0) } @@ -21,14 +21,14 @@ output that describes the processing steps.} \code{\link[=ncdf2oce]{ncdf2oce()}} returns an \linkS4class{oce} object. } \description{ -Read a netcdf file such as are created with e.g. \code{\link[=oce2ncdf]{oce2ncdf()}}, +Read a NetCDF file such as are created with e.g. \code{\link[=oce2ncdf]{oce2ncdf()}}, interpreting variable names according to \code{varTable} (if provided). -This is intended to work with netcdf files created by -\code{\link[=oce2ncdf]{oce2ncdf()}}, but it may also handle some other netcdf files. +This is intended to work with NetCDF files created by +\code{\link[=oce2ncdf]{oce2ncdf()}}, but it may also handle some other NetCDF files. (Try \code{\link[oce:read.netcdf]{oce::read.netcdf()}} if this fails. If that also fails, you will need to work with the \code{ncdf4} library directly.) -Note that the returned object does \emph{not} get a specialized oce class, -because this is not known within netcdf files. For ctd data, +Note that the returned object does \emph{not} get a specialized \code{oce} class, +because this is not known within NetCDF files. For ctd data, try \code{\link[=ncdf2ctd]{ncdf2ctd()}} instead of \code{\link[=ncdf2oce]{ncdf2oce()}}, or wrap the result of calling the latter in \code{\link[oce:as.ctd]{oce::as.ctd()}}. } diff --git a/man/ncdfNames2oceNames.Rd b/man/ncdfNames2oceNames.Rd index ea78e52..3d30eed 100644 --- a/man/ncdfNames2oceNames.Rd +++ b/man/ncdfNames2oceNames.Rd @@ -2,13 +2,13 @@ % Please edit documentation in R/vartable.R \name{ncdfNames2oceNames} \alias{ncdfNames2oceNames} -\title{Translate netcdf names to oce names} +\title{Translate NetCDF names to oce names} \usage{ ncdfNames2oceNames(names, varTable = NULL, debug = 0) } \arguments{ \item{names}{vector of character values in oce convention (e.g. "TEMP" -for temperature, if varTable is "argo").} +for temperature, if \code{varTable} equals \code{"argo"}).} \item{varTable}{character value indicating the variable-naming scheme to be used, which is passed to \code{\link[=read.varTable]{read.varTable()}} to set @@ -19,7 +19,7 @@ from messages and warnings, or any larger value to see more output that describes the processing steps.} } \description{ -Translate netcdf names to oce names +Translate NetCDF names to oce names } \author{ Dan Kelley diff --git a/man/oce2ncdf.Rd b/man/oce2ncdf.Rd index 812cbb0..54dd6cd 100644 --- a/man/oce2ncdf.Rd +++ b/man/oce2ncdf.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/oce2ncdf.R \name{oce2ncdf} \alias{oce2ncdf} -\title{Save an oce-class object as a netcdf file.} +\title{Save an oce-class object as a NetCDF file.} \usage{ oce2ncdf(x, varTable = NULL, ncfile = NULL, force_v4 = TRUE, debug = 0) } @@ -19,10 +19,10 @@ up variable names, units, etc.} for a file name to be created automatically (e.g. \code{ctd.nc} for a CTD object).} -\item{force_v4}{logical value which controls the netCDF file version during +\item{force_v4}{logical value which controls the NetCDF file version during the \link[ncdf4]{nc_create} step. The default here is TRUE, whereas the -\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the netCDF -file is compatible with netCDF v3). Some features, including large data +\link[ncdf4]{ncdf4-package} defaults to FALSE (ensuring that the NetCDF +file is compatible with NetCDF v3). Some features, including large data sizes, may require v4.} \item{debug}{integer, 0 (the default) for quiet action apart diff --git a/man/oceNames2ncdfNames.Rd b/man/oceNames2ncdfNames.Rd index 2371e62..d94b7c0 100644 --- a/man/oceNames2ncdfNames.Rd +++ b/man/oceNames2ncdfNames.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/vartable.R \name{oceNames2ncdfNames} \alias{oceNames2ncdfNames} -\title{Translate netcdf names to oce names} +\title{Translate NetCDF names to oce names} \usage{ oceNames2ncdfNames(names, varTable = NULL, debug = 0) } @@ -19,7 +19,7 @@ from messages and warnings, or any larger value to see more output that describes the processing steps.} } \description{ -Translate netcdf names to oce names +Translate NetCDF names to oce names } \author{ Dan Kelley diff --git a/man/ocencdf.Rd b/man/ocencdf-package.Rd similarity index 61% rename from man/ocencdf.Rd rename to man/ocencdf-package.Rd index 3c9b72c..c3411c7 100644 --- a/man/ocencdf.Rd +++ b/man/ocencdf-package.Rd @@ -1,26 +1,28 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocencdf.R \docType{package} -\name{ocencdf} +\name{ocencdf-package} \alias{ocencdf} -\title{ocencdf: Save oce Objects in Netcdf Files} +\alias{ocencdf-package} +\title{ocencdf: Save \code{oce} Objects in NetCDF Files} \description{ The ocencdf package provides functions for saving objects -created by the oce package into Netcdf files. +created by the oce package into NetCDF files. -Oce objects have two main components, named 'data' and 'metadata'. +Objects of the \code{oce} have two slots, 'data' and 'metadata', +that are very significant to the \code{ocencdf} package. The 'data' contents take the form of vector and array data, and hence can be -stored in the DATA section of the Netcdf file. Since these items can be -accessed easily by standard means of reading Netcdf files, nothing special need +stored in the DATA section of the NetCDF file. Since these items can be +accessed easily by standard means of reading NetCDF files, nothing special need be explained here. However, the 'metadata' contents of oce objects take the form of a tree-like -structure that cannot be stored in the DATA section of a Netcdf file, which is +structure that cannot be stored in the DATA section of a NetCDF file, which is designed for vectors and arrays. For this reason, the 'metadata' contents are -stored in a global attribute of the Netcdf file, named "metadata". It is in +stored in a global attribute of the NetCDF file, named "metadata". It is in JSON format, for ease of parsing in many languages. In R, for example, this can -be converted using the json2metadata() function of the 'ocencdf' package. This +be converted using \code{\link[=json2metadata]{json2metadata()}}. This does more than just translate, however, because JSON format lacks the ability to handle some R structures (notably, the 'expression' class). The following explains the changes that are involved in expanding the JSON contents into a @@ -40,3 +42,21 @@ converted to integers for the JSON representation, and so if there is a need to get the original values, a conversion will be required. } } +\seealso{ +Useful links: +\itemize{ + \item \url{https://dankelley.github.io/ocencdf/} + \item Report bugs at \url{https://github.com/dankelley/ocencdf/issues} +} + +} +\author{ +\strong{Maintainer}: Dan Kelley \email{Dan.Kelley@Dal.Ca} (\href{https://orcid.org/0000-0001-7808-5911}{ORCID}) + +Other contributors: +\itemize{ + \item Clark Richards \email{clark.richards@gmail.com} (\href{https://orcid.org/0000-0002-7833-206X}{ORCID}) [contributor] +} + +} +\keyword{internal} diff --git a/man/read.varTable.Rd b/man/read.varTable.Rd index 850ffc9..96faa07 100644 --- a/man/read.varTable.Rd +++ b/man/read.varTable.Rd @@ -16,12 +16,12 @@ output that describes the processing steps.} } \value{ \code{\link[=read.varTable]{read.varTable()}} returns a list that specifies some information -to be stored in netcdf files created by e.g. \code{\link[=ctd2ncdf]{ctd2ncdf()}}. +to be stored in NetCDF files created by e.g. \code{\link[=ctd2ncdf]{ctd2ncdf()}}. } \description{ This function, meant for internal use by the package, uses \code{\link[yaml:yaml.load]{yaml::yaml.load_file()}} to read YAML files that describe the -output netcdf format created by e.g. \code{\link[=ctd2ncdf]{ctd2ncdf()}}. Users wishing +output NetCDF format created by e.g. \code{\link[=ctd2ncdf]{ctd2ncdf()}}. Users wishing to define such files for their own use should follow the pattern of the source directory \code{inst/extdata/argo.yml}. } @@ -37,7 +37,7 @@ if \code{varTable} is a character value, then there are 3 possibilities. \item Otherwise, \code{".yml"} is appended to \code{varTable} and a file with that name is sought in the \code{inst/ext_data} source directory. At the moment, there are two such built-in files, named -\code{"argo.yml"} and `"whp.yml". +\code{"argo.yml"} and \code{"whp.yml"}. } } \examples{ diff --git a/revdep/data.sqlite b/revdep/data.sqlite new file mode 100644 index 0000000..32610fa Binary files /dev/null and b/revdep/data.sqlite differ diff --git a/tests/testthat/test_adv.R b/tests/testthat/test_adv.R index 314a8e5..fb04691 100644 --- a/tests/testthat/test_adv.R +++ b/tests/testthat/test_adv.R @@ -1,73 +1,13 @@ # vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4 -test_that("adv2ncdf on data(adv) creates a file with expected variable names", +test_that("adv2ncdf/ncdf2adv duplicates original data and metadata", { data(adv, package="oce") ncfile <- tempfile(pattern="adv", fileext=".nc") expect_silent(adv2ncdf(adv, ncfile=ncfile)) - o <- nc_open(ncfile) - expect_equal(names(o$var), - c("v", "a", "q", "time", "pressure", "timeBurst", "recordsBurst", - "voltageSlow", "timeSlow", "headingSlow", "pitchSlow", - "rollSlow", "temperatureSlow")) - unlink(ncfile) - }) - -test_that("ncdf2adv creates a file with expected metadata", - { - data(adv, package="oce") - ncfile <- tempfile(pattern="adv", fileext=".nc") - expect_silent(adv2ncdf(adv, ncfile=ncfile)) - o <- nc_open(ncfile) ADV <- ncdf2adv(ncfile) + expect_equal(adv@data, ADV@data) expect_equal(adv@metadata, ADV@metadata) - unlink(ncfile) + file.remove(ncfile) }) -test_that("ncdf2adv creates a file with expected data", - { - data(adv, package="oce") - ncfile <- tempfile(pattern="adv", fileext=".nc") - #ncfile <- "adv.nc" - expect_silent(adv2ncdf(adv, ncfile=ncfile)) - ADV <- ncdf2adv(ncfile) - # Convert two numeric things to raw. (We don't bother trying to - # save them as raw in adv2ncdf(), but maybe we should.) - dim <- dim(adv@data$a) - for (item in c("a", "q")) { - ADV@data[[item]] <- as.raw(ADV@data[[item]]) - dim(ADV@data[[item]]) <- dim - } - for (name in paste('monkey',names(adv@data))) { - expect_equal(adv@data[[name]], ADV@data[[name]])#, tolerance=1e-3) - if (is.integer(adv@data[[name]])) { - if (!all.equal(adv@data[[name]], ADV@data[[name]])) { - cat("conflict in integer-class item ", name, ":\n") - cat(" orig: ", adv@data[[name]], "\n") - cat(" new: ", ADV@data[[name]], "\n") - } - } else if (is.raw(adv@data[[name]])) { - dim <- dim(adv@data[[name]]) - ADV@data[[name]] <- as.raw(ADV@data[[name]]) - dim(ADV@data[[name]]) <- dim - if (!all.equal(adv@data[[name]], ADV@data[[name]])) { - cat("conflict in raw-class item", name, ":\n") - cat(" orig: ", adv@data[[name]], "\n") - cat(" new: ", ADV@data[[name]], "\n") - } - } else if (inherits(adv@data[[name]], "POSIXt")) { - if (!all.equal(adv@data$time, ADV@data$time)) { - cat("conflict in POSIXt-class item", name, ":\n") - cat(" orig: ", adv@data[[name]], "\n") - cat(" new: ", ADV@data[[name]], "\n") - } - } else { - if (!all.equal(adv@data[[name]], ADV@data[[name]], tolerance=1e-7)) { - cat("conflict in float item ", name, ":\n") - cat(" orig: ", adv@data[[name]], "\n") - cat(" new: ", ADV@data[[name]], "\n") - } - } - } - unlink(ncfile) - }) diff --git a/tests/testthat/test_ctd.R b/tests/testthat/test_ctd.R index ca23ab4..efcfb72 100644 --- a/tests/testthat/test_ctd.R +++ b/tests/testthat/test_ctd.R @@ -10,7 +10,7 @@ test_that("ctd2nc on data(ctd) creates a file with expected variable names", o <- nc_open(ncfile) expect_equal(names(o$var), c("scan", "timeS", "PRES", "depth", "TEMP", "PSAL", "flag")) - unlink(ncfile) + file.remove(ncfile) }) test_that("ctd2nc on a section station creates a file with expected variable names", @@ -21,5 +21,5 @@ test_that("ctd2nc on a section station creates a file with expected variable nam #expect_equal(names(o$var), # c("scan", "timeS", "PRES", "depth", "TEMP", "PSAL", "flag", "TIME", # "station", "LONGITUDE", "LATITUDE")) - unlink(ncfile) + file.remove(ncfile) }) diff --git a/tests/testthat/test_metadata.R b/tests/testthat/test_metadata.R index b8bb950..29e8d43 100644 --- a/tests/testthat/test_metadata.R +++ b/tests/testthat/test_metadata.R @@ -1,7 +1,7 @@ # vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4 # Test the scheme used to convert metadata contents to a JSON string, for -# storage in the netcdf file as a global attribute named 'metadata'. +# storage in the NetCDF file as a global attribute named 'metadata'. test_that("ctd metadata", { diff --git a/vignettes/built_in_vartables.R b/vignettes/built_in_vartables.R index 55859ad..2dcdbd8 100644 --- a/vignettes/built_in_vartables.R +++ b/vignettes/built_in_vartables.R @@ -1,7 +1,23 @@ +## ----eval=FALSE--------------------------------------------------------------- +# system.file("extdata", "adp.yml", package="ocencdf") + +## ----echo=FALSE--------------------------------------------------------------- +lines <- readLines(system.file("extdata", "adp.yml", package="ocencdf")) +for (line in lines) + cat(line, "\n") + +## ----eval=FALSE--------------------------------------------------------------- +# system.file("extdata", "adv.yml", package="ocencdf") + +## ----echo=FALSE--------------------------------------------------------------- +lines <- readLines(system.file("extdata", "adv.yml", package="ocencdf")) +for (line in lines) + cat(line, "\n") + ## ----eval=FALSE--------------------------------------------------------------- # system.file("extdata", "argo.yml", package="ocencdf") -## ---- echo=FALSE-------------------------------------------------------------- +## ----echo=FALSE--------------------------------------------------------------- lines <- readLines(system.file("extdata", "argo.yml", package="ocencdf")) for (line in lines) cat(line, "\n") @@ -9,7 +25,7 @@ for (line in lines) ## ----eval=FALSE--------------------------------------------------------------- # system.file("extdata", "yhp.yml", package="ocencdf") -## ---- echo=FALSE-------------------------------------------------------------- +## ----echo=FALSE--------------------------------------------------------------- lines <- readLines(system.file("extdata", "whp.yml", package="ocencdf")) for (line in lines) cat(line, "\n") diff --git a/vignettes/built_in_vartables.Rmd b/vignettes/built_in_vartables.Rmd index cbf9513..8c9a68e 100644 --- a/vignettes/built_in_vartables.Rmd +++ b/vignettes/built_in_vartables.Rmd @@ -22,15 +22,49 @@ editor_options: # Introduction -This vignette discusses two built-in variable-table files. These may be used as -patterns by users wishing to create their own tables. Note that the package +This vignette discusses two built-in variable-table files. These may be used +as patterns by users wishing to create their own tables. Note that the package requires that the files be in proper YAML format, which can be checked by using `yaml::yaml.load_file("file.yml")`, where `"file.yml"` is the trial file. This function will report an error if the contents are not in proper YAML format. # The built-in tables -## argo +## `adp` + +This table is stored in a file that may be accessed with +```{r eval=FALSE} +system.file("extdata", "adp.yml", package="ocencdf") +``` +and the contents are as follows. +```{r, echo=FALSE} +#| echo: false +#| fig.width: 10 +#| comment: "" +lines <- readLines(system.file("extdata", "adp.yml", package="ocencdf")) +for (line in lines) + cat(line, "\n") +``` + + +## `adv` + +This table is stored in a file that may be accessed with +```{r eval=FALSE} +system.file("extdata", "adv.yml", package="ocencdf") +``` +and the contents are as follows. +```{r, echo=FALSE} +#| echo: false +#| fig.width: 10 +#| comment: "" +lines <- readLines(system.file("extdata", "adv.yml", package="ocencdf")) +for (line in lines) + cat(line, "\n") +``` + + +## `argo` This table, patterned on naming conventions in the Argo ocean float program, is stored in a file that may be accessed with @@ -47,7 +81,7 @@ for (line in lines) cat(line, "\n") ``` -## yhp +## `yhp` This table, patterned on naming conventions in the World Hydrographic Program, is stored in a file that may be accessed with @@ -64,4 +98,3 @@ for (line in lines) cat(line, "\n") ``` - diff --git a/vignettes/introduction.R b/vignettes/introduction.R index 5ea87df..3fe46f5 100644 --- a/vignettes/introduction.R +++ b/vignettes/introduction.R @@ -1,4 +1,4 @@ -## ---- echo = FALSE------------------------------------------------------------ +## ----echo = FALSE------------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ## ----------------------------------------------------------------------------- @@ -10,13 +10,14 @@ summary(stn) plot(stn) ## ----------------------------------------------------------------------------- -oce2ncdf(stn, varTable="argo", ncfile="stn.nc") +ncfile <- tempfile(pattern = "argo", fileext = ".nc") +oce2ncdf(stn, varTable = "argo", ncfile = ncfile) ## ----------------------------------------------------------------------------- -STN <- ncdf2ctd("stn.nc", varTable="argo") +STN <- ncdf2ctd(ncfile, varTable = "argo") summary(STN) plot(STN) ## ----echo=FALSE--------------------------------------------------------------- -unlink("stn.nc") +file.remove(ncfile) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index c7981cb..70d2d64 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -44,39 +44,40 @@ knitr::opts_chunk$set(collapse = TRUE, comment = "#>") # Purpose The `ocencdf` package provides a way to store approximate forms of oce objects -as Netcdf files, and to translate those files back into oce objects. This is -useful because Netcdf format is handled in a wide variety of computing languages, -and is commonly used in data archives. +as NetCDF files, and to translate those files back into oce objects. This is +useful because NetCDF format is handled in a wide variety of computing +languages, and is commonly used in data archives. -The package provides both "forward" and "reverse" functions. The former translate -oce objects to Netcdf, and the latter transfer Netcdf files (made by the package) -back into oce objects. +The package provides both "forward" and "reverse" functions. The former +translate oce objects to NetCDF, and the latter transfer NetCDF files (made by +the package) back into oce objects. -It should be noted that the reverse functions are designed to work with Netcdf -files created by the forward functions, with e.g. `ncdf2ctd()` handling Netcdf +It should be noted that the reverse functions are designed to work with NetCDF +files created by the forward functions, with e.g. `ncdf2ctd()` handling NetCDF files created by `ctd2ncdf()` based on oce objects. The reverse functions may -be able to handle the data portions of other Netcdf files, but they do not parse -the attribute portions of those Netcdf files in a useful way. This is because there -is no way for the code to know what conventions were used in creating an arbitrary -Netcdf file. For example, a CTD dataset might record the ship name, the name of -the research program, etc., but whether these things are recorded in the data section -of the Netcdf file, or in attributes, or not at all, cannot be known *a priori*, -and guessing is a risky proposition. - -# Limitations of Netcdf format - -Unfortunately, direct transferral of R information to Netcdf is not possible. -This is because Netcdf is an array-oriented format that is not designed to hold -tree-oriented data such as R lists (which are used throughout oce). It is -possible to flatten simple lists, but the process gets complicated for nested -lists, which are common in oce. Other difficulties with the Netcdf format -include its lack of basic elements programming elements such as user-defined -classes and variable-length character strings in the data portion of the files. - -This package is in early development, and efforts are focussed on a single oce -class, the ctd object. This focus is intended to permit coding practices to gel, -in preparation for the addition of other classes. Given the anticipated needs -of users, the next planned item for support is ADCP data. +be able to handle the data portions of other NetCDF files, but they do not +parse the attribute portions of those NetCDF files in a useful way. This is +because there is no way for the code to know what conventions were used in +creating an arbitrary NetCDF file. For example, a CTD dataset might record the +ship name, the name of the research program, etc., but whether these things are +recorded in the data section of the NetCDF file, or in attributes, or not at +all, cannot be known before the fact, and guessing is a risky proposition. + +# Limitations of NetCDF format + +Unfortunately, direct transferal of R information to NetCDF is not +possible. This is because NetCDF is an array-oriented format that is not +designed to hold tree-oriented data such as R lists (which are used +throughout oce). It is possible to flatten simple lists, but the +process gets complicated for nested lists, which are common in oce. +Other difficulties with the NetCDF format include its lack of basic +elements programming elements such as user-defined classes and +variable-length character strings in the data portion of the files. + +This package is in early development, and efforts are focused on a single oce +class, the ctd object. This focus is intended to permit coding practices to +gel, in preparation for the addition of other classes. Given the anticipated +needs of users, the next planned item for support is ADCP data. # How the package works @@ -84,25 +85,26 @@ of users, the next planned item for support is ADCP data. The design goal is to save the following elements -1. Entries in the `data` slot (e.g. temperature, salinity, etc.), renamed as appropriate. +1. Entries in the `data` slot (e.g. temperature, salinity, etc.), renamed as + appropriate. 2. The `metadata` slot (saved in a string form as a global attribute). -3. An approximate form of units, as strings (to fit Netcdf conventions). +3. An approximate form of units, as strings (to fit NetCDF conventions). 4. Information on the conversion process. ## Renaming elements Oce uses a restricted set of names for certain variables. For example, in ctd -objects, temperature is called `temperature`, and if the ctd had two temperature -sensors, there would be an additional entry called `temperature2`. These are -not typically the names used in raw data files, however. More commonly, -temperature might be named `TEMP`, for example. In recognition of this, ocencdf -provides a way to rename oce objects using other systems of names. The mapping -between oce name and other name is controlled by YAML (yet another markup -language) files, which are called varTables in this package. Tables are provided -for the Argo system and for the World Hydographic Program system. These are -available as `"argo"` and `"whp"`, respectively. They are stored in the -`inst/extdata` directory of the package source tree. Users seeking to define new -naming systems must copy the formats of those files. +objects, temperature is called `temperature`, and if the ctd had two +temperature sensors, there would be an additional entry called `temperature2`. +These are not typically the names used in raw data files, however. More +commonly, temperature might be named `TEMP`, for example. In recognition of +this, ocencdf provides a way to rename oce objects using other systems of +names. The mapping between oce name and other name is controlled by YAML (yet +another markup language) files, which are called varTables in this package. +Tables are provided for the Argo system and for the World Hydrographic Program +system. These are available as `"argo"` and `"whp"`, respectively. They are +stored in the `inst/extdata` directory of the package source tree. Users +seeking to define new naming systems must copy the formats of those files. # Example with CTD data @@ -119,25 +121,26 @@ summary(stn) plot(stn) ``` -Now, save as a netcdf file, using (say) the Argo convention for variable names. +Now, save as a NetCDF file, using (say) the Argo convention for variable names. ```{r} -oce2ncdf(stn, varTable="argo", ncfile="stn.nc") +ncfile <- tempfile(pattern = "argo", fileext = ".nc") +oce2ncdf(stn, varTable = "argo", ncfile = ncfile) ``` -The `stn.nc` file may be examined in various ways, but we leave that up to the -reader. Note that the column names are e.g. `TEMP` in the Netcdf file, +The temporary NetCDF file may be examined in various ways, but we leave that up +to the reader. Note that the column names are e.g. `TEMP` in the NetCDF file, because the varTable named `"argo"` establishes that nickname. -In R, we can read `stn.nc` into a ctd object and get a summary with the following. +We can read the temporary NetCDF file into a ctd object and get a summary with +the following. ```{r} -STN <- ncdf2ctd("stn.nc", varTable="argo") +STN <- ncdf2ctd(ncfile, varTable = "argo") summary(STN) plot(STN) ``` ```{r echo=FALSE} -unlink("stn.nc") +file.remove(ncfile) ``` -