Nothing
saveUIAttr <- function(csite, input) {
csite$ui_attr$timepoint_sp_idx <- input$timepoint_sp_idx
csite$ui_attr$timepoint_tt_idx <- input$timepoint_tt_idx
csite$ui_attr$solute_select_ts <- input$solute_select_ts
csite$ui_attr$solute_select_sp <- input$solute_select_sp
csite$ui_attr$solute_select_stp <- input$solute_select_stp
csite$ui_attr$solute_select_wr <- input$solute_select_wr
csite$ui_attr$sample_loc_select_ts <- input$sample_loc_select_ts
csite$ui_attr$sample_loc_select_wr <- input$sample_loc_select_wr
csite$ui_attr$sample_loc_select_stp <- input$sample_loc_select_stp
# Note that input$aggregate_select_sp == input$aggregate_select_tt and only
# 'ui_attr$aggregate_selec' will set the select control.
csite$ui_attr$aggregate_select <- input$aggregate_select_sp
csite$ui_attr$color_select_tt <- input$color_select_tt
csite$ui_attr$trend_thresh_selected <- input$trend_or_threshold
csite$ui_attr$show_thresh_ts <- input$check_threshold
csite$ui_attr$logscale_wr <- input$logscale_wr
csite$ui_attr$logscale_stp <- input$logscale_stp
csite$ui_attr$plume_thresh_pd <- input$plume_thresh_pd
csite$ui_attr$ground_porosity <- input$ground_porosity
#csite$ui_attr$ground_porosity_pd <- input$ground_porosity_pd
csite$ui_attr$solute_conc_stp <- input$solute_conc_stp
##Well Redundancy
csite$ui_attr$ImplementReducedWellSet<-input$ImplementReducedWellSet
csite$ui_attr$sample_Omitted_Wells_selected<-input$sample_Omitted_Wells
return(csite)
}
createUIAttr <- function(All.Data, GWSDAT_Options) {
ui_attr <- list()
ui_attr$site_name <- GWSDAT_Options$SiteName
ui_attr$sample_loc_names <- All.Data$sample_loc$names
ui_attr$sample_loc_select_ts <- ui_attr$sample_loc_names[1]
ui_attr$sample_loc_select_wr <- ui_attr$sample_loc_names
ui_attr$sample_loc_select_stp <- ui_attr$sample_loc_names
ui_attr$solute_names <- All.Data$cont_names
ui_attr$solute_select_ts <- ui_attr$solute_names[1]
ui_attr$solute_select_sp <- ui_attr$solute_names[1]
ui_attr$solute_select_stp <- ui_attr$solute_names[1]
#ui_attr$solute_select_pd <- ui_attr$solute_names[1]
ui_attr$solute_select_wr <- ui_attr$solute_names
ui_attr$conc_unit_list <- list("ng/l","ug/l","mg/l")
ui_attr$conc_unit_selected <- ui_attr$conc_unit_list[2]
ui_attr$solute_conc_stp <- ui_attr$conc_unit_list[2]
ts_options = NULL
ts_options["Conc. Trend Smoother"] <- TRUE
ts_options["Conc. Linear Trend Fit"] <- FALSE
ts_options["Show Legend"] <- FALSE
ts_options["Scale to Conc. Data"] <- FALSE
ts_options["Log Conc. Scale"] <- TRUE
ts_options["Overlay GW levels"] <- FALSE
if (!is.null(All.Data$NAPL.Thickness.Data)) ts_options["Overlay NAPL Thickness"] <- FALSE
ui_attr$ts_options <- ts_options
ui_attr$napl_present <- FALSE
ui_attr$timepoints <- format.Date(All.Data$All_Agg_Dates, "%d-%m-%Y")
ui_attr$timepoint_sp <- ui_attr$timepoints[length(ui_attr$timepoints)]
ui_attr$timepoint_sp_idx <- length(ui_attr$timepoints)
ui_attr$timepoint_tt <- ui_attr$timepoints[length(ui_attr$timepoints)]
ui_attr$timepoint_tt_idx <- length(ui_attr$timepoints)
ui_attr$contour_types <- c("Conc-Terrain", "Conc-Topo","Conc-GreyScale","Conc-Terrain-Circles","Conc-Topo-Circles","Conc-GreyScale-Circles", if (!is.null(All.Data$NAPL.Thickness.Data)) {"NAPL-Circles"})
ui_attr$contour_selected <- ui_attr$contour_types[1]
spatial_options <- NULL
spatial_options["Show Well Labels"] <- TRUE
spatial_options["Scale colours to Data"] <- FALSE
spatial_options["Show Conc. Values"] <- TRUE
spatial_options["Show GW Contour"] <- FALSE
if (!is.null(GWSDAT_Options$ShapeFileNames)) spatial_options["Overlay ShapeFiles"] <- TRUE
spatial_options["Plume Diagnostics"] <- FALSE
ui_attr$spatial_options <- spatial_options
ui_attr$gw_options <- c("None", "Same Length", "Weighted Length")
ui_attr$gw_selected <- ui_attr$gw_options[3]
ui_attr$aggregate_list <- c("Day", "Month", "Quarter", "Year") # disabled (error in plotSpatialImage(): , "Year")
ui_attr$aggregate_select <- GWSDAT_Options$Aggby
ui_attr$trend_thresh_list <- c("Trend", "Threshold - Absolute", "Threshold - Statistical")
ui_attr$trend_thresh_selected <- ui_attr$trend_thresh_list[1]
ui_attr$trend_color_list <- c("All", "Reds", "Greens", "White", "Non-Detects", "Greys")
ui_attr$color_select_tt <- ui_attr$trend_color_list[1]
ui_attr$show_thresh_ts <- FALSE
ui_attr$logscale_wr <- "Yes"
ui_attr$logscale_stp <- "Yes"
# Define image save options.
ui_attr$img_width_px <- 900
ui_attr$img_height_px <- 500
ui_attr$img_width_px_wide <- 1100
ui_attr$img_height_px_wide <- 500
ui_attr$img_jpg_quality <- 90
ui_attr$img_ppi <- 90
# Related to plume model; read by 'uiPlumeTimeSeries.R'.
ui_attr$ground_porosity <- GWSDAT_Options$DefPorosity
#ui_attr$ground_porosity_pd <- ui_attr$ground_porosity * 100
# Related to plume model; read by 'uiPlumeTimeSeries.R'.
ui_attr$plume_thresh <- rep(GWSDAT_Options$DefPlumeThresh, length(ui_attr$solute_names))
names(ui_attr$plume_thresh) <- ui_attr$solute_names
ui_attr$plume_thresh_pd <- ui_attr$plume_thresh[1]
# Related to trend/threshold table, not (yet) used in UI.
ui_attr$conc_thresh <- rep(GWSDAT_Options$DefContThresh, length(ui_attr$solute_names))
names(ui_attr$conc_thresh) <- ui_attr$solute_names
# Prediction interval for interpolation, not in UI.
ui_attr$pred_interval = "Predicted"
# Used extensivly in plotSpatialImage, never changed, not in UI.
ui_attr$lev_cut <- c(0,5,10,25,50,75,100,200, 400, 800, 1500, 3000, 5000, 5000000)
ui_attr$sd_lev_cut <- 100 * c(seq(0,3,by = 0.25),10000000)
#ui_attr$lev_cut_by_solute<-as.data.frame(matrix(rep(ui_attr$lev_cut[-length(ui_attr$lev_cut)],length(ui_attr$solute_names)),ncol=length(ui_attr$solute_names)))
#names(ui_attr$lev_cut_by_solute)<-ui_attr$solute_names
#ui_attr$lev_cut_by_solute<-as.list(ui_attr$lev_cut_by_solute)
ui_attr$lev_cut_by_solute<-create_lev_cut_by_solute(ui_attr$lev_cut,ui_attr$solute_names)
##Well Redundancy
ui_attr$ImplementReducedWellSet<-FALSE
ui_attr$sample_Omitted_Wells_selected<-NULL
return(ui_attr)
}
#### Function to create a solute by solute threshold concs.
create_lev_cut_by_solute<-function(lev_cut,solute_names){
lev_cut_by_solute<-as.data.frame(matrix(rep(lev_cut[-length(lev_cut)],length(solute_names)),ncol=length(solute_names)))
names(lev_cut_by_solute)<-solute_names
return(as.list(lev_cut_by_solute))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.