Merge pull request #13 from NEONScience/master-merge

Subtree push from int1.3.1 update on FIU-algorithm repo
NEONScience · Mar 16, 2023 · 898a72d · 898a72d
2 parents d77bd67 + 5f733f0
commit 898a72d
Show file tree

Hide file tree

Showing 88 changed files with 4,833 additions and 1,430 deletions.
diff --git a/flow/tool/flow.dnld.dp0p.hdf5.R b/flow/tool/flow.dnld.dp0p.hdf5.R
@@ -0,0 +1,58 @@
+##############################################################################################
+#' @title Workflow for downloading dp0p data from S3
+
+#' @author
+#' David Durden \email{eddy4R.info@gmail.com}
+
+#' @description
+#' Workflow. Downloading dp0p data from S3.
+
+#' @param Currently none
+
+#' @return Currently none
+
+#' @references
+
+#' @keywords eddy-covariance, NEON
+
+#' @examples Currently none
+
+#' @seealso Currently none
+
+# changelog and author contributions / copyrights
+#   David (2020-01-25)
+#     original creation
+##############################################################################################
+
+#site to download data for
+site <- "STEI"
+#domain
+dom <- "D05"
+#SAE system (ecte vs. ecse)
+sys <- "ecte"
+
+#Create download folder, create if it doesn't exist
+DirDnld <- paste0("~/eddy/data/turbTow/inpRefe/",site)
+if(!dir.exists(DirDnld)) dir.create(DirDnld, recursive = TRUE)
+
+#Create data download string
+DateBgn <- as.Date("2019-09-11")
+DateEnd <- as.Date("2019-09-21")
+DateSeq <- seq.Date(from = DateBgn,to = DateEnd, by = "day")
+PrdWndwDnld <- base::as.character(DateSeq)
+
+
+
+#Filename base
+fileInBase <- paste0("NEON.",dom,".",site,".IP0.00200.001.",sys,".")
+
+#Create URL for data files
+urlDnld <- paste0("https://storage.cloud.google.com/neon-sae-files/ods/dataproducts/IP0/",PrdWndwDnld,"/",site,"/",fileInBase,PrdWndwDnld,".l0p.h5")
+
+#Download filename (full path)
+fileDnld <-  paste0(DirDnld,"/",base::toupper(sys),"_dp0p_",site,"_",PrdWndwDnld,".h5")
+
+#Download files
+sapply(seq_along(urlDnld), function(x){
+download.file(url = urlDnld[x], destfile = fileDnld[x])
+})
diff --git a/pack/eddy4R.base/DESCRIPTION b/pack/eddy4R.base/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: eddy4R.base
 Title: Eddy-covariance calculation for R: Base package
