R/lookup.R

get_plaus <- function(
  co2 = c(220, 770),
  fco2 = c(-50, 100),
  fh2o = c(-2, 14),
  g = c(-110, 220),
  E_0 = c(0, 600),
  le = c(-100, 700),
  p = c(0, 0.05),
  pair = c(70000, 120000),
  ppfd = c(0, 2200),
  rg = c(0, 1200),
  rh = c(0, 100),
  rn = c(-200, 1000),
  rpot = c(0, 3000),
  swc = c(0, 0.7),
  tair = c(-50, 50),
  tau = c(-100, 100),
  tsoil = c(-20, 50),
  ustar = c(0, 6),
  vpd = c(0, 50),
  wd = c(0, 360),
  ws = c(0, 40)
) {

}

get_deps <- function(
  # separating instruments and fluxes prevents double-counting additive tests
  sa = c("u", "v", "w", "ts"),
  irga75 = c("irga75", "co2", "h2o"),
  irga77 = c("irga77", "ch4"),
  fco2 = c("fco2", "irga75", "sa", "all"),
  fch4 = c("fch4", "irga77", "sa", "all"),
  le = c("le", "irga75", "sa", "all"),
  h = c("h", "sa", "all"),
  tau = c("tau", "sa")
) {
  as.list(environment())
}

get_deps2 <- function(...) {
  # TODO allow for overriding deps through ...
  # separating instruments and fluxes prevents double-counting additive tests
  list <- list(
    sa = c("u", "v", "w", "ts"),
    irga75 = c("irga75", "co2", "h2o"),
    irga77 = c("irga77", "ch4"),
    fco2 = c("fco2", "irga75", "sa", "all"),
    fch4 = c("fch4", "irga77", "sa", "all"),
    le = c("le", "irga75", "sa", "all"),
    h = c("h", "sa", "all"),
    tau = c("tau", "sa")
  )
}

get_subset <- function(x, ...) {
  # TODO ignore var if it is not in the dataset, i.e. drop it silently
  # temp (?) fix -- use ... to 'unselect' vars manually
  list <- list(
    fluxes = c("tau", "h", "le", "fco2", "fch4", "fh2o"),
    covariances = c("w_ts_cov", "w_co2_cov", "w_h2o_cov", "w_ch4_cov"),
    wind = c(
      "urot", "uunrot", "u_sphf", "u_sd", "u_var",
      "vrot", "vunrot", "v_sphf", "v_sd", "v_var",
      "wrot", "wunrot", "w_sphf", "w_sd", "w_var",
      "ts", "ts_sphf", "ts_sd", "ts_var",
      "ustar", "tke", "ws", "wd", "max_ws", "yaw", "pitch", "tstar", "l", "zeta"
    ),
    biomet = c(
      "lwin", "lwout", "ppfd", "p", "rh", "rn", "g", "swc", "swin", "swout",
      "tair", "tsoil", "vpd", "twater", "pbaro", "tbaro", "wtd"
    ),
    precheck = c(
      "urot", "vrot", "wunrot", "wrot", "ts", "ws", "wsmax", "wd", "tke",
      "ustar", "co2", "h2o", "ch4", "tau", "h", "le", "fco2", "fh2o", "fch4",
      "u_sd", "v_sd", "w_sd", "ts_sd", "h2o_sd", "co2_sd", "ch4_sd",
      "unc_tau", "unc_h", "unc_le", "unc_fco2", "unc_fch4",
      "tau_scf", "h_scf", "le_scf", "co2_scf", "ch4_scf", "u_sphf", "v_sphf",
      "w_sphf", "ts_sphf", "co2_sphf", "h2o_sphf", "ch4_sphf",
      "h_st", "le_st", "co2_st", "ch4_st", "h2o_vadv", "co2_vadv", "ch4_vadv",
      "co2_tlag", "h2o_tlag", "ch4_tlag", "xpeak", "x90p", "rssi75", "rssi77"
    ),
    wd_dep = c("wrot", "wunrot", "w_sd", "ustar", "tke")
  )
  out <- list[[x]]
  dots <- unlist(list(...))
  if (length(dots) > 0) out[!out %in% dots] else out
}

