FIESTA: Forest Inventory Estimation and Analysis

########################################################################
### DBgetEvalid()
########################################################################
iseval <- FALSE
if (eval == "FIA") {
  evalCur <- ifelse (Cur || !is.null(Endyr), TRUE, FALSE) 
  evalAll <- ifelse (All, TRUE, FALSE) 
  evalEndyr <- Endyr
  measCur=allyrs <- FALSE
  measEndyr <- NULL
  
} else {
  measCur <- ifelse (Cur || !is.null(Endyr), TRUE, FALSE) 
  allyrs <- ifelse (All, TRUE, FALSE) 
  if (length(Endyr) > 1) {
    stop("only one Endyr allowed for custom estimations")
  }
  measEndyr <- Endyr
  evalCur=evalAll <- FALSE
  evalEndyr <- NULL
}

####################################################################
## Get states, Evalid and/or invyrs info
##########################################################
evalInfo <- tryCatch(
  DBgetEvalid(states = states, 
              RS = RS, 
              datsource = datsource,
              data_dsn = data_dsn,
              dbTabs = list(plot_layer=plot_layer),
              dbconn = dbconn,
              dbconnopen = TRUE,
              invtype = invtype, 
              evalid = evalid, 
              evalCur = evalCur, 
              evalEndyr = evalEndyr, 
              evalType = evalType,
              gui = gui),
  error = function(e) {
    message(e,"\n")
    return(NULL) })
if (is.null(evalInfo)) {
  iseval <- FALSE
}
if (is.null(evalInfo)) {
  message("no data to return")
  return(NULL)
}
states <- evalInfo$states
rslst <- evalInfo$rslst
evalidlist <- evalInfo$evalidlist
invtype <- evalInfo$invtype
invyrtab <- evalInfo$invyrtab
if (length(evalidlist) > 0) {
  invyrlst <- evalInfo$invyrs
  iseval <- TRUE
  savePOP <- TRUE
}
dbconn <- evalInfo$dbconn
SURVEY <- evalInfo$SURVEY
if (!is.null(SURVEY)) {
  surveynm <- "SURVEY"
  setkey(SURVEY, "CN")
}

POP_PLOT_STRATUM_ASSGN <- evalInfo$POP_PLOT_STRATUM_ASSGN
PLOT <- evalInfo$PLOT



####################################################################
## Check custom Evaluation data
####################################################################
if (!iseval) {
  evalchk <- customEvalchk(states = states, 
                           measCur = measCur, 
                           measEndyr = measEndyr, 
                           allyrs = allyrs, 
                           invyrs = invyrs, 
                           measyrs = measyrs,
                           invyrtab = invyrtab)
  if (is.null(evalchk)) {
    stop("must specify an evaluation timeframe for data extraction... \n", 
         "...see eval_opts parameter, (e.g., eval_opts=eval_options(Cur=TRUE))")
  }
  measCur <- evalchk$measCur
  measEndyr <- evalchk$measEndyr
  allyrs <- evalchk$allyrs
  invyrs <- evalchk$invyrs
  measyrs <- evalchk$measyrs
  invyrlst <- evalchk$invyrlst
  measyrlst <- evalchk$measyrlst
}





