Maintenance scheduled for Thursday, October 22nd at 15:00 MDT. Expected downtime <1 hour.

Unverified Commit a78d6be4 authored by Blodgett, David L.'s avatar Blodgett, David L. Committed by GitHub

Merge pull request #62 from dblodgett-usgs/master

nc_meta fix
parents 19a0e0ee f201a407
......@@ -50,23 +50,27 @@ read_timeseries_dsg = function(nc_file){
nc_meta <- nc_meta(nc_file)
nc_atts <- nc_meta$attribute
if(!"name" %in% names(nc_atts)) {
names(nc_atts) <- c("name", "variable", "value")
}
nc_list<-list()
# Check important global atts
check <- filter(nc_atts, variable == "NC_GLOBAL" & attribute == 'Conventions')$value
check <- filter(nc_atts, variable == "NC_GLOBAL" & name == 'Conventions')$value
if(length(check) == 0 || !grepl('CF', check)) {
warning('File does not advertise CF conventions, unexpected behavior may result.')
}
check <- filter(nc_atts, variable == "NC_GLOBAL" & attribute == "featureType")$value
check <- filter(nc_atts, variable == "NC_GLOBAL" & name == "featureType")$value
if(length(check) == 0 || !grepl('timeSeries', check)) {
warning('File does not advertise use of the CF timeseries featureType, unexpected behavior may result.')
}
# Look for variable with the timeseries_id in it.
timeseries_id <- filter(nc_atts, attribute == "standard_name" &
timeseries_id <- filter(nc_atts, name == "standard_name" &
value == "station_id")$variable
timeseries_id <- filter(nc_atts, attribute == "cf_role" &
timeseries_id <- filter(nc_atts, name == "cf_role" &
value == pkg.env$timeseries_id_cf_role)$variable
if(length(timeseries_id) == 0) {
......@@ -85,7 +89,7 @@ read_timeseries_dsg = function(nc_file){
nc_coord_vars$Z, nc_coord_vars$T))
coord_vars <- coord_vars[!is.na(coord_vars)]
data_vars <- filter(nc_atts, attribute == "coordinates" &
data_vars <- filter(nc_atts, name == "coordinates" &
grepl(paste(coord_vars, collapse = "|"), value))
# Given the coordinates found look for one and only one variable
......@@ -93,14 +97,14 @@ read_timeseries_dsg = function(nc_file){
# OR (worst case maybe don't support) units like 'days since 1970-01-01 00:00:00',
# or 'degrees_east', or 'degrees_north'
sn <- filter(nc_atts, attribute == "standard_name")
sn <- filter(nc_atts, name == "standard_name")
lat <- filter(sn, value == pkg.env$lat_coord_var_standard_name)
lon <- filter(sn, value == pkg.env$lon_coord_var_standard_name)
alt <- filter(sn, value == pkg.env$alt_coord_var_standard_name)
time <- filter(sn, value == pkg.env$time_var_standard_name)
if(nrow(time) == 0) {
time <- filter(nc_atts, attribute == "units" & grepl(" since ", value))
time <- filter(nc_atts, name == "units" & grepl(" since ", value))
}
if(length(lat) == 0) { stop('No latitude coordinate found.') }
......@@ -124,7 +128,7 @@ read_timeseries_dsg = function(nc_file){
}
time_vals <- var.get.nc(nc, time$variable)
time_units <- filter(nc_atts, variable == time$variable & attribute == "units")
time_units <- filter(nc_atts, variable == time$variable & name == "units")
nc_list$time <- utcal.nc(time_units$value[[1]], time_vals, type = "c")
......@@ -156,12 +160,12 @@ read_timeseries_dsg = function(nc_file){
nc_var <- filter(nc_meta$variable, name == data_var)
nc_list$data_unit[data_var] <- filter(nc_atts, variable == data_var &
attribute == "units")$value[[1]]
name == "units")$value[[1]]
nc_list$data_prec[data_var] <- nc_var$type # todo map this to NetCDF types
nc_list$varmeta[data_var][[1]]$name <- data_var
nc_list$varmeta[data_var][[1]]$long_name <- filter(nc_atts, variable == data_var &
attribute == "long_name")$value[[1]]
name == "long_name")$value[[1]]
# Ensures we get back data with time in rows.
var_inq <- var.inq.nc(nc, data_var)
if(var_inq$type == "NC_CHAR") {
......@@ -180,18 +184,18 @@ read_timeseries_dsg = function(nc_file){
}
nc_list$global_attributes$nc_summary <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "summary")$value
name == "summary")$value
nc_list$global_attributes$nc_date_created <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "date_created")$value
name == "date_created")$value
nc_list$global_attributes$nc_creator_name <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "creator_name")$value
name == "creator_name")$value
nc_list$global_attributes$nc_creator_email <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "creator_email")$value
name == "creator_email")$value
nc_list$global_attributes$nc_project <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "project")$value
name == "project")$value
nc_list$global_attributes$nc_proc_level <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "processing_level")$value
name == "processing_level")$value
nc_list$global_attributes$nc_title <- filter(nc_atts, variable == "NC_GLOBAL" &
attribute == "title")$value
name == "title")$value
return(nc_list)
}
\ No newline at end of file
......@@ -111,10 +111,6 @@ write_timeseries_dsg = function(nc_file, instance_names, lats, lons, times, data
data_name = data_metadata[['name']]
if(add_to_existing) {
# Open existing file.
orig_nc <- nc_file
nc_file <- tempfile()
file.copy(orig_nc, nc_file)
nc<-open.nc(nc_file, write = TRUE)
data_vars = list()
......@@ -130,7 +126,7 @@ write_timeseries_dsg = function(nc_file, instance_names, lats, lons, times, data
close.nc(nc)
if(add_to_existing) file.rename(nc_file, orig_nc)
return(nc_file)
} else {
nc <- create.nc(nc_file, large = TRUE)
......
../../../inst/extdata/fixture_wkt.json
\ No newline at end of file
../../../inst/extdata/yahara_alb_gdp_file.csv
\ No newline at end of file
......@@ -3,8 +3,6 @@ library(ncdf4)
library(sf)
library(sp)
nc_file<-tempfile()
compareSP <- function(polygonData, returnPolyData) {
polygonData <- sf::as_Spatial(polygonData)
returnPolyData <- sf::as_Spatial(returnPolyData)
......@@ -54,7 +52,8 @@ checkAllPoly <- function(polygonData, node_count, part_node_count = NULL, part_t
}
get_fixture_data <- function(geom_type) {
fixtureData <- jsonlite::fromJSON("data/fixture_wkt.json")
fixtureData <- jsonlite::fromJSON(txt = system.file("extdata/fixture_wkt.json",
package = "ncdfgeom"))
return(sf::st_sf(geom = sf::st_as_sfc(fixtureData[["2d"]][geom_type]),
crs = "+init=epsg:4326"))
......@@ -73,8 +72,10 @@ get_sample_timeseries_data <- function() {
lons<-lon_lat[,"X"]
alts<-rep(1,length(lats))
all_data <- geoknife::parseTimeseries("data/yahara_alb_gdp_file.csv",
delim=',',with.units=TRUE)
local_file <- system.file("extdata/yahara_alb_gdp_file.csv",
package = "ncdfgeom")
all_data <- geoknife::parseTimeseries(local_file,
delim=',', with.units=TRUE)
var_data <- all_data[2:(ncol(all_data)-3)]
units <- all_data$units[1]
......
......@@ -3,7 +3,7 @@ context("geom_examples.md")
test_that("create geom_examples.md", {
geom_examples <- "data/geom_examples.md"
fixtureData <- jsonlite::fromJSON("data/fixture_wkt.json")
fixtureData <- jsonlite::fromJSON(system.file('extdata/fixture_wkt.json', package = 'ncdfgeom'))
# "multipoint", "MultiPoint (2D)",
order<-c("point", "linestring", "polygon",
"multilinestring", "multipolygon",
......@@ -34,6 +34,6 @@ test_that("create geom_examples.md", {
}
sink()
testthat::skip_on_cran()
expect(file.exists(geom_examples))
expect_true(file.exists(geom_examples))
}, silent = TRUE)
})
context("orthogonal netcdf timeseries")
test_that("Create basic DSG file", {
unlink(nc_file)
nc_file<-tempfile()
nc_summary<-'test summary'
nc_date_create<-'2099-01-01'
nc_creator_name='test creator'
......@@ -162,7 +163,7 @@ test_that("Create basic DSG file", {
attributes=global_attributes)
testnc<-nc_open(testnc)
expect(testnc$dim$time$len == 1460)
expect_true(testnc$dim$time$len == 1460)
char_test <- dplyr::mutate_all(test_dat2, as.character)
time <- c(test_data$time,test_data$time)
......@@ -176,7 +177,7 @@ test_that("Create basic DSG file", {
attributes=global_attributes)
testnc<-nc_open(testnc)
expect(testnc$dim$time$len == 1460)
expect_true(testnc$dim$time$len == 1460)
expect("duplicate" %in% names(testnc$var), failure_message = names(testnc$var))
......@@ -198,9 +199,8 @@ test_that("Create basic DSG file", {
testnc<-nc_open(nc_file)
expect("character" %in% names(testnc$var), failure_message = names(testnc$var))
})
test_that("bork the file", {
nc_close(testnc)
test_data <- get_sample_timeseries_data()
......@@ -268,7 +268,7 @@ test_that("bork the file", {
att.delete.nc(nc, "time", "standard_name")
close.nc(nc)
warn <- capture_warnings(testlist<-read_timeseries_dsg(nc_file_borked))
expect(all(c("no data variables found, attempting to infer via shared dimensions",
expect_true(all(c("no data variables found, attempting to infer via shared dimensions",
"no latitude coordinate found",
"no longitude coordinate found") %in% warn))
......@@ -316,6 +316,6 @@ test_that('soilmoisturetools data writes as expected', {
nc <- nc_open(nc_file)
expect(file.exists(nc_file))
expect_true(file.exists(nc_file))
unlink(nc_file)
})
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment