Maps

Dockerfile

@@ -1,6 +1,6 @@
 # start with the ropensci image including debian:testing, r-base, rocker/rstudio, rocker/hadleyverse
 # https://hub.docker.com/r/rocker/ropensci/
-FROM quay.io/battelleecology/rstudio:4.0.5
+FROM 	ghcr.io/rocker-org/geospatial:4.2.2
 
 WORKDIR /home/eddy/eddy4R
 

flow/tool/flow.meta.loc.turb.R

@@ -0,0 +1,70 @@
+##############################################################################################
+#' @title Workflow for to grab ECTE sensor locations and calculate UTM coordinates
+
+#' @author
+#' David Durden \email{eddy4R.info@gmail.com}
+
+#' @description
+#' Workflow. Downloading dp0p data from S3 and converting to ICOS format.
+
+#' @param Currently none
+
+#' @return Currently none
+
+#' @references
+
+#' @keywords eddy-covariance, NEON
+
+#' @examples Currently none
+
+#' @seealso Currently none
+
+# changelog and author contributions / copyrights
+#   David (2024-09-12)
+#     original creation
+##############################################################################################
+
+
+#Install and load libraries
+library(devtools)
+install_github('NEONScience/NEON-geolocation/geoNEON', dependencies=TRUE)
+library(geoNEON)
+
+#Set the NEON site code
+Site <- "KONZ"
+
+#Angle of local tower coordinate reference system (x aligned with C face from CD corner)
+angRefeTowr <- c("BARR" = 255,"CLBJ" = 270,"MLBS" = 180,"DSNY" = 270,"NIWO" = 225,"ORNL" = 270,"OSBS" = 225,
+                    "SCBI" = 300,"LENO" = 315,"TALL" = 270,"CPER" = 270,"BART" = 270,"HARV" = 270,"BLAN" = 240,
+                    "SERC" = 230,"JERC" = 135,"GUAN" = 270,"LAJA" = 270,"STEI" = 225,"TREE" = 225,"UNDE" = 200,
+                    "KONA" = 290,"KONZ" = 290,"UKFS" = 230,"GRSM" = 230,"DELA" = 280,"DCFS" = 245,"NOGP" = 220,
+                    "WOOD" = 245,"RMNP" = 303,"OAES" = 270,"YELL" = 180,"MOAB" = 270,"STER" = 270,"JORN" = 220,
+                    "SRER" = 290,"ONAQ" = 180,"ABBY" = 270,"WREF" = 225,"SJER" = 270,"SOAP" = 180,"TEAK" = 270,
+                    "TOOL" = 270,"BONA" = 270,"DEJU" = 290,"HEAL" = 270,"PUUM" = 295)[Site]
+
+#Grab site location metadata for all configure locations for the current time with history = F
+locSite <- geoNEON::getLocBySite(Site, type="TIS", history=F)
+
+
+#Grab tower location metadata
+locTowr <- locSite[grep(pattern = "TOWER", x = locSite$namedLocation),]
+
+#Grab a subset of Tower sensor location metadata
+locSensTowr <- locSite[grep(pattern = "BOOM|LEVEL", x = locSite$locationParent),]
+locSensTowr <- locSensTowr[grep(pattern = "CFGLOC[0-9]{6}$", x = locSensTowr$namedLocation),]
+
+
+#perform actual rotation
+xOfst <- as.numeric(locSensTowr$xOffset)*cos(angRefeTowr) - as.numeric(locSensTowr$yOffset) * sin(angRefeTowr)  
+yOfst <- as.numeric(locSensTowr$xOffset) * sin(angRefeTowr) + as.numeric(locSensTowr$yOffset) * cos(angRefeTowr)
+
+#Apply offsets to get UTM coordinates for sensors
+locSensTowr$easting <- as.numeric(locTowr$easting) + xOfst
+locSensTowr$northing <-  as.numeric(locTowr$northing) + yOfst
+locSensTowr$utmZone <- locTowr$utmZone
+
+#Grab a subset of ECTE sensor location metadata
+locEcte <- locSensTowr[grep(pattern = "ECTE IRGA L|3D Wind L", x = locSensTowr$locationDescription),]
+
+#Calculate Lat and Lon from UTM coordinates (needs terra installed)
+#latLon <- geoNEON::calcLatLong(locSens$easting, locSens$northing, utmZone = locSens$utmZone)

pack/eddy4R.base/R/def.bin.R

