R/DBgetXY.R

#' Database - Extracts plot coordinates.
#' 
#' Extracts public plot coordinates for an FIA evaluation or a custom 
#' evaluation. Plots are extracted from FIA's public Datamart 
#' (https://apps.fs.usda.gov/fia/datamart/datamart.html) or other defined
#' datasource. 
#' 
#' 
#' @param states String or numeric vector. Name (e.g., 'Arizona','New Mexico')
#' or code (e.g., 4, 35) of state(s) for evalid. If all states in one or more
#' FIA Research Station is desired, set states=NULL and use RS argument to
#' define RS.
#' @param RS String vector. Name of research station(s) to get public XY
#' coordinates for ('RMRS','SRS','NCRS','NERS','PNWRS'). Do not use if states 
#' is populated. See FIESTA::ref_statecd for reference to RS and states.
#' @param xy_datsource Source of XY data ('datamart', 'sqlite', 'obj', 'csv').
#' @param xy_dsn If datsource='sqlite', the file name (data source name) of
#' the sqlite database (*.db) where XY data reside.
#' @param xy sf R object or String. If xy_dsn = 'datamart', name of xy table 
#' in FIA DataMart. If xy_dsn = 'sqlite', name of xy layer in database. If 
#' datsource = 'csv', full pathname of xy CSV file(s). If datsource = 'obj', 
#' name of xy R object. If datsource = 'shp', full pathname of shapefile.
#' @param xy_opts List of xy data options for xy (e.g., xy_opts = list(xvar='LON', 
#' yvar='LAT'). See xy_options() for more options and defaults.
#' @param datsource String. Source of FIA data for defining FIA evaluations or 
#' appending variables ('datamart', 'sqlite', 'obj', 'csv'). If datsource = NULL, 
#' datsource = xy_datsource. If datsource = 'datamart', data are downloaded
#' extracted from FIA DataMart (http://apps.fs.usda.gov/fia/datamart/datamart.html). 
#' If datsource='sqlite', specify database name(s) in data_dsn and table name(s) 
#' in dbTabs() argument. If datsource = ('obj','csv'), specify *.csv file name in 
#' dbTabs argument.
#' @param data_dsn String. Name of database with plot_layer and/or ppsa_layer.
#' @param dbTabs String or R Object. If data_dsn = 'datamart', name of table(s) 
#' in FIA DataMart. If data_dsn = 'sqlite', name of layer(s) in database. If 
#' datsource = 'csv', name of CSV file(s). If datsource = 'obj', name of R object.
#' @param pjoinid String. Variable in plot table to join to XY data, if 
#' plot_layer is not NULL. Not necessary to be unique. If using most current 
#' XY coordinates, use identifier for a plot (e.g., PLOT_ID).
#' @param eval String. Type of evaluation time frame for data extraction 
#' ('FIA', 'custom'). See eval_opts for more further options. 
#' @param eval_opts List of evaluation options for 'FIA' or 'custom'
#' evaluations to determine the set of data returned. See help(eval_options)
#' for a list of options.
#' @param invtype String. Type of FIA inventory to extract ('PERIODIC',
#' 'ANNUAL').  Only one inventory type (PERIODIC/ANNUAL) at a time.
#' @param coordType String. c('PUBLIC', 'ACTUAL'). Defines type of coordinates and is
#' used for the output name.
#' @param intensity1 Logical. If TRUE, includes only XY coordinates where 
#' INTENSITY = 1 (FIA base grid).
#' @param pvars2keep String vector. One or more variables in plot_layer to append 
#' to output.
#' @param issp Logical. If TRUE, returns spatial XY data as a list object with
#' query.
#' @param returndata Logical. If TRUE, returns XY data as a list object with
#' query.
#' @param savedata Logical. If TRUE, saves XY data. Specify outfolder and 
#' format using savedata_opts. 
#' @param exportsp Logical. If TRUE, exports data as spatial. 
#' @param savedata_opts List. See help(savedata_options()) for a list
#' of options. Only used when savedata = TRUE or exportsp = TRUE.
#' @param SURVEY Data frame. The name of the SURVEY data frame object
#' if it has been already downloaded and stored in environment.
#' @param POP_PLOT_STRATUM_ASSGN Data frame. The name of the 
#' PLOT data frame object if it is already downloaded and stored in
#' environment. 
#' @param PLOT Data frame. The name of the PLOT data frame object if 
#' it is already downloaded and stored in environment. 
#' @param POP_PLOT_STRATUM_ASSGN Data frame. The name of the 
#' POP_PLOT_STRATUM_ASSGN data frame object if it is already downloaded 
#' and stored in environment. 
#' @param dbconnopen Logical. If TRUE, the dbconn connection is not closed. 
#' @param evalInfo List. List object output from DBgetEvalid or DBgetXY 
#' FIESTA functions. 
#'
#' @return if returndata=TRUE, a list of the following objects: 
#' \item{xy}{ Data frame. XY data from database. The output name is based on
#' coordType parameter (e.g., xy_PUBLIC). the data frame include xy.uniqueid,
#' xvar, yvar and appended plot variables in pvars2keep if plot_layer is not 
#' NULL. The default plot variables included are 'STATECD','UNITCD','COUNTYCD',
#' 'PLOT','PLOT_ID' (ID+STATECD+UNTCD+COUNTYCD+PLOT), 'COUNTYFIPS'. 
#' If issp=TRUE, returns an sf object. }
#' \item{xyqry}{ String. Query to extract coordinates. }
#' \item{xvar}{ String. Name of X variable in xy*. }
#' \item{yvar}{ String. Name of Y variable in xy*. }
#' 
#' If savedata=TRUE, outputs the xy* based on savedata_opts. 
#' If exportsp=TRUE, the output xy saved as spatial layer based on savedata_opts.
#' @note
#' 
#' If no parameters are included, the user is prompted for input. If partial
#' parameters, the default parameter values are used for those not specified.
#' 
#' @author Tracey S. Frescino
#' @keywords data
#' @examples
#' \dontrun{
#' # Most current evaluation and shapefile with public coordinates
#' COxylst <- DBgetXY(states = "Colorado",
#'                    eval = "FIA",
#'                    eval_opts=eval_options(Endyr = 2019))
#' names(COxylst)
#' 
#' head(COxylst$xy_PUBLIC)
#' COxylst$xyqry
#' }
#' @export DBgetXY
DBgetXY <- function (states = NULL, 
                     RS = NULL, 
                     xy_datsource, 
                     xy_dsn = NULL, 
                     xy = "PLOT", 
                     xy_opts = xy_options(),
                     datsource = NULL,
                     data_dsn = NULL, 
                     dbTabs = dbTables(),
                     pjoinid = "CN", 
                     eval = "FIA",
                     eval_opts = eval_options(),
                     invtype = "ANNUAL", 
                     coordType = "PUBLIC",
                     intensity1 = FALSE, 
                     pvars2keep = NULL,
                     issp = FALSE, 
                     returndata = TRUE, 
                     savedata = FALSE, 
                     exportsp = FALSE,
                     savedata_opts = NULL,
                     PLOT = NULL,
                     POP_PLOT_STRATUM_ASSGN = NULL,
                     SURVEY = NULL,
                     dbconnopen = FALSE,
                     evalInfo = NULL
                     ) {

  ## DESCRIPTION: Get the most current coordinates in the FIA database
  
  gui <- FALSE
  istree=isseed=isveg=ischng=isdwm <- FALSE
  if (gui) {
    intensity1=savedata=parameters=out_fmt=overwrite <- NULL
  }
    
  
  ## Set global variables
  parameters <- FALSE
  SCHEMA.=invyrtab=evalEndyr=plotnm=ppsanm=ppsanm=pltflds=ppsaflds=pvars=
  dbconn=XYdf <- NULL


  ##################################################################
  ## CHECK INPUT PARAMETERS
  ##################################################################

  ## Check arguments
  input.params <- names(as.list(match.call()))[-1]
  if (!all(input.params %in% c(names(formals(DBgetXY)), "istree", "isseed", "isveg"))) {
    miss <- input.params[!input.params %in% formals(DBgetXY)]
    stop("invalid parameter: ", toString(miss))
  } 
 
  ## Check parameter lists
  pcheck.params(input.params, savedata_opts=savedata_opts, eval_opts=eval_opts,
				xy_opts=xy_opts)


  ## Set eval_options defaults
  eval_defaults_list <- formals(eval_options)[-length(formals(eval_options))] 
  for (i in 1:length(eval_defaults_list)) {
    assign(names(eval_defaults_list)[[i]], eval_defaults_list[[i]])
  } 
 
  ## Set user-supplied eval_opts values
  if (length(eval_opts) > 0) {
    for (i in 1:length(eval_opts)) {
      if (names(eval_opts)[[i]] %in% names(eval_defaults_list)) {
        assign(names(eval_opts)[[i]], eval_opts[[i]])
      } else {
        stop(paste("Invalid parameter: ", names(eval_opts)[[i]]))
      }
    }
  } else {
    message("no evaluation timeframe specified...")
    message("see eval and eval_opts parameters (e.g., eval='custom', eval_opts=eval_options(Cur=TRUE))\n")
    stop()
  }

  ## Set xy_options defaults
  xy_defaults_list <- formals(xy_options)[-length(formals(xy_options))]
  for (i in 1:length(xy_defaults_list)) {
    assign(names(xy_defaults_list)[[i]], xy_defaults_list[[i]])
  }
  ## Set user-supplied xy_opts values
  if (length(xy_opts) > 0) {
    for (i in 1:length(xy_opts)) {
      if (names(xy_opts)[[i]] %in% names(xy_defaults_list)) {
        assign(names(xy_opts)[[i]], xy_opts[[i]])
      } else {
        stop(paste("Invalid parameter: ", names(xy_opts)[[i]]))
      }
    }
  } 

  ## Set dbTables defaults
  dbTables_defaults_list <- formals(dbTables)[-length(formals(dbTables))]
  for (i in 1:length(dbTables_defaults_list)) {
    assign(names(dbTables_defaults_list)[[i]], dbTables_defaults_list[[i]])
  }
  ## Set user-supplied dbTables values
  if (length(dbTabs) > 0) {
    for (i in 1:length(dbTabs)) {
      if (names(dbTabs)[[i]] %in% names(dbTables_defaults_list)) {
        assign(names(dbTabs)[[i]], dbTabs[[i]])
      } else {
        stop(paste("Invalid parameter: ", names(dbTabs)[[i]]))
      }
    }
  }

  ## Set savedata defaults
  savedata_defaults_list <- formals(savedata_options)[-length(formals(savedata_options))]
  for (i in 1:length(savedata_defaults_list)) {
    assign(names(savedata_defaults_list)[[i]], savedata_defaults_list[[i]])
  } 
  ## Set user-supplied savedata values
  if (length(savedata_opts) > 0) {
    if (!savedata) {
      message("savedata=FALSE with savedata parameters... no data are saved")
    }
    for (i in 1:length(savedata_opts)) {
      if (names(savedata_opts)[[i]] %in% names(savedata_defaults_list)) {
        assign(names(savedata_opts)[[i]], savedata_opts[[i]])
      } else {
        stop(paste("Invalid parameter: ", names(savedata_opts)[[i]]))
      }
    }
  }

  ########################################################################
  ### GET PARAMETER INPUTS 
  ########################################################################
  iseval <- FALSE

  ## Get state abbreviations and codes 
  ###########################################################
  stabbrlst <- pcheck.states(states, statereturn="ABBR")
  stcdlst <- pcheck.states(states, statereturn="VALUE")

  ## Get number of states 
  nbrstates <- length(states)

  ## Check invtype
  invtypelst <- c('ANNUAL', 'PERIODIC')
  invtype <- pcheck.varchar(invtype, varnm="invtype", checklst=invtypelst,
		caption="Inventory Type", gui=gui)

  ## Check intensity1
  ####################################################################
  intensity1 <- pcheck.logical(intensity1, varnm="intensity1", 
		               title="Single intensity?", first="YES", gui=gui)
                   intensity <- NULL
  if (intensity1) {
	  intensity <- 1
  }

  ###########################################################################
  ## Check XY database 
  ###########################################################################
  xy_datsourcelst <- c("datamart", "sqlite", "csv", "obj")
  xy_datsource <- pcheck.varchar(var2check=xy_datsource, varnm="xy_datsource", 
		gui=gui, checklst=xy_datsourcelst, caption="XY data source?")

  if (xy_datsource == "sqlite" && !is.null(xy_dsn)) {
    xyconn <- DBtestSQLite(xy_dsn, dbconnopen=TRUE, showlist=FALSE)
    xytablst <- DBI::dbListTables(xyconn)
    if (length(xytablst) == 0) {
      stop("no data in ", xy_datsource)
    }
	  xyindb=plotindb=ppsaindb <- FALSE
  }

  ## Check xy database
  ####################################################################
  if (all(list(class(xy), class(plot_layer)) == "character") && 
		(is.null(datsource) || xy_datsource == datsource)) {
    xyisplot <- ifelse (identical(tolower(xy), tolower(plot_layer)), TRUE, FALSE)
  } else if (!identical(xy_datsource, datsource)) {
    xyisplot <- FALSE
  } else if (xy_datsource == "datamart" && datsource == "datamart") {
    xyisplot <- TRUE
  } else {
    xyisplot <- ifelse (identical(xy, plot_layer), TRUE, FALSE)
  }

  ###########################################################################
  ## Check plot database (if xyisplot = FALSE)
  ###########################################################################
  if (xyisplot) {
    datsource <- xy_datsource
    data_dsn <- xy_dsn
  } else {
    if (is.null(datsource)) {
      datsource <- xy_datsource
      data_dsn <- xy_dsn
    } else if (!identical(xy_datsource, datsource) || !identical(xy_dsn, data_dsn)) {
      ## Check database connection - data_dsn
      ########################################################
      datsourcelst <- c("datamart", "sqlite", "csv", "obj", "shp")
      datsource <- pcheck.varchar(var2check=datsource, varnm="datsource", 
		       gui=gui, checklst=datsourcelst, caption="Plot data source?",
           stopifnull=TRUE, stopifinvalid=TRUE)
    } else {
      datsource <- xy_datsource
      data_dsn <- xy_dsn
    }
  }

  if (datsource == "sqlite" && !is.null(data_dsn)) {
    if (!is.null(xy_dsn) && data_dsn == xy_dsn) {
      dbconn <- DBtestSQLite(data_dsn, dbconnopen=TRUE, showlist=FALSE)
    } else {
      dbconn <- DBtestSQLite(data_dsn, dbconnopen=TRUE, showlist=FALSE)
    }
    dbtablst <- DBI::dbListTables(dbconn)
    if (length(dbtablst) == 0) {
      message("no data in ", datsource)
	  return(NULL)
    }
  }
  
  if (datsource == "sqlite" && is.null(data_dsn)) {
    message("datsource=", datsource, " but data_dsn=NULL... returning NULL")
	  return(NULL)
  }

  ## Check eval
  ####################################################################
  evallst <- c('FIA', 'custom')
  eval <- pcheck.varchar(eval, varnm="eval", checklst=evallst, 
		caption="Evaluation Type", gui=gui)

  ## Check coordType
  ####################################################################
  coordTypelst <- c("PUBLIC", "ACTUAL")
  coordType <- pcheck.varchar(var2check=coordType, varnm="coordType", 
		gui=gui, checklst=coordTypelst, caption="Coordinate Type?")


  ## Check savedata
  ####################################################################
  savedata <- pcheck.logical(savedata, varnm="savedata", 
		title="Save data to outfolder?", first="YES", gui=gui)

  ## Check exportsp
  ####################################################################
  exportsp <- pcheck.logical(exportsp, varnm="exportsp", 
		title="Export spatial?", first="YES", gui=gui)
  if (exportsp) {
    issp <- TRUE
  }

  ## Check outfolder, outfn.date, overwrite_dsn
  ####################################################################
  if (savedata) {
    outlst <- pcheck.output(outfolder = outfolder, 
                            out_dsn = out_dsn,
                            out_fmt = out_fmt,
                            outfn.pre = outfn.pre, 
                            outfn.date = outfn.date, 
                            overwrite_dsn = overwrite_dsn, 
                            overwrite_layer = overwrite_layer,
                            add_layer = add_layer, 
                            append_layer = append_layer, 
                            gui = gui)
    outfolder <- outlst$outfolder
    out_dsn <- outlst$out_dsn
    out_fmt <- outlst$out_fmt
    overwrite_layer <- outlst$overwrite_layer
    append_layer <- outlst$append_layer
    outfn.date <- outlst$outfn.date
    outfn.pre <- outlst$outfn.pre

    if (is.null(out_layer)) {
      out_layer <- "spxy"
    }
  } 

  ## GETS DATA TABLES (OTHER THAN PLOT/CONDITION) IF NULL
  ###########################################################
  if (gui) {
    Typelst <- c("ALL", "CURR", "VOL", "P2VEG", "DWM", "INV", "GROW", "MORT", "REMV", "GRM")
    Type <- select.list(Typelst, title="eval type", 
		preselect="VOL", multiple=TRUE)
    if (length(Type)==0) Type <- "VOL"
  } 

  if (any(Type == "P2VEG")) {
    # understory vegetation tables 
    # (P2VEG_SUBPLOT_SPP, P2VEG_SUBP_STRUCTURE, INVASIVE_SUBPLOT_SPP)
    isveg=issubp <- TRUE
  } 
  if (any(Type == "DWM")) {
    # summarized condition-level down woody debris table (COND_DWM_CALC)
    isdwm <- TRUE
  }
  if (any(Type == "CHNG")) {
    # current and previous conditions, subplot-level - sccm (SUBP_COND_CHNG_MTRX) 
    ischng=issubp <- TRUE
  }
  if (any(Type == "GRM")) {
    ischng=issubp=isgrm <- TRUE
  }
  if (isveg && invtype == "PERIODIC") {
    message("understory vegetation data only available for annual data\n")
    isveg <- FALSE
  } 

  if (isveg && invtype == "PERIODIC") {
    message("understory vegetation data only available for annual data\n")
    isveg <- FALSE
  } 

  ########################################################################
  ### DBgetEvalid()
  ########################################################################

  ## Get DBgetEvalid parameters from eval_opts
  ####################################################################
  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
  ##########################################################
  if (!is.null(evalInfo)) {
    list.items <- c("states", "invtype")
    evalInfo <- pcheck.object(evalInfo, "evalInfo", list.items=list.items)

  } else {
    evalInfo <- tryCatch(
				DBgetEvalid(states = states, 
                    RS = RS, 
                    datsource = datsource,
                    data_dsn = data_dsn,
                    dbTabs = dbTabs,
                    dbconn = dbconn,
                    dbconnopen = TRUE,
                    invtype = invtype, 
                    evalid = evalid, 
                    evalCur = evalCur, 
                    evalEndyr = evalEndyr, 
                    evalAll = evalAll,
                    evalType = Type,
						        returnPOP = TRUE,
                    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
  surveynm <- evalInfo$surveynm
  SURVEY <- evalInfo$SURVEY
  ppsanm <- evalInfo$ppsanm
  POP_PLOT_STRATUM_ASSGN <- evalInfo$POP_PLOT_STRATUM_ASSGN
  PLOT <- evalInfo$PLOT
  plotnm <- evalInfo$plotnm
  

  ####################################################################
  ## 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
  }

  ## Define variables
  ###########################################################
  XYvarlst <- unique(c(xy.uniqueid, xyjoinid, xvar, yvar))
  if (any(XYvarlst %in% "")) {
    XYempty <- XYvarlst[XYvarlst %in% ""] 
    XYvarlst <- XYvarlst[!XYvarlst %in% XYempty]
  }
  pvars2keep <- unique(c("STATECD", "UNITCD", "COUNTYCD", "PLOT", 
					pvars2keep))

  if (!iseval) {
    pvars2keep <- unique(pvars2keep, "SRV_CN")
  }    

  if (!is.null(measyrs) || measCur) {
    XYvarlst <- unique(c(XYvarlst, "MEASYEAR", "PLOT_STATUS_CD", "INVYR")) 
  }
  if (!is.null(invyrs)) {
    XYvarlst <- unique(c(XYvarlst, "INVYR")) 
  }
  if (intensity1) {
    XYvarlst <- unique(c(XYvarlst, "INTENSITY")) 
  }

  ####################################################################
  ## Check xy table
  ####################################################################
  if (xy_datsource == "datamart") {
  
    ## Check pop_plot_stratum_assgn
    if (iseval) {
      if (is.null(POP_PLOT_STRATUM_ASSGN) || !is.data.frame(POP_PLOT_STRATUM_ASSGN)) {
        POP_PLOT_STRATUM_ASSGN <- tryCatch( DBgetCSV("POP_PLOT_STRATUM_ASSGN", 
                             stabbrlst,
                             returnDT = TRUE, 
                             stopifnull = FALSE),
			            error = function(e) {
                  message(e, "\n")
                  return(NULL) }) 
      }				  
    }
	  if (!is.null(POP_PLOT_STRATUM_ASSGN)) {
	    ppsanm <- "POP_PLOT_STRATUM_ASSGN"
	  }
	
    ## Check xy
    XYdf <- pcheck.table(xy, stopifnull=FALSE)
    if (is.null(XYdf)) {
      if (is.character(xy) && exists(xy) && !is.null(get(xy))) {
        XYdf <- get(xy)
      } else { 
        XYdf <- tryCatch( 
            DBgetCSV(xy, 
                     stabbrlst,
                     returnDT = TRUE, 
                     stopifnull = FALSE),
			          error = function(e) {
                  message(e, "\n")
                  return(NULL) })
      }
    } 
    if (!is.null(XYdf)) {
      xynm <- "XYdf"
      xyflds <- names(XYdf)
    }
  } else if (xy_datsource == "sqlite") {

    if (!is.character(xy)) {
      message("invalid xy")
	    return(NULL)
    }
    ## Check pop_plot_stratum_assgn
  	if (iseval) {
	    if (!is.null(POP_PLOT_STRATUM_ASSGN) && is.data.frame(POP_PLOT_STRATUM_ASSGN)) {
	      ppsanm <- "POP_PLOT_STRATUM_ASSGN"
	    } else if (is.null(POP_PLOT_STRATUM_ASSGN) || !is.character(POP_PLOT_STRATUM_ASSGN)) {
	      ppsanm <- chkdbtab(xytablst, "POP_PLOT_STRATUM_ASSGN", stopifnull=FALSE)
		    if (!is.null(ppsanm)) {
		      ppsaindb <- TRUE
		      ppsaflds <- DBI::dbListFields(xyconn, ppsanm)
		    }
      } else if (is.character(POP_PLOT_STRATUM_ASSGN)) {
	      ppsanm <- POP_PLOT_STRATUM_ASSGN
	    } 	    
	  }
    xynm <- chkdbtab(xytablst, xy, stopifnull=FALSE)
    if (!is.null(xynm)) {
      xyflds <- DBI::dbListFields(xyconn, xynm)
    } else {
      stop(xy, " does not exist in database\n ", toString(xytablst))
    }
	  xyindb <- TRUE
	
  } else {
    if (iseval && is.null(POP_PLOT_STRATUM_ASSGN)) {
	    ppsanm <- dbTables$ppsa_layer
      ppsaqry <- paste0("SELECT * FROM ", ppsanm, " WHERE evalid IN(",
               toString(unlist(evalidlist)), ")")
			
      POP_PLOT_STRATUM_ASSGN <- tryCatch( DBI::dbGetQuery(dbconn, ppsaqry),
			error = function(e) {
                  message(e, "\n")
                  return(NULL) })
      ppsanm <- "POP_PLOT_STRATUM_ASSGN"
	  }

    XYdf <- pcheck.table(xy, stopifnull=TRUE, stopifinvalid=TRUE)
    xynm <- "XYdf"
    names(XYdf) <- toupper(names(XYdf))
    xyflds <- names(XYdf)
  }

  ## Check xy.uniqueid
  xy.uniqueid <- pcheck.varchar(var2check=xy.uniqueid, varnm="xy.uniqueid", 
		gui=gui, checklst=xyflds, caption="UniqueID variable in xy",
		warn=paste(xy.uniqueid, "not in xy table"), stopifnull=TRUE)

  ## Check xyjoinid
  xyjoinid <- pcheck.varchar(var2check=xyjoinid, varnm="xyjoinid", 
		              gui=gui, checklst=xyflds, caption="Join variable in xy",
		              stopifnull=FALSE)
  if (is.null(xyjoinid)) {
    xyjoinid <- xy.uniqueid
  }

  ## Check XYdf variables
  ####################################################################
  xyvars <- unique(c(XYvarlst, pvars2keep))
  if (!all(xyvars %in% xyflds)) {
    xypmiss <- xyvars[!xyvars %in% xyflds]
    if (length(xypmiss) > 0) {
      pvars2keep <- xypmiss
    } else {
      pvars2keep <- NULL
    }
    xyvars <- xyvars[!xyvars %in% xypmiss]
  } else {
    pvars2keep <- NULL
  }

  ####################################################################
  ## Check plot table
  ####################################################################
  if (xyisplot || is.null(pvars2keep)) {
    
    ## Check plot table
    if (is.null(xynm) || !is.null(pvars2keep)) {
      if (datsource == "datamart") {
        PLOT <- tryCatch( DBgetCSV("PLOT", 
                                   stabbrlst,
                                   returnDT = TRUE, 
                                   stopifnull = FALSE),
                          error = function(e) {
                            message(e, "\n")
                            return(NULL) })
        if (!is.null(PLOT)) {
          plotnm=xynm <- "PLOT"
          pltflds=xyflds <- names(PLOT)
        }
      } else if (datsource == "sqlite") {
        ## If XY and plot data are from the same databases, 
        ## we will query both
        if (!plotindb) {
          plotnm <- chkdbtab(dbtablst, plot_layer, stopifnull=FALSE)
        }
        if (!is.null(plotnm)) {
          xyindb <- TRUE	 
          xynm <- plotnm
          pltflds=xyflds <- DBI::dbListFields(dbconn, xynm)     
        }
      } else {
        if (!is.null(plotnm)) {
          PLOT <- pcheck.table(plot_layer, stopifnull=TRUE, stopifinvalid=TRUE)
          plotnm=xynm <- "PLOT"
        }
        names(PLOT) <- toupper(names(PLOT))
        pltflds=xyflds <- names(PLOT)
      }
    } else {
      plotnm <- xynm
      pltflds <- xyflds
    }
  
    ## check pjoinid
    pjoinid <- findnm(pjoinid, xyflds, returnNULL=TRUE)
    if (is.null(pjoinid)) {
      pjoinid <- findnm(xyjoinid, xyflds, returnNULL=TRUE)
      if (is.null(pjoinid)) {
        if (xyjoinid == "PLT_CN" && "CN" %in% pltflds) {
          pjoinid <- "CN"
        } else {
          stop("pjoinid is invalid")
        }
      }
    }

    if (!is.null(pvars2keep)) {
      pmiss <- pvars2keep[!pvars2keep %in% xyflds]
      if (any(pmiss %in% XYvarlst)) {
        xymiss <- pmiss[pmiss %in% XYvarlst]
        if (length(xymiss) > 0) {
          if (all(c("LON", "LAT") %in% xymiss) && all(c("LON_PUBLIC", "LAT_PUBLIC") %in% xyflds)) {
            xyvars <- c(xyvars[!xyvars %in% c("LON", "LAT")], "LON_PUBLIC", "LAT_PUBLIC")
            xymiss <- xymiss[!xymiss %in% c("LON", "LAT")]
            xvar <- "LON_PUBLIC"
            yvar <- "LAT_PUBLIC"
          }
          if (length(xymiss) > 0) {
            stop("missing essential variables: ", toString(xymiss))
          }
        } else {
          message("missing plot variables: ", toString(pmiss))
        }
      }
	  }

	  ## Define xyfromqry
	  xyfromqry <- paste0("\nFROM ", SCHEMA., xynm, " xy")

	  ## Define xyfromqry2
	  if (measCur) {
	    groupvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT")
	    groupvars <- sapply(groupvars, findnm, xyvars, returnNULL = TRUE)
	    if (any(is.null(groupvars))) {
	      missvars <- groupvars[is.null(groupvars)]
        if (length(missvars) > 1 || missvars != "unitcd") {
		      stop("dataset must include statecd, countycd, and plot")		  
        }
	    } else {
	      groupvars <- as.vector(groupvars)
	    }
	    groupvars <- groupvars[groupvars %in% xyvars]
	
	    xyfromqry2 <- paste0("\nINNER JOIN maxyear ON (")
	    for (i in 1:length(groupvars)) {
	      gvar <- groupvars[i]
	      xyfromqry2 <- paste0(xyfromqry2, "xy.", gvar, " = maxyear.", gvar)	   
	      if (i < length(groupvars)) {
	        xyfromqry2 <- paste0(xyfromqry2, " and ")
	      }
	    }
	    xyfromqry2 <- paste0(xyfromqry2, " and xy.", varCur, " = maxyear.maxyr)")
	  
	  } else {
	    xyfromqry2 <- paste0("\nINNER JOIN p ON (xy.", xyjoinid, " = p.", pjoinid, ")")
	  }
	
#	  xyfromqry <- paste0("\nFROM ", SCHEMA., xynm, " xy",
#                  "\nINNER JOIN p ON(xy.", pjoinid, " = p.", pjoinid, ")")	

    xyfromqry <- paste0(xyfromqry, xyfromqry2)
    xyqry <- paste0("SELECT ", toString(paste0("xy.", xyvars)), 
                  xyfromqry)
    
  } else if (!xyisplot && !is.null(pvars2keep)) {    

    ## Check plot table
    ########################################################
    if (datsource == "datamart") {
	    ## If XY is from database and plot data are from datamart, 
	    ## we will extract xy data by state first
      if (xy_datsource == "sqlite") {
        statenm <- findnm("STATECD", xyflds, returnNULL=TRUE)
        if (is.null(statenm)) {
          stop("must include STATECD in xy dataset")
        } else {
          xy.qry <- paste("SELECT DISTINCT", toString(xyvars), 
                          "\nFROM", xy, 
				                  "\nWHERE statecd in(", toString(stcdlst), ")")
          XYdf <- DBI::dbGetQuery(xyconn, xy.qry)
          xynm <- "XYdf"
          xy_datsource <- "datamart"
        }
      }
      if (is.null(PLOT)) {
        PLOT <- tryCatch( DBgetCSV("PLOT", 
                             stabbrlst,
                             returnDT = TRUE, 
                             stopifnull = FALSE),
			          error = function(e) {
                  message(e, "\n")
                  return(NULL) })
      }
      if (!is.null(PLOT)) {
        plotnm <- "PLOT"
        pltflds <- names(PLOT)
      }
	  
    } else if (datsource == "sqlite") {

	    ## If XY and plot data are from the same databases, 
	    ## we will query both
	    if (xy_datsource == "sqlite" && all.equal(dbconn, xyconn)) {
	      if (!plotindb) {
          plotnm <- chkdbtab(dbtablst, plot_layer, stopifnull=FALSE)
	      }
        if (!is.null(plotnm)) {
          plotindb <- TRUE	  
          pltflds <- DBI::dbListFields(dbconn, plotnm)     
	  
	        ## Check for indices
          if (evalCur || measCur) {  	  
            chk <- checkidx(dbconn, plotnm, c("STATECD", "UNITCD", "COUNTYCD", "PLOT"))
            if (is.null(chk)) {
              message("to speed query... add an index to the plot table")
              message("createidx(dbconn, '", plotnm, 
                 "', c('STATECD', 'UNITCD', 'COUNTYCD', 'PLOT'))")
	          }
          }
        }
      } else {

	      ## If XY and plot data are from different databases, 
		    ## extract both first by state before querying
		    if (!is.null(plotnm)) {
          plot.qry <- paste0("SELECT DISTINCT ", toString(unique(c(pjoinid, pvars2keep))), 
		                         "\nFROM ", plotnm, 
				                     "\nWHERE statecd IN (", toString(stcdlst), ")")
          PLOT <- tryCatch( DBI::dbGetQuery(dbconn, plot.qry),
                            error = function(e) {
                              message(e, "\n")
                              return(NULL) })
          if (is.null(PLOT)) {
            message("invalid query: \n", plot.qry)
            stop()
          }
          PLOT <- setDT(PLOT)
          plotnm <- "PLOT"
		      pltflds <- names(PLOT)
		      datsource <- xy_datsource
		      plotindb <- FALSE
        }
          
        if (datsource == "sqlite") {
          xy.qry <- paste0("SELECT ", toString(xyvars), 
		                     "\nFROM ", xy, 
				                 "\nWHERE statecd IN (", toString(stcdlst), ")")
          XYdf <- tryCatch( DBI::dbGetQuery(xyconn, xy.qry),
                            error = function(e) {
                              message(e, "\n")
                              return(NULL) })
          if (is.null(XYdf)) {
            message("invalid query: \n", xy.qry)
            stop()
          }
          XYdf <- setDT(XYdf)
	      } else {
	        xynm <- "XYdf"
	      }
	    }
    } else {
	    if (!is.null(plotnm)) {
        PLOT <- pcheck.table(plot_layer, stopifnull=TRUE, stopifinvalid=TRUE)
        plotnm <- "PLOT"
	    }
      names(PLOT) <- toupper(names(PLOT))
      pltflds <- names(PLOT)
    }

    ## Check plot variables
    ########################################################	
    if (!all(pvars2keep %in% pltflds)) {
      pmiss <- pvars2keep[!pvars2keep %in% pltflds]
	  
      if (any(pmiss %in% XYvarlst)) {
        xymiss <- pmiss[pmiss %in% XYvarlst]
        if (length(xymiss) > 0) {
          stop("missing essential variables: ", toString(xymiss))
        } else {
          warning("missing plot variables: ", toString(pmiss))
        }
        if (length(pmiss) < length(pvars2keep)) {
          pvars <- pvars2keep[!pvars2keep %in% pmiss]
        }
      } else {

	      message("missing variable: ", toString(pmiss))
		    pvars <- pvars2keep[!pvars2keep %in% pmiss] 
	    }
    } else {
      pvars <- pvars2keep
    }

    if (!is.null(plotnm) && length(pvars) > 0) {
	
      ## Check xyjoinid
      xyjoinid <- findnm(xyjoinid, xyflds, returnNULL=TRUE)
      if (is.null(xyjoinid)) {
        message("xyjoinid is NULL... using ", xy.uniqueid, " to join to plot table")
        xyjoinid <- xy.uniqueid
      }

      ## Check pjoinid
      pjoinid <- findnm(pjoinid, pltflds, returnNULL=TRUE)
      if (is.null(pjoinid)) {
        pjoinid <- findnm(xyjoinid, pltflds, returnNULL=TRUE)
        if (is.null(pjoinid)) {
          if (xyjoinid == "PLT_CN" && "CN" %in% pltflds) {
            pjoinid <- "CN"
          } else {
            stop("pjoinid is invalid")
          }
        }
      }
	  }
	
    ## Define xyfromqry
	  xyfromqry <- paste0("\nFROM ", SCHEMA., xynm, " xy")
	  xyfromqry <- paste0(xyfromqry, "\nINNER JOIN ", plotnm, " p ON(xy.", xyjoinid, " = p.", pjoinid, ")")
	
	  ## Define xyfromqry2
	  if (measCur) {
	    inxy <- TRUE
	    groupvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT")
	    groupvars <- sapply(groupvars, findnm, xyvars, returnNULL = TRUE)

	    if (any(is.null(groupvars))) {
	      missvars <- groupvars[is.null(groupvars)]
        if (length(missvars) > 1 || missvars != "unitcd") {
		      inxy <- FALSE	
          groupvars <- sapply(groupvars, findnm, pvars, returnNULL = TRUE)	
	        if (any(is.null(groupvars))) {
	          missvars <- groupvars[is.null(groupvars)]
            if (length(missvars) > 1 || missvars != "unitcd") {
			        stop("dataset must include statecd, countycd, and plot")
		        }
		      }
        }
	    } else {
	      groupvars <- as.vector(groupvars)
	    }
	    groupvars <- groupvars[groupvars %in% xyvars]
	  
	    alias. <- ifelse (inxy, "xy.", "p.")
	    xyfromqry2 <- paste0("\nINNER JOIN maxyear ON (")
	    for (i in 1:length(groupvars)) {
	      gvar <- groupvars[i]
	      xyfromqry2 <- paste0(xyfromqry2, alias., gvar, " = maxyear.", gvar)	   
	      if (i < length(groupvars)) {
	        xyfromqry2 <- paste0(xyfromqry2, " and ")
	      }
	    }
	    valias. <- ifelse (varCur %in% xyvars, "xy.", "p.")
	    xyfromqry2 <- paste0(xyfromqry2, " and ", valias., varCur, " = maxyear.maxyr)")
      #xyfromqry <- paste0(xyfromqry, xyfromqry2)	  
	  } 
	  xyqry <- paste0("SELECT ", toString(c(paste0("xy.", xyvars), paste0("p.", pvars))), 
             xyfromqry)	

    ## Inventory year table query
    yrvar <- ifelse(!is.null(invyrs), "INVYR", "MEASYEAR")
	  yrvarnmA=stcdnmA <- NULL
    if (!is.null(pvars)) {
      yrvarnm <- findnm(yrvar, pvars, returnNULL=TRUE)
	    if (!is.null(yrvarnm)) {
	      yrvarnmA <- paste0("pp.", yrvarnm)
	    }
      stcdnm <- findnm("STATECD", pvars, returnNULL=TRUE)
	    if (!is.null(stcdnm)) {
	      stcdnmA <- paste0("pp.", stcdnm)
	    }
    }
	  if (!is.null(xyvars)) {
	    if (is.null(yrvarnmA)) {
        yrvarnm <- findnm(yrvar, xyvars, returnNULL=TRUE)
	      if (!is.null(yrvarnm)) {
	        yrvarnmA <- paste0("pp.", yrvarnm)
	      }
	    }
 	    if (is.null(stcdnmA)) {
        stcdnm <- findnm("STATECD", xyvars, returnNULL=TRUE)
	      if (!is.null(stcdnm)) {
	        stcdnmA <- paste0("pp.", stcdnm)
	      }
	    }
    }

    if (!all(is.null(yrvarnmA), is.null(stcdnmA))) {
      invarsA <- toString(c(stcdnmA, yrvarnmA))
      invyrtab.qry <- paste0("SELECT distinct ", invarsA, ", COUNT(*)", 
		                         xyfromqry,
				                    "\n GROUP BY ", invarsA, 
				                    "\n ORDER BY ", invarsA) 
    }
  }

  ###########################################################################
  ## Build filter
  ###########################################################################
  if (xyisplot || is.null(plotnm)) {
    pnm <- xynm
    pid <- xy.uniqueid
    pflds <- xyflds
	  pltvars <- xyvars
  } else {
    pnm <- plotnm
    pid <- pjoinid
	  pflds <- pltflds
	  pltvars <- pvars
  }
  popSURVEY <- FALSE
  if (!is.null(SURVEY) && "SRV_CN" %in% pltflds) {
    popSURVEY <- TRUE
  }

  ## If iseval = TRUE 
  if (iseval) {
  
    if (is.null(POP_PLOT_STRATUM_ASSGN)) {
      ## Check ppsa_layer
      if (datsource == "sqlite") {
        ppsanm <- chkdbtab(dbtablst, ppsa_layer)
        ppsaflds <- DBI::dbListFields(dbconn, ppsanm)
        evalidnm <- findnm("EVALID", ppsaflds) 

        ## Check evalids 
        evalid.qry <- paste("select distinct evalid from ", ppsanm) 
        if (datsource == "sqlite") {
          evalidindb <- DBI::dbGetQuery(dbconn, evalid.qry)[[1]]
        } else {
          evalidindb <- sqldf::sqldf(evalid.qry)
        }
        if (!all(evalid %in% evalidindb)) {
          missevalid <- sort(!evalid[evalid %in% evalidindb])
          stop(ppsa_layer, " is missing evalids: ", toString(missevalid))
          ppsanm <- NULL
        }
      } else if (datsource == "datamart") {
        POP_PLOT_STRATUM_ASSGN <- DBgetCSV("POP_PLOT_STRATUM_ASSGN", stabbrlst, 
			                              returnDT=TRUE, stopifnull=FALSE)
        if (!all(evalid %in% unique(POP_PLOT_STRATUM_ASSGN$EVALID))) {
          miss <- sort(evalid[!evalid %in% 
				  unique(POP_PLOT_STRATUM_ASSGN$EVALID)])
          stop("evalid not in POP_PLOT_STRATUM_ASSGN: ", toString(sort(evalid)))
        }
        ppsanm <- "POP_PLOT_STRATUM_ASSGN"
        ppsaflds <- names(POP_PLOT_STRATUM_ASSGN)

      } else {
        POP_PLOT_STRATUM_ASSGN <- pcheck.table(ppsa_layer, stopifnull=TRUE, stopifinvalid=TRUE)
                              evalidnm <- findnm("EVALID", names(POP_PLOT_STRATUM_ASSGN))
        if (!all(evalid %in% unique(POP_PLOT_STRATUM_ASSGN[[evalidnm]]))) {
          miss <- sort(evalid[!evalid %in% 
				              unique(POP_PLOT_STRATUM_ASSGN[[evalidnm]])])
          stop("evalid not in POP_PLOT_STRATUM_ASSGN: ", toString(sort(evalid)))
        }
        ppsaflds <- names(POP_PLOT_STRATUM_ASSGN)
      }
    } else {
      ppsaflds <- names(POP_PLOT_STRATUM_ASSGN)
    }

	  if (exists(pnm) && !is.function(get(pnm)) &&!is.null(get(pnm))) {
      setkeyv(get(pnm), pid)
	  } 
    withqry <- getpwithqry(evalid = unlist(evalidlist), 
                           pjoinid = pid,
                           intensity = intensity,
                           plotnm = pnm,
		                       pltflds = pflds,
                           ppsanm = ppsanm,
		                       ppsaflds = ppsaflds,
		                       pvars = pvars)
  } else {

    ## Get statecd for filter
    stcds <- pcheck.states(states, "VALUE")
    statecdnm <- findnm("STATECD", xyvars, returnNULL=TRUE)
    stabbr <- pcheck.states(states, "ABBR")
 
    if (length(unlist(invyrs)) > 1) {
	
	    if (exists(pnm) && !is.function(get(pnm)) &&!is.null(get(pnm))) {
		    setkeyv(get(pnm), pid)
	    } 
	    withqry <- getpwithqry(states = stcds, 
                           pjoinid = pid,
                           intensity = intensity,
                           plotnm = pnm,
		                       pltflds = pflds,
                           invyrs = unlist(invyrs),
		                       pvars = pltvars,
		                       popSURVEY = popSURVEY,
		                       surveynm = surveynm,
		                       Type = Type)

    } else if (length(unlist(measyrs)) > 1) {

	    if (exists(pnm) && !is.function(get(pnm)) &&!is.null(get(pnm))) {
		    setkeyv(get(pnm), pid)
	    } 
	
      withqry <- getpwithqry(states = stcds, 
                             pjoinid = pid,
                             intensity = intensity,
                             plotnm = pnm,
		                         pltflds = pflds,
                             measyears = unlist(measyrs),
		                         pvars = pltvars,
		                         popSURVEY = popSURVEY,
		                         surveynm = surveynm,
		                         Type = Type) 
		   
    } else if (measCur) {

      ## Set key variable in pnm
	    if (exists(pnm) && !is.function(get(pnm)) &&!is.null(get(pnm))) {
	      keyvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT", "INVYR")
        keyvars <- keyvars[keyvars %in% xyflds]
		    setkeyv(get(pnm), keyvars)
	    } 
      withqry <- getpwithqry(states = stcds, 
	                           plotCur = TRUE,
	                           Endyr = measEndyr,	                        
                             varCur = varCur, 
                             SCHEMA. = SCHEMA., 
                             intensity = intensity, 
                             plotnm = pnm,
                             pjoinid = pid,
                             surveynm = surveynm,
                             popSURVEY = popSURVEY,
							               pltflds = pflds,
							               pvars = pltvars,
                             Type = Type)

    } else if (allyrs) {

	    if (exists(pnm) && !is.function(get(pnm)) &&!is.null(get(pnm))) {
		    setkeyv(get(pnm), pid)
	    } 
	
      withqry <- getpwithqry(states = stcds, 
                             pjoinid = pid,
                             intensity = intensity,
                             plotnm = pnm,
		                         pltflds = pflds,
                             allyrs = TRUE,
		                         pvars = pltvars,
		                         popSURVEY = popSURVEY,
		                         surveynm = surveynm,
		                         Type = Type) 
	  }
  }
  
  ##################################################################################
  ##################################################################################
  ## Generate queries
  ##################################################################################

  ## Create invyrtab query 
  ###########################################################
  xycoords.qry <- paste0(withqry, "\n", xyqry)
  message(xycoords.qry)

 if (xy_datsource == "sqlite") {
    xyx <- tryCatch( DBI::dbGetQuery(xyconn, xycoords.qry),
			          error = function(e) {
                  message(e, "\n")
                  return(NULL) })
    if (!iseval && is.null(invyrtab) && !is.null(invyrtab.qry)) {
      invyrtab <- tryCatch( DBI::dbGetQuery(xyconn, invyrtab.qry),
			           error = function(e) {
                  message(e, "\n")
                  return(NULL) }) 
    }      
  } else {

    xyx <- tryCatch( sqldf::sqldf(xycoords.qry, connection = NULL,
						   stringsAsFactors = FALSE), 
			        error = function(e) {
                  message(e, "\n")
                  return(NULL) })

    if (!iseval && is.null(invyrtab) && !is.null(invyrtab.qry)) {
      invyrtab <- tryCatch( sqldf::sqldf(invyrtab.qry, 
						stringsAsFactors = FALSE),
			error = function(e) {
                  return(NULL) }) 
    } 
    xyx <- setDT(xyx)     
  }

  if (is.null(xyx) || nrow(xyx) == 0) {
    warning("invalid xy query\n")
    message(xycoords.qry)
    stop()
  }
  
  if (nrow(xyx) > length(unique(xyx[[xy.uniqueid]]))) {
    xyx <- unique(xyx)
  }

  ## Change CN to PLT_CN if exists
  if ("CN" %in% names(xyx) && !"PLT_CN" %in% names(xyx)) {
    setnames(xyx, "CN", "PLT_CN")
    xy.uniqueid <- "PLT_CN"
    xyjoinid <- "PLT_CN"
  }

  ## Remove KNOWN plots that are no longer in inventory
  if (measCur || !is.null(measEndyr)) {
    xyx <- xyx[!xyx$PLT_CN %in% FIESTAutils::kindcd3old$CN, ]
  }
   
  if (all(c("STATECD", "UNITCD", "COUNTYCD", "PLOT") %in% names(xyx))) {
    xyx[["PLOT_ID"]] <- paste0("ID", 
		formatC(xyx$STATECD, width=2, digits=2, flag=0), 
          	formatC(xyx$UNITCD, width=2, digits=2, flag=0),
          	formatC(xyx$COUNTYCD, width=3, digits=3, flag=0),
          	formatC(xyx$PLOT, width=5, digits=5, flag=0)) 
  }

  ## Change names of X/Y variables to *_PUBLIC
  if (xvar == "LON" && yvar == "LAT") {
    setnames(xyx, c("LON", "LAT"), c("LON_PUBLIC", "LAT_PUBLIC"))
    xvar <- "LON_PUBLIC"
    yvar <- "LAT_PUBLIC"
  }

  if (all(c("STATECD", "COUNTYCD") %in% names(xyx))) {
    xyx$COUNTYFIPS <- paste0(formatC(xyx$STATECD, width=2, digits=2, flag=0), 
          		formatC(xyx$COUNTYCD, width=3, digits=3, flag=0))
  }
  if (Cur) {
    xyoutnm <- paste0("xyCur_", coordType)
    assign(xyoutnm, xyx)
  } else {
    xyoutnm <- paste0("xy_", coordType)
    assign(xyoutnm, xyx)
  } 

  if (is.null(out_layer) || out_layer == "outdat") {
    out_layer <- xyoutnm
    if (issp) {
      outsp_layer <- paste0("sp", xyoutnm)
    }
  } else {
    if (issp) {
	  outsp_layer <- paste0("sp", out_layer)
	}
  }

  if (issp) {
    spxyoutnm <- paste0("sp", xyoutnm)
     
    if (all(c(xvar, yvar) %in% names(xyx))) {

      ## Generate shapefile
      assign(spxyoutnm, spMakeSpatialPoints(xyplt = xyx, 
                      xvar = xvar, yvar = yvar, xy.uniqueid = xy.uniqueid, 
                      xy.crs = 4269, addxy = FALSE, 
                      exportsp = exportsp,
                      savedata_opts=list(out_dsn=out_dsn, 
                      out_fmt=outsp_fmt,
                      outfolder=outfolder, out_layer=outsp_layer, 
		                  outfn.date=outfn.date, 
                      overwrite_layer=overwrite_layer, 
		                  append_layer=append_layer, outfn.pre=outfn.pre) ))
    } else { 
      message("need ", xvar, " and ", yvar, " variables to generate spatial xy")
    }
  }
 
  ###############################################################################
  ## SAVE data
  ###############################################################################
  if (savedata) {
    index.unique.xyplt <- xy.uniqueid
    
    datExportData(get(xyoutnm),  
          index.unique = index.unique.xyplt,
          savedata_opts = list(outfolder = outfolder, 
                              out_fmt = out_fmt, 
                              out_dsn = out_dsn, 
                              out_layer = out_layer,
                              outfn.pre = outfn.pre, 
                              outfn.date = outfn.date, 
                              overwrite_layer = overwrite_layer,
                              append_layer = append_layer, 
                              add_layer = TRUE))
  }

  ## Set xyjoinid
  if (is.null(xyjoinid)) {
    xyjoinid <- xy.uniqueid
  }
 
  ## GENERATE RETURN LIST
  ###########################################################
  if (returndata) {
    returnlst <- list()
    if (issp) {
      returnlst$spxy <- get(spxyoutnm)
    } 
    returnlst[[xyoutnm]] <- get(xyoutnm)
    returnlst$xyqry <- xycoords.qry
    returnlst$xy_opts <- list(xy.uniqueid=xy.uniqueid, 
                             xvar=xvar, yvar=yvar, 
                             xy.crs=xy.crs, xyjoinid=xyjoinid)
    returnlst$pjoinid <- pjoinid
    returnlst$invyrlst <- invyrlst
    
    if (dbconnopen) {
      returnlst$dbconn <- dbconn
    }
    returnlst$evalInfo <- evalInfo
 
    if (!is.null(ppsanm) && exists(ppsanm)) {
      returnlst$pop_plot_stratum_assgn <- get(ppsanm)
    }

    ## Return data list
    return(returnlst)
  } 

  ## Disconnect database
  if (!is.null(dbconn) && !dbconnopen && DBI::dbIsValid(dbconn)) {
    DBI::dbDisconnect(dbconn)
  } 

}

Try the FIESTA package in your browser

Any scripts or data that you put into this service are public.

FIESTA documentation built on June 22, 2024, 7:37 p.m.