-Version: 0.2.20
+Version: 0.2.24
 Authors@R: c( person("Stefan", "Metzger", email = "eddy4R.info@gmail.com", role = c("aut", "cre")),
               person("David", "Durden", email = "ddurden@battelleecology.org", role = c("aut")),
               person("Natchaya", "Pingintha-Durden", email = "ndurden@battelleecology.org", role = c("aut")),
@@ -28,4 +28,4 @@ Suggests:
     NEONprocIS.base
 License: GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.1
diff --git a/pack/eddy4R.base/NAMESPACE b/pack/eddy4R.base/NAMESPACE
@@ -30,6 +30,7 @@ export(def.idx.agr)
 export(def.idx.diff)
 export(def.inst.depe)
 export(def.irga.vali.cor)
+export(def.irga.vali.thsh)
 export(def.lag)
 export(def.mean.med.mode)
 export(def.med.mad)

diff --git a/pack/eddy4R.base/R/def.hdf5.copy.para.R b/pack/eddy4R.base/R/def.hdf5.copy.para.R
@@ -39,6 +39,10 @@
 #     applied term name convention; replaced FileIn by FileInp
 #    Natchaya P-Durden (2018-05-22)
 #     rename function from def.para.hdf5.dp01() to def.hdf5.copy.para()
+#   Dave Durden (2021-08-17)
+#     Failsafe to remove rhdf5 attribute from list of attributes written out
+#   Dave Durden (2021-10-12)
+#     Copy global attributes by adding file level to listGrp
 ##############################################################################################################
 #Start of function call to read metadata from one file and write to another
 ##############################################################################################################
@@ -63,6 +67,8 @@ listPara <- rhdf5::h5ls(FileInp, datasetinfo = FALSE)
 #listPara <- listPara[listPara$otype == "H5I_GROUP",] #Used to grab metadata if it is only attached to the group level
 listGrp <- base::paste(listPara$group, listPara$name, sep = "/") # Combining output
 
+#Append global attribute level
+listGrp <- append("/", listGrp)
 
 # read attributes from input file
 listAttr <- base::lapply(listGrp, rhdf5::h5readAttributes, file = FileInp)
@@ -74,6 +80,13 @@ base::names(listAttr) <- listGrp
 #Remove all empty lists
 listAttr <- listAttr[!base::sapply(listAttr, function(x) base::length(x) == 0)]
 
+#Failsafe to remove rhdf5 attribute
+lapply(names(listAttr), function(x){
+  if(length(names(listAttr[[x]])) == 1 && grepl(pattern = "rhdf5", x = names(listAttr[[x]]))){
+    #Remove attribute if rhdf5 attribute is the only one written
+    listAttr[[x]] <<- NULL
+  }#end if logical for single rhdf5 attribute   
+})#end failsafe for rhdf5 attribute
 
 #Open the output file HDF5 link
 idFile <- rhdf5::H5Fopen(FileOut)

diff --git a/pack/eddy4R.base/R/def.hdf5.crte.R b/pack/eddy4R.base/R/def.hdf5.crte.R
@@ -73,6 +73,8 @@
 #     Adding irga validation system sensors for ECTE (pressure sensors)
 #   Dave Durden (2019-07-14)
 #     Adding irga validation system sensors for ECTE (valve and pump)
+#   Dave Durden (2020-02-09)
+#     Grabbing objDesc and Readme from S3, removing dropbox link
 ##############################################################################################################
 #Start of function call to generate NEON HDF5 files
 ##############################################################################################################
@@ -102,8 +104,7 @@ def.hdf5.crte <- function(
 
     DirTmp <- tempdir()
     #Download file description readme and object list  
-    eddy4R.base::def.dld.zip(Inp = list(Url = "https://www.dropbox.com/s/dqq3j7epiy98y29/fileDesc.zip?dl=1",
-                                        Dir = DirTmp))
+    eddy4R.base::def.dld.zip(Inp = list(Url = "https://storage.googleapis.com/neon-ec-goldfiles/EC-turbulence-processing/fileDesc.zip", Dir = DirTmp))
 
     #Store the path to the readme file
     FileNameReadMe <- base::list.files( path = base::paste0(DirTmp,"/fileDesc"), pattern = ".txt", full.names = TRUE)

diff --git a/pack/eddy4R.base/R/def.hdf5.extr.R b/pack/eddy4R.base/R/def.hdf5.extr.R
@@ -52,6 +52,10 @@
 #     applied term name convention; replaced FileIn by FileInp
 #   Natchaya P-Durden (2018-05-11)
 #     rename function from def.extr.hdf5() to def.hdf5.extr()
+#   Dave Durden (2018-03-12)
+#     Adding failsafe for rhdf5 metadata attribute on individual dp0p arrays
+#   Dave Durden (2021-10-12)
+#     Copy global attributes by adding file level to listGrp
 ##############################################################################################################
 #Start of function call to extract data from one file and write to another
 ##############################################################################################################
@@ -88,6 +92,9 @@ if(base::is.null(rpt)) {
 
     #List of all object names
     listObjName <- base::paste(listObj$group, listObj$name, sep = "/")
+
+    #Append global attribute level
+    listObjName <- append("/", listObjName)
 
 
   # Groups for HDF5 group structure
@@ -191,10 +198,20 @@ if(!is.null(FileOut)) {
 
   # determine if attributes should be written to output HDF5
   if(MethExtrAttr == TRUE){
+    #Failsafe to remove rhdf5 attribute
+    lapply(names(rpt$listAttr), function(x){
+      if(length(names(rpt$listAttr[[x]])) == 1 && grepl(pattern = "rhdf5", x = names(rpt$listAttr[[x]]))){
+        #Remove attribute if rhdf5 attribute is the only one written
+        rpt$listAttr[[x]] <<- NULL
+      }#end if logical for single rhdf5 attribute   
+    })#end failsafe for rhdf5 attribute
+
     #Write attributes to the output HDF5 file
     lapply(names(rpt$listAttr), function(x){
+      #print(x)
       idData <- rhdf5::H5Oopen(idFile, x)
       base::lapply(names(rpt$listAttr[[x]]), function(y){
+        #print(y)
         #y <- names(rpt$listAttr[[x]])[1]
         rhdf5::h5writeAttribute(attr = rpt$listAttr[[x]][[y]], h5obj = idData, name = y)})
     })

diff --git a/pack/eddy4R.base/R/def.hdf5.pack.R b/pack/eddy4R.base/R/def.hdf5.pack.R
@@ -112,6 +112,7 @@ if(MethMeas %in% "ecse"){
   if (Dp %in% c("Dp01", "Dp02")) { 
 
     for(idxDp in names(inpList)) {
+      #idxDp <- "co2Stor" #for testing
 
       tmp00[[idxDp]] <- list()
       tmp01[[idxDp]] <- list()
@@ -121,14 +122,14 @@ if(MethMeas %in% "ecse"){
         #idxLvLReso <- names(inpList[[idxDp]])[1]
         #Check if qm is part of the input list
         if(exists('qm', where = inpList[[idxDp]][[idxLvLReso]][[1]]) == TRUE){
-
+          
           # Add the qm's to tmp list
           tmp00[[idxDp]][[idxLvLReso]]$qm <- lapply(names(inpList[[idxDp]][[idxLvLReso]][[1]]$qm), function(idxStat)
             # second call to lapply, targeting the observations to be combined into the result data.frames
             do.call(rbind, lapply(1:length(inpList[[idxDp]][[idxLvLReso]]), function(idxt) {
               inpList[[idxDp]][[idxLvLReso]][[idxt]]$qm[[idxStat]]
-              } )
-          ))
+            } )
+            ))
           # assign names to data.frames      
           names(tmp00[[idxDp]][[idxLvLReso]]$qm) <- names(inpList[[idxDp]][[idxLvLReso]][[1]]$qm)
         }
@@ -138,7 +139,7 @@ if(MethMeas %in% "ecse"){
 
         tmp01[[idxDp]][[idxLvLReso]] <- lapply(names(inpList[[idxDp]][[idxLvLReso]][[1]]), function(idxStat)
           # second call to lapply, targeting the observations to be combined into the result data.frames
-          do.call(rbind, lapply(1:length(inpList[[idxDp]][[idxLvLReso]]), function(idxt) inpList[[idxDp]][[idxLvLReso]][[idxt]][[idxStat]] ))
+          base::as.data.frame(dplyr::bind_rows(lapply(1:length(inpList[[idxDp]][[idxLvLReso]]), function(idxt) inpList[[idxDp]][[idxLvLReso]][[idxt]][[idxStat]] )))
         )
 
         # assign names to data.frames      

diff --git a/pack/eddy4R.base/R/def.hdf5.read.qfqm.R b/pack/eddy4R.base/R/def.hdf5.read.qfqm.R
@@ -12,10 +12,11 @@
 #' @param VarLoca Character: Which instrument to read data from.
 #' @param LvlTowr The tower level that the sensor data is being collected in NEON data product convention (HOR_VER)
 #' @param FreqLoca Integer: Measurement frequency.
+#' @param DataType Character: Specify between data and qfqm for read in.
 #' @param MethMeas A vector of class "character" containing the name of measurement method (eddy-covariance turbulent exchange or storage exchange), MethMeas = c("ecte", "ecse"). Defaults to "ecte".
 
 #' @return
-#' Named list \code{qfqm} containing time-series of quality flags.
+#' Named list \code{rpt} containing time-series of quality flags.
 
 #' @references
 #' License: GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007.
@@ -42,6 +43,8 @@
 #     applied term name convention; replaced Levl by Lvl
 #   Natchaya P-Durden (2018-05-22)
 #     rename function from def.neon.read.hdf5.qfqm() to def.hdf5.read.qfqm()
+#   David Durden (2020-06-22)
+#     extending function to work with data and qfqm, as well as adding metadata
 ##############################################################################################
 
 def.hdf5.read.qfqm <- function(
@@ -51,32 +54,77 @@ def.hdf5.read.qfqm <- function(
   VarLoca,
   LvlTowr = c("000_040", "000_050", "000_060")[3],
   FreqLoca,
+  DataType = c("data","qfqm")[1],
   MethMeas = c("ecte", "ecse")[1]
 ){
 
 #Read in the flags from the HDF5 file
 if (MethMeas == "ecte") {
-qfqm <- rhdf5::h5read(file = base::paste0(DirInpLoca, "/ECTE_dp0p_", SiteLoca, "_", DateLoca, ".h5"),
-                      name = base::paste0("/", SiteLoca, "/dp0p/qfqm/", VarLoca, "/",LvlTowr), read.attributes = TRUE)
+rpt <- rhdf5::h5read(file = base::paste0(DirInpLoca, "/ECTE_dp0p_", SiteLoca, "_", DateLoca, ".h5"),
+                      name = base::paste0("/", SiteLoca, "/dp0p/",DataType,"/", VarLoca, "/",LvlTowr), read.attributes = TRUE) 
 }
 
 if (MethMeas == "ecse") {
-qfqm <- rhdf5::h5read(file = base::paste0(DirInpLoca, "/ECSE_dp0p_", SiteLoca, "_", DateLoca, ".h5"),
-                      name = base::paste0("/", SiteLoca, "/dp0p/qfqm/", VarLoca, "/",LvlTowr), read.attributes = TRUE)
+rpt <- rhdf5::h5read(file = base::paste0(DirInpLoca, "/ECSE_dp0p_", SiteLoca, "_", DateLoca, ".h5"),
+                      name = base::paste0("/", SiteLoca, "/dp0p/",DataType,"/", VarLoca, "/",LvlTowr), read.attributes = TRUE) 
 }
 
+# print message to screen
+msg <- paste0("dataset ", DateLoca, ": ", VarLoca, " hdf5 read-in complete")
+tryCatch({rlog$debug(msg)}, error=function(cond){print(msg)})  
+
 #Convert each flag to a vector from a 1D array
-for(idx in base::names(qfqm)) qfqm[[idx]] <- base::as.vector(qfqm[[idx]]); base::rm(idx)
+for(idx in base::names(rpt)) rpt[[idx]] <- base::as.vector(rpt[[idx]]); base::rm(idx)
+
+#Cache attributes before coverting to data.frame
+attr <- attributes(rpt)
+#Convert each flag to a vector from a 1D array
+for(idx in base::names(attr)) attr[[idx]] <- base::as.vector(attr[[idx]]); base::rm(idx)
+
+# convert list to data.frame
+rpt <- base::as.data.frame(rpt, stringsAsFactors = FALSE)
+
+#Reapply attributes to reported data.frame
+attributes(rpt)$unit <- attr$Unit
+if(is.null(attr(rpt,"unit")) & DataType == "qfqm") attributes(rpt)$unit <- rep(NA, length(rpt))
+
+# convert type of variable time
+if("time" %in% colnames(rpt)){
+rpt$time <- base::as.POSIXct(rpt$time, format="%Y-%m-%dT%H:%M:%OSZ", tz="UTC") + 0.0001
+}
+
+# perform unit conversion
+if(DataType == "data"){
+rpt <- base::suppressWarnings(eddy4R.base::def.unit.conv(data = rpt,
+                                                          unitFrom = attributes(rpt)$unit,
+                                                          unitTo = "intl"))
+}
+
+#Reapply attributes to reported data.frame
+lapply(grep("Unit", names(attr), value = TRUE, invert = TRUE), function(x){
+  attributes(rpt)[x] <<- attr[x]
+  })
+
+
+# sd assign attribute to gasRefe
+if (VarLoca == "gasRefe"){
+  names(attr(rpt,"Sd")) <-  attr(rpt,"Name")
+  names(attributes(rpt))[which(names(attributes(rpt))=="Sd")] <- "sd" #Change to lower case to keep format
+  names(attr(rpt,"DfSd")) <-  attr(rpt,"Name")
+  #base::attributes(rpt)$sd <- attr$Sd[base::names(rpt)]
+  #base::attributes(rpt)$DfSd <- attr$DfSd[base::names(rpt)]
+}
 
 #Apply units to each flag
-lapply(seq_len(length(qfqm)), function(x){
+lapply(seq_len(length(rpt)), function(x){
   tryCatch({rlog$debug(x)}, error=function(cond){print(x)})
-  attributes(qfqm[[x]])$Unit <<- attributes(qfqm)$Unit[[x]]
+  attributes(rpt[[x]])$unit <<- attributes(rpt)$unit[[x]]
+  attributes(rpt[[x]])$`Dspk$Br86$MaxReso` <<- attributes(rpt)$`Dspk$Br86$MaxReso`[[x]]
+  attributes(rpt[[x]])$`Dspk$Br86$NumBin` <<- attributes(rpt)$`Dspk$Br86$NumBin`[[x]]
+  attributes(rpt[[x]])$`Dspk$Br86$NumWndw` <<- attributes(rpt)$`Dspk$Br86$NumWndw`[[x]]
   })
 
-# convert list to data.frame
-qfqm <- base::as.data.frame(qfqm, stringsAsFactors = FALSE)
 
-return(qfqm)
+return(rpt)
 }