@@ -11,19 +11,19 @@
 #' @param depe Either a vector or matrix of class numeric or integer containing the dependent variable and of the same length as \code{idep}. []
 #' @param RngMinMax An object of class numeric or integer containing the minimum and maximum values of the independent variable. Defaults to NULL. []
 #' @param NumBin An object of class numeric or integer containing the number of bins. []
-#' @param widtBin An object of class string containing the functions ("lin", "log10", "exp10", "logExp", "expLog") to determine bin width distribution of the independent variable. []
-#' @param meanFunc An object of class string containing the arithmetic "mean" and "median". []
+#' @param WidtBin An object of class string containing the functions ("lin", "log10", "exp10", "logExp", "expLog") to determine bin width distribution of the independent variable. []
+#' @param Func An object of class string containing the arithmetic "mean", "median", or "sd". []
 
-#' @return \code{idep} A list object of class "numeric" containing the resulted binning of independent variable and of the same length as {widtBin} and \code{depe} a matrix containing the the resulted binning of dependent variable and of the same length as {widtBin}. \cr
+#' @return \code{idep} A list object of class "numeric" containing the resulted binning of independent variable and of the same length as {WidtBin} and \code{depe} a matrix containing the the resulted binning of dependent variable and of the same length as {WidtBin}. \cr
 
 #' @references
 #' License: GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007
 
 #' @keywords bin
 
 #' @examples 
-#' def.bin(idep = rnorm(5000), depe = rnorm(5000), RngMinMax = NULL, NumBin = 23, widtBin = "log10", meanFunc = "mean" )
-#' def.bin(idep = rnorm(500), depe = rnorm(500), RngMinMax = c(0.1, 0.4), NumBin = 12, widtBin = "lin", meanFunc = "median" )
+#' def.bin(idep = rnorm(5000), depe = rnorm(5000), RngMinMax = NULL, NumBin = 23, WidtBin = "log10", Func = "mean" )
+#' def.bin(idep = rnorm(500), depe = rnorm(500), RngMinMax = c(0.1, 0.4), NumBin = 12, WidtBin = "lin", Func = "median" )
 
 #' @seealso Currently none
 
@@ -38,6 +38,8 @@
 #     Initail naming convention for eddy4R
 #   Natchaya P-Durden (2018-04-03)
 #     update @param format
+#   Stefan Metzger (2024-02-02)
+#     add functionality for binned standard deviation
 ##############################################################################################
 #BIN DATA
 