get_full_names <- function(
  # essential variables
  bowen = "Bowen ratio",
  ch4 = "CH4 mixing ratio",
  co2 = "CO2 mixing ratio",
  er = "Ecosystem respiration",
  et = "Evapotranspiration",
  fch4 = "CH4 flux",
  fco2 = "CO2 flux",
  fh2o = "H2O flux",
  gpp = "Gross primary production",
  h = "Sensible heat flux",
  h2o = "H2O mixing ratio",
  l = "Monin-Obukhov length",
  le = "Latent heat flux",
  nee = "Net ecosystem exchange",
  pair = "Air pressure",
  q = "Specific humidity",
  rssi75 = "LI-7500 relative signal strength",
  rssi77 = "LI-7700 relative signal strength",
  tdew = "Dew point temperature",
  tau = "Momentum flux",
  tke = "Turbulent kenetic energy",
  ts = "Sonic temperature",
  urot = "Rotated horizontal wind speed",
  uunrot = "Unrotated horizontal wind speed",
  ustar = "Friction velocity",
  vrot = "Rotated cross wind speed",
  vunrot = "Unrotated cross wind speed",
  vpd = "Vapor pressure deficit",
  wrot = "Rotated vertical wind speed",
  wunrot = "Unrotated vertical wind speed",
  wd = "Wind direction",
  ws = "Wind speed",
  wsmax = "Maximum wind speed",
  xpeak = "Peak fetch length",
  x70p = "70% fetch length",
  x90p = "90% fetch length",
  zeta = "Monin-Obukhov stability parameter",

  # biomet variables
  g = "Soil heat flux",
  lwin = "Incoming longwave radiation",
  lwout = "Outgoing longwave radiation",
  p = "Precipitation",
  ppfd = "Photosynthetic photon flux density",
  rg = "Global radiation",
  rh = "Relative humidity",
  rn = "Net radiation",
  swin = "Incoming shortwave radiation",
  swout = "Outgoing shortwave radiation",
  swc = "Soil water content",
  tair = "Air temperature",
  tsoil = "Soil temperature",
  twater = "Water column temperature",
  wtd = "Water table depth"
) {
  as.list(environment())
}

get_full_names2 <- function(x, fill = "-") {
  list <- list(
    # essential variables
    bowen = "Bowen ratio",
    ch4 = "CH4 mixing ratio",
    co2 = "CO2 mixing ratio",
    er = "Ecosystem respiration",
    et = "Evapotranspiration",
    fch4 = "CH4 flux",
    fco2 = "CO2 flux",
    fh2o = "H2O flux",
    gpp = "Gross primary production",
    h = "Sensible heat flux",
    h2o = "H2O mixing ratio",
    l = "Monin-Obukhov length",
    le = "Latent heat flux",
    nee = "Net ecosystem exchange",
    pair = "Air pressure",
    q = "Specific humidity",
    rssi75 = "LI-7500 relative signal strength",
    rssi77 = "LI-7700 relative signal strength",
    tdew = "Dew point temperature",
    tau = "Momentum flux",
    tke = "Turbulent kenetic energy",
    ts = "Sonic temperature",
    urot = "Rotated horizontal wind speed",
    uunrot = "Unrotated horizontal wind speed",
    ustar = "Friction velocity",
    vrot = "Rotated cross wind speed",
    vunrot = "Unrotated cross wind speed",
    vpd = "Vapor pressure deficit",
    wrot = "Rotated vertical wind speed",
    wunrot = "Unrotated vertical wind speed",
    wd = "Wind direction",
    ws = "Wind speed",
    wsmax = "Maximum wind speed",
    xpeak = "Peak fetch length",
    x70p = "70% fetch length",
    x90p = "90% fetch length",
    zeta = "Monin-Obukhov stability parameter",

    # biomet variables
    g = "Soil heat flux",
    lwin = "Incoming longwave radiation",
    lwout = "Outgoing longwave radiation",
    p = "Precipitation",
    ppfd = "Photosynthetic photon flux density",
    rg = "Global radiation",
    rh = "Relative humidity",
    rn = "Net radiation",
    swin = "Incoming shortwave radiation",
    swout = "Outgoing shortwave radiation",
    swc = "Soil water content",
    tair = "Air temperature",
    tsoil = "Soil temperature",
    twater = "Water column temperature",
    wtd = "Water table depth",

    # prefixes
    unc = "random uncertainty",

    # suffixes
    scf = "spectral correction factor",
    sphf = "high-frequency spikes",
    sd = "standard deviation",
    tlag = "time lag",
    un = "uncorrected",
    var = "variance"
  )
  len <- length(x)
  out <- vector("character", len)
  for (i in 1:len) {
    if (is.null(list[[x[i]]])) {
      out[i] <- fill
    } else out[i] <- list[[x[i]]]
  }
  out
}

