diff --git a/R/defStormsDataset.R b/R/defStormsDataset.R
index 8f1e6e19..2f74c9ee 100644
--- a/R/defStormsDataset.R
+++ b/R/defStormsDataset.R
@@ -1,8 +1,3 @@
-
-
-
-
-
############################
# Unit conversion functions#
############################
@@ -44,13 +39,78 @@ atm2pa <- function(x) {
+#' Convert variable in the correct metric in the dataset
+#' @noRd
+#' @param data database generated with either getDataFromNcdfFile or
+#' getDataFromCsvFile
+#' @param unitConversion named character vector (Cf defStormsDatabase)
+#'
+#' @return data with converted variables
+convertVariables <- function(data, unitConversion){
+
+ # Maximum sustained wind
+ if (unitConversion["msw"] == "mph2ms") {
+ data$msw <- mph2ms(data$msw)
+ } else if (unitConversion["msw"] == "knt2ms") {
+ data$msw <- knt2ms(data$msw)
+ } else if (unitConversion["msw"] == "kmh2ms") {
+ data$msw <- kmh2ms(data$msw)
+ }
+
+ # Radius of maximum wind
+ if ("rmw" %in% names(data)) {
+ if (unitConversion["rmw"] == "nm2km") {
+ data$rmw <- nm2km(data$rmw)
+ }
+ }
+
+ # Pressure
+ if ("pressure" %in% names(data)) {
+ if (unitConversion["pressure"] == "mb2pa") {
+ data$pressure <- mb2pa(data$pressure)
+
+ } else if (unitConversion["pressure"] == "b2pa") {
+ data$pressure <- b2pa(data$pressure)
+
+ } else if (unitConversion["pressure"] == "psi2pa") {
+ data$pressure <- psi2pa(data$pressure)
+
+ } else if (unitConversion["pressure"] == "atm2pa") {
+ data$pressure <- atm2pa(data$pressure)
+ }
+ }
+
+ # Pressure
+ if ("poci" %in% names(data)) {
+ if (unitConversion["poci"] == "mb2pa") {
+ data$poci <- mb2pa(data$poci)
+
+ } else if (unitConversion["poci"] == "b2pa") {
+ data$poci <- b2pa(data$poci)
+
+ } else if (unitConversion["poci"] == "psi2pa") {
+ data$poci <- psi2pa(data$poci)
+
+ } else if (unitConversion["poci"] == "atm2pa") {
+ data$poci <- atm2pa(data$poci)
+ }
+ }
+
+ return(data)
+
+}
+
+
+#########
+# Class #
+#########
#' stormsDataset
#'
#' Choose the database to use within the package's functions
#'
-#' @slot filename character. Name of the database to load. Must be a netcdf file
+#' @slot filename character. Name of the database to load. Must be either a netcdf or a csv file
#' @slot fields named character vector. Dictionary that provides all the name of
#' dimensions to extract from the netcdf database (See `Details`)
#' @slot basin character. Basin name to filter the database within its
@@ -134,29 +194,45 @@ stormsDataset <- methods::setClass(
+####################
+# Helper functions#
+###################
#' check inputs for defStormsDataset function
#'
#' @noRd
#' @param filename character
+#' @param sep character
#' @param fields character vector
#' @param basin character
#' @param seasons numeric vector
#' @param unitConversion character vector
+#' @param notNamed character
#' @param verbose numeric
#'
#' @return NULL
-checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitConversion, verbose) {
+checkInputsdefStormsDataset <- function(filename, sep, fields, basin, seasons, unitConversion, notNamed, verbose) {
# Checking filename input
stopifnot("filename is missing" = !missing(filename))
stopifnot("filename must be character" = identical(class(filename), "character"))
stopifnot("filename must be length one" = length(filename) == 1)
-
+
+ # Checking sep input
+ if(!is.null(sep)){
+ stopifnot("sep must be character" = identical(class(sep), "character"))
+ stopifnot("sep must be length one" = length(sep) == 1)
+ }
+
+ # Checking extension
+ splitedFilename <- strsplit(filename, "\\.")[[1]]
+ extension <- splitedFilename[length(splitedFilename)]
+ stopifnot("filename must be either a NetCDF (.nc) or a CSV (.csv) file" = extension %in% c("nc", "csv"))
+
# Checking fields input
stopifnot("fields must be character" = identical(class(fields), "character"))
stopifnot("unitConversion must be character" = identical(class(unitConversion), "character"))
-
+
# Mandatory fields
stopifnot("No 'names' selection in fields" = "names" %in% names(fields))
stopifnot("No 'seasons' selection in fields" = "seasons" %in% names(fields))
@@ -169,7 +245,7 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
"Invalid unitConversion directive for 'msw'" =
unitConversion["msw"] %in% c("None", "mph2ms", "knt2ms", "kmh2ms")
)
-
+
# Optional fields
if (("basin" %in% names(fields)) && is.null(basin)) {
warning("No basin argument specified. StormR will work as expected
@@ -178,15 +254,15 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
stop("No basin field in `fields` input specified. StormR will work as
expected but cannot use basin filtering for speed-up when collecting data")
}
-
-
+
+
if (!("rmw" %in% names(fields))) {
warning("No 'rmw' selection in fields, use empirical_rmw = TRUE for the forthcoming computations")
} else {
stopifnot("No unit conversion directive for 'rmw' selection in unitConversion" = "rmw" %in% names(unitConversion))
stopifnot("Invalid unitConversion directive for 'msw'" = unitConversion["rmw"] %in% c("None", "nm2km"))
}
-
+
if (!("pressure" %in% names(fields))) {
warning("No 'pressure' selection in fields, Cannot use Holland method for the forthcoming computations")
} else {
@@ -199,8 +275,8 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
unitConversion["pressure"] %in% c("None", "b2pa", "mb2pa", "psi2pa", "atm2pa")
)
}
-
-
+
+
if (!("poci" %in% names(fields))) {
warning("No 'poci' selection in fields, Cannot use Holland method for the forthcoming computations")
} else {
@@ -209,9 +285,9 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
"poci" %in% names(unitConversion)
)
stopifnot("Invalid unitConversion directive for 'msw'" = unitConversion["poci"]
- %in% c("None", "b2pa", "mb2pa", "psi2pa", "atm2pa"))
+ %in% c("None", "b2pa", "mb2pa", "psi2pa", "atm2pa"))
}
-
+
# Checking basin input
if (!is.null(basin)) {
stopifnot("basin must be character" = identical(class(basin), "character"))
@@ -221,10 +297,14 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
basin %in% c("NA", "SA", "EP", "WP", "SP", "SI", "NI")
)
}
-
+
# Checking seasons input
stopifnot("seasons must be numeric" = identical(class(seasons), "numeric"))
stopifnot("seasons must be a range of calendar year" = length(seasons) == 2 & seasons[1] <= seasons[2])
+
+ # Checking notNamed input
+ stopifnot("notNamed must be a character" = identical(class(notNamed), "character"))
+ stopifnot("notNamed must be length one " = length(notNamed) == 1)
# Checking verbose input
stopifnot("verbose must be numeric" = identical(class(verbose), "numeric"))
@@ -235,23 +315,279 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
+#' Load database when filename is a NetCDF
+#' (CF defStormsDataset for additional informations about parameters)
+#' @noRd
+#' @param filename character
+#' @param fields named character vecor
+#' @param basin character
+#' @param seasons numeric vector
+#' @param unitConversion named character vector
+#' @param notNamed character for not named storms
+#' @param verbose numeric
+#'
+#' @return list of arrays
+getDataFromNcdfFile <- function(filename, fields, basin, seasons, unitConversion, notNamed, verbose){
+
+ if (verbose) {
+ cat("=== Loading data ===\nOpen database... ")
+ }
+
+ dataBase <- ncdf4::nc_open(filename)
+
+ if (verbose) {
+ cat(filename, "opened\nCollecting data ...\n")
+ }
+
+ lon <- ncdf4::ncvar_get(dataBase, fields["lon"])
+ season <- ncdf4::ncvar_get(dataBase, fields["seasons"])
+ names <- ncdf4::ncvar_get(dataBase, fields["names"])
+
+ row <- dim(lon)[1]
+
+ # Remove notNamed storms
+ ind <- which(!(names %in% notNamed))
+
+ # Filter by season
+ indS <- which(season %in% seq(seasons[1], seasons[2], 1))
+ ind <- intersect(ind, indS)
+ len <- length(ind)
+
+ if (!is.null(basin)) {
+ # Filter by basin ID
+ basins <- ncdf4::ncvar_get(dataBase, fields["basin"])
+ indB <- which(basins[1, ] == basin)
+ ind <- intersect(ind, indB)
+ len <- length(ind)
+ }
+
+ # Collect data
+ data <- list(
+ names = names[ind],
+ seasons = season[ind],
+ isotimes = array(ncdf4::ncvar_get(dataBase, fields["isoTime"])[, ind],
+ dim = c(row, len)
+ ),
+ longitude = array(ncdf4::ncvar_get(dataBase, fields["lon"])[, ind],
+ dim = c(row, len)
+ ),
+ latitude = array(ncdf4::ncvar_get(dataBase, fields["lat"])[, ind],
+ dim = c(row, len)
+ ),
+ msw = array(ncdf4::ncvar_get(dataBase, fields["msw"])[, ind], dim = c(row, len))
+ )
+
+ # Sort by Date
+ o <- order(data$isotimes[1, ])
+
+ data$names <- data$names[o]
+ data$seasons <- data$seasons[o]
+ data$isotimes <- data$isotimes[, o]
+ data$longitude <- data$longitude[, o]
+ data$latitude <- data$latitude[, o]
+ data$msw <- data$msw[, o]
+
+ if ("rmw" %in% names(fields)) {
+ data$rmw <- array(ncdf4::ncvar_get(dataBase, fields["rmw"])[, ind], dim = c(row, len))
+ data$rmw <- data$rmw[, o]
+ }
+
+ if ("pressure" %in% names(fields)) {
+ data$pressure <- array(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind], dim = c(row, len))
+ data$pressure <- data$pressure[, o]
+ }
+
+ if ("poci" %in% names(fields)) {
+ data$poci <- array(ncdf4::ncvar_get(dataBase, fields["poci"])[, ind], dim = c(row, len))
+ data$poci <- data$poci[, o]
+ }
+
+
+ ncdf4::nc_close(dataBase)
+
+ return(data)
+}
+
+
+
+
+#' Load database when filename is a CSV
+#' (CF defStormsDataset for additional informations about parameters)
+#'
+#' @noRd
+#' @param filename character
+#' @param sep character. separator for the csv file in input
+#' @param fields named character vecor
+#' @param basin character
+#' @param seasons numeric vector
+#' @param unitConversion named character vector
+#' @param notNamed character for not named storms
+#' @param verbose numeric
+#'
+#' @return list of arrays
+getDataFromCsvFile <- function(filename, sep, fields, basin, seasons, unitConversion, notNamed, verbose){
+
+ if (verbose) {
+ cat("=== Loading data ===\nOpen database... ")
+ }
+
+ if(is.null(sep)){
+ sep = ","
+ }
+
+ dataBase <- utils::read.csv(file = filename, sep = sep)
+
+ if (verbose) {
+ cat(filename, "opened\nCollecting data ...\n")
+ }
+
+ # Extract columns
+ filter <- which(colnames(dataBase) %in% fields)
+ dataBaseFiltered <- dataBase[, filter]
+
+ # Remove sub header
+ dataBaseFiltered <- dataBase[2:dim(dataBaseFiltered)[1], filter]
+
+ # Remove notNamed storms
+ filter <- which(!(dataBaseFiltered[,fields["names"]] %in% notNamed))
+ dataBaseFiltered <- dataBaseFiltered[filter,]
+
+ # Remove NA lon-lat row
+ filter <- which(!is.na(dataBaseFiltered[,fields["lon"]]) & !is.na(dataBaseFiltered[,fields["lat"]]))
+ dataBaseFiltered <- dataBaseFiltered[filter,]
+
+ # Filter by season
+ filter <- which(as.numeric(dataBaseFiltered[,fields["seasons"]]) >= seasons[1] & as.numeric(dataBaseFiltered[,fields["seasons"]]) <= seasons[2])
+ dataBaseFiltered <- dataBaseFiltered[filter,]
+
+ # Filter by basin
+ if(!is.null((basin))){
+ filter <- which(dataBaseFiltered[,fields["basin"]] == basin)
+ dataBaseFiltered <- dataBaseFiltered[filter,]
+ }
+
+ # Get dimensions
+ stormNames <- dataBaseFiltered[,fields["names"]]
+ stormSeasons <- dataBaseFiltered[,fields["seasons"]]
+ sid <- paste0(stormNames, stormSeasons)
+
+ # Do the following code to replace table function
+ k <- 0
+ actualStorm <- sid[1]
+ countObs <- c()
+ names <- c()
+ for (i in 1:length(sid)){
+ if(sid[i] != actualStorm){
+ countObs <- c(countObs, k)
+ names <- c(names, actualStorm)
+ actualStorm <- sid[i]
+ k <- 1
+ }else{
+ k = k + 1
+ }
+ }
+ countObs <- c(countObs, k)
+ names <- c(names, sid[length(t)])
+ names(countObs) <- names
+
+ # Do not work anymore without sid field
+ # sid <- dataBaseFiltered[,fields["sid"]]
+ # countObs <- table(sid) # count of observation by storm
+
+ row <- max(countObs) # maximum number of rows
+ len <- length(unique(sid)) # number of unique storm in csv
+ cumulativeIndex <- cumsum(countObs) # starting points for each storm in csv
+
+ # Initialize template structure
+ templateArray = array(NaN, dim=c(row,len))
+
+ # Mandatory fields
+ data <- list(
+ names = array(NaN, dim=len),
+ seasons = array(NaN, dim=len),
+ isotimes = templateArray,
+ longitude = templateArray,
+ latitude = templateArray,
+ msw = templateArray
+ )
+
+
+ if("rmw" %in% names(fields)){
+ data$rmw <- templateArray
+ }
+
+ if("pressure" %in% names(fields)){
+ data$pressure <- templateArray
+ }
+
+ if("poci" %in% names(fields)){
+ data$poci <- templateArray
+ }
+
+ for(i in 1:len){
+
+ # Get rows observations boundaries
+ if(i!=1){
+ start = cumulativeIndex[i-1] + 1
+ }else{
+ start = 1
+ }
+ end = cumulativeIndex[i]
+
+ # Fill data
+ data$names[i] <- dataBaseFiltered[start, fields["names"]]
+ data$seasons[i] <- as.numeric(dataBaseFiltered[start, fields["seasons"]])
+ data$isotimes[,i] <- c(dataBaseFiltered[start:end, fields["isoTime"]], rep(NaN, row-countObs[i]))
+ data$longitude[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["lon"]], rep(NaN, row-countObs[i])))
+ data$latitude[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["lat"]], rep(NaN, row-countObs[i])))
+
+
+ data$msw[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["msw"]], rep(NaN, row-countObs[i])))
+
+ if ("rmw" %in% names(fields)) {
+ data$rmw[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["rmw"]], rep(NaN, row-countObs[i])))
+ }
+
+ if ("pressure" %in% names(fields)) {
+ data$pressure[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["pressure"]], rep(NaN, row-countObs[i])))
+ }
+
+ if ("poci" %in% names(fields)) {
+ data$poci[,i] <- as.numeric(c(dataBaseFiltered[start:end, fields["poci"]], rep(NaN, row-countObs[i])))
+ }
+
+ }
+
+ return(data)
+
+}
+
+
+
+
+################
+# Main function#
+################
+
#' Creating a `stormsDataset` object
#'
-#' The `defStormsDataset()` function creates a `stormsDataset` object from a NetCDF file.
+#' The `defStormsDataset()` function creates a `stormsDataset` object from either a NetCDF or a CSV file.
#' This is an essential first step before other `stormR` functions can be used.
#'
-#' @param filename character. Name of the NetCDF (.nc) file. Default is the `test_dataset.nc`
+#' @param filename character. Name of the NetCDF (.nc)/CSV (.csv) file. Default is the `test_dataset.nc`
#' file located in the `inst/extdata` repository of the directory (accessible by
#' `system.file("extdata", "test_dataset.nc", package = "StormR")`). This test dataset is extracted
#' from the IBTrACS.SP.v04r00.nc file and provides all the tropical cyclones that occurred around Vanuatu
#' from 2015 to 2016 and around New Caledonia from 2020 to 2021.
-#' @param fields named character vector. This argument allows to specify the corresponding variable names
-#' in the input NetCDF file for each field in the output `stormsDataset`. By default, the corresponding
-#' variable names are set up to import data from a NetCDF file from the IBTrACS database (Knapp et al., 2010).
+#' @param sep character. The field separator character if `filename` is a CSV file. Default value is set to `NULL`
+#' which will set the separator to `","`.
+#' @param fields named character vector. This argument allows to specify the corresponding variable names (NetCDF) or
+#' headers (CSV) in the input file for each field in the output `stormsDataset`. By default, the corresponding
+#' variable names are set up to import data from a NetCDF file from the IBTrACS database (Knapp et al., 2010).
#' Corresponding variable names for following fields have to (mandatory fields) or can be
#' (recommended or optional fields) provided:
#' \itemize{
-#' \item "`names"`, names of the storms (mandatory),
+#' \item `"names"`, names of the storms (mandatory),
#' \item `"seasons"`, years of observations (mandatory),
#' \item `"isoTime"`, date and time of observations (mandatory),
#' \item `"lon"`, longitude of the observations (mandatory),
@@ -308,6 +644,9 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
#' \item `"psi2pa"`, to convert psi to Pascal, or
#' \item `"None"`, if no conversion is needed.
#' }
+#'
+#' @param notNamed character. Constant name for not named storms to remove in the database.
+#' Default value is "NOT_NAMED" (IBTrACS database)
#' @param verbose numeric. Whether the function should display (`= 1`)
#' or not (`= 0`) information about the processes.
#' @return The `defStormsDataset()` function returns a `stormsDataset` object.
@@ -320,10 +659,17 @@ checkInputsdefStormsDataset <- function(filename, fields, basin, seasons, unitCo
#' @examples
#' # Creating a `stormsDataset` object with storms between 2010 and 2015
#' # in the South Pacific using the NetCDF provided with the package
-#' SP_2015_2020 <- defStormsDataset(seasons = c(2010, 2015))
-#' str(SP_2015_2020)
+#' SP_2015_2020_nc <- defStormsDataset(seasons = c(2010, 2015))
+#' str(SP_2015_2020_nc)
+#'
+#' # Creating a `stormsDataset` object with storms between 2010 and 2015
+#' # in the South Pacific using the CSV provided with the package
+#' fileName <- system.file("extdata", "test_dataset.csv", package = "StormR")
+#' SP_2015_2020_csv <- defStormsDataset(seasons = c(2010, 2021))
+#' str(SP_2015_2020_csv)
#' @export
defStormsDataset <- function(filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
+ sep = NULL,
fields = c(
names = "name",
seasons = "season",
@@ -344,135 +690,33 @@ defStormsDataset <- function(filename = system.file("extdata", "test_dataset.nc"
pressure = "mb2pa",
poci = "mb2pa"
),
+ notNamed = "NOT_NAMED",
verbose = 1) {
-
- checkInputsdefStormsDataset(filename, fields, basin, seasons, unitConversion, verbose)
-
- if (verbose) {
- cat("=== Loading data ===\nOpen database... ")
- }
-
-
- dataBase <- ncdf4::nc_open(filename)
-
- if (verbose) {
- cat(filename, "opened\nCollecting data ...\n")
- }
-
- lon <- ncdf4::ncvar_get(dataBase, fields["lon"])
- season <- ncdf4::ncvar_get(dataBase, fields["seasons"])
-
- # Get dimensions
- row <- dim(lon)[1]
- len <- dim(lon)[2]
- ind <- seq(1, len)
-
- # Filter by season
- ind <- which(season %in% seq(seasons[1], seasons[2], 1))
- len <- length(ind)
-
- if (!is.null(basin)) {
- # Filter by basin ID
- basins <- ncdf4::ncvar_get(dataBase, fields["basin"])
- indB <- which(basins[1, ] == basin)
- ind <- intersect(ind, indB)
- len <- length(ind)
- }
-
-
- if (unitConversion["msw"] == "mph2ms") {
- msw <- array(mph2ms(ncdf4::ncvar_get(dataBase, fields["msw"])[, ind]),
- dim = c(row, len)
- )
- } else if (unitConversion["msw"] == "knt2ms") {
- msw <- array(knt2ms(ncdf4::ncvar_get(dataBase, fields["msw"])[, ind]),
- dim = c(row, len)
- )
- } else if (unitConversion["msw"] == "kmh2ms") {
- msw <- array(kmh2ms(ncdf4::ncvar_get(dataBase, fields["msw"])[, ind]),
- dim = c(row, len)
- )
- } else {
- msw <- array(ncdf4::ncvar_get(dataBase, fields["msw"])[, ind],
- dim = c(row, len)
- )
- }
-
- # Collect data
- data <- list(
- names = ncdf4::ncvar_get(dataBase, fields["names"])[ind],
- seasons = season[ind],
- isotimes = array(ncdf4::ncvar_get(dataBase, fields["isoTime"])[, ind],
- dim = c(row, len)
- ),
- longitude = array(ncdf4::ncvar_get(dataBase, fields["lon"])[, ind],
- dim = c(row, len)
- ),
- latitude = array(ncdf4::ncvar_get(dataBase, fields["lat"])[, ind],
- dim = c(row, len)
- ),
- msw = msw
- )
-
- # Sort by Date
- o <- order(data$isotimes[1, ])
-
- data$names <- data$names[o]
- data$seasons <- data$seasons[o]
- data$isotimes <- data$isotimes[, o]
- data$longitude <- data$longitude[, o]
- data$latitude <- data$latitude[, o]
- data$msw <- data$msw[, o]
-
-
- if ("rmw" %in% names(fields)) {
- if (unitConversion["rmw"] == "nm2km") {
- data$rmw <- array(nm2km(ncdf4::ncvar_get(dataBase, fields["rmw"])[, ind]), dim = c(row, len))
- } else {
- data$rmw <- array(ncdf4::ncvar_get(dataBase, fields["rmw"])[, ind], dim = c(row, len))
- }
- data$rmw <- data$rmw[, o]
- }
-
- if ("pressure" %in% names(fields)) {
- if (unitConversion["pressure"] == "mb2pa") {
- data$pressure <- array(mb2pa(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind]), dim = c(row, len))
- } else if (unitConversion["pressure"] == "b2pa") {
- data$pressure <- array(b2pa(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind]), dim = c(row, len))
- } else if (unitConversion["pressure"] == "psi2pa") {
- data$pressure <- array(psi2pa(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind]), dim = c(row, len))
- } else if (unitConversion["pressure"] == "atm2pa") {
- data$pressure <- array(atm2pa(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind]), dim = c(row, len))
- } else {
- data$pressure <- array(ncdf4::ncvar_get(dataBase, fields["pressure"])[, ind], dim = c(row, len))
- }
- data$pressure <- data$pressure[, o]
- }
-
-
- if ("poci" %in% names(fields)) {
- if (unitConversion["poci"] == "mb2pa") {
- data$poci <- array(mb2pa(ncdf4::ncvar_get(dataBase, fields["poci"])[, ind]), dim = c(row, len))
- } else {
- data$poci <- array(ncdf4::ncvar_get(dataBase, fields["poci"])[, ind], dim = c(row, len))
- }
- data$poci <- data$poci[, o]
+ checkInputsdefStormsDataset(filename, sep, fields, basin, seasons, unitConversion, notNamed, verbose)
+
+
+ splitedFilename <- strsplit(filename, "\\.")[[1]]
+ extension <- splitedFilename[length(splitedFilename)]
+
+
+ if(extension == "csv"){
+ data <- getDataFromCsvFile(filename, sep, fields, basin, seasons, unitConversion, notNamed, verbose)
+ }else{
+ data <- getDataFromNcdfFile(filename, fields, basin, seasons, unitConversion, notNamed, verbose)
}
-
- ncdf4::nc_close(dataBase)
-
-
-
+
+ data <- convertVariables(data, unitConversion)
+
+
if (verbose) {
cat("=== DONE ===\n")
}
-
+
if (is.null(basin)) {
basin <- "None"
}
-
-
+
sds <- new(
Class = "stormsDataset",
filename = filename,
@@ -481,7 +725,7 @@ defStormsDataset <- function(filename = system.file("extdata", "test_dataset.nc"
basin = basin,
seasons = c(min = min(data$seasons, na.rm = TRUE), max = max(data$seasons, na.rm = TRUE))
)
-
-
+
+
return(sds)
}
diff --git a/R/sysdata.rda b/R/sysdata.rda
index ea11ed2a..36f31e38 100644
Binary files a/R/sysdata.rda and b/R/sysdata.rda differ
diff --git a/data-raw/internalData.R b/data-raw/internalData.R
index c70c7618..a8ea7218 100644
--- a/data-raw/internalData.R
+++ b/data-raw/internalData.R
@@ -57,28 +57,37 @@ xsup <- 95
xinf <- 18
nbC <- xsup - xinf
x <- seq(xinf, xsup)
-
y <- x
colorRange <- colorRampPalette(sshsPalette[2:7], bias = 1)
mswSSHSPalette <- colorRange(nbC)
-
plot(x, y, col = mswSSHSPalette, lwd = 3)
abline(v = sshs)
-
mswPalette <- rev(grDevices::heat.colors(50))
pdiPalette <- rev(viridis::inferno(50))
exposurePalette <- rev(viridis::viridis(50))
-# Data for test functions
+################################################################################
+########### Data for the tests of functions ####################################
+################################################################################
+
+# spatialBehaviour functions
suppressWarnings(sds <- defStormsDataset())
pam <- defStormsList(sds, loi = "Vanuatu", names = "PAM", verbose = 0)
dfGetDataInterpolate <- getDataInterpolate(pam@data[["PAM"]], seq(26, 49), 4, 3, FALSE, "Willoughby")
+
+# defStormsDataset functions
+sdsFromNc <- defStormsDataset(seasons = c(2015, 2020))
+sdsFromCsv <- defStormsDataset(filename = system.file("extdata", "test_dataset.csv", package = "StormR"),
+ seasons = c(2015, 2020))
+
+
+
usethis::use_data(resolutions,
mph2msC, knt2msC, kmh2msC, nm2kmC, b2paC, mb2paC, psi2paC, atm2paC,
km, wgs84, Basins, sshs,
margin,
oceanColor, groundColor, sshsPalette, mswSSHSPalette, mswPalette, pdiPalette, exposurePalette,
- dfGetDataInterpolate,
+ dfGetDataInterpolate, sdsFromNc, sdsFromCsv,
internal = TRUE, overwrite = TRUE
)
diff --git a/inst/extdata/test_dataset.csv b/inst/extdata/test_dataset.csv
new file mode 100644
index 00000000..42917987
--- /dev/null
+++ b/inst/extdata/test_dataset.csv
@@ -0,0 +1,602 @@
+name,season,iso_time,usa_lon,usa_lat,usa_wind,usa_sshs,usa_rmw,usa_pres,usa_poci
+'LUCAS',2021,'2021-01-29 00:00:00',144.1,-14.1,20,-3,35,999,1001
+'LUCAS',2021,'2021-01-29 03:00:00',144.46753,-13.904994,20,-3,35,999,1001
+'LUCAS',2021,'2021-01-29 06:00:00',144.9,-13.7,20,-3,35,999,1001
+'LUCAS',2021,'2021-01-29 09:00:00',145.43509,-13.485062,22,-3,40,1000,1002
+'LUCAS',2021,'2021-01-29 12:00:00',146,-13.3,25,-1,45,1002,1004
+'LUCAS',2021,'2021-01-29 15:00:00',146.51494,-13.169901,25,-1,45,1000,1004
+'LUCAS',2021,'2021-01-29 18:00:00',147,-13.1,25,-1,45,999,1004
+'LUCAS',2021,'2021-01-29 21:00:00',147.45,-1369842,27,-1,45,999,1004
+'LUCAS',2021,'2021-01-30 00:00:00',147.9,-13.1,30,-1,45,1000,1004
+'LUCAS',2021,'2021-01-30 03:00:00',148.38501,-13.177401,30,-1,45,998,1002
+'LUCAS',2021,'2021-01-30 06:00:00',148.9,-13.3,30,-1,45,997,1001
+'LUCAS',2021,'2021-01-30 09:00:00',149.42007,-13.442268,30,-1,45,997,1001
+'LUCAS',2021,'2021-01-30 12:00:00',150,-13.6,30,-1,45,997,1001
+'LUCAS',2021,'2021-01-30 15:00:00',150.71481,-13.772758,30,-1,45,997,1001
+'LUCAS',2021,'2021-01-30 18:00:00',151.4,-13.9,30,-1,45,997,1001
+'LUCAS',2021,'2021-01-30 21:00:00',151.88766,-13.922168,32,-1,45,997,1001
+'LUCAS',2021,'2021-01-31 00:00:00',152.3,-13.9,35,0,45,998,1001
+'LUCAS',2021,'2021-01-31 03:00:00',152.68217,-13.936909,40,0,45,995,1001
+'LUCAS',2021,'2021-01-31 06:00:00',153.2,-13.9,45,0,45,992,1001
+'LUCAS',2021,'2021-01-31 09:00:00',1540371,-13.61992,50,0,42,989,1001
+'LUCAS',2021,'2021-01-31 12:00:00',155,-13.4,55,0,40,987,1001
+'LUCAS',2021,'2021-01-31 15:00:00',156.1365,-13.540654,55,0,40,988,1001
+'LUCAS',2021,'2021-01-31 18:00:00',157.2,-13.8,55,0,40,989,1001
+'LUCAS',2021,'2021-01-31 21:00:00',157.85081,-13.92601,52,0,27,990,1001
+'LUCAS',2021,'2021-02-01 00:00:00',158.5,-14.1,50,0,15,991,1002
+'LUCAS',2021,'2021-02-01 03:00:00',159.5549,-14.405606,55,0,15,987,1001
+'LUCAS',2021,'2021-02-01 06:00:00',160.7,-14.8,60,0,15,983,1000
+'LUCAS',2021,'2021-02-01 09:00:00',161.71002,-15.234726,62,0,15,981,1000
+'LUCAS',2021,'2021-02-01 12:00:00',162.6,-15.7,65,1,15,980,1000
+'LUCAS',2021,'2021-02-01 15:00:00',163.36754,-16.179605,62,0,15,981,1000
+'LUCAS',2021,'2021-02-01 18:00:00',164,-16.6,60,0,15,983,1000
+'LUCAS',2021,'2021-02-01 21:00:00',164.52359,-16.819578,52,0,27,986,1000
+'LUCAS',2021,'2021-02-02 00:00:00',165,-17.1,45,0,40,990,1000
+'LUCAS',2021,'2021-02-02 03:00:00',165.57936,-17.697693,45,0,40,990,1000
+'LUCAS',2021,'2021-02-02 06:00:00',166.1,-18.4,45,0,40,990,1000
+'LUCAS',2021,'2021-02-02 09:00:00',166.41597,-18.999588,45,0,40,990,1000
+'LUCAS',2021,'2021-02-02 12:00:00',166.7,-19.6,45,0,40,990,1000
+'LUCAS',2021,'2021-02-02 15:00:00',167.22379,-20.257904,50,0,40,988,1000
+'LUCAS',2021,'2021-02-02 18:00:00',167.6,-20.9,55,0,40,986,1000
+'LUCAS',2021,'2021-02-02 21:00:00',167.4838,-21.50245,52,0,50,987,1000
+'LUCAS',2021,'2021-02-03 00:00:00',167.2,-22,50,0,60,988,1000
+'LUCAS',2021,'2021-02-03 03:00:00',167923,-22.374928,47,0,60,988,1000
+'LUCAS',2021,'2021-02-03 06:00:00',167,-22.6,45,-2,60,988,1000
+'LUCAS',2021,'2021-02-03 09:00:00',166.85744,-22.695004,40,-2,60,990,1000
+'LUCAS',2021,'2021-02-03 12:00:00',166.7,-22.7,35,-2,60,992,1001
+'LUCAS',2021,'2021-02-03 15:00:00',166.58752,-22.714819,30,-2,52,995,1002
+'LUCAS',2021,'2021-02-03 18:00:00',166.4,-22.7,25,-1,45,999,1003
+'LUCAS',2021,'2021-02-03 21:00:00',166499,-22.657902,22,-1,45,1000,1003
+'LUCAS',2021,'2021-02-04 00:00:00',165.6,-22.6,20,-2,45,1002,1003
+'PAM',2015,'2015-03-08 12:00:00',168.9,-7.5,25,-1,50,1004,1005
+'PAM',2015,'2015-03-08 15:00:00',1694248,-7.6525087,27,-1,50,1002,1002
+'PAM',2015,'2015-03-08 18:00:00',169.2,-7.8,30,-1,50,1000,1000
+'PAM',2015,'2015-03-08 20:00:00',169.32002,-7.89456,30,-1,50,1000,1000
+'PAM',2015,'2015-03-08 21:00:00',169.38504,-7.942489,30,-1,50,1000,1000
+'PAM',2015,'2015-03-09 00:00:00',169.6,-8.1,30,-1,50,1000,1001
+'PAM',2015,'2015-03-09 03:00:00',169.84253,-8.284999,32,-1,50,998,1001
+'PAM',2015,'2015-03-09 06:00:00',170.1,-8.5,35,0,50,996,1001
+'PAM',2015,'2015-03-09 09:00:00',170.39493,-8.757534,40,0,40,992,1001
+'PAM',2015,'2015-03-09 12:00:00',170.6,-9,45,0,30,989,1001
+'PAM',2015,'2015-03-09 15:00:00',170.58759,-9.15748,50,0,25,985,1001
+'PAM',2015,'2015-03-09 18:00:00',170.5,-9.3,55,0,20,982,1001
+'PAM',2015,'2015-03-09 20:00:00',170.4921,-9.419999,56,0,20,980,1001
+'PAM',2015,'2015-03-09 21:00:00',170.4925,-9.484999,57,0,20,980,1001
+'PAM',2015,'2015-03-10 00:00:00',170.5,-9.7,60,0,20,978,1001
+'PAM',2015,'2015-03-10 03:00:00',170.52994,-9.94998,62,0,20,976,998
+'PAM',2015,'2015-03-10 06:00:00',170.5,-10.2,65,1,20,974,996
+'PAM',2015,'2015-03-10 09:00:00',170.30759,-10.422555,70,1,20,970,998
+'PAM',2015,'2015-03-10 12:00:00',170.1,-10.6,75,1,20,967,1001
+'PAM',2015,'2015-03-10 15:00:00',170.10106,-10.71355,80,1,20,963,1001
+'PAM',2015,'2015-03-10 18:00:00',170,-10.8,85,2,20,959,1001
+'PAM',2015,'2015-03-10 21:00:00',169.6,-10.9,85,2,20,959,1001
+'PAM',2015,'2015-03-11 00:00:00',169.7,-11,100,3,20,948,1001
+'PAM',2015,'2015-03-11 03:00:00',169.75343,-10.99999,102,3,20,946,996
+'PAM',2015,'2015-03-11 06:00:00',169.8,-11,105,3,20,944,992
+'PAM',2015,'2015-03-11 09:00:00',169.89252,-11.105004,107,3,20,942,992
+'PAM',2015,'2015-03-11 12:00:00',170,-11.3,110,3,20,941,992
+'PAM',2015,'2015-03-11 15:00:00',170.12242,-11.5625105,112,3,20,939,992
+'PAM',2015,'2015-03-11 16:00:00',170.15697,-11.66791,113,4,20,938,992
+'PAM',2015,'2015-03-11 18:00:00',170.2,-11.9,115,4,20,937,992
+'PAM',2015,'2015-03-11 20:00:00',170.18504,-12.156297,116,4,20,935,992
+'PAM',2015,'2015-03-11 21:00:00',170.16512,-12.292502,117,4,20,935,992
+'PAM',2015,'2015-03-12 00:00:00',170.1,-12.7,120,4,20,933,992
+'PAM',2015,'2015-03-12 03:00:00',170.12231,-1342475,122,4,17,931,992
+'PAM',2015,'2015-03-12 06:00:00',170.1,-13.4,125,4,15,929,992
+'PAM',2015,'2015-03-12 09:00:00',169.93015,-13.850032,130,4,15,925,992
+'PAM',2015,'2015-03-12 12:00:00',169.7,-14.3,135,4,15,922,992
+'PAM',2015,'2015-03-12 15:00:00',169.4924,-14.649999,137,5,13,920,992
+'PAM',2015,'2015-03-12 18:00:00',169.3,-15,140,5,12,918,992
+'PAM',2015,'2015-03-12 20:00:00',169.19208,-15.295036,140,5,12,918,992
+'PAM',2015,'2015-03-12 21:00:00',169.14247,-15.449974,140,5,12,918,992
+'PAM',2015,'2015-03-13 00:00:00',169,-15.9,140,5,12,918,992
+'PAM',2015,'2015-03-13 02:00:00',168.88371,-16.132854,143,5,12,915,992
+'PAM',2015,'2015-03-13 03:00:00',168.82753,-16.24252,145,5,12,914,992
+'PAM',2015,'2015-03-13 06:00:00',168.7,-16.6,150,5,12,911,992
+'PAM',2015,'2015-03-13 09:00:00',168.66254,-174749,150,5,12,911,992
+'PAM',2015,'2015-03-13 12:00:00',168.7,-17.6,150,5,12,911,992
+'PAM',2015,'2015-03-13 15:00:00',168.77751,-18.262518,147,5,12,912,992
+'PAM',2015,'2015-03-13 18:00:00',168.9,-19,145,5,12,914,992
+'PAM',2015,'2015-03-13 20:00:00',168.96019,-19.475676,143,5,13,915,992
+'PAM',2015,'2015-03-13 21:00:00',168.99837,-19.719831,142,5,13,916,992
+'PAM',2015,'2015-03-14 00:00:00',169.2,-20.5,140,5,15,918,992
+'PAM',2015,'2015-03-14 03:00:00',169.59778,-21.34016,137,5,15,920,992
+'PAM',2015,'2015-03-14 06:00:00',170.1,-22.3,135,4,15,922,992
+'PAM',2015,'2015-03-14 09:00:00',170.54927,-23.404478,130,4,15,925,992
+'PAM',2015,'2015-03-14 12:00:00',171.1,-24.6,125,4,15,929,993
+'PAM',2015,'2015-03-14 15:00:00',171.82031,-25.747162,120,4,15,933,993
+'PAM',2015,'2015-03-14 18:00:00',172.7,-27,115,4,15,937,993
+'PAM',2015,'2015-03-14 21:00:00',173.72453,-28.54528,105,3,17,944,993
+'PAM',2015,'2015-03-15 00:00:00',174.8,-30,95,2,20,952,993
+'PAM',2015,'2015-03-15 03:00:00',175.77748,-30.973904,80,1,20,963,993
+'PAM',2015,'2015-03-15 06:00:00',176.7,-31.8,65,1,20,974,993
+'PAM',2015,'2015-03-15 09:00:00',177.59906,-32.751472,60,0,20,978,993
+'PAM',2015,'2015-03-15 12:00:00',178.5,-33.8,55,-4,20,982,993
+'SOLO',2015,'2015-04-09 06:00:00',163.1,-12.6,25,-1,,1004,
+'SOLO',2015,'2015-04-09 09:00:00',162.59755,-12.732663,27,-1,,1002,
+'SOLO',2015,'2015-04-09 12:00:00',162.1,-12.9,30,-1,,1000,
+'SOLO',2015,'2015-04-09 15:00:00',161.62003,-13.127486,32,-1,,998,
+'SOLO',2015,'2015-04-09 18:00:00',161.2,-13.4,35,0,50,996,1008
+'SOLO',2015,'2015-04-09 21:00:00',160.84,-13.662464,40,0,50,992,1008
+'SOLO',2015,'2015-04-10 00:00:00',160.6,-14,45,0,50,989,1008
+'SOLO',2015,'2015-04-10 03:00:00',160.49744,-14.484939,45,0,45,989,1007
+'SOLO',2015,'2015-04-10 06:00:00',160.5,-15,45,0,40,989,1006
+'SOLO',2015,'2015-04-10 09:00:00',160.52002,-15.422476,47,0,35,987,1007
+'SOLO',2015,'2015-04-10 12:00:00',160.6,-15.8,50,0,30,985,1008
+'SOLO',2015,'2015-04-10 15:00:00',160.72762,-16.127499,52,0,27,983,1008
+'SOLO',2015,'2015-04-10 18:00:00',160.9,-16.5,55,0,25,982,1008
+'SOLO',2015,'2015-04-10 20:00:00',1611447,-16.873047,55,0,23,982,1008
+'SOLO',2015,'2015-04-10 21:00:00',1617738,-177245,55,0,22,982,1008
+'SOLO',2015,'2015-04-11 00:00:00',161.3,-17.6,55,0,20,982,1008
+'SOLO',2015,'2015-04-11 03:00:00',161.5405,-17.837221,52,0,20,983,1008
+'SOLO',2015,'2015-04-11 06:00:00',161.9,-18,50,0,20,985,1008
+'SOLO',2015,'2015-04-11 09:00:00',162.44754,-18.27759,50,0,22,985,1008
+'SOLO',2015,'2015-04-11 12:00:00',163.1,-18.6,50,0,25,985,1009
+'SOLO',2015,'2015-04-11 15:00:00',163.72797,-18.92719,45,0,35,989,1008
+'SOLO',2015,'2015-04-11 18:00:00',164.4,-19.3,40,0,45,993,1008
+'SOLO',2015,'2015-04-11 20:00:00',164.8524,-19.5673,36,0,45,995,1008
+'SOLO',2015,'2015-04-11 21:00:00',16591,-19.711744,35,0,45,996,1008
+'SOLO',2015,'2015-04-12 00:00:00',165.9,-20.2,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 03:00:00',166.8908,-20.754856,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 06:00:00',168,-21.4,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 09:00:00',169.14934,-22.164804,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 12:00:00',170.3,-22.9,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 15:00:00',171.37471,-23.458412,30,-1,45,1000,1009
+'SOLO',2015,'2015-04-12 18:00:00',172.4,-23.9,30,-1,45,1000,1009
+'NIRAN',2021,'2021-02-27 06:00:00',150,-15.7,20,-3,,1000,
+'NIRAN',2021,'2021-02-27 09:00:00',149.6901,-15.842608,20,-3,,1001,
+'NIRAN',2021,'2021-02-27 12:00:00',149.4,-16,20,-3,40,1002,1005
+'NIRAN',2021,'2021-02-27 15:00:00',149.14243,-16.184944,20,-3,40,1002,1004
+'NIRAN',2021,'2021-02-27 18:00:00',148.9,-16.4,20,-3,40,1002,1003
+'NIRAN',2021,'2021-02-27 21:00:00',148.62013,-16.672546,22,-3,40,1001,1003
+'NIRAN',2021,'2021-02-28 00:00:00',148.4,-16.9,25,-1,40,1000,1003
+'NIRAN',2021,'2021-02-28 03:00:00',148.31989,-16.979944,27,-1,40,998,1002
+'NIRAN',2021,'2021-02-28 06:00:00',148.3,-17,30,-1,40,996,1001
+'NIRAN',2021,'2021-02-28 09:00:00',148.27995,-1742446,32,-1,40,996,1002
+'NIRAN',2021,'2021-02-28 12:00:00',148.2,-17.1,35,0,40,996,1004
+'NIRAN',2021,'2021-02-28 15:00:00',147.9726,-17.207575,32,-1,40,996,1004
+'NIRAN',2021,'2021-02-28 18:00:00',147.7,-17.3,30,-1,40,996,1004
+'NIRAN',2021,'2021-02-28 21:00:00',147.48505,-17.352474,32,-1,40,996,1004
+'NIRAN',2021,'2021-03-01 00:00:00',147.3,-17.3,35,0,40,996,1004
+'NIRAN',2021,'2021-03-01 03:00:00',147.12741,-17.102491,37,0,40,994,1002
+'NIRAN',2021,'2021-03-01 06:00:00',147,-16.8,40,0,40,992,1000
+'NIRAN',2021,'2021-03-01 09:00:00',146.89738,-16.457457,40,0,37,993,1001
+'NIRAN',2021,'2021-03-01 12:00:00',146.9,-16.1,40,0,35,994,1002
+'NIRAN',2021,'2021-03-01 15:00:00',1476265,-15.777541,42,0,27,989,1002
+'NIRAN',2021,'2021-03-01 18:00:00',147.3,-15.5,45,0,20,984,1002
+'NIRAN',2021,'2021-03-01 21:00:00',147.50748,-15.270001,45,0,22,989,1002
+'NIRAN',2021,'2021-03-02 00:00:00',147.7,-15.1,45,0,25,994,1003
+'NIRAN',2021,'2021-03-02 03:00:00',147.87247,-14.977496,50,0,25,991,1003
+'NIRAN',2021,'2021-03-02 06:00:00',148,-14.9,55,0,25,988,1003
+'NIRAN',2021,'2021-03-02 09:00:00',148.10251,-14.84246,55,0,27,987,1003
+'NIRAN',2021,'2021-03-02 12:00:00',148.1,-14.8,55,0,30,986,1004
+'NIRAN',2021,'2021-03-02 15:00:00',147.88496,-14.735095,55,0,30,984,1002
+'NIRAN',2021,'2021-03-02 18:00:00',147.7,-14.7,55,0,30,983,1001
+'NIRAN',2021,'2021-03-02 21:00:00',147.82747,-14.742543,57,0,30,983,1002
+'NIRAN',2021,'2021-03-03 00:00:00',148,-14.8,60,0,30,983,1004
+'NIRAN',2021,'2021-03-03 03:00:00',147.96501,-14.799994,65,1,25,976,1004
+'NIRAN',2021,'2021-03-03 06:00:00',147.9,-14.8,70,1,20,970,1004
+'NIRAN',2021,'2021-03-03 09:00:00',147.92749,-14.849995,65,1,20,977,1004
+'NIRAN',2021,'2021-03-03 12:00:00',148,-14.9,60,0,20,984,1005
+'NIRAN',2021,'2021-03-03 15:00:00',1487756,-14.884976,70,1,16,975,1003
+'NIRAN',2021,'2021-03-03 18:00:00',148.2,-14.9,80,1,12,966,1001
+'NIRAN',2021,'2021-03-03 21:00:00',148.34755,-152737,82,1,13,964,1001
+'NIRAN',2021,'2021-03-04 00:00:00',148.6,-15.2,85,2,15,962,1001
+'NIRAN',2021,'2021-03-04 03:00:00',1490491,-15.365043,90,2,13,958,1000
+'NIRAN',2021,'2021-03-04 06:00:00',149.5,-15.5,95,2,12,954,1000
+'NIRAN',2021,'2021-03-04 09:00:00',149.91791,-15.549247,92,2,12,957,1001
+'NIRAN',2021,'2021-03-04 12:00:00',150.5,-15.6,90,2,12,961,1002
+'NIRAN',2021,'2021-03-04 15:00:00',151.41806,-15.697788,92,2,12,959,1002
+'NIRAN',2021,'2021-03-04 18:00:00',152.5,-15.9,95,2,12,958,1002
+'NIRAN',2021,'2021-03-04 21:00:00',153.52803,-16.231888,105,3,12,950,1002
+'NIRAN',2021,'2021-03-05 00:00:00',154.6,-16.7,115,4,12,942,1002
+'NIRAN',2021,'2021-03-05 03:00:00',155.7347,-17.292105,122,4,8,934,1000
+'NIRAN',2021,'2021-03-05 06:00:00',156.9,-17.9,130,4,5,926,999
+'NIRAN',2021,'2021-03-05 09:00:00',1585133,-18.356802,135,4,5,921,1000
+'NIRAN',2021,'2021-03-05 12:00:00',159.2,-18.8,140,5,5,917,1001
+'NIRAN',2021,'2021-03-05 15:00:00',160.33658,-19.296528,135,4,5,921,1000
+'NIRAN',2021,'2021-03-05 18:00:00',161.5,-19.9,130,4,5,926,999
+'NIRAN',2021,'2021-03-05 21:00:00',162.72018,-20.676619,120,4,5,935,999
+'NIRAN',2021,'2021-03-06 00:00:00',164,-21.5,110,3,5,945,999
+'NIRAN',2021,'2021-03-06 03:00:00',165.337,-22.199251,107,3,5,946,999
+'NIRAN',2021,'2021-03-06 06:00:00',166.7,-22.9,105,3,5,948,1000
+'NIRAN',2021,'2021-03-06 09:00:00',167.97823,-23.674202,97,3,5,953,1000
+'NIRAN',2021,'2021-03-06 12:00:00',169.4,-24.5,90,2,5,958,1000
+'NIRAN',2021,'2021-03-06 15:00:00',171.25471,-25.390501,77,1,5,967,1001
+'NIRAN',2021,'2021-03-06 18:00:00',173.1,-26.2,65,1,5,976,1002
+'NIRAN',2021,'2021-03-06 21:00:00',174.45117,-26.752596,60,0,32,982,1002
+'NIRAN',2021,'2021-03-07 00:00:00',175.7,-27.3,55,0,60,988,1003
+'NIRAN',2021,'2021-03-07 03:00:00',177.16425,-2841044,47,0,60,989,1003
+'NIRAN',2021,'2021-03-07 06:00:00',178.8,-28.9,40,-2,60,991,1003
+'UESI',2020,'2020-02-07 18:00:00',163.3,-13.2,25,-1,30,1005,1002
+'UESI',2020,'2020-02-07 21:00:00',163.34998,-13.412503,25,-1,35,1002,1002
+'UESI',2020,'2020-02-08 00:00:00',163.4,-13.6,25,-1,40,1000,1003
+'UESI',2020,'2020-02-08 03:00:00',163.45001,-13.749999,27,-1,40,999,1002
+'UESI',2020,'2020-02-08 06:00:00',163.5,-13.9,30,-1,40,998,1001
+'UESI',2020,'2020-02-08 09:00:00',163.55,-1499998,30,-1,40,998,1002
+'UESI',2020,'2020-02-08 12:00:00',163.6,-14.3,30,-1,40,998,1003
+'UESI',2020,'2020-02-08 15:00:00',163.65002,-14.449999,30,-1,40,997,1002
+'UESI',2020,'2020-02-08 18:00:00',163.7,-14.6,30,-1,40,996,1001
+'UESI',2020,'2020-02-08 21:00:00',163.75749,-14.792503,32,-1,40,996,1001
+'UESI',2020,'2020-02-09 00:00:00',163.8,-15,35,0,40,996,1002
+'UESI',2020,'2020-02-09 03:00:00',163.815,-15.199997,37,0,40,994,1002
+'UESI',2020,'2020-02-09 06:00:00',163.8,-15.4,40,0,40,993,1002
+'UESI',2020,'2020-02-09 09:00:00',163.76497,-15.584995,42,0,40,992,1002
+'UESI',2020,'2020-02-09 12:00:00',163.7,-15.8,45,0,40,992,1002
+'UESI',2020,'2020-02-09 15:00:00',163.6374,-1692434,47,0,32,990,1001
+'UESI',2020,'2020-02-09 18:00:00',163.5,-16.4,50,0,25,988,1001
+'UESI',2020,'2020-02-09 21:00:00',163.20763,-16.665136,52,0,25,987,1001
+'UESI',2020,'2020-02-10 00:00:00',162.9,-16.9,55,0,25,986,1002
+'UESI',2020,'2020-02-10 03:00:00',162.71242,-17.107443,57,0,25,984,1002
+'UESI',2020,'2020-02-10 06:00:00',162.6,-17.3,60,0,25,982,1002
+'UESI',2020,'2020-02-10 09:00:00',162.52748,-17.499983,62,0,20,980,1002
+'UESI',2020,'2020-02-10 12:00:00',162.5,-17.7,65,1,15,979,1002
+'UESI',2020,'2020-02-10 15:00:00',162.49248,-17.877499,65,1,25,979,1002
+'UESI',2020,'2020-02-10 18:00:00',162.5,-18.1,65,1,35,979,1002
+'UESI',2020,'2020-02-10 21:00:00',162.49255,-18.420002,65,1,20,979,1002
+'UESI',2020,'2020-02-11 00:00:00',162.5,-18.8,65,1,5,980,1002
+'UESI',2020,'2020-02-11 03:00:00',162.5425,-19.177505,65,1,7,979,1001
+'UESI',2020,'2020-02-11 06:00:00',162.6,-19.6,65,1,10,978,1000
+'UESI',2020,'2020-02-11 09:00:00',162.65746,-2085009,67,1,15,976,1001
+'UESI',2020,'2020-02-11 12:00:00',162.7,-20.6,70,1,20,975,1002
+'UESI',2020,'2020-02-11 15:00:00',162.72241,-2199987,75,1,20,971,1002
+'UESI',2020,'2020-02-11 18:00:00',162.7,-21.6,80,1,20,968,1002
+'UESI',2020,'2020-02-11 21:00:00',162.6151,-22.10751,77,1,20,969,1001
+'UESI',2020,'2020-02-12 00:00:00',162.5,-22.6,75,1,20,971,1001
+'UESI',2020,'2020-02-12 03:00:00',162.40732,-2349974,72,1,22,972,1000
+'UESI',2020,'2020-02-12 06:00:00',162.3,-23.5,70,1,25,973,1000
+'UESI',2020,'2020-02-12 09:00:00',162.15738,-23.962515,67,1,32,972,1000
+'UESI',2020,'2020-02-12 12:00:00',162,-24.5,65,1,40,971,1000
+'UESI',2020,'2020-02-12 15:00:00',161.87198,-25.162416,62,0,35,972,1000
+'UESI',2020,'2020-02-12 18:00:00',161.7,-25.9,60,0,30,974,1000
+'UESI',2020,'2020-02-12 21:00:00',161.41528,-26.650097,60,0,30,975,1001
+'UESI',2020,'2020-02-13 00:00:00',161.1,-27.4,60,0,30,977,1002
+'UESI',2020,'2020-02-13 03:00:00',160.84933,-28.107357,60,0,50,976,1002
+'UESI',2020,'2020-02-13 06:00:00',160.6,-28.8,60,0,70,976,1002
+'UESI',2020,'2020-02-13 09:00:00',160.29991,-29.500025,57,0,70,976,1002
+'UESI',2020,'2020-02-13 12:00:00',160,-30.2,55,-2,70,977,1002
+'UESI',2020,'2020-02-13 15:00:00',159.7715,-30.914679,55,-2,70,976,1002
+'UESI',2020,'2020-02-13 18:00:00',159.5,-31.6,55,-2,70,976,1002
+'UESI',2020,'2020-02-13 21:00:00',1591378,-32.23056,52,-2,70,978,1003
+'UESI',2020,'2020-02-14 00:00:00',158.6,-32.8,50,-2,70,980,1004
+'UESI',2020,'2020-02-14 03:00:00',158.52383,-33.322212,47,-2,70,981,1004
+'UESI',2020,'2020-02-14 06:00:00',158.6,-33.8,45,-2,70,982,1004
+'UESI',2020,'2020-02-14 09:00:00',158.62787,-34.219975,45,-2,70,982,1004
+'UESI',2020,'2020-02-14 12:00:00',158.7,-34.7,45,-2,70,982,1004
+'UESI',2020,'2020-02-14 15:00:00',158.82025,-35.35498,42,-2,70,983,1004
+'UESI',2020,'2020-02-14 18:00:00',159,-36.1,40,-2,70,984,1004
+'UESI',2020,'2020-02-14 21:00:00',159.2132,-36.84236,40,-2,70,985,1004
+'UESI',2020,'2020-02-15 00:00:00',159.5,-37.6,40,-2,70,987,1004
+'UESI',2020,'2020-02-15 03:00:00',159.87779,-38.342564,40,-2,70,983,1002
+'UESI',2020,'2020-02-15 06:00:00',160.3,-39.1,40,-4,70,980,1000
+'UESI',2020,'2020-02-15 09:00:00',160.65808,-39.86932,40,-4,70,979,1000
+'UESI',2020,'2020-02-15 12:00:00',161.1,-40.7,40,-4,70,979,1000
+'UESI',2020,'2020-02-15 15:00:00',161.76945,-41.6131,40,-4,70,980,1000
+'UESI',2020,'2020-02-15 18:00:00',162.5,-42.6,40,-4,70,981,1000
+'UESI',2020,'2020-02-15 21:00:00',163.13246,-43.637413,40,-4,70,981,1000
+'UESI',2020,'2020-02-16 00:00:00',163.7,-44.7,40,-4,70,981,1000
+'ULA',2016,'2015-12-29 12:00:00',-171,-9,30,-1,20,1000,1002
+'ULA',2016,'2015-12-29 15:00:00',-169.86316,-922787,35,0,20,996,1002
+'ULA',2016,'2015-12-29 18:00:00',-169,-9.2,40,0,20,993,1002
+'ULA',2016,'2015-12-29 19:00:00',-168.80981,-9.321344,41,0,20,991,1002
+'ULA',2016,'2015-12-29 21:00:00',-168.4,-9.7,45,0,20,989,1002
+'ULA',2016,'2015-12-30 00:00:00',-167.3,-10.6,45,0,20,989,1001
+'ULA',2016,'2015-12-30 03:00:00',-166.76768,-11.26194,45,0,20,989,1001
+'ULA',2016,'2015-12-30 06:00:00',-166.5,-12,45,0,20,989,1001
+'ULA',2016,'2015-12-30 07:00:00',-166.32414,-12.339973,45,0,20,989,1001
+'ULA',2016,'2015-12-30 09:00:00',-166.1,-13.1,45,0,20,989,1001
+'ULA',2016,'2015-12-30 12:00:00',-166.4,-14.3,50,0,20,985,1001
+'ULA',2016,'2015-12-30 15:00:00',-166.7061,-14.857686,50,0,20,985,1001
+'ULA',2016,'2015-12-30 18:00:00',-167.1,-15,50,0,20,985,1001
+'ULA',2016,'2015-12-30 21:00:00',-167.70767,-15.137891,52,0,20,983,1001
+'ULA',2016,'2015-12-31 00:00:00',-168.3,-15.2,55,0,20,982,1001
+'ULA',2016,'2015-12-31 03:00:00',-168.64514,-15.284715,57,0,13,980,1001
+'ULA',2016,'2015-12-31 06:00:00',-168.9,-15.4,60,0,7,978,1001
+'ULA',2016,'2015-12-31 09:00:00',-169.22243,-15.585034,62,0,7,976,1001
+'ULA',2016,'2015-12-31 12:00:00',-169.5,-15.8,65,1,7,974,1001
+'ULA',2016,'2015-12-31 15:00:00',-169.65022,-15.984866,77,1,7,965,1002
+'ULA',2016,'2015-12-31 18:00:00',-169.8,-16.2,90,2,7,956,1003
+'ULA',2016,'2015-12-31 21:00:00',-170402,-16.47733,87,2,8,957,1003
+'ULA',2016,'2015-12-31 22:00:00',-170.1444,-16.58106,86,2,9,958,1003
+'ULA',2016,'2016-01-01 00:00:00',-170.4,-16.8,85,2,10,959,1003
+'ULA',2016,'2016-01-01 03:00:00',-170.87503,-17.157248,80,1,12,963,1002
+'ULA',2016,'2016-01-01 06:00:00',-171.5,-17.5,75,1,15,967,1001
+'ULA',2016,'2016-01-01 09:00:00',-172.29982,-17.787989,75,1,15,967,1001
+'ULA',2016,'2016-01-01 12:00:00',-173.1,-18,75,1,15,967,1001
+'ULA',2016,'2016-01-01 15:00:00',-173.68033,-18.129406,75,1,15,967,1001
+'ULA',2016,'2016-01-01 18:00:00',-174.2,-18.2,75,1,15,967,1001
+'ULA',2016,'2016-01-01 21:00:00',-174.83,-18.26518,77,1,15,965,1001
+'ULA',2016,'2016-01-02 00:00:00',-175.4,-18.3,80,1,15,963,1001
+'ULA',2016,'2016-01-02 03:00:00',-175.77272,-18.284592,82,1,15,961,1001
+'ULA',2016,'2016-01-02 06:00:00',-176.1,-18.3,85,2,15,959,1001
+'ULA',2016,'2016-01-02 09:00:00',-176.54996,-18.41259,87,2,15,957,1001
+'ULA',2016,'2016-01-02 12:00:00',-177,-18.6,90,2,15,956,1001
+'ULA',2016,'2016-01-02 15:00:00',-177.35031,-18.812256,92,2,15,954,1001
+'ULA',2016,'2016-01-02 18:00:00',-177.7,-19.1,95,2,15,952,1001
+'ULA',2016,'2016-01-02 21:00:00',-178.16455,-19.507685,95,2,15,952,1001
+'ULA',2016,'2016-01-03 00:00:00',-178.6,-19.9,95,2,15,952,1002
+'ULA',2016,'2016-01-03 03:00:00',-178.8471,-20.106539,97,3,12,950,1002
+'ULA',2016,'2016-01-03 06:00:00',-179.1,-20.3,100,3,10,948,1002
+'ULA',2016,'2016-01-03 09:00:00',-179.5,-20.6,100,3,10,948,1002
+'ULA',2016,'2016-01-03 12:00:00',-179.8,-21,105,3,10,944,1002
+'ULA',2016,'2016-01-03 15:00:00',-179.96733,-21.287373,100,3,10,948,1002
+'ULA',2016,'2016-01-03 18:00:00',179.9,-21.5,95,2,10,952,1002
+'ULA',2016,'2016-01-03 21:00:00',179.65012,-21.730078,90,2,10,955,1002
+'ULA',2016,'2016-01-04 00:00:00',179.4,-21.9,85,2,10,959,1002
+'ULA',2016,'2016-01-04 03:00:00',179.2499,-21.979883,80,1,12,963,1002
+'ULA',2016,'2016-01-04 06:00:00',179.1,-22,75,1,15,967,1002
+'ULA',2016,'2016-01-04 09:00:00',178.86502,-221502,72,1,15,968,1002
+'ULA',2016,'2016-01-04 12:00:00',178.6,-22,70,1,15,970,1002
+'ULA',2016,'2016-01-04 15:00:00',178.31998,-21.96506,65,1,15,974,1002
+'ULA',2016,'2016-01-04 18:00:00',178.1,-21.9,60,0,15,978,1003
+'ULA',2016,'2016-01-04 21:00:00',1782005,-21.814934,60,0,15,978,1003
+'ULA',2016,'2016-01-05 00:00:00',178,-21.7,60,0,15,978,1003
+'ULA',2016,'2016-01-05 03:00:00',177.98007,-21.549932,57,0,15,980,1003
+'ULA',2016,'2016-01-05 06:00:00',177.9,-21.4,55,0,15,982,1003
+'ULA',2016,'2016-01-05 09:00:00',177.67247,-21.292591,52,0,15,983,1003
+'ULA',2016,'2016-01-05 12:00:00',177.4,-21.2,50,0,15,985,1003
+'ULA',2016,'2016-01-05 15:00:00',177.1926,-21.114946,50,0,15,985,1003
+'ULA',2016,'2016-01-05 18:00:00',177,-21,50,0,15,985,1004
+'ULA',2016,'2016-01-05 21:00:00',176.79245,-20.8075,50,0,20,985,1004
+'ULA',2016,'2016-01-06 00:00:00',176.6,-20.6,50,0,25,985,1004
+'ULA',2016,'2016-01-06 03:00:00',176.45013,-20.449945,47,0,25,987,1004
+'ULA',2016,'2016-01-06 06:00:00',176.3,-20.3,45,0,25,989,1004
+'ULA',2016,'2016-01-06 09:00:00',1769995,-20.100025,45,0,25,989,1004
+'ULA',2016,'2016-01-06 12:00:00',175.9,-19.9,45,0,25,989,1004
+'ULA',2016,'2016-01-06 15:00:00',175.73505,-19.734983,45,0,25,989,1004
+'ULA',2016,'2016-01-06 18:00:00',175.6,-19.6,45,0,25,989,1005
+'ULA',2016,'2016-01-06 21:00:00',175.50008,-19.499966,45,0,25,989,1005
+'ULA',2016,'2016-01-07 00:00:00',175.4,-19.4,45,0,25,989,1005
+'ULA',2016,'2016-01-07 03:00:00',175.25749,-19.257505,47,0,25,987,1005
+'ULA',2016,'2016-01-07 06:00:00',175.1,-19.1,50,0,25,985,1005
+'ULA',2016,'2016-01-07 09:00:00',174.94249,-18.935003,52,0,25,983,1005
+'ULA',2016,'2016-01-07 12:00:00',174.8,-18.8,55,0,25,982,1005
+'ULA',2016,'2016-01-07 15:00:00',174.68506,-18.74249,55,0,17,982,1005
+'ULA',2016,'2016-01-07 18:00:00',174.6,-18.7,55,0,10,982,1006
+'ULA',2016,'2016-01-07 21:00:00',174.55002,-18.599983,55,0,15,982,1007
+'ULA',2016,'2016-01-08 00:00:00',174.5,-18.5,55,0,20,982,1008
+'ULA',2016,'2016-01-08 03:00:00',174.4075,-18.435003,57,0,20,980,1008
+'ULA',2016,'2016-01-08 06:00:00',174.3,-18.4,60,0,20,978,1008
+'ULA',2016,'2016-01-08 09:00:00',174.20752,-18.39248,65,1,20,974,1008
+'ULA',2016,'2016-01-08 12:00:00',174.1,-18.4,70,1,20,970,1008
+'ULA',2016,'2016-01-08 15:00:00',173.96497,-18.384985,75,1,13,966,1008
+'ULA',2016,'2016-01-08 18:00:00',173.8,-18.4,80,1,7,963,1008
+'ULA',2016,'2016-01-08 21:00:00',173.60753,-18.485,82,1,9,961,1008
+'ULA',2016,'2016-01-09 00:00:00',173.4,-18.6,85,2,12,959,1008
+'ULA',2016,'2016-01-09 03:00:00',173.22244,-18.699886,87,2,11,957,1008
+'ULA',2016,'2016-01-09 06:00:00',173,-18.8,90,2,10,956,1008
+'ULA',2016,'2016-01-09 09:00:00',172.65749,-18.89262,95,2,11,952,1008
+'ULA',2016,'2016-01-09 12:00:00',172.3,-19,100,3,12,948,1008
+'ULA',2016,'2016-01-09 15:00:00',1723487,-19.119898,105,3,13,944,1008
+'ULA',2016,'2016-01-09 18:00:00',171.8,-19.3,110,3,15,941,1008
+'ULA',2016,'2016-01-09 21:00:00',171.55751,-19.584934,115,4,11,937,1008
+'ULA',2016,'2016-01-10 00:00:00',171.3,-19.9,120,4,7,933,1008
+'ULA',2016,'2016-01-10 03:00:00',170.99986,-20.142519,117,4,9,935,1008
+'ULA',2016,'2016-01-10 05:00:00',170.79684,-20.307878,115,4,11,936,1008
+'ULA',2016,'2016-01-10 06:00:00',170.7,-20.4,115,4,12,937,1008
+'ULA',2016,'2016-01-10 07:00:00',170.60312,-20.505241,114,4,12,937,1008
+'ULA',2016,'2016-01-10 09:00:00',170.42007,-20.735006,112,3,12,939,1008
+'ULA',2016,'2016-01-10 11:00:00',170.26363,-20.978094,110,3,12,940,1008
+'ULA',2016,'2016-01-10 12:00:00',170.2,-21.1,110,3,12,941,1008
+'ULA',2016,'2016-01-10 15:00:00',1707722,-21.412437,107,3,9,942,1008
+'ULA',2016,'2016-01-10 18:00:00',170,-21.8,105,3,7,944,1008
+'ULA',2016,'2016-01-10 21:00:00',169.87039,-22.370022,100,3,11,948,1008
+'ULA',2016,'2016-01-11 00:00:00',169.8,-23,95,2,15,952,1008
+'ULA',2016,'2016-01-11 03:00:00',169.85489,-23.56496,92,2,15,954,1008
+'ULA',2016,'2016-01-11 06:00:00',170,-24.1,90,2,15,956,1008
+'ULA',2016,'2016-01-11 09:00:00',170.1776,-24.607485,82,1,15,961,1008
+'ULA',2016,'2016-01-11 12:00:00',170.4,-25.1,75,1,15,967,1008
+'ULA',2016,'2016-01-11 15:00:00',170.62787,-25.592407,70,1,15,970,1008
+'ULA',2016,'2016-01-11 18:00:00',170.9,-26.1,65,1,15,974,1008
+'ULA',2016,'2016-01-11 21:00:00',171.19815,-26.642172,60,0,15,978,1008
+'ULA',2016,'2016-01-12 00:00:00',171.6,-27.2,55,0,15,982,1008
+'ULA',2016,'2016-01-12 03:00:00',172.16205,-27.78015,52,0,17,983,1009
+'ULA',2016,'2016-01-12 06:00:00',172.8,-28.3,50,0,20,985,1011
+'ULA',2016,'2016-01-12 09:00:00',173.41562,-28.687405,47,0,22,987,1012
+'ULA',2016,'2016-01-12 12:00:00',174,-29,45,0,25,989,1013
+'ULA',2016,'2016-01-12 15:00:00',174.49326,-29.306856,40,0,25,992,1013
+'ULA',2016,'2016-01-12 18:00:00',175,-29.6,35,0,25,996,1013
+'ULA',2016,'2016-01-12 21:00:00',175.64203,-29.930193,32,-1,25,998,1013
+'ULA',2016,'2016-01-13 00:00:00',176.3,-30.2,30,-2,25,1000,1013
+'ULA',2016,'2016-01-13 03:00:00',176.8779,-30.340109,30,-2,27,1000,1013
+'ULA',2016,'2016-01-13 06:00:00',177.4,-30.4,30,-2,30,1000,1013
+'WINSTON',2016,'2016-02-09 18:00:00',169.5,-13.6,20,-3,45,1007,1005
+'WINSTON',2016,'2016-02-09 21:00:00',169.70238,-13.862545,25,-3,42,1003,1004
+'WINSTON',2016,'2016-02-10 00:00:00',169.9,-14.1,30,-1,40,1000,1003
+'WINSTON',2016,'2016-02-10 03:00:00',170926,-14.299963,30,-1,40,999,1003
+'WINSTON',2016,'2016-02-10 06:00:00',170.3,-14.5,30,-1,40,999,1003
+'WINSTON',2016,'2016-02-10 09:00:00',170.56491,-14.757553,32,-1,40,999,1003
+'WINSTON',2016,'2016-02-10 12:00:00',170.8,-15,35,0,40,1000,1004
+'WINSTON',2016,'2016-02-10 15:00:00',170.9226,-15.164949,37,0,35,996,1003
+'WINSTON',2016,'2016-02-10 18:00:00',171,-15.3,40,0,30,993,1003
+'WINSTON',2016,'2016-02-10 21:00:00',171.10004,-15.434996,40,0,30,993,1003
+'WINSTON',2016,'2016-02-11 00:00:00',171.2,-15.6,40,0,30,993,1004
+'WINSTON',2016,'2016-02-11 03:00:00',171.31494,-15.84251,42,0,35,991,1003
+'WINSTON',2016,'2016-02-11 06:00:00',171.4,-16.1,45,0,40,989,1003
+'WINSTON',2016,'2016-02-11 09:00:00',171.40758,-16.29249,50,0,32,985,1003
+'WINSTON',2016,'2016-02-11 12:00:00',171.4,-16.5,55,0,25,982,1003
+'WINSTON',2016,'2016-02-11 15:00:00',171.44995,-16.777508,57,0,25,980,1003
+'WINSTON',2016,'2016-02-11 18:00:00',171.5,-17.1,60,0,25,978,1003
+'WINSTON',2016,'2016-02-11 21:00:00',171.50754,-17.427502,65,1,25,974,1003
+'WINSTON',2016,'2016-02-12 00:00:00',171.5,-17.8,70,1,25,970,1003
+'WINSTON',2016,'2016-02-12 03:00:00',171.50745,-18.227503,80,1,22,963,1002
+'WINSTON',2016,'2016-02-12 06:00:00',171.5,-18.7,90,2,20,956,1002
+'WINSTON',2016,'2016-02-12 09:00:00',171.44269,-19.192507,97,3,16,950,1003
+'WINSTON',2016,'2016-02-12 12:00:00',171.4,-19.7,105,3,12,944,1004
+'WINSTON',2016,'2016-02-12 15:00:00',171.42752,-20.17,110,3,12,940,1004
+'WINSTON',2016,'2016-02-12 18:00:00',171.5,-20.7,115,4,12,937,1004
+'WINSTON',2016,'2016-02-12 21:00:00',171.5776,-21.392477,115,4,12,937,1004
+'WINSTON',2016,'2016-02-13 00:00:00',171.7,-22.1,115,4,12,937,1004
+'WINSTON',2016,'2016-02-13 03:00:00',171.87024,-22.672438,107,3,11,942,1003
+'WINSTON',2016,'2016-02-13 06:00:00',172.1,-23.2,100,3,10,948,1003
+'WINSTON',2016,'2016-02-13 09:00:00',172.34755,-23.794725,100,3,11,948,1003
+'WINSTON',2016,'2016-02-13 12:00:00',172.7,-24.3,100,3,12,948,1003
+'WINSTON',2016,'2016-02-13 15:00:00',173.19066,-24.587357,97,3,12,950,1003
+'WINSTON',2016,'2016-02-13 18:00:00',173.8,-24.8,95,2,12,952,1003
+'WINSTON',2016,'2016-02-13 21:00:00',174.49924,-25.137756,92,2,12,954,1003
+'WINSTON',2016,'2016-02-14 00:00:00',175.2,-25.4,90,2,12,956,1003
+'WINSTON',2016,'2016-02-14 03:00:00',175.75754,-25.489328,85,2,18,959,1003
+'WINSTON',2016,'2016-02-14 06:00:00',176.3,-25.4,80,1,25,963,1003
+'WINSTON',2016,'2016-02-14 09:00:00',176.95036,-25.16008,75,1,27,966,1003
+'WINSTON',2016,'2016-02-14 12:00:00',177.6,-24.8,70,1,30,970,1003
+'WINSTON',2016,'2016-02-14 15:00:00',178.18723,-24.437336,67,1,30,972,1003
+'WINSTON',2016,'2016-02-14 18:00:00',178.7,-24,65,1,30,974,1003
+'WINSTON',2016,'2016-02-14 21:00:00',179993,-23.479496,60,0,32,978,1003
+'WINSTON',2016,'2016-02-15 00:00:00',179.5,-22.9,55,0,35,982,1003
+'WINSTON',2016,'2016-02-15 03:00:00',-179.98,-22.29244,52,0,32,983,1002
+'WINSTON',2016,'2016-02-15 06:00:00',-179.4,-21.7,50,0,30,985,1001
+'WINSTON',2016,'2016-02-15 09:00:00',-178.83061,-21.17711,50,0,27,985,1001
+'WINSTON',2016,'2016-02-15 12:00:00',-178.2,-20.7,50,0,25,985,1001
+'WINSTON',2016,'2016-02-15 15:00:00',-177.45006,-20.23522,47,0,27,987,1001
+'WINSTON',2016,'2016-02-15 18:00:00',-176.7,-19.8,45,0,30,989,1001
+'WINSTON',2016,'2016-02-15 21:00:00',-1766285,-19.377209,47,0,35,987,1001
+'WINSTON',2016,'2016-02-16 00:00:00',-175.5,-19,50,0,40,985,1001
+'WINSTON',2016,'2016-02-16 03:00:00',-174.97783,-18.677301,52,0,30,983,1000
+'WINSTON',2016,'2016-02-16 06:00:00',-174.5,-18.4,55,0,20,982,1000
+'WINSTON',2016,'2016-02-16 09:00:00',-1746519,-18.127169,57,0,17,980,1000
+'WINSTON',2016,'2016-02-16 12:00:00',-173.6,-17.9,60,0,15,978,1000
+'WINSTON',2016,'2016-02-16 15:00:00',-172.9925,-17.72025,65,1,15,974,1000
+'WINSTON',2016,'2016-02-16 18:00:00',-172.4,-17.6,70,1,15,970,1000
+'WINSTON',2016,'2016-02-16 21:00:00',-171.93268,-17.534878,75,1,15,966,1000
+'WINSTON',2016,'2016-02-17 00:00:00',-171.6,-17.5,80,1,15,963,1000
+'WINSTON',2016,'2016-02-17 03:00:00',-171.40504,-17.449867,82,1,15,961,999
+'WINSTON',2016,'2016-02-17 06:00:00',-171.3,-17.4,85,2,15,959,999
+'WINSTON',2016,'2016-02-17 09:00:00',-171.19252,-17.349981,87,2,15,957,999
+'WINSTON',2016,'2016-02-17 12:00:00',-171.1,-17.3,90,2,15,956,999
+'WINSTON',2016,'2016-02-17 15:00:00',-170.96999,-17.250008,90,2,15,956,999
+'WINSTON',2016,'2016-02-17 18:00:00',-170.9,-17.2,90,2,15,956,999
+'WINSTON',2016,'2016-02-17 21:00:00',-170.94753,-17.142454,95,2,15,952,999
+'WINSTON',2016,'2016-02-18 00:00:00',-171.1,-17.1,100,3,15,948,999
+'WINSTON',2016,'2016-02-18 03:00:00',-171.30504,-178493,100,3,15,948,998
+'WINSTON',2016,'2016-02-18 06:00:00',-171.6,-17.1,100,3,15,948,998
+'WINSTON',2016,'2016-02-18 09:00:00',-171.96255,-17.13494,102,3,16,946,998
+'WINSTON',2016,'2016-02-18 12:00:00',-172.4,-17.2,105,3,17,944,998
+'WINSTON',2016,'2016-02-18 15:00:00',-172.86993,-17.299858,105,3,16,944,998
+'WINSTON',2016,'2016-02-18 18:00:00',-173.4,-17.4,105,3,15,944,998
+'WINSTON',2016,'2016-02-18 21:00:00',-173.97745,-17.472376,107,3,13,942,998
+'WINSTON',2016,'2016-02-19 00:00:00',-174.6,-17.5,110,3,12,941,998
+'WINSTON',2016,'2016-02-19 03:00:00',-175.22003,-17.47212,117,4,12,935,999
+'WINSTON',2016,'2016-02-19 06:00:00',-175.9,-17.4,125,4,12,929,1000
+'WINSTON',2016,'2016-02-19 09:00:00',-176.70766,-17.30026,127,4,12,927,1000
+'WINSTON',2016,'2016-02-19 12:00:00',-177.5,-17.2,130,4,12,926,1001
+'WINSTON',2016,'2016-02-19 15:00:00',-178.12248,-17.12696,135,4,12,922,1001
+'WINSTON',2016,'2016-02-19 18:00:00',-178.7,-17.1,140,5,12,918,1002
+'WINSTON',2016,'2016-02-19 21:00:00',-179.33499,-17.12729,145,5,12,914,1001
+'WINSTON',2016,'2016-02-20 00:00:00',-180,-17.2,150,5,12,911,1000
+'WINSTON',2016,'2016-02-20 03:00:00',179.33006,-17.299582,152,5,12,909,1000
+'WINSTON',2016,'2016-02-20 06:00:00',178.6,-17.4,155,5,12,907,1000
+'WINSTON',2016,'2016-02-20 09:00:00',177.73509,-17.472837,147,5,12,912,1000
+'WINSTON',2016,'2016-02-20 12:00:00',176.9,-17.5,140,5,12,918,1000
+'WINSTON',2016,'2016-02-20 15:00:00',176.24733,-17.457056,132,4,12,923,999
+'WINSTON',2016,'2016-02-20 18:00:00',175.7,-17.4,125,4,12,929,998
+'WINSTON',2016,'2016-02-20 21:00:00',175.17003,-17.38486,122,4,12,931,998
+'WINSTON',2016,'2016-02-21 00:00:00',174.7,-17.4,120,4,12,933,999
+'WINSTON',2016,'2016-02-21 03:00:00',174.27754,-17.442366,120,4,12,933,999
+'WINSTON',2016,'2016-02-21 06:00:00',173.9,-17.5,120,4,12,933,999
+'WINSTON',2016,'2016-02-21 09:00:00',173.52003,-17.557495,117,4,12,935,999
+'WINSTON',2016,'2016-02-21 12:00:00',173.2,-17.6,115,4,12,937,999
+'WINSTON',2016,'2016-02-21 15:00:00',172.96996,-17.599915,110,3,12,940,999
+'WINSTON',2016,'2016-02-21 18:00:00',172.8,-17.6,105,3,12,944,999
+'WINSTON',2016,'2016-02-21 21:00:00',172.6425,-17.63497,100,3,12,948,1001
+'WINSTON',2016,'2016-02-22 00:00:00',172.5,-17.7,95,2,12,952,1004
+'WINSTON',2016,'2016-02-22 03:00:00',172.32753,-17.777521,92,2,12,954,1002
+'WINSTON',2016,'2016-02-22 06:00:00',172.2,-17.9,90,2,12,956,1001
+'WINSTON',2016,'2016-02-22 09:00:00',172.16249,-1892472,90,2,13,956,1002
+'WINSTON',2016,'2016-02-22 12:00:00',172.2,-18.3,90,2,15,956,1003
+'WINSTON',2016,'2016-02-22 15:00:00',172.2701,-18.434977,87,2,15,957,1002
+'WINSTON',2016,'2016-02-22 18:00:00',172.4,-18.6,85,2,15,959,1001
+'WINSTON',2016,'2016-02-22 21:00:00',172.58495,-18.877523,82,1,20,961,1001
+'WINSTON',2016,'2016-02-23 00:00:00',172.8,-19.2,80,1,25,963,1002
+'WINSTON',2016,'2016-02-23 03:00:00',172.98529,-19.477423,77,1,25,965,1002
+'WINSTON',2016,'2016-02-23 06:00:00',173.2,-19.8,75,1,25,967,1002
+'WINSTON',2016,'2016-02-23 09:00:00',173.50725,-20.227617,70,1,25,970,1002
+'WINSTON',2016,'2016-02-23 12:00:00',173.8,-20.7,65,1,25,974,1002
+'WINSTON',2016,'2016-02-23 15:00:00',173.98024,-21.142422,60,0,30,978,1001
+'WINSTON',2016,'2016-02-23 18:00:00',174.1,-21.6,55,0,35,982,1000
+'WINSTON',2016,'2016-02-23 21:00:00',174.22989,-2299995,52,0,40,983,1000
+'WINSTON',2016,'2016-02-24 00:00:00',174.3,-22.6,50,0,45,985,1001
+'WINSTON',2016,'2016-02-24 03:00:00',174.32477,-2372311,47,0,45,987,1001
+'WINSTON',2016,'2016-02-24 06:00:00',174.2,-23.5,45,0,45,989,1001
+'WINSTON',2016,'2016-02-24 09:00:00',173.86778,-23.88754,45,0,45,989,1001
+'WINSTON',2016,'2016-02-24 12:00:00',173.4,-24.2,45,0,45,989,1001
+'WINSTON',2016,'2016-02-24 15:00:00',172.92165,-24.384897,42,0,52,991,1001
+'WINSTON',2016,'2016-02-24 18:00:00',172.4,-24.6,40,-2,60,993,1002
+'WINSTON',2016,'2016-02-24 21:00:00',171.90948,-2511684,40,-2,60,993,1002
+'WINSTON',2016,'2016-02-25 00:00:00',171.3,-25.5,40,-2,60,993,1002
+'WINSTON',2016,'2016-02-25 03:00:00',170.46053,-25.980137,40,-2,80,993,1002
+'WINSTON',2016,'2016-02-25 06:00:00',169.5,-26.4,40,-2,100,993,1003
+'WINSTON',2016,'2016-02-25 09:00:00',168.57898,-26.686527,40,-2,100,993,1003
+'WINSTON',2016,'2016-02-25 12:00:00',167.6,-26.9,40,-2,100,993,1003
+'WINSTON',2016,'2016-02-25 15:00:00',166.53015,-27.129457,40,-2,100,993,1003
+'WINSTON',2016,'2016-02-25 18:00:00',165.4,-27.3,40,-2,100,993,1004
+'WINSTON',2016,'2016-02-25 21:00:00',164.20473,-27.38788,40,-2,100,993,1004
+'WINSTON',2016,'2016-02-26 00:00:00',163.1,-27.4,40,-2,100,993,1004
+'WINSTON',2016,'2016-02-26 03:00:00',162.20271,-27.394146,40,-2,100,993,1004
+'WINSTON',2016,'2016-02-26 06:00:00',161.5,-27.3,40,-2,100,993,1004
+'WINSTON',2016,'2016-02-26 09:00:00',160.93233,-2779449,37,-2,100,994,1005
+'WINSTON',2016,'2016-02-26 12:00:00',160.5,-26.8,35,-2,100,996,1006
+'WINSTON',2016,'2016-02-26 15:00:00',160.1278,-26.549725,35,-2,100,996,1006
+'WINSTON',2016,'2016-02-26 18:00:00',159.8,-26.3,35,-2,100,996,1006
+'WINSTON',2016,'2016-02-26 21:00:00',159.44267,-2657465,32,-2,75,998,1006
+'WINSTON',2016,'2016-02-27 00:00:00',159.1,-25.8,30,-2,50,1000,1007
+'WINSTON',2016,'2016-02-27 03:00:00',158.77762,-25.522463,30,-2,50,1000,1007
+'WINSTON',2016,'2016-02-27 06:00:00',158.5,-25.2,30,-2,50,1000,1007
+'WINSTON',2016,'2016-02-27 09:00:00',158.29263,-24.792376,27,-2,50,1002,1007
+'WINSTON',2016,'2016-02-27 12:00:00',158.1,-24.4,25,-2,50,1004,1007
+'WINSTON',2016,'2016-02-27 15:00:00',157.86513,-24.112453,25,-2,75,1004,1007
+'WINSTON',2016,'2016-02-27 18:00:00',157.6,-23.9,25,-2,100,1004,1007
+'WINSTON',2016,'2016-02-27 21:00:00',157.27762,-23.757612,25,-2,100,1004,1007
+'WINSTON',2016,'2016-02-28 00:00:00',157,-23.6,25,-2,100,1004,1007
+'WINSTON',2016,'2016-02-28 03:00:00',156.89275,-23.314833,25,-2,100,1004,1007
+'WINSTON',2016,'2016-02-28 06:00:00',156.8,-23,25,-2,100,1004,1007
+'WINSTON',2016,'2016-02-28 09:00:00',156.58969,-22.732708,22,-2,100,1005,1007
+'WINSTON',2016,'2016-02-28 12:00:00',156.3,-22.5,20,-2,100,1007,1007
+'ZENA',2016,'2016-04-04 06:00:00',162,-13.3,25,-1,60,1004,1007
+'ZENA',2016,'2016-04-04 09:00:00',162.28232,-13.40529,25,-1,60,1004,1007
+'ZENA',2016,'2016-04-04 12:00:00',162.5,-13.5,25,-1,60,1004,1007
+'ZENA',2016,'2016-04-04 15:00:00',162.65283,-13.584413,25,-1,50,1004,1006
+'ZENA',2016,'2016-04-04 18:00:00',163,-13.7,25,-1,40,1004,1006
+'ZENA',2016,'2016-04-04 21:00:00',163.80267,-13.86297,32,-1,42,998,1006
+'ZENA',2016,'2016-04-05 00:00:00',164.8,-14.1,40,0,45,993,1006
+'ZENA',2016,'2016-04-05 03:00:00',165.7224,-14.427403,42,0,45,991,1006
+'ZENA',2016,'2016-04-05 06:00:00',166.6,-14.8,45,0,45,989,1006
+'ZENA',2016,'2016-04-05 09:00:00',167.32112,-15.118923,50,0,45,985,1006
+'ZENA',2016,'2016-04-05 12:00:00',168.1,-15.5,55,0,45,982,1006
+'ZENA',2016,'2016-04-05 15:00:00',169.12517,-1619808,60,0,27,978,1005
+'ZENA',2016,'2016-04-05 18:00:00',170.3,-16.6,65,1,10,974,1004
+'ZENA',2016,'2016-04-05 21:00:00',171.51309,-17.156847,77,1,8,965,1005
+'ZENA',2016,'2016-04-06 00:00:00',172.8,-17.7,90,2,7,956,1006
+'ZENA',2016,'2016-04-06 03:00:00',174.14307,-18.214512,75,1,8,967,1006
+'ZENA',2016,'2016-04-06 06:00:00',175.5,-18.7,60,0,10,978,1006
+'ZENA',2016,'2016-04-06 08:00:00',176.3697,-191767,53,0,11,983,1006
+'ZENA',2016,'2016-04-06 09:00:00',176.80061,-19.171255,50,0,12,985,1006
+'ZENA',2016,'2016-04-06 12:00:00',178.1,-19.6,40,0,15,993,1006
+'ZENA',2016,'2016-04-06 15:00:00',179.43642,-19.96978,35,0,17,996,1006
+'ZENA',2016,'2016-04-06 18:00:00',-179.2,-20.3,30,-1,20,1000,1006
+'GRETEL',2020,'2020-03-13 12:00:00',152.9,-16.5,30,-3,90,997,1003
+'GRETEL',2020,'2020-03-13 15:00:00',153.35742,-16.487879,32,-3,90,996,1002
+'GRETEL',2020,'2020-03-13 18:00:00',153.8,-16.5,35,-3,90,996,1001
+'GRETEL',2020,'2020-03-13 21:00:00',154.24033,-16.561964,35,-3,90,993,1001
+'GRETEL',2020,'2020-03-14 00:00:00',154.8,-16.7,35,0,90,991,1002
+'GRETEL',2020,'2020-03-14 03:00:00',155.59012,-16.912617,35,0,90,989,1000
+'GRETEL',2020,'2020-03-14 06:00:00',156.5,-17.2,35,0,90,988,999
+'GRETEL',2020,'2020-03-14 09:00:00',157.38554,-17.5121,37,0,95,987,999
+'GRETEL',2020,'2020-03-14 12:00:00',158.3,-17.9,40,0,100,987,999
+'GRETEL',2020,'2020-03-14 15:00:00',159.26529,-18.354973,42,0,92,987,999
+'GRETEL',2020,'2020-03-14 18:00:00',160.2,-18.9,45,0,85,987,999
+'GRETEL',2020,'2020-03-14 21:00:00',1612327,-19.51185,50,0,70,984,998
+'GRETEL',2020,'2020-03-15 00:00:00',161.8,-20.2,55,0,55,982,998
+'GRETEL',2020,'2020-03-15 03:00:00',162.56355,-20.94156,60,0,52,978,997
+'GRETEL',2020,'2020-03-15 06:00:00',163.4,-21.7,65,1,50,974,996
+'GRETEL',2020,'2020-03-15 09:00:00',164.40659,-22.377367,62,0,45,976,997
+'GRETEL',2020,'2020-03-15 12:00:00',165.5,-23.1,60,0,40,978,999
+'GRETEL',2020,'2020-03-15 15:00:00',166.60806,-23.962233,57,0,50,977,999
+'GRETEL',2020,'2020-03-15 18:00:00',167.7,-24.9,55,0,60,977,999
+'GRETEL',2020,'2020-03-15 21:00:00',168.70125,-25.871155,52,0,65,977,999
+'GRETEL',2020,'2020-03-16 00:00:00',169.7,-26.8,50,0,70,978,999
+'GRETEL',2020,'2020-03-16 03:00:00',170.79503,-27.557135,52,0,70,976,998
+'GRETEL',2020,'2020-03-16 06:00:00',171.9,-28.3,55,0,70,974,998
+'GRETEL',2020,'2020-03-16 09:00:00',172.89174,-29.212214,55,0,72,972,998
+'GRETEL',2020,'2020-03-16 12:00:00',174,-30.1,55,-2,75,971,998
+'GRETEL',2020,'2020-03-16 15:00:00',175.40369,-30.81288,55,-2,75,976,998
+'GRETEL',2020,'2020-03-16 18:00:00',177,-31.4,55,-2,75,982,998
diff --git a/man/defStormsDataset.Rd b/man/defStormsDataset.Rd
index 079c9c76..ee095557 100644
--- a/man/defStormsDataset.Rd
+++ b/man/defStormsDataset.Rd
@@ -6,29 +6,34 @@
\usage{
defStormsDataset(
filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
+ sep = NULL,
fields = c(names = "name", seasons = "season", isoTime = "iso_time", lon = "usa_lon",
lat = "usa_lat", msw = "usa_wind", basin = "basin", rmw = "usa_rmw", pressure =
"usa_pres", poci = "usa_poci"),
basin = NULL,
seasons = c(1980, as.numeric(format(Sys.time(), "\%Y"))),
unitConversion = c(msw = "knt2ms", rmw = "nm2km", pressure = "mb2pa", poci = "mb2pa"),
+ notNamed = "NOT_NAMED",
verbose = 1
)
}
\arguments{
-\item{filename}{character. Name of the NetCDF (.nc) file. Default is the \code{test_dataset.nc}
+\item{filename}{character. Name of the NetCDF (.nc)/CSV (.csv) file. Default is the \code{test_dataset.nc}
file located in the \code{inst/extdata} repository of the directory (accessible by
\code{system.file("extdata", "test_dataset.nc", package = "StormR")}). This test dataset is extracted
from the IBTrACS.SP.v04r00.nc file and provides all the tropical cyclones that occurred around Vanuatu
from 2015 to 2016 and around New Caledonia from 2020 to 2021.}
-\item{fields}{named character vector. This argument allows to specify the corresponding variable names
-in the input NetCDF file for each field in the output \code{stormsDataset}. By default, the corresponding
+\item{sep}{character. The field separator character if \code{filename} is a CSV file. Default value is set to \code{NULL}
+which will set the separator to \code{","}.}
+
+\item{fields}{named character vector. This argument allows to specify the corresponding variable names (NetCDF) or
+headers (CSV) in the input file for each field in the output \code{stormsDataset}. By default, the corresponding
variable names are set up to import data from a NetCDF file from the IBTrACS database (Knapp et al., 2010).
Corresponding variable names for following fields have to (mandatory fields) or can be
(recommended or optional fields) provided:
\itemize{
-\item "\verb{names"}, names of the storms (mandatory),
+\item \code{"names"}, names of the storms (mandatory),
\item \code{"seasons"}, years of observations (mandatory),
\item \code{"isoTime"}, date and time of observations (mandatory),
\item \code{"lon"}, longitude of the observations (mandatory),
@@ -88,6 +93,9 @@ For \code{pressure} and \code{poci},
\item \code{"None"}, if no conversion is needed.
}}
+\item{notNamed}{character. Constant name for not named storms to remove in the database.
+Default value is "NOT_NAMED" (IBTrACS database)}
+
\item{verbose}{numeric. Whether the function should display (\verb{= 1})
or not (\verb{= 0}) information about the processes.}
}
@@ -95,14 +103,20 @@ or not (\verb{= 0}) information about the processes.}
The \code{defStormsDataset()} function returns a \code{stormsDataset} object.
}
\description{
-The \code{defStormsDataset()} function creates a \code{stormsDataset} object from a NetCDF file.
+The \code{defStormsDataset()} function creates a \code{stormsDataset} object from either a NetCDF or a CSV file.
This is an essential first step before other \code{stormR} functions can be used.
}
\examples{
# Creating a `stormsDataset` object with storms between 2010 and 2015
# in the South Pacific using the NetCDF provided with the package
-SP_2015_2020 <- defStormsDataset(seasons = c(2010, 2015))
-str(SP_2015_2020)
+SP_2015_2020_nc <- defStormsDataset(seasons = c(2010, 2015))
+str(SP_2015_2020_nc)
+
+# Creating a `stormsDataset` object with storms between 2010 and 2015
+# in the South Pacific using the CSV provided with the package
+fileName <- system.file("extdata", "test_dataset.csv", package = "StormR")
+SP_2015_2020_csv <- defStormsDataset(seasons = c(2010, 2021))
+str(SP_2015_2020_csv)
}
\references{
Knapp, K. R., Kruk, M. C., Levinson, D. H., Diamond, H. J., & Neumann, C. J. (2010).
diff --git a/man/stormsDataset-class.Rd b/man/stormsDataset-class.Rd
index 756f562c..b5344de5 100644
--- a/man/stormsDataset-class.Rd
+++ b/man/stormsDataset-class.Rd
@@ -55,7 +55,7 @@ databases:
\section{Slots}{
\describe{
-\item{\code{filename}}{character. Name of the database to load. Must be a netcdf file}
+\item{\code{filename}}{character. Name of the database to load. Must be either a netcdf or a csv file}
\item{\code{fields}}{named character vector. Dictionary that provides all the name of
dimensions to extract from the netcdf database (See \code{Details})}
diff --git a/tests/testthat/test-stormsDataset.R b/tests/testthat/test-stormsDataset.R
index f76b965c..0976d25b 100644
--- a/tests/testthat/test-stormsDataset.R
+++ b/tests/testthat/test-stormsDataset.R
@@ -1,6 +1,16 @@
-
-
+test_that("Test conversions functions",{
+
+ expect_equal(knt2ms(1), 0.514)
+ expect_equal(mph2ms(1), 0.44704)
+ expect_equal(kmh2ms(1), 1 / 3.6)
+ expect_equal(nm2km(1), 1.852)
+ expect_equal(b2pa(1), 100000)
+ expect_equal(mb2pa(1), 100)
+ expect_equal(psi2pa(1), 6895)
+ expect_equal(atm2pa(1), 101300)
+
+})
@@ -30,6 +40,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -59,6 +70,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -88,8 +100,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -106,7 +117,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -121,8 +131,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -131,19 +140,17 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = 1,
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -151,19 +158,17 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = TRUE,
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -171,6 +176,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"seasons" = "season",
@@ -178,7 +184,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -193,8 +198,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -202,6 +206,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -209,7 +214,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -224,8 +228,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -233,6 +236,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -240,7 +244,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -255,8 +258,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -264,6 +266,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -271,7 +274,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"isoTime" = "iso_time",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -286,8 +288,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -295,6 +296,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -302,23 +304,19 @@ test_that("Test checkInputsdefStormsDataset function", {
"isoTime" = "iso_time",
"lon" = "usa_lon",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -327,6 +325,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -334,23 +333,19 @@ test_that("Test checkInputsdefStormsDataset function", {
"isoTime" = "iso_time",
"lon" = "usa_lon",
"lat" = "usa_lat",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -358,6 +353,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -366,7 +362,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -380,8 +375,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -389,6 +383,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -397,23 +392,19 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb_to_pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -421,6 +412,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -429,22 +421,18 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -452,6 +440,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -460,23 +449,19 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb_to_pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -484,6 +469,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -492,20 +478,16 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(msw = "knt2ms",
rmw = "nm2km",
poci = "mb2pa"),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -513,6 +495,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -521,23 +504,19 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
basin = TRUE,
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
+ seasons = c(1980, as.numeric(format(Sys.time(), "%Y"))),
unitConversion = c(
msw = "knt2ms",
rmw = "nm2km",
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -545,6 +524,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -553,7 +533,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -567,8 +546,7 @@ test_that("Test checkInputsdefStormsDataset function", {
rmw = "nm2km",
pressure = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -576,6 +554,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -584,7 +563,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -599,7 +577,6 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
verbose = TRUE
)
)
@@ -608,6 +585,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -616,7 +594,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -631,8 +608,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -640,6 +616,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"names" = "name",
"seasons" = "season",
@@ -647,7 +624,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -662,8 +638,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -671,6 +646,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -679,7 +655,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -694,8 +669,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -703,6 +677,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -711,7 +686,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -726,8 +700,6 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
verbose = 1
)
)
@@ -735,6 +707,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -743,7 +716,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -758,8 +730,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -768,6 +739,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -776,7 +748,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -789,8 +760,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -798,6 +768,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -806,7 +777,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -819,8 +789,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -828,6 +797,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -836,7 +806,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -849,8 +818,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -858,6 +826,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -866,7 +835,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -879,8 +847,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -890,6 +857,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -898,7 +866,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -908,8 +875,7 @@ test_that("Test checkInputsdefStormsDataset function", {
), "%Y"))),
unitConversion = 1,
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -917,6 +883,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -925,7 +892,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -935,125 +901,29 @@ test_that("Test checkInputsdefStormsDataset function", {
), "%Y"))),
unitConversion = TRUE,
-
-
- verbose = 1
- )
- )
-
- # Checking scale input
- expect_error(
- checkInputsdefStormsDataset(
- filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
- fields = c(
- names = "name",
- seasons = "season",
- isoTime = "iso_time",
- lon = "usa_lon",
- lat = "usa_lat",
- msw = "usa_wind",
- basin = "basin",
- scale = "usa_sshs",
- rmw = "usa_rmw",
- pressure = "usa_pres",
- poci = "usa_poci"
- ),
- basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
- unitConversion = c(
- msw = "knt2ms",
- rmw = "nm2km",
- pressure = "mb2pa",
- poci = "mb2pa"
- ),
- scale = c("1", "2"),
-
- verbose = 1
- )
- )
-
- expect_error(
- checkInputsdefStormsDataset(
- filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
- fields = c(
- names = "name",
- seasons = "season",
- isoTime = "iso_time",
- lon = "usa_lon",
- lat = "usa_lat",
- msw = "usa_wind",
- basin = "basin",
- scale = "usa_sshs",
- rmw = "usa_rmw",
- pressure = "usa_pres",
- poci = "usa_poci"
- ),
- basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
- unitConversion = c(
- msw = "knt2ms",
- rmw = "nm2km",
- pressure = "mb2pa",
- poci = "mb2pa"
- ),
- scale = TRUE,
-
- verbose = 1
- )
- )
-
- # Checking scalePalette input
- expect_error(
- checkInputsdefStormsDataset(
- filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
- fields = c(
- names = "name",
- seasons = "season",
- isoTime = "iso_time",
- lon = "usa_lon",
- lat = "usa_lat",
- msw = "usa_wind",
- basin = "basin",
- scale = "usa_sshs",
- rmw = "usa_rmw",
- pressure = "usa_pres",
- poci = "usa_poci"
- ),
- basin = "SP",
- seasons = c(1980, as.numeric(format(Sys.time(
-
- ), "%Y"))),
- unitConversion = c(
- msw = "knt2ms",
- rmw = "nm2km",
- pressure = "mb2pa",
- poci = "mb2pa"
- ),
-
- scalePalette = c(1,2,2,3),
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
+
+ # Checking verbose input
expect_error(
checkInputsdefStormsDataset(
- filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
+ filename = "database.nc",
+ sep = NULL,
fields = c(
- names = "name",
- seasons = "season",
- isoTime = "iso_time",
- lon = "usa_lon",
- lat = "usa_lat",
- msw = "usa_wind",
- basin = "basin",
- scale = "usa_sshs",
- rmw = "usa_rmw",
- pressure = "usa_pres",
- poci = "usa_poci"
+ "basin" = "basin",
+ "names" = "name",
+ "seasons" = "season",
+ "isoTime" = "iso_time",
+ "lon" = "usa_lon",
+ "lat" = "usa_lat",
+ "msw" = "usa_wind",
+ "sshs" = "usa_sshs",
+ "rmw" = "usa_rmw",
+ "pressure" = "usa_pres",
+ "poci" = "usa_poci"
),
basin = "SP",
seasons = c(1980, as.numeric(format(Sys.time(
@@ -1065,28 +935,27 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
- scalePalette = TRUE,
- verbose = 1
+ notNamed = "NOT_NAMED",
+ verbose = -1
)
)
- # Checking length of scale/scalePalette
expect_error(
checkInputsdefStormsDataset(
- filename = system.file("extdata", "test_dataset.nc", package = "StormR"),
+ filename = "database.nc",
+ sep = NULL,
fields = c(
- names = "name",
- seasons = "season",
- isoTime = "iso_time",
- lon = "usa_lon",
- lat = "usa_lat",
- msw = "usa_wind",
- basin = "basin",
- scale = "usa_sshs",
- rmw = "usa_rmw",
- pressure = "usa_pres",
- poci = "usa_poci"
+ "basin" = "basin",
+ "names" = "name",
+ "seasons" = "season",
+ "isoTime" = "iso_time",
+ "lon" = "usa_lon",
+ "lat" = "usa_lat",
+ "msw" = "usa_wind",
+ "sshs" = "usa_sshs",
+ "rmw" = "usa_rmw",
+ "pressure" = "usa_pres",
+ "poci" = "usa_poci"
),
basin = "SP",
seasons = c(1980, as.numeric(format(Sys.time(
@@ -1098,17 +967,15 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
- scale = c(18,30),
-
- verbose = 1
+ notNamed = "NOT_NAMED",
+ verbose = "1"
)
)
-
- # Checking verbose input
expect_error(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -1117,7 +984,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres",
"poci" = "usa_poci"
@@ -1132,14 +998,17 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
- verbose = "1"
+ notNamed = "NOT_NAMED",
+ verbose = TRUE
)
)
- # Warnings
+
+ # Check Warnings
expect_warning(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -1148,7 +1017,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"pressure" = "usa_pres",
"poci" = "usa_poci"
),
@@ -1162,15 +1030,16 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
+
expect_warning(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -1179,7 +1048,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"poci" = "usa_poci"
),
@@ -1193,8 +1061,7 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
@@ -1202,6 +1069,7 @@ test_that("Test checkInputsdefStormsDataset function", {
expect_warning(
checkInputsdefStormsDataset(
filename = "database.nc",
+ sep = NULL,
fields = c(
"basin" = "basin",
"names" = "name",
@@ -1210,7 +1078,6 @@ test_that("Test checkInputsdefStormsDataset function", {
"lon" = "usa_lon",
"lat" = "usa_lat",
"msw" = "usa_wind",
-
"rmw" = "usa_rmw",
"pressure" = "usa_pres"
),
@@ -1224,9 +1091,56 @@ test_that("Test checkInputsdefStormsDataset function", {
pressure = "mb2pa",
poci = "mb2pa"
),
-
-
+ notNamed = "NOT_NAMED",
verbose = 1
)
)
})
+
+
+test_that("Test getDataFrom functions", {
+
+ fields = c(
+ names = "name",
+ seasons = "season",
+ isoTime = "iso_time",
+ lon = "usa_lon",
+ lat = "usa_lat",
+ msw = "usa_wind",
+ basin = "basin",
+ sshs = "usa_sshs",
+ rmw = "usa_rmw",
+ pressure = "usa_pres",
+ poci = "usa_poci"
+ )
+
+ unitConversion = c(
+ msw = "knt2ms",
+ rmw = "nm2km",
+ pressure = "mb2pa",
+ poci = "mb2pa"
+ )
+
+ filename = system.file("extdata", "test_dataset.csv", package = "StormR")
+ databaseFromCsv <- getDataFromCsvFile(filename=filename,
+ sep = ",",
+ fields=fields,
+ basin=NULL,
+ seasons=c(2015,2020),
+ unitConversion=unitConversion,
+ notNamed="NOT_NAMED",
+ verbose=0)
+
+ filename = system.file("extdata", "test_dataset.nc", package = "StormR")
+ databaseFromNc <- getDataFromNcdfFile(filename=filename,
+ fields=fields,
+ basin=NULL,
+ seasons=c(2015,2020),
+ unitConversion=unitConversion,
+ notNamed="NOT_NAMED",
+ verbose=0)
+
+ expect_equal(convertVariables(databaseFromCsv, unitConversion), sdsFromCsv@database)
+ expect_equal(convertVariables(databaseFromNc, unitConversion), sdsFromNc@database)
+
+})
diff --git a/vignettes/DataSource.Rmd b/vignettes/DataSource.Rmd
index 72114d82..9ec72e37 100644
--- a/vignettes/DataSource.Rmd
+++ b/vignettes/DataSource.Rmd
@@ -17,11 +17,11 @@ library(StormR)
```
Before running `StormR` functions users have to provide a tropical storm track
-dataset as a ".nc" (NetCDF) file in which the location and some characteristics
-of storms are given across their lifespan. This file is used to create a
+dataset either as a ".nc" (NetCDF) or a ".csv" (CSV) file in which the location and some characteristics
+of storms are given across their lifespan. Using a CSV file as a dataset implies following few specific formatting rules, please refer to the [CSV Formatting] section below. These files are then used to create a
`stormsDataset` object using the `defStormsDataset()` function. By default, the
arguments of `defStormsDataset()` function are set up to create a `stormsDataset`
-object using the USA fields in the IBTrACS database [International Best Track
+object using the USA fields in the NetCDF IBTrACS database [International Best Track
Archive for Climate
Stewardship](https://www.ncei.noaa.gov/products/international-best-track-archive)
(Knapp *et al.*, [-@knapp_international_2010], [-@knapp_international_2018]). This database provides a fairly comprehensive record of
@@ -146,10 +146,42 @@ For both `pressure` and `poci`:
`psi2pa`: converts psi in Pascal
`None`: no conversion
-### Test data set
+### Test data sets
-A `test_dataset` is provided with the `StormR` package. This test data set
+A `test_dataset` is provided with the `StormR` package in two formats (a NetCDF and a CSV file). This test data set
comprises the track data of nine storms that occurred near Vanuatu and New
Caledonia between 2015-2016 and 2020-2021, respectively.
+### CSV Formatting
+
+In order to load and read a CSV file in `defStormsDataset()`, it must stick to the following rules:
+* As for the NetCDF file, the CSV file must contains at least a name, season, iso times, longitude, latitude,and a maximum wind speed column.
+* Every observation (row) in the CSV must be sorted in increasing order according to the ISO times AND joined by storm. For example, if several storms happened during the same iso Times, the observations for the storm that first appeared should be stacked before the observations of the second one and so on.
+
+In addition to these mandatory rules above, the default separator is set to a single comma ','. Nevertheless the user might decide to change it using the `sep` parameter in `defStormsDataset()`.
+
+Hereafter, an example where we access the data with `test_dataset.csv`.
+Notice that the header of the csv and the names of columns in `fields` input must be equals
+```{r chunk 4}
+# Header of the csv
+head(read.csv(system.file("extdata", "test_dataset.csv", package = "StormR")))
+```
+
+
+```{r chunk 5}
+# Is already the default setting (in this particular case)
+fields <- c(
+ names = "name",
+ seasons = "season",
+ isoTime = "iso_time",
+ lon = "usa_lon",
+ lat = "usa_lat",
+ msw = "usa_wind",
+ sshs = "usa_sshs",
+ rmw = "usa_rmw",
+ pressure = "usa_pres",
+ poci = "usa_poci"
+)
+SP_2015_2020_csv <- defStormsDataset(fields = fields, seasons = c(2015, 2020))
+```
## Reference