R/getlt10char.R

In FIESTAutils: Utility Functions for Forest Inventory Estimation and Analysis

#' @rdname internal_desc
#' @export
getlt10char <- function(dbname){

  ## Set global variables
  DBNAME <- NULL


  ## GENERATE TABLE OF NAMES 10 CHARS OR LESS TO SUBSTITUTE FOR NAMES > 10 CHARS
  ##	(FOR SPATIAL LAYER)
  ###############################################################################
  dbnamelst <- list(

   ## PLOT VARIABLES
	c("PLOT_NONSAMPLE_REASN_CD", "PNONSAMPCD"),
	c("PLOT_STATUS_CD", "PSTATUSCD"),
	c("NF_SAMPLED_CD_RMRS", "PSAMPLEDNF"),
	c("NF_PLOT_NONSAMPLE_REASN_CD", "PNONSAMPNF"),
	c("NF_PLOT_STATUS_CD", "PSTATUSNF"),
	c("NF_SAMPLING_STATUS_CD", "PSAMPSTNF"),
	c("SAMP_METHOD_CD", "SAMPMETHCD"),
	c("SUBP_EXAMINE_CD", "SUBPEXAMCD"),
	c("MANUAL_RMRS", "MANUALRMRS"),
	c("KINDCD_RMRS", "KINDCDRMRS"),
	c("EMAP_HEX_ACTUAL", "EMAP_HEX"),
	c("CONGCD_ACTUAL", "CONGCD"),
	c("ECOSUBCD_ACTUAL", "ECOSUBCD"),
	c("MORT_TYP_CD", "MORTTYPCD"),
	c("GROW_TYP_CD", "GROWTYPCD"),
	c("LAT_LON_ACTUAL_SOURCE", "LLSOURCE"),
	c("LAT_ACTUAL_NAD83", "LAT_ACTUAL"),
	c("LON_ACTUAL_NAD83", "LON_ACTUAL"),
	c("ACCT_NBR_POINTS_RMRS", "ACCTNBRPTS"),
	c("ACTUAL_OWNCD", "OWN_ACTUAL"),
	c("ACTUAL_FORINDCD", "IND_ACTUAL"),
	c("LON_DIGITIZED", "LON_DIGITZ"),
	c("LAT_DIGITIZED", "LAT_DIGITZ"),
	c("PREV_PLT_CN", "PREV_PLTCN"),
	c("UTM_EASTING_X", "UTMX"),
	c("UTM_NORTHING_Y", "UTMY"),
	c("P2VEG_SAMPLING_STATUS_CD", "P2VEGSTAT"),
	c("ELEV_PUBLIC", "ELEV_PUB"),

  ## COND VARIABLES
  	c("SUBPPROP_UNADJ", "SUBPPROPUN"),
  	c("MICRPROP_UNADJ", "MICRPROPUN"),
  	c("CONDPROP_UNADJ", "CONDPROPUN"),
  	c("MACRPROP_UNADJ", "MACRPROPUN"),
  	c("COND_NONSAMPLE_REASN_CD", "CNONSAMPCD"),
  	c("COND_STATUS_CD", "CSTATUSCD"),
  	c("FORTYPCDCALC", "FORTYPCALC"),
  	c("LAND_USECD_RMRS", "LANDUSECD"),
  	c("NBR_SEEDLING_RMRS", "NBRSEEDS"),
  	c("LIVE_MISSING_CANOPY_CVR_PCT", "CCLIVEMISS"),
  	c("LIVE_CANOPY_CVR_PCT", "CCLIVE"),
  	c("CRCOVPCT_RMRS", "CRCOV"),
  	c("CRCOVPCT_LIVE_RMRS", "CRCOV_L"),
  	c("CRCOVPCT_LIVEMISS_RMRS", "CRCOV_LM"),
  	c("NBR_SEEDLINGS_RMRS", "SEEDS"),
  	c("SDIPCT_RMRS", "SDIPCT"),
  	c("SDIMAX_RMRS", "SDIMAX"),
  	c("SDI_RMRS", "SDI"),
  	c("RANGETYPCD_RMRS", "RANGETYPCD"),
  	c("QMD_RMRS", "QMD"),
  	c("PCTBARE_RMRS", "PCTBARE"),
  	c("PHYSCLCD_NF", "PHYSCLCDNF"),
  	c("NF_COND_NONSAMPLE_REASN_CD", "CNONSAMPNF"),
  	c("NF_COND_STATUS_CD", "CSTATUSNF"),
  	c("CANOPY_CVR_SAMPLE_METHOD_CD", "CCMETHODCD"),
  	c("CARBON_UNDERSTORY_BG", "CARBUNDBG"),
  	c("CARBON_UNDERSTORY_AG", "CARBUNDAG"),
  	c("CARBON_STANDING_DEAD", "CARBSTDEAD"),
  	c("CARBON_SOIL_ORG", "CARBSOIL"),
  	c("CARBON_LITTER", "CARBLITTER"),
  	c("CARBON_DOWN_DEAD", "CARBDNDEAD"),
  	c("PLOT_PERIODIC", "PLOT_PER"),

  ## MISC
  	c("FIELD_VISIT", "FIELDVISIT"),
  	c("LOCATION_STATUS", "LOCSTATUS"),
  	c("OWNER_GROUP", "POWNERGRP"),
  	c("OWNER_CLASS", "POWNCLASS"),
  	c("OWNER_LEVEL1", "POWNLEVEL1"),
  	c("OWNER_LEVEL2", "POWNLEVEL2"),
  	c("OWNER_LEVEL3", "POWNLEVEL3")
  )

  dbnames <- data.table(do.call(rbind, dbnamelst), stringsAsFactors=FALSE)
  setnames(dbnames, c("DBNAME", "NEWNAME"))

  ## Find dbname in table. If not, truncate to 10 characters or less.
  newname <- ifelse(dbname %in% dbnames[,DBNAME],
			dbnames[DBNAME==dbname, "NEWNAME"][[1]],
				substr(dbname, 0, 10))
  return(newname)
}