R/getEdinfo.R

Defines functions rngPrinter updateEdinfo print.edinfo getEdinfo

Documented in getEdinfo

#' @title Browse a List of Curated Environmental Datasets
#'
#' @description This function gets the list of environmental datasets provided
#'   as a recommended starting point for various measures
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#'
#' @return a list of edinfo list objects
#'
#' @examples
#'
#' ediList <- getEdinfo()
#' ediList[[1]]
#' ediList[['jplMURSST41']]
#'
#' @export
#'
getEdinfo <- function() {
    # hycomList <- list(
    #      'HYCOM_GLBu19.1' = list(base = 'http://ncss.hycom.org/thredds/ncss/',
    #                              dataset = 'GLBu0.08/expt_19.1',
    #                              fileType = 'netcdf',
    #                              vars = c('surf_el', 'salinity', 'water_temp', 'water_u', 'water_v'),
    #                              is180 = TRUE,
    #                              limits = list(
    #                                  Longitude = c(-180, 179.92),
    #                                  Latitude = c(-80, 80),
    #                                  UTC = as.POSIXct(c('1995-08-01 00:00:00', '2012-12-31 00:00:00'), tz='UTC'),
    #                                  Depth = c(0, 5000)
    #                              ),
    #                              spacing = list(
    #                                  Longitude = .08,
    #                                  Latitude = .08,
    #                                  UTC = 86400,
    #                                  Depth = 5000 / 39
    #                              ),
    #                              stride = 1,
    #                              source = 'hycom'),
    #      'HYCOM_GLBy93.0' = list(base = 'http://ncss.hycom.org/thredds/ncss/',
    #                              dataset = 'GLBy0.08/expt_93.0',
    #                              fileType = 'netcdf',
    #                              vars = c('surf_el', 'salinity', 'water_temp', 'water_u', 'water_v'),
    #                              is180 = FALSE,
    #                              limits = list(
    #                                  Longitude = c(0, 359.92),
    #                                  Latitude = c(-80, 80),
    #                                  UTC = c(as.POSIXct('2018-12-04 12:00:00', tz='UTC'), nowUTC() - 13 * 3600),
    #                                  Depth = c(0, 5000)
    #                              ),
    #                              spacing = list(
    #                                  Longitude = .08,
    #                                  Latitude = .04,
    #                                  UTC = 10800,
    #                                  Depth = 5000 / 39
    #                              ),
    #                              stride = 1,
    #                              source = 'hycom'))
    # for(i in seq_along(hycomList)) {
    #     class(hycomList[[i]]) <- c('edinfo', 'list')
    # }
    
    result <- PAMmisc::erddapList
    result$HYCOM <- PAMmisc::hycomList
    result
    # hycomlist
}

#' @export
#'
print.edinfo <- function(x, ...) {
    if(!is.null(x$isCurrent) && 
       isTRUE(x$isCurrent)) {
        x$limits$UTC[2] <- nowUTC()
    }
    cat('Dataset id ', x$dataset, ' has ', length(x$vars), ' variables:\n    ',
        paste0(x$vars, collapse=', '), '\n  With valid coordinate limts:\n    ',
        rngPrinter(x$limits), '\n  And average coordinate spacing:\n    ',
        rngPrinter(x$spacing), sep='')
}

# update edinfo objects, mostly relevant for -Present time ranges
updateEdinfo <- function() {
    baseURLs <- c('https://upwell.pfeg.noaa.gov/erddap/')
    datasets <- list(id = c('jplMURSST41mday', 'jplMURSST41', 'jplMURSST41clim', 'erdMH1pp8day', 'erdMBchla8day', 'erdSrtm30plusSeafloorGradient'),
                     baseIx = c(1, 1, 1, 1, 1, 1))
    erddapList <- vector('list', length = length(datasets$id))
    for(i in seq_along(datasets$id)) {
        erddapList[[i]] <- erddapToEdinfo(datasets$id[i], baseURLs[datasets$baseIx[i]], chooseVars = FALSE)
    }
    names(erddapList) <- datasets$id
    save(erddapList, file = './data/erddapList.rda')
}

rngPrinter <- function(x) {
    allRng <- vector('character', length = length(x))
    for(n in seq_along(allRng)) {
        rngVal <- x[[n]]
        if(names(x)[n] == 'UTC' &&
           is.numeric(rngVal)) {
            if(max(rngVal) > 3000) {
                rngVal <- round(rngVal / 24 / 3600, 3) # converting time spacing to days instead of seconds
            }
            rngVal <- paste0(rngVal, ' (days)')
        }
        if(is.numeric(rngVal)) {
            rngVal <- round(rngVal, 3)
        }
        allRng[n] <- paste0(names(x)[n], ': ',
                            paste0(as.character(rngVal), collapse = ' to '))
    }
    paste0(allRng, collapse = ', ')
}

Try the PAMmisc package in your browser

Any scripts or data that you put into this service are public.

PAMmisc documentation built on Aug. 17, 2023, 1:06 a.m.