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 @@
@@ -49,10 +49,10 @@ @@ -60,7 +60,14 @@ Changelog - + @@ -96,7 +103,7 @@vignettes/built_in_vartables.Rmd
built_in_vartables.Rmd
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
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 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 @@
vignettes/introduction.Rmd
introduction.Rmd
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.
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 @@
metadata
slot (saved in a string form as a global
attribute)."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 @@
-library(ocencdf)
+library(ocencdf)
#> Loading required package: oce
#> Loading required package: gsw
library(oce)
@@ -236,19 +243,20 @@ Example with CTD data#> - 2022-01-03 13:21:08 UTC: `initializeFlagScheme(object, 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))`
plot(stn)
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.
-STN <- ncdf2ctd("stn.nc", varTable="argo")
+STN <- ncdf2ctd(ncfile, varTable = "argo")
summary(STN)
#> CTD Summary
#> -----------
@@ -273,8 +281,8 @@ Example with CTD data#> * 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
#>
@@ -288,10 +296,11 @@ Example with CTD data#>
#> * Processing Log
#>
-#> - 2023-06-11 11:49:05 UTC: `create 'ctd' object`
-#> - 2023-06-11 11:49:05 UTC: `as.ctd(salinity = ncdf2oce(ncfile = ncfile, varTable = varTable, debug = debug))`
+#> - 2024-01-26 13:39:27 UTC: `create 'ctd' object`
+#> - 2024-01-26 13:39:27 UTC: `as.ctd(salinity = ncdf2oce(ncfile = ncfile, varTable = varTable, debug = debug))`
plot(STN)
#> [1] TRUE
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 @@ @@ -32,16 +32,22 @@Dan Kelley. Author, maintainer.
+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 @@
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.
NEWS.md
force_v4
in all conversions to NetCDF, which permits the handling of large files.adv2ncdf()
and ncdf2adv()
.adp2ncdf()
and ncdf2adp()
.R/adp.R
adp2ncdf.Rd
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)
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()
.
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.
integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -93,12 +107,12 @@
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 @@
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
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)
an oce object of class adv
, as created by e.g. oce::read.adv()
.
character value indicating the variable-naming
+scheme to be used, which is passed to read.varTable()
to set
+up variable names, units, etc.
character value naming the output file. Use NULL
+for a file name to be created automatically (e.g. ctd.nc
for
+a CTD object).
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.
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.
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()
.
Other things related to adv data:
+ncdf2adv()
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
+
+
R/ctd.R
ctd2ncdf.Rd
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)
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.
integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -92,11 +106,11 @@
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 @@
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
-
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()
.
read.varTable()
.
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
Save an adp object to a netcdf file
Save an ADP object to a NetCDF file
Save an adv object to a NetCDF file
Save a ctd object to a netcdf file
Save a ctd object to a NetCDF file
Get information on a variable, using varTable
Convert a JSON string to an oce metadata slot
Convert an oce metadata slot to JSON
Read a netcdf file and create an adp object
Read a NetCDF file and create an ADP object
Read a NetCDF file and create an adv object
Read a netcdf file and create a ctd object
Read a NetCDF file and create a ctd object
Read a netcdf file and create a general oce object
Read a NetCDF file and create a general oce
object
Translate netcdf names to oce names
Translate NetCDF names to oce names
Save an oce-class object as a netcdf file.
Save an oce-class object as a NetCDF file.
Translate netcdf names to oce names
Translate NetCDF names to oce names
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)
character value, typically the output from metadata2json()
.
json2metadata returns a list in the format of a metadata
slot from an oce
object.
Other things relating to serialization:
+metadata2json()
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)
contents of the metadata
slot of an oce object.
integer, the number of digits to store in the JSON +representation.
metadata2json returns a character value holding
+the metadata
slot in JSON, transformed as indicated in
+the “Details” section.
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.
Oce uses expression
objects to store units, and these are converted
+to character values using as.character()
before converting to JSON.
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.
The following items are converted from POSIXct values to character
+values: date
, endTime
, startTime
, and systemUploadTime
.
Other things relating to serialization:
+json2metadata()
# 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"]
+#> }
+
+
R/adp.R
ncdf2adp.Rd
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 @@
R/ctd.R
ncdf2ctd.Rd
Read a netcdf file and create a ctd object
+Read a NetCDF file and create a ctd object
oce
objectR/ncdf2oce.R
ncdf2oce.Rd
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()
.
R/vartable.R
ncdfNames2oceNames.Rd
Translate netcdf names to oce names
+Translate NetCDF names to oce names
vector of character values in oce convention (e.g. "TEMP" -for temperature, if varTable is "argo").
varTable
equals "argo"
).
R/oce2ncdf.R
oce2ncdf.Rd
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)
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.
integer, 0 (the default) for quiet action apart from messages and warnings, or any larger value to see more @@ -93,7 +107,7 @@
R/vartable.R
oceNames2ncdfNames.Rd
Translate netcdf names to oce names
+Translate NetCDF names to oce names
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.
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.
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.
Useful links:
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.
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.
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.
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
.
read.varTable()
returns a list that specifies some information
-to be stored in netcdf files created by e.g. ctd2ncdf()
.
ctd2ncdf()
.
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"
.