getpwithqry <- function(dbconn = NULL, popevalid = NULL, states = NULL, 
                        pjoinid, plotCur = FALSE, varCur = "MEASYEAR", 
                        Endyr = NULL, invyrs = NULL, measyears = NULL, 
                        SCHEMA.=NULL, invtype = "ANNUAL", Type = "VOL", 
                        subcycle99 = FALSE, intensity = NULL, popSURVEY = FALSE, 
                        plotnm = "plot", ppsanm = "pop_plot_stratum_assgn", 
                        pltassgnid = NULL, surveynm = "survey", pvars = NULL,
                        pltflds = NULL, ppsaflds = NULL, syntax = "sql",
                        dbconnopen = FALSE) {
  ## DESCRIPTION: gets from statement for database query
  ## syntax - ('sql', 'R')
  ## evalid - Integer. EVALID code defining FIA Evaluation
  ## plotCur - Logical. If TRUE, gets most current plot
  ## pjoinid - String. Name of variable in plot table to join
  ## varCur - String. Name of variable to use for most current plot
  ##            ('MEASYEAR', 'INVYR')
  ## Endyr - Integer. Year to determine most current measurement
  ## invyrs - Integer vector. Inventory years to query
  ## allyrs - Logical. All years in database
  ## SCHEMA. - Oracle schema
  ## subcycle99 - Logical. If TRUE, include plots with subcycle=99
  ## designcd1 - Logical. If TRUE, include only plots with DESIGNCD = 1
  ## intensity - Logical. If TRUE, include only plots with defined intensity values
  ## popSURVEY - Logical. If TRUE, include SURVEY table in query
  ## chk - Logical. If TRUE, check for variables 
  ## Type - Logical. Type of query ('All', 'Vol')
  ## syntax - String. SQL or R query syntax ('sql', 'R')
  ## plotnm - String. Name of plot table in database or as R object.
  ## ppsanm - String. Name of plot_pop_stratum_assgn table
  ## ppsaid - String. Name of unique id in ppsa
  ## surveynm - String. Name of survey table 
  ## PLOTdf - R object. Plot table if exists as R object

  getjoinqry <- function(joinid1, joinid2=NULL, alias1 = "p.", alias2 = "ppsa.") {
    ## DESCRIPTION - creates string of for a SQL query joining multiple ids
    
    if (is.null(joinid2)) {
      joinid2 <- joinid1
    }
    
    joinqry <- "ON ("
    for (i in 1:length(joinid1)) {
      joinqry <- paste0(joinqry, alias1, joinid1[i], " = ", alias2, joinid2[i])
      if (i == length(joinid1)) {
        joinqry <- paste0(joinqry, ")")
      } else {
        joinqry <- paste(joinqry, "AND ")
      }
    }
    return(joinqry)
  }
  
    
  ## set global variables
  pwhereqry <- NULL
  chkvalues <- TRUE
  
  ## Get inventory type
  anntype <- ifelse(invtype == "ANNUAL", "Y", "N")

  ## Define plot select variables
  if (is.null(pvars)) {
    selectpvars <- "p.*"
  } else {
    selectpvars <- toString(paste0("p.", unique(c(pjoinid, pvars))))
  }
  
  ###################################################################################
  ## GET pfromqry
  ###################################################################################
  if (!is.null(plotnm) && !is.null(ppsanm)) {
    joinqry <- getjoinqry(pjoinid, pltassgnid)
    pfromqry <- paste0("\nFROM ", SCHEMA., ppsanm, " ppsa \nJOIN ",
                       SCHEMA., plotnm, " p ", joinqry)
    pflds <- unique(c(ppsaflds, pltflds))
    pltassgnvars <- pltassgnid	
  } else {
    if (is.null(plotnm)) {
      pfromqry <- paste0("\nFROM ", SCHEMA., ppsanm, " ppsa")
      pflds <- ppsaflds
      pltassgnvars <- puniqueid	
    } else if (is.null(ppsanm)) {
      pfromqry <- paste0("\nFROM ", SCHEMA., plotnm, " p")
      pflds <- pltflds
      pltassgnvars <- puniqueid
    }
  }
  srv_cnnm <- findnm("SRV_CN", pltflds, returnNULL = TRUE)
  if (popSURVEY && !is.null(srv_cnnm)) {
    pfromqry <- paste0(pfromqry, 
                  "\nINNER JOIN ", SCHEMA., surveynm, " survey ",  
                  "ON (survey.CN = p.", srv_cnnm, " AND survey.ANN_INVENTORY = '", anntype, "')")
  }

  if (!is.null(ppsanm) && is.null(pltassgnid)) {
    pltassgnid <- pjoinid
  }
  
  ## Check pjoinid
  ## If pjoinid is NULL, set to pltassgnid
  if (!is.null(plotnm) && !is.null(ppsanm)) {
    pjoinidchk <- unlist(sapply(pjoinid, findnm, pltflds, returnNULL=TRUE))
    if (is.null(pjoinidchk)) {
      pjoinid <- pltassgnid
    } 
    pjoinidchk <- unlist(sapply(pjoinid, findnm, pltflds, returnNULL=TRUE))
    if (length(pjoinidchk) < length(pjoinid)) {
      pjoinmiss <- pjoinid[!pjoinid %in% pjoinidchk]
      message("pjoinid variables are missing from plt: ", toString(pjoinmiss))
      return(NULL)
    } else if (length(pjoinidchk) != length(pltassgnid)) {
      message("pjoinid must be same number of variables as pltassgnid")
      return(NULL)
    } else {
      pjoinid <- pjoinidchk
    }
  }
  
  ###################################################################################
  ## GET whereqry
  ###################################################################################
  if (!is.null(popevalid)) {
 
    ## Check popevalid pop filter in ppsa and plt
    #######################################################################
    evalidnm <- findnm("EVALID", pflds, returnNULL = TRUE)	  
    if (is.null(evalidnm)) {
      message("the EVALID field does not exist in plt/pltassgn data set\n",
              "   ...assuming all plots are in FIA Evaluation ", popevalid)
    } else {

      if (chkvalues) {
        ## Check popevalid values in database
        evalida. <- ifelse(evalidnm %in% ppsaflds, pltassgn., p.)	  
        evalidqry <- paste0("SELECT DISTINCT ", evalida., evalidnm, 
                          pltfromqry,
                          "\nORDER BY ", evalida., evalidnm)
        if (pltindb) {      
          evalidvals <- DBI::dbGetQuery(dbconn, evalidqry)[[1]]
        } else {
          evalidvals <- sqldf::sqldf(evalidqry)[[1]]
        }
        evalidmiss <- popevalid[!popevalid %in% evalidvals]
        if (any(!popevalid %in% evalidvals)) {
          message("evalids are missing: ", toString(popevalid[!popevalid %in% evalidvals]))
          return(NULL)
        }
      }
    
      ## Build where query to include popevalid popfilter 
      ewhereqry <- paste0(evalida., evalidnm, " IN(", toString(popevalid), ")")
      if (is.null(pwhereqry)) {
        pwhereqry <- paste0("\nWHERE ", ewhereqry)
      } else {
        pwhereqry <- paste0(pwhereqry, 
                          "\n  AND ", ewhereqry)
      }
    }
    
  } else {
    
    ## Check states
    if (!is.null(states)) {
      stcds <- pcheck.states(states, statereturn = "VALUE")
      statenm <- findnm("STATECD", pflds, returnNULL=TRUE)
      if (!is.null(statenm)) {
        statenm <- "STATECD"
      }
      stwhere.qry <- paste0("p.", statenm, " in(", toString(stcds), ")")
      if (is.null(pwhereqry)) {
        pwhereqry <- paste0("\nWHERE ", stwhere.qry)
      } else {
        pwhereqry <- paste0(pwhereqry, 
                               "\n  AND ", stwhere.qry)
      }
    }

    ## Add plot_status_cd to where statement
    if (any(Type == "All")) {
      pwhereqry <- pwhereqry
    } else {
      plotstatusnm <- findnm("PLOT_STATUS_CD", pflds, returnNULL=TRUE)
      if (is.null(plotstatusnm)) {
        message("PLOT_STATUS_CD not in data... assuming all sampled plots")
      } else {
        plotstatus.qry <- paste0("p.", plotstatusnm, " <> 3")
        if (syntax == 'R') plotstatus.qry <- gsub("<>", "!=", plotstatus.qry)
        if (is.null(pwhereqry)) {
          pwhereqry <- plotstatus.qry
        } else {
          pwhereqry <- paste0(pwhereqry, " AND ", plotstatus.qry)
        } 
      } 
    }
    
    ## Add subcycle to where statement
    if (!is.null(subcycle99) && !subcycle99) {
      subcyclenm <- findnm("SUBCYCLE", pflds, returnNULL=TRUE)
      if (is.null(subcyclenm)) {
        message("SUBCYCLE not in data... assuming all SUBCYCLE <> 99")
      } else {
        subcycle.filter <- paste0("p.", subcyclenm, " <> 99")
        if (syntax == 'R') subcycle.filter <- gsub("<>", "!=", subcycle.filter)
        if (is.null(pwhereqry)) {
          pwhereqry <- subcycle.filter
        } else {
          pwhereqry <- paste(paste(pwhereqry, subcycle.filter, sep=" AND "))
        }
      }
    }

    ## If Change Plots, remove plots that have no remeasurement data
    ######################################################################################
    if (popType %in% c("GRM", "CHNG", "LULC")) {
      rempernm <- findnm("REMPER", pflds, returnNULL = TRUE)
      if (is.null(rempernm)) {
        message("REMPER is not in dataset... assuming all remeasured plots")
      } else {
        
        ## Build where query to include remper NA removing
        rempera. <- ifelse(rempernm %in% ppsaflds, pltassgn., plt.)	  
        
        remper.filter <- paste0(rempera., rempernm, " > 0")
        if (is.null(pwhereqry)) {
          pwhereqry <- paste0("\nWHERE ", remper.filter)
        } else {
          pwhereqry <- paste0(pwhereqry, 
                               "\n AND ", remper.filter)
        }	
      }
    }
    
    ## Check designcd in ppsa and plt
    #######################################################################
    if (chkvalues) {
      designcdnm <- findnm("DESIGNCD", pflds, returnNULL = TRUE)
      if (is.null(designcdnm)) {
        message("DESIGNCD is not in dataset... assuming one plot design")
      } else {
        
        ## Check designcd values in database
        designcda. <- ifelse(designcdnm %in% ppsaflds, pltassgn., plt.)	  
        designcdqry <- paste0("SELECT DISTINCT ", designcda., designcdnm, 
                              pltfromqry,
                              pwhereqry,
                              "\nORDER BY ", designcda., designcdnm)
        if (pltindb) {      
          designcdvals <- DBI::dbGetQuery(dbconn, designcdqry)[[1]]
        } else {
          designcdvals <- sqldf::sqldf(designcdqry)[[1]]
        }
        
        if (length(designcdvals) > 1) {
          if (any(!designcdvals %in% c(1, 501:505, 230:242, 311:323, 328))) {
            if (adj == "samp") {
              message("designcds include: ", toString(designcdvals))
              message("samp adjustment for trees is only for annual inventory designs... see FIA database manual")
            } else {
              warning("more than 1 plot design, calculate separate estimates by design")
            }
          }
        }
      }
    }
  }
  
  ## Add intensity to where statement 
  ########################################################################
  if (!is.null(intensity)) { 	   
    intensitynm <- findnm("INTENSITY", pflds, returnNULL = TRUE)
    if (is.null(intensitynm)) {
      message("the INTENSITY field does not exist in data set...")
      return(NULL)
    }
    
    if (chkvalues) {
      ## Check intensity values in database
      intensitya. <- ifelse(intensitynm %in% ppsaflds, pltassgn., plt.)	  
      intensity.qry <- paste0("SELECT DISTINCT ", intensitya., intensitynm, 
                           pltfromqry,
                           pwhereqry,
                           "\nORDER BY ", intensitya., intensitynm)
      if (pltindb) {      
        intensityvals <- DBI::dbGetQuery(dbconn, intensity.qry)[[1]]
      } else {
        intensityvals <- sqldf::sqldf(intensityqry)[[1]]
      }
      intensitymiss <- intensity[!intensity %in% intensityvals]
      if (any(!intensity %in% intensityvals)) {
        message("intensity are missing: ", toString(intensity[!intensity %in% intensityvals]))
        return(NULL)
      }
    }
    
    ## Build where query to include invyr popfilter 
    iwhere.qry <- paste0(intensitya., intensitynm, " IN(", toString(intensity), ")")
    if (is.null(pwhereqry)) {
      pwhereqry <- paste0("\nWHERE ", iwhere.qry)
    } else {
      pwhereqry <- paste0(pwhereqry, 
                          "\n  AND ", iwhere.qry)
    }
  }

  ###################################################################################
  ## Get most current plots in database
  ###################################################################################
  if (plotCur) {
    ## Add an Endyr to where statement
    if (!is.null(Endyr)) {
      #if (!is.numeric(Endyr)) stop("Endyr must be numeric year")
      if (chkvalues) {
        yrlst.qry <- paste("SELECT DISTINCT", varCur, 
                           "\nFROM", plotnm, 
                           "\nORDER BY INVYR")
        pltyrs <- DBI::dbGetQuery(dbconn, yrlst.qry)
        
        if (Endyr <= min(pltyrs, na.rm=TRUE)) {
          message(Endyr, " is less than minimum year in dataset")
          return(NULL)
        }
      }
      Endyr.filter <- paste0("p.", varCur, " <= ", Endyr)
      if (is.null(pwhereqry)) {
        pwhereqry <- Endyr.filter
      } else {
        pwhereqry <- paste(paste(pwhereqry, Endyr.filter, sep=" AND "))
      }
    }
    
    ## Define group variables
    groupvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT")
    if (!is.null(pltflds)) {
      pgroupvars <- sapply(groupvars, findnm, pltflds, returnNULL = TRUE)
      if (any(is.null(pgroupvars))) {
        missvars <- pgroupvars[is.null(pgroupvars)]
        if (length(missvars) > 1 || missvars != "unitcd") {
          warning("dataset must include statecd, countycd, and plot")
        }
      } else {
        groupvars <- as.vector(pgroupvars)
      }
    }

    ## Define select variables
    #subpvars <- toString(paste0("p.", unique(c(groupvars, pvars))))
    selectpvars <- toString(paste0("p.", unique(c(puniqueid, pvars))))
    
    ## Create subquery
    subqry <- paste0("SELECT ", toString(paste0("p.", groupvars)), ", MAX(p.", varCur, ") MAXYR  ",
                     pfromqry)
    if (!is.null(pwhereqry) || pwhereqry != "") {
      subqry <- paste0(subqry, pwhereqry)
    }
    subqry <- paste0(subqry,
                  "\nGROUP BY ", toString(paste0("p.", groupvars)))
    
    ## Create select query
    subjoinqry <- getjoinqry(c(groupvars, "MEASYEAR"), c(groupvars, "MAXYR"), alias2 = "pp.")
    selectqry <- paste0(
      "SELECT ", selectpvars,
      "\nFROM ", SCHEMA., plotnm, " p", 
      "\nINNER JOIN ",
      "\n (", subqry, ") pp ", subjoinqry)
 
  } else if (!is.null(invyrs)) {
    
    if (chkvalues) {
      invyrlst.qry <- paste("SELECT DISTINCT invyr \nFROM", plotnm, "\nORDER BY invyr")
      pltyrs <- DBI::dbGetQuery(dbconn, invyrlst.qry)
      
      invyrs.miss <- invyrs[which(!invyrs %in% pltyrs)]
      message("invyrs not in dataset: ", paste(invyrs.miss, collapse=", "))
      if (length(invyrs.miss) == length(invyrs)) stop("")
      invyrs <- invyrs[!invyrs %in% invyrs.miss]
    }
    
    ## Create select query
    selectqry <- paste0("SELECT ", selectpvars,
                         pfromqry)	   
    
    ## Add invyrs to where statement 
    invyrnm <- findnm("INVYR", pltflds, returnNULL=TRUE)
    if (is.null(invyrnm)) {
      message("INVYR variable not in data")
    } else {
      invyr.filter <- paste0("p.", invyrnm, " IN(", toString(invyrs), ")")
      if (syntax == 'R') invyr.filter <- gsub("IN\\(", "%in% c\\(", invyr.filter)
      if (is.null(pwhereqry)) {
        pwhereqry <- invyr.filter
      } else {
        pwhereqry <- paste(paste(pwhereqry, invyr.filter, sep=" AND "))
      }
    }
    
    ## Add pwhereqry to selectqry
    if (!is.null(pwhereqry) || pwhereqry != "") {
      selectqry <- paste0(selectqry, pwhereqry, ")")
    }
    
  } else if (!is.null(measyears)) {
    
    if (chk) {
      measyrlst.qry <- paste("SELECT DISTINCT measyear FROM", plotnm, "ORDER BY measyear")
      pltyrs <- DBI::dbGetQuery(dbconn, measyrlst.qry)
      
      measyr.miss <- measyears[which(!measyears %in% pltyrs)]
      message("invyrs not in dataset: ", paste(invyrs.miss, collapse=", "))
      if (length(measyr.miss) == length(measyears)) stop("")
      measyears <- measyears[!measyears %in% measyr.miss]
    }
    
    ## Create select query
    selectqry <- paste0("SELECT ", selectpvars,
                        pfromqry)	   
    
    ## Add measyears to where statement 
    measyrnm <- findnm("MEASYEAR", pltflds, returnNULL=TRUE)
    if (is.null(measyrnm)) {
      message("MEASYEAR variable not in data")
    } else {
      measyr.filter <- paste0("p.", measyrnm, " IN(", toString(measyears), ")")
      if (syntax == 'R') measyr.filter <- gsub("IN\\(", "%in% c\\(", measyr.filter)
      if (is.null(pwhereqry)) {
        pwhereqry <- measyr.filter
      } else {
        pwhereqry <- paste(paste(pwhereqry, measyr.filter, sep=" AND "))
      }
    }
    
    ## Add pwhereqry to selectqry
    if (!is.null(pwhereqry) || pwhereqry != "") {
      selectqry <- paste0(selectqry, pwhereqry, ")")
    }
    
  } else {
    
    ## Create select query
    selectqry <- paste0("SELECT ", selectpvars,
                      pfromqry)
    
    ## Add pwhereqry to selectqry
    if (!is.null(pwhereqry) || pwhereqry != "") {
      selectqry <- paste0(selectqry, pwhereqry, ")")
    }	  
  }
  
  if (!is.null(dbconn) && !dbconnopen) {
    DBI::dbDisconnect(dbconn)
  }
  
  return(list(selectqry=selectqry, pfromqry=pfromqry, pwhereqry=pwhereqry, ewhereqry=ewhereqry))
}