GLEON / rLakeAnalyzer

An R version of Lake Analyzer
43 stars 26 forks source link

Extra argument for water level fluctuation #113

Open JorgeMonPe opened 3 years ago

JorgeMonPe commented 3 years ago

Hellow,

Could be possible to include an extra argument for water level fluctuation for some functions?

I'm working with temperature profile in reservoirs. In some functions, such as epi.temperature() or schmidt.stability(), you need to take account changes in water level which affect surface of each layer (bthA). In that cases I work around subtracting water surface depth to bthD vector. For water surface depth I mean the depth which is the surface of the water respect to water surface in a full capacity situation in the reservoir.

##Example:
#Bathymetry
bthA    <-  c(1000,900,864,820,200,10,10,10,10)
bthD    <-  c(0,2.3,2.5,4.2,5.8,7,8,9,10)

#Water temperature profile
wtr <-  c(28,27,26.4,26,25.4,24,23.3)
depths  <-  c(0,1,2,3,4,5,6)

#surface depth (2 meters lower than in full capacity situation)
surface_depth <- 2

schmidt.stability(wtr, depths, bthA, bthD-surface_depth)

#I based on this piece of code:

    if (min(bthD) < 0) {
        useI = bthD >= 0
        if (any(bthD == 0)) {
            depT = bthD[useI]
        }
        else {
            depT = c(0, bthD[useI])
        }
        bthA = stats::approx(bthD, bthA, depT)$y
        bthD = depT
    }

The problem is when I need to use time series function ts.schmidt.stability(). Then, I have to modify the original function. In my case, I added a new argument called surface_depth which is a vector with surface water depth for each day.

This is the code that I use:

ts.schmidt.stability_reservoir <- function (wtr, bathy, na.rm = FALSE, surface_depth = NULL) 
{
  if (is.null(surface_depth)){
    surface_depth <- c(0,length.out = nrow(wtr))
  }
  if (nrow(wtr) != length(surface_depth)) {
    stop("surface depth must be supply for each 'wtr' row")
  }
  depths = get.offsets(wtr)
  n = nrow(wtr)
  s.s = rep(NA, n)
  #wtr.mat = as.matrix(drop.datetime(wtr))#This line return an error: Function drop.time not found. I don't know why...
  wtr.mat = as.matrix(dplyr::select(wtr,-datetime))  #Alternative line
  dimnames(wtr.mat) <- NULL
  for (i in 1:n) {
    if (na.rm) {
      temps = wtr.mat[i, ]
      if (all(is.na(temps))) {
        next
      }
      notNA = !is.na(temps)
      s.s[i] = schmidt.stability(temps[notNA], depths[notNA], 
                                 bathy$areas, bathy$depths-surface_depth[i])
    }
    else {
      if (any(is.na(wtr.mat[i, ]))) {
        s.s[i] = NA
        next
      }
      s.s[i] = schmidt.stability(wtr.mat[i, ], depths, 
                                 bathy$areas, bathy$depths-surface_depth[i])
    }
  }
  #output = data.frame(datetime = get.datetime(wtr), schmidt.stability = s.s) #Same as drop.datetime I don't know why get.datetime() is not found.
  output = data.frame(datetime = dplyr::select(wtr, datetime), schmidt.stability = s.s)  #Alternative line
  return(output)
}

I'm having problems with drop.datetime() and get.datetime() functions, any idea why R can not find these functions?

Finally, I think it would be useful to have an extra argument to work in systems which undergo water level fluctuations. Surely, there is a good reason for not doing so. Is there an easier way to work around this issue?

Maybe someone can give any feedback to improve the code or find it useful...

SpijkCo commented 3 years ago

I am interested in this topic too. Especially to incorporate into the wtr.heat.map function.