diff --git a/MBA_MESO_Nodes.xlsx b/MBA_MESO_Nodes.xlsx index 5567bc8..1346741 100644 Binary files a/MBA_MESO_Nodes.xlsx and b/MBA_MESO_Nodes.xlsx differ diff --git a/app.R b/app.R index d866c99..eac8ce0 100644 --- a/app.R +++ b/app.R @@ -23,8 +23,8 @@ rw <- modules::use("reWeight.R") addResourcePath("js", "./www/js") -layers <- c("Pressures to Functional Groups", "Functional Groups to Output Processes", "Output Processes to Ecosystem services") -transitions <- c("Pressures to Functional Groups", "Pressures to Output Processes", "Pressures to Ecosystem services") +layers <- c("Pressures to Functional Groups", "Functional Groups to Ecosystem Processes", "Ecosystem Processes to Ecosystem services") +transitions <- c("Pressures to Functional Groups", "Pressures to Ecosystem Processes", "Pressures to Ecosystem services") impacts <- c("Very High", ">= High", ">= Medium", ">= Low", "All") thresholds <- c(0.97, 0.9, 0.45, 0.17, 0) impLabels <- c("Very High", "High", "Medium", "Low", "Very Low") @@ -111,7 +111,7 @@ ui <- dashboardPage( tags$p( style = "font-size: 12pt", "The tool provides a mapping using a Continuous Gaussian Bayesian Belief Network from the - Anthropogenic Pressures through the biotopes and to the output processes and ultimately the + Anthropogenic Pressures through the biotopes and to the Ecosystem processes and ultimately the Ecosystem services, to which the habitat supports." ), tags$p( @@ -170,9 +170,9 @@ ui <- dashboardPage( ) ), plotlyOutput("layer1", height = "270px") %>% withSpinner(), - h4("Effect on Output Processes"), + h4("Effect on Ecosystem Processes"), plotlyOutput("layer2", height = "270px") %>% withSpinner(), - h4("Effect on Ecosystem services"), + h4("Effect on Ecosystem Services"), plotlyOutput("layer3", height = "270px") %>% withSpinner() ), tabItem(tabName = "3",h2("Bayesian Network"), @@ -272,6 +272,8 @@ server <- function(input, output, session) { newNameMap <- openxlsx::read.xlsx("MBA_MESO_Nodes.xlsx") %>% dplyr::select(hab, nodeType, Suggestion, node, newname) + + newNameMap$hab <- stringr::str_replace_all(newNameMap$hab, "_", " ") #save(newNameMap, file="nameMap.RData") stripStr <- function(nodeStr) { @@ -322,7 +324,9 @@ server <- function(input, output, session) { if (!is.null(wb)) { - habName <- substr(fileList[idx], 1, (nchar(fileList[idx])-5)) + habName <- substr(fileList[idx], 1, (nchar(fileList[idx])-5)) %>% + stringr::str_replace_all("_", " ") + print(habName) wb2 <- setNewNames(wb, habName) @@ -693,12 +697,12 @@ server <- function(input, output, session) { zerolinewidth = 10) # plot_ly(boxPlot, x = boxPlot[,1], y = ~Range, color = as.character(boxPlot$Group), colors = palette, type = "box") %>% - layout(xaxis = xform, yaxis=list(range=c(-1.2, 1.2)), showlegend = FALSE, title = title) + layout(xaxis = xform, yaxis=list(dtick=0.25, range=c(-1.25, 1.25)), showlegend = FALSE, title = title) } } - prepPlot <- function(code = "ba", name = "Bio-Assemblage") { + prepPlot <- function(code = "ba", name = "Functional Group") { if (!is.null(.likelihoods$p_es)) { inScope <- startsWith(.likelihoods$p_es$code, code) thisPlot <- .likelihoods$p_es[inScope, c(1,3,4)] @@ -711,11 +715,11 @@ server <- function(input, output, session) { } output$layer1 <- renderPlotly({ - prepPlot("ba", "Bio-Assemblage") + prepPlot("ba", "Functional Groups") }) output$layer2 <- renderPlotly({ - prepPlot("op", "Output Processes") + prepPlot("op", "Ecosystem Processes") }) output$layer3 <- renderPlotly({ diff --git a/reWeight.R b/reWeight.R index b4bd9c7..842ee10 100644 --- a/reWeight.R +++ b/reWeight.R @@ -69,7 +69,7 @@ reWeightModel <- function(thisNet, pressStatus) { dplyr::select(presscode, layer, ba_code, values) %>% tidyr::nest(data=c(presscode, values)) - newP <- reWeightLayer(p_on, fudge=1) + newP <- reWeightLayer(p_on, fudge=2) @@ -86,7 +86,7 @@ reWeightModel <- function(thisNet, pressStatus) { dplyr::rename(op_code=output) %>% tidyr::nest(data=c(ba_code, values)) - newBA <- reWeightLayer(ba_impacted, fudge=4) + newBA <- reWeightLayer(ba_impacted, fudge=2) print("About to recalc op - es") @@ -101,7 +101,7 @@ reWeightModel <- function(thisNet, pressStatus) { dplyr::rename(es_code=output) %>% tidyr::nest(data=c(op_code, values)) - newOP <- reWeightLayer(op_impacted, fudge=4) + newOP <- reWeightLayer(op_impacted, fudge=2) #Check for any more links through the system print("About to recalc es - es") @@ -117,7 +117,7 @@ reWeightModel <- function(thisNet, pressStatus) { dplyr::rename(lo_code=output) %>% tidyr::nest(data=c(lo_code, values)) - newES <- reWeightLayer(es_impacted, fudge=2) + newES <- reWeightLayer(es_impacted, fudge=8) incode <- c(newP$presscode, newBA$ba_code, newOP$op_code, newES$es_code) outcode <- c(newP$ba_code, newBA$op_code, newOP$es_code, newES$lo_code)