get_vars <- function(
  # essential variables
  bowen = "bowen", # bowen ratio of heat fluxes
  ch4 = "ch4", # methane mixing ratio
  co2 = "co2", # carbon dioxide mixing ratio
  er = "er", # ecosystem respiration
  et = "et", # evapotranspiration
  fch4 = "fch4", # methane flux
  fco2 = "fco2", # carbon dioxide flux
  fh2o = "fh2o", # water vapor flux
  gpp = "gpp", # gross primary production
  h = "h", # sensible heat flux
  h2o = "h2o", # water vapor mixing ratio
  l = "l", # monin-obhukov length
  le = "le", # latent heat flux
  nee = "nee", # net ecosystem exchange
  pair = "pair", # air pressure
  q = "q", # specific humidity
  rssi75 = "rssi75", # LI-7500 relative signal strength
  rssi77 = "rssi77", # LI-7700 relative signal strength
  tdew = "tdew", # dewpoint temperature
  tau = "tau", # momentum flux
  tke = "tke", # turbulent kenetic energy
  ts = "ts", # sonic temperature
  urot = "urot", # rotated horizontal wind speed
  uunrot = "uunrot", # unrotated horizontal wind speed
  ustar = "ustar", # friction velocity
  vrot = "vrot", # rotated cross wind speed
  vunrot = "vunrot", # unrotated cross wind speed
  vpd = "vpd", # vapor pressure deficit
  wrot = "wrot", # rotated vertical wind speed
  wunrot = "wunrot", # unrotated vertical wind speed
  wd = "wd", # wind direction
  ws = "ws", # wind speed
  wsmax = "wsmax", # maximum wind speed
  xpeak = "xpeak", # peak fetch length
  x70p = "x70p", # 70% fetch length
  x90p = "x90p", # 90% fetch length
  zeta = "zeta", # monin-obhukov stability parameter

  # biomet variables
  g = "g", # soil heat flux
  lwin = "lwin", # incoming longwave radiation
  lwout = "lwout", # outgoing longwave radiation
  p = "p", # precipitation
  ppfd = "ppfd", # photosynthetic photon flux density
  rg = "rg", # global radiation
  rh = "rh", # relative humidity
  rn = "rn", # net radiation
  swin = "swin", # incoming shortwave radiation
  swout = "swout", # outgoing shortwave radiation
  swc = "swc", # soil water content
  tair = "tair", # air temperature
  tsoil = "tsoil", # soil temperature
  twater = "twater", # water column temperature
  wtd = "wtd" # water table depth
) {
  as.list(environment())
}

get_limits <- function(...) {
  list <- list(
    "rg" = c(0, 1200), # W+1m-2
    "rpot" = c(0, 3000), # W+1m-2
    "ppfd" = c(0, 2200), # W+1m-2
    "par" = c(0, 2500), # W+1m-2
    "tair" = c(-50, 50), # C
    "tsoil" = c(-20, 50), # C
    "vpd" = c(0, 50),
    "rh" = c(0, 100), # %
    "nee" = c(-50, 100),
    "ustar" = c(-1, 50),
    "E_0" = c(0, 600),
    "pair" = c(70, 120), # kPa
    "rn" = c(-200, 1000), # W+1m-2
    "p" = c(0, 0.05), # m
    #"swc" = c(0, 0.7),
    "g" = c(-110, 220)
  )
  list
}

get_limits2 <- function(x, fill = NA, ...) {
  list <- list(
    "rg" = c(0, 1200), # W+1m-2
    "rpot" = c(0, 3000), # W+1m-2
    "ppfd" = c(0, 2200), # W+1m-2
    "par" = c(0, 2500), # W+1m-2
    "tair" = c(-50, 50), # C
    "tbaro" = c(-50, 50), # C
    "tsoil" = c(-20, 50), # C
    "vpd" = c(0, 50),
    "rh" = c(0, 100), # %
    "nee" = c(-50, 100),
    "ustar" = c(-1, 50),
    "E_0" = c(0, 600),
    "pair" = c(70, 120), # kPa
    "pbaro" = c(70, 120), # kPa
    "rn" = c(-200, 1000), # W+1m-2
    "p" = c(0, 0.05), # m
    #"swc" = c(0, 0.7),
    "g" = c(-110, 220)
  )
  if (is.null(list[[x]])) fill else list[[x]]
}
grahamstewart12/tidyflux documentation built on June 4, 2019, 7:44 a.m.