-
Notifications
You must be signed in to change notification settings - Fork 15
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'staging' of https://github.com/USDAForestService/Forest…
…VegetationSimulator-Interface into open-main
- Loading branch information
Showing
17 changed files
with
9,061 additions
and
8,708 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,16 +1,17 @@ | ||
| Package: fvsOL | ||
| Title: Forest Vegetation Simulator | ||
| Version: 2023.07.28 | ||
| Version: 2024.04.01 | ||
| Authors@R: c(person("Nicholas", "Crookston", email = "[email protected]", | ||
| role = c("aut")), | ||
| person("FVS", "Staff", email = "[email protected]", | ||
| role = c("aut", "cre"))) | ||
| Description: An R-Shiny interface to the Forest Vegetation Simulator which can be | ||
| run as an "Online" or "Onlocal" configuration. | ||
| Depends: R (>= 4.0.0), rFVS (>= 2021.03.15), shiny (>= 1.6.0), Cairo (>= 1.5.11), | ||
| rhandsontable (>= 0.3.7), ggplot2 (>= 3.3.3), parallel (>= 4.0.0), | ||
| RSQLite (>= 2.2.4), plyr (>= 1.8.6), dplyr (>= 1.0.4), colourpicker (>= 1.1.0), | ||
| rgl (>= 0.105.0), leaflet (>= 2.0.4.1), zip (>= 2.1.1), openxlsx (>= 4.2.3) | ||
| Depends: | ||
| R (>= 4.0.0), rFVS (>= 2021.03.15), shiny (>= 1.6.0), Cairo (>= 1.5.11), rhandsontable (>= 0.3.7), | ||
| ggplot2 (>= 3.3.3), parallel (>= 4.0.0), RSQLite (>= 2.2.4), plyr (>= 1.8.6), dplyr (>= 1.0.4), | ||
| colourpicker (>= 1.1.0), rgl (>= 0.105.0), leaflet (>= 2.0.4.1), zip (>= 2.1.1), openxlsx (>= 4.2.3), | ||
| shinyFiles (>= 0.9.3) | ||
| Suggests: rgdal (>= 1.5-23), nlme (>= 3.1-140) | ||
| License: MIT | ||
| Roxygen: list(markdown = TRUE) | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,96 @@ | ||
| #################################################################################### | ||
| # change_project_dir - r.20230711 | ||
| # | ||
| # Accepts path to directory | ||
| # | ||
| # Opens new interface instance with last modified project in chosen directory | ||
| # | ||
| # makes heavy usage of code from server.R for input input$PrjOpen | ||
| # | ||
| # Function does not verify user access to chosen directory, | ||
| # must be handled prior to function call | ||
| #################################################################################### | ||
|
|
||
|
|
||
| change_project_dir <- function(new_proj_dir) { | ||
| cat(paste0("User Specified Dir: ", new_proj_dir)) | ||
|
|
||
| if (dir.exists(new_proj_dir)) { | ||
| if (isLocal()) { | ||
| if (exists("RscriptLocation")) { | ||
| rscript= RscriptLocation | ||
| } else { | ||
| exe_file = normalizePath(commandArgs(trailingOnly = FALSE)[1]) | ||
|
|
||
| if (.Platform$OS.type == "windows") { | ||
| bin = regexpr("\\\\bin\\\\", exe_file) | ||
| } else { | ||
| bin = regexpr("/bin/", exe_file) | ||
| } | ||
|
|
||
| bin = substr(exe_file, 1, bin + attr(bin, "match.length") - 2) | ||
|
|
||
| if (.Platform$OS.type == "windows") { | ||
| file.path(bin,"Rscript.exe") | ||
| } else { | ||
| file.path(bin,"Rscript") | ||
| } | ||
| } | ||
|
|
||
| rscript = gsub("\\\\", "/", rscript) | ||
| defs = paste0("RscriptLocation='", rscript, "';") | ||
|
|
||
| if (exists("mdbToolsDir")) { | ||
| defs = paste0(defs, "mdbToolsDir='", mdbToolsDir, "';") | ||
| } | ||
|
|
||
| if (exists("sqlite3exe")) { | ||
| defs = paste0(defs, "sqlite3exe='", sqlite3exe, "';") | ||
| } | ||
|
|
||
| cat(".libPaths=", unlist(.libPaths()), "\n") | ||
|
|
||
| if (exists("RscriptLocation")) { | ||
| Rlib2Use <- | ||
| paste0(dirname(dirname(dirname(RscriptLocation))), "/library") | ||
| defs = paste0(defs, ".libPaths('", Rlib2Use, "');") | ||
| } | ||
|
|
||
| # Get list of projects in supplied Directory | ||
| prjs = list() | ||
| dirs = dir(new_proj_dir) | ||
| for (dir in dirs) { | ||
| if (file.exists(paste0(new_proj_dir, "/", dir, "/projectId.txt"))){ | ||
| prjs = append(prjs, paste0(new_proj_dir, "/", dir)) | ||
| prjs <- as.character((prjs)) | ||
| } | ||
| } | ||
|
|
||
| if (!length(prjs)) { | ||
| if (file.exists(paste0(new_proj_dir, "/Project_1/projectId.txt"))) { | ||
| #Display notice of locked project | ||
| } else { | ||
| #Create new project_1 directory and launch | ||
| dir.create(paste0(new_proj_dir, "/Project_1")) | ||
| write(file = paste0(new_proj_dir, "/Project_1/projectId.txt"), | ||
| "title= Project_1") | ||
| prjs = append(prjs, paste0(new_proj_dir, "/Project_1")) | ||
| } | ||
| } | ||
|
|
||
| ord = sort(unlist(lapply(prjs, function(x) as.integer(file.mtime(x)))), | ||
| decreasing = TRUE, index.return = TRUE)$ix | ||
|
|
||
| cmd = paste0("$",rscript,"$ --vanilla -e $", defs, "require(fvsOL)", | ||
| ";fvsOL(prjDir='", prjs[ord[1]], "',fvsBin='", fvsBin, "'); | ||
| quit()$") | ||
| cmd = gsub('$', '\"', cmd, fixed=TRUE) | ||
|
|
||
| if (.Platform$OS.type == "unix") { | ||
| cmd = paste0("nohup ", cmd, " >> /dev/null") | ||
| } | ||
| rtn=try(system(cmd, wait=FALSE)) | ||
| cat("cmd for launch project=", cmd, "\nrtn=", rtn, "\n") | ||
| } | ||
| } | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,142 @@ | ||
| checkMinColumnDefs <- function(dbo, progress = NULL, pn = 0) { | ||
| cat("In checkMinColumnDefs\n") | ||
| # Set up list of column names that are automatic database rejection | ||
| reject_if_missing <- c("Variant", "Stand_ID", "Inv_Year") | ||
|
|
||
| # Set up data frame to dub in required columns if missing | ||
| StdInitColumnReq <- data.frame( | ||
| ColumnName = c("Groups", "FVSKeywords", "Sam_Wt"), | ||
| DataType = c("text", "text", "real"), | ||
| Default = c("'All_Stands'", NA, NA) | ||
| ) | ||
|
|
||
| FVS_StandInit = FALSE | ||
| valid_table_found = FALSE | ||
| FIA_dataset = FALSE | ||
| FIA_Tables = c("FVS_StandInit_Plot", "FVS_PlotInit_Plot", "FVS_StandInit_Cond") | ||
| for (table in FIA_Tables) { | ||
| tryCatch( | ||
| # Try to read table from db connection | ||
| { | ||
| stdInit <- dbReadTable(dbo, table) | ||
| FIA_dataset = TRUE | ||
| }, | ||
|
|
||
| # if an error . . . | ||
| error = function(e) { | ||
| cat(paste0("Table: ", table, " not found in database\n")) | ||
| } | ||
| ) | ||
| } | ||
| if (FIA_dataset) return(NULL) | ||
|
|
||
| for (initnm in c("FVS_StandInit", "FVS_PlotInit")) { | ||
| initnm_exists = FALSE | ||
| tryCatch( | ||
| # Try to read table from db connection | ||
| { | ||
| stdInit <- dbReadTable(dbo, initnm) | ||
| initnm_exists = TRUE | ||
| valid_table_found = TRUE | ||
| }, | ||
|
|
||
| # if an error . . . | ||
| error = function(e) { | ||
| cat(paste0("Table: ", initnm, " not found in database\n")) | ||
| } | ||
| ) | ||
| if (initnm_exists) { | ||
| if (initnm == "FVS_StandInit") FVS_StandInit = TRUE | ||
|
|
||
| # get list of column names in table | ||
| fields <- tolower(names(stdInit)) | ||
| reject = reject_if_missing | ||
|
|
||
| if (initnm == 'FVS_PlotInit' || initnm == 'FVS_PlotInit_Plot') { | ||
| plotInit = c("StandPlot_ID") | ||
| reject = c(reject_if_missing, plotInit) | ||
| } | ||
|
|
||
|
|
||
| # Check for missing required columns that would reject database | ||
| for (e in reject) { | ||
| if (!is.null(progress)) { | ||
| pn = pn+1 | ||
| progress$set(message = paste0("Checking ", initnm), value = pn, | ||
| detail = e) | ||
| } | ||
|
|
||
| if (!(tolower(e) %in% fields)) { | ||
| return(paste0("<h4>Input database invalid.<br>", | ||
| initnm, " table Missing column: '", e, "'</h4>")) | ||
| } | ||
|
|
||
| # Add logic to check for blank entries | ||
| # Note: Sqlite extensions 'math', 'regexp', 'series', 'csv' not enabled by default | ||
| RSQLite::initExtension(dbo, extension = c('regexp')) | ||
| q <- paste0("SELECT COUNT(*) FROM ", initnm, " WHERE ", e, | ||
| " NOT REGEXP '[A-Za-z0-9_]' OR ", e, " IS NULL") | ||
|
|
||
| if (tolower(e) == 'inv_year'){ | ||
| q <- paste0("SELECT COUNT (*) FROM ", initnm, " WHERE CAST(INV_YEAR AS INT) <= 0 OR INV_YEAR IS NULL") | ||
| } | ||
| tryCatch( | ||
| { | ||
| result <- dbGetQuery(dbo, q) | ||
| if (result > 0) { | ||
| return(paste0("<h4>Input database invalid.<br>", | ||
| initnm, " Column ", e, " contains a blank or missing value</h4>")) | ||
| } | ||
| }, | ||
| error = function(e) { | ||
| return(paste0("Attempt to read column: ", e, "Failed.")) | ||
| } | ||
| ) | ||
| } | ||
|
|
||
| for (reqColumn in StdInitColumnReq$ColumnName) { | ||
| type = StdInitColumnReq$DataType[ | ||
| StdInitColumnReq$ColumnName == reqColumn] | ||
|
|
||
| default = StdInitColumnReq$Default[ | ||
| StdInitColumnReq$ColumnName == reqColumn] | ||
|
|
||
| if (reqColumn == "Groups" && | ||
| (initnm == "FVS_PlotInit" || initnm == "FVS_PlotInit_Plot")) { | ||
| default = "'All_Plots'" | ||
| } | ||
|
|
||
| if (!is.null(progress)) { | ||
| pn = pn + 1 | ||
| progress$set(message = paste0("Checking ", initnm), | ||
| value = pn, detail = reqColumn) | ||
| } | ||
|
|
||
| if (!(tolower(reqColumn) %in% fields)) { | ||
|
|
||
| tryCatch( | ||
| { | ||
| if(!is.na(default)){ | ||
| dbExecute(dbo, paste0("alter table ", initnm, " add column ", | ||
| reqColumn, " ", type, " default ", default, ";")) | ||
| } | ||
| else{ | ||
| dbExecute(dbo, paste0("alter table ", initnm, " add column ", | ||
| reqColumn, " ", type, ";")) | ||
| } | ||
|
|
||
| }, | ||
| error = function(e) { | ||
| return(paste0("Attempt to add column: ", reqColumn, "Failed.")) | ||
| } | ||
| ) | ||
| } | ||
| } | ||
| } | ||
| } | ||
| if (!valid_table_found) { | ||
| return(paste0("<h4>Input database invalid.<br>", | ||
| "No valid StandInit or PlotInit tables found</h4>")) | ||
| } | ||
| return(NULL) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.