Fixes to weights and improve display readability

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({

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)