@@ -46,15 +48,15 @@ def.bin <- function(
   depe,
   RngMinMax = NULL,
   NumBin,
-  widtBin = c("lin", "log10", "exp10", "logExp", "expLog"),
-  meanFunc = c("mean", "median")
+  WidtBin = c("lin", "log10", "exp10", "logExp", "expLog"),
+  Func = c("mean", "median", "sd")
 ) {
   #aggregation with binning 
   #  idep: independent variable, frequency, wavenumber etc.
   #  depe: dependent variable, vector or matrix of same length as idep
   #  RngMinMax: min and max range
   #  NumBin: number of bins
-  #  widtBin: c("lin", "log10", "exp10", "logExp", "expLog") bin width distribution as function of idep
+  #  WidtBin: c("lin", "log10", "exp10", "logExp", "expLog") bin width distribution as function of idep
 
   #prepare variables
   idep <- idep
@@ -63,23 +65,28 @@ def.bin <- function(
 
   #define boundary
   if(is.null(RngMinMax)) minMax <- base::range(idep)
-  if(widtBin == "lin") rng <- base::seq(minMax[1], minMax[2], length.out=(NumBin + 1))
-  if(widtBin == "log10") rng <- base::log10(base::seq(10^(minMax[1]), 10^(minMax[2]), length.out=(NumBin + 1)))
-  if(widtBin == "exp10") rng <- 10^(base::seq(base::log10(minMax[1]), base::log10(minMax[2]), length.out=(NumBin + 1)))
-  if(widtBin == "logExp") rng <- base::log(base::seq(base::exp(minMax[1]), base::exp(minMax[2]), length.out=(NumBin + 1)))
-  if(widtBin == "expLog") rng <- base::exp(base::seq(base::log(minMax[1]), base::log(minMax[2]), length.out=(NumBin + 1)))
+  if(WidtBin == "lin") rng <- base::seq(minMax[1], minMax[2], length.out=(NumBin + 1))
+  if(WidtBin == "log10") rng <- base::log10(base::seq(10^(minMax[1]), 10^(minMax[2]), length.out=(NumBin + 1)))
+  if(WidtBin == "exp10") rng <- 10^(base::seq(base::log10(minMax[1]), base::log10(minMax[2]), length.out=(NumBin + 1)))
+  if(WidtBin == "logExp") rng <- base::log(base::seq(base::exp(minMax[1]), base::exp(minMax[2]), length.out=(NumBin + 1)))
+  if(WidtBin == "expLog") rng <- base::exp(base::seq(base::log(minMax[1]), base::log(minMax[2]), length.out=(NumBin + 1)))
   if(is.null(RngMinMax)) rng[c(1,length(rng))] <- c(0,Inf)
 
   #actual binning
   for(i in 1:(length(rng)-1)) {
     whrBin <- which(idep > rng[i] & idep <= rng[i+1])
-    if(meanFunc == "median") {
+    if(Func == "median") {
       idepTmp <- stats::median(idep[whrBin], na.rm=T)
       depeTmp <- sapply(1:ncol(depe), function(x) stats::median(depe[whrBin,x], na.rm=T))
-    } else {
+    }
+    if(Func == "mean") {
       idepTmp <- base::mean(idep[whrBin], na.rm=T)
       depeTmp <- sapply(1:ncol(depe), function(x) base::mean(depe[whrBin,x], na.rm=T))
     }
+    if(Func == "sd") {
+      idepTmp <- base::mean(idep[whrBin], na.rm=T)
+      depeTmp <- sapply(1:ncol(depe), function(x) stats::sd(depe[whrBin,x], na.rm=T))
+    }
     if(i == 1) {
       idepBin <- idepTmp
       depeBin <- depeTmp

pack/eddy4R.maps/.Rbuildignore

@@ -0,0 +1,3 @@
+^eddy4R\.maps\.Rproj$
+^\.Rproj\.user$
+^data-raw$

pack/eddy4R.maps/DESCRIPTION

@@ -0,0 +1,45 @@
+Package: eddy4R.maps
+Title: Eddy-covariance calculation for R: Flux Mapper™ source codes (basic)
+Version: 0.0.1
+Authors@R: c( person(given = "Stefan",
+              family = "Metzger",
+              role = c("aut", "cre"),
+              email = "smetzger@atmofacts.com",
+              comment = c(ORCID = "0000-0002-4201-852X")),
+              person(given = "Samuel",
+              family = "Bower",
+              role = c("aut"),
+              email = "sbower@atmofacts.com"),
+              person(given = "David",
+              family = "Durden",
+              role = c("aut"),
+              email = "ddurden@battelleecology.org")
+           )
+Description: Basic commonalities and tools for working with Flux Maps™ in R.
+Depends:
+    R (>= 4.0.5)
+Imports:
+    assertthat,
+    mapview,
+    gdalcubes (>= 0.3.1),
+    gifski (>= 1.4.3-1),
+    here (>= 1.0.1),
+    htmlwidgets (>= 1.5.3),
+    leaflet (>= 2.0.4.1),
+    lubridate (>= 1.9.2),
+    matlab (>= 1.0.2),
+    raster (>= 3.4-10),
+    RColorBrewer (>= 1.1-2),
+    rstac (>= 0.9.1),
+    sf (>= 0.9-8),
+    sp (>= 1.4-5),
+    stars (>= 0.5-2),
+    tmap (>= 3.3-1),
+    tmaptools (>= 3.1-1),
+    tools (>= 4.0.5)
+Comments: Dependency package(s) 'OpenStreetMap (>= 0.3.4)' not available.
+License: GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3

pack/eddy4R.maps/NAMESPACE

@@ -0,0 +1,11 @@
+# Generated by roxygen2: do not edit by hand
+
+export(def.algn.foot.rng)
+export(def.bbox)
+export(def.plot.flux.animate)
+export(def.plot.flux.interactive)
+export(def.plot.flux.static)
+export(def.spat.data.cube)
+export(def.spatialize.flux.foot)
+export(wrap.spat.data.grab)
+importFrom(matlab,padarray)

pack/eddy4R.maps/R/def.algn.foot.rng.R

@@ -0,0 +1,103 @@
+#' @title Align Footprint Map with Remote Sensing Data
+#'
+#' @author
+#' Stefan Metzger \email{smetzger@atmofacts.com}
+#' Andrei Serafimovich
+#' 
+#' @description Function definition. This function adjusts the dimensions of a footprint map
+#' (PHIcr_pad) to match and align with the dimensions of remote sensing (RS) data. It handles both cases
+#' where the footprint map is smaller or larger than the RS data extent in all directions.
+#'
+#' @param PHIcr_pad Matrix representing the footprint map.
+#' @param nortF Numeric vector representing the north extent of the footprint.
+#' @param eastF Numeric vector representing the east extent of the footprint.
+#' @param RS List containing 'nort' and 'east' vectors for remote sensing data extents.
+#' 
+#' @return List containing the adjusted footprint map matrix and the updated extents (nortF and eastF).
+#' 
+#' @references
+#' License: GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007
+#' 
+#' @keywords visualization, flux mapping
+#' 
+#' @importFrom matlab padarray
+#' 
+#' @examples
+#' # Example usage:
+#' # result <- alignFootprintMap(PHIcr_pad, nortF, eastF, RS)
+#' # aligned_PHIcr_pad <- result$PHIcr_pad
+#' # updated_nortF <- result$nortF
+#' # updated_eastF <- result$eastF
+#' 
+#' @seealso Currently none.
+#' 
+#' @export
+#
+# changelog and author contributions / copyrights
+#   Stefan Metzger (2013-01-01) original creation
+#   Andrei Serafimovich (2015-06-15) fixed padding for footprint matrices
+#   Stefan Metzger (2023-01-31) add Roxygen header, AGPL3 publication
+# 
+###############################################################################################
+
+def.algn.foot.rng <- function(
+  PHIcr_pad,
+  nortF,
+  eastF,
+  RS) {
+
+  # Pad or trim the footprint matrix to get same dimension as and alignment with RS data
+
+  # Extent in south
+  if(min(nortF, na.rm=TRUE) > 1) {
+    #case1: footprint matrix smaller than RS extent
+    PHIcr_pad <- matlab::padarray(PHIcr_pad, range(nortF)[1]-1,0,"post")
+    nortF <- c(1:(range(nortF)[1]-1), nortF)
+  } else if (min(nortF, na.rm=TRUE) < 1) {
+    #case2: footprint matrix larger than RS extent
+    #            PHIcr_pad <- PHIcr[-which(nortF < 0),]
+    PHIcr_pad <- PHIcr_pad[-which(nortF <= 0),]
+    #            nortF <- nortF[-which(nortF < 0)]
+    nortF <- nortF[-which(nortF <= 0)]
+  }
+
+  # Extent in north
+  if( max(nortF, na.rm=TRUE) < length(RS$nort) ) {
+    #case1: footprint matrix smaller than RS extent
+    PHIcr_pad <- matlab::padarray(PHIcr_pad,length(RS$nort)-range(nortF)[2],0,"pre")
+    nortF <- c(nortF, (range(nortF)[2]+1):length(RS$nort))
+  } else if ( max(nortF, na.rm=TRUE) > length(RS$nort) ) {
+    #case2: footprint matrix larger than RS extent
+    PHIcr_pad <- PHIcr_pad[-which(nortF > length(RS$nort)),]
+    nortF <- nortF[-which(nortF > length(RS$nort))]
+  }
+
+  # Extent in west
+  if(min(eastF, na.rm=TRUE) > 1) {
+    #case1: footprint matrix smaller than RS extent
+    PHIcr_pad <- cbind(matrix(nrow=nrow(PHIcr_pad), ncol=range(eastF)[1]-1, 0), PHIcr_pad)
+    eastF <- c(1:(range(eastF)[1]-1), eastF)
+  } else if (min(eastF, na.rm=TRUE) < 1) {
+    #case2: footprint matrix larger than RS extent
+    #              PHIcr_pad <- PHIcr_pad[,-which(eastF < 0)]
+    PHIcr_pad <- PHIcr_pad[,-which(eastF <= 0)]
+    #              eastF <- eastF[-which(eastF < 0)]
+    eastF <- eastF[-which(eastF <= 0)]
+  }
+
+  # Extent in east
+  if( max(eastF, na.rm=TRUE) < length(RS$east) ) {
+    #case1: footprint matrix smaller than RS extent
+    PHIcr_pad <- cbind(PHIcr_pad, matrix(nrow=nrow(PHIcr_pad),
+                                         ncol=length(RS$east)-range(eastF)[2], 0))
+    eastF <- c(eastF, (range(eastF)[2]+1):length(RS$east))
+  } else if (max(eastF, na.rm=TRUE) > length(RS$east)) {
+    #case2: footprint matrix larger than RS extent
+    PHIcr_pad <- PHIcr_pad[,-which(eastF > length(RS$east))]
+    #              eastF <- eastF[-which(nortF > length(RS$east))]
+    eastF <- eastF[-which(eastF > length(RS$east))]
+  }
+
+  # Return the adjusted matrix and extents
+  return(list(PHIcr_pad = PHIcr_pad, nortF = nortF, eastF = eastF))
+}