Strip comments, save files and whitespace blocks

Parses.R

@@ -117,7 +117,6 @@ getOutNodes <- function(codes, codeList) {
 }
 
 buildGraph <- function(model, desc) {
-
   # model contains the following
   # node table, edge table
 
@@ -125,7 +124,6 @@ buildGraph <- function(model, desc) {
   # inputCode - the top layer of the model
   # outputCodes - all subsequent layers to be included in the model
 
-
   inputNodes <- model$nodes$code[which(startsWith(model$nodes$code, desc$inputCode))]
   inputText <- paste0("[", inputNodes, "]", collapse = "")
 
@@ -153,13 +151,7 @@ buildGraph <- function(model, desc) {
 
   print("Saving model prior to network modelling")
   modelDefn <- paste0(inputText, edges)
-  save(modelDefn, file = "buildGraph.RData")
+  # save(modelDefn, file = "buildGraph.RData")
-
-
-  # print("about to build network")
-  # print(paste0(inputText, edges))
-
-
 
   net <- model2network(paste0(inputText, edges), debug = FALSE)
 
@@ -175,15 +167,12 @@ buildGraph <- function(model, desc) {
 
   allDists <- as.list(setNames(c(inDist, outDist), c(inputNodes, outNodes)))
 
-  # print(allDists)
   cfit <- custom.fit(net, allDists)
 
   cat("about to calculate sample distributions")
-  # print(outNodes)
 
   sampleDists <- cpdist(cfit, nodes = outNodes, evidence = TRUE, n = 10000, method = "lw")
   summDists <- summary(sampleDists)
-  # stdDev <- sd(sampleDists)
 
   print("sample distribution build successful")
 
@@ -204,7 +193,6 @@ buildGraph <- function(model, desc) {
 
 
 getValidNodes <- function(mapping, prevOutputs, prefix) {
-
   # Find row id for input nodes, internal and published
   inputNodes <- mapping[2:nrow(mapping), 1]
 
@@ -271,10 +259,6 @@ getCode <- function(name, nodeDF) {
 }
 
 getValidEdges <- function(mapping, nodeDF, prevEdge = NULL, prefix) {
-  # utils::str(nodeDF)
-
-  # save(mapping, nodeDF, prevEdge, prefix, file="validEdges.RData")
-
   edgeCols <- c("inputNode", "outputNode", "impact")
   edgeM <- matrix(data = NA, nrow = 0, ncol = length(edgeCols), dimnames = list(NULL, edgeCols))
 
@@ -297,6 +281,7 @@ getValidEdges <- function(mapping, nodeDF, prevEdge = NULL, prefix) {
       # if (count == 0) print(paste("No edges found for output", colnames(mapping)[col]))
     }
   }
+
   if (is.null(prevEdge)) {
     return(data.frame(
       input = edgeM[, "inputNode"],
@@ -321,8 +306,6 @@ parseMapping <- function(mapping, prevOutputs, prefix) {
   nodeDF <- getValidNodes(mapping, prevOutputs$nodes, prefix)
   edgeDF <- getValidEdges(mapping, nodeDF, prevEdge = prevOutputs$edges, prefix)
 
-  # save(nodeDF, edgeDF, file="mapping.RData")
-
   return(list(
     # New structure
     nodes = nodeDF,
@@ -331,8 +314,6 @@ parseMapping <- function(mapping, prevOutputs, prefix) {
 }
 
 parseSheet <- function(fName) {
-  # get sheet names
-
   print(paste("starting sheet load", fName))
 
   if (file.exists(fName)) {
@@ -342,7 +323,7 @@ parseSheet <- function(fName) {
       sheets <- sort(delNA(match(names, mappings)))
 
       cat("starting sheet parse")
-      # print(sheets)
+      print(sheets)
 
       if (sum(sheets == refs) == length(refs)) {
         # read all mapping tables

app.R

@@ -8,7 +8,6 @@ modules::import(shinyBS)
 modules::import(bnlearn)
 modules::import(visNetwork)
 modules::import(RColorBrewer)
-modules::import(plotly)
 modules::import(openxlsx)
 modules::import(zip)
 modules::import(DT)
@@ -16,7 +15,6 @@ modules::import(plyr)
 modules::import(magrittr)
 
 parser <- modules::use("Parses.R")
-
 rw <- modules::use("reWeight.R")
 
 
@@ -173,11 +171,11 @@ ui <- dashboardPage(
             p("Download results as Excel workbook")
           )
         ),
-        plotlyOutput("layer1", height = "270px") %>% withSpinner(),
+        plotly::plotlyOutput("layer1", height = "270px") %>% withSpinner(),
         h4("Effect on Ecosystem Processes"),
-        plotlyOutput("layer2", height = "270px") %>% withSpinner(),
+        plotly::plotlyOutput("layer2", height = "270px") %>% withSpinner(),
         h4("Effect on Ecosystem Services"),
-        plotlyOutput("layer3", height = "270px") %>% withSpinner()
+        plotly::plotlyOutput("layer3", height = "270px") %>% withSpinner()
       ),
       tabItem(
         tabName = "3", h2("Bayesian Network"),
@@ -229,7 +227,6 @@ server <- function(input, output, session) {
 
   palette <- c("firebrick", "coral", "rosybrown", "tan", "salmon", "olivedrab", "seagreen", "aquamarine", "darkcyan", "dodgerblue", "steelblue", "royalblue")
 
-
   models <- NULL
   pressures <- NULL
 
@@ -302,9 +299,6 @@ server <- function(input, output, session) {
   }
 
   setNewNames <- function(wb, habName) {
-
-    # habName <- substr(fileList[idx], 1, (nchar(fileList[idx])-5))
-
     print(habName)
     possNames <- newNameMap %>%
       dplyr::filter(hab == habName) %>%
@@ -334,7 +328,6 @@ server <- function(input, output, session) {
       print(paste("attempting to load", paste0(dataStorage, fileList[idx])))
 
       wb <- parser$parseSheet(paste0(dataStorage, fileList[idx]))
-      # print(tmp)
 
       wb$p_es$edges$values <- sapply(wb$p_es$edges$impact, getImpact)
 
@@ -349,11 +342,9 @@ server <- function(input, output, session) {
         models <<- c(models, habName)
         print(paste("Model file successfully loaded", fileList[idx]))
 
-        # save(tmp, file = "tmp.RData")
         cnt <- cnt + 1
       }
     }
-    # save(modelList, file="models.RData")
     updateSelectInput(session, "modelSelect", choices = models)
     return(modelList)
   }
@@ -361,11 +352,6 @@ server <- function(input, output, session) {
   # parse on load sheets in the input sheet folder - replace with R Data
   modelList <- getAvailableModels()
 
-  # save(modelList, file = "model.RData")
-
-  # print(load("modelList.RData"))
-
-
   calcLikelihood <- function(layer, pressStatus, forPlotly) {
     isolate({
       modelList[[.selections$model]]$p_es$edges$values <<- sapply(modelList[[.selections$model]]$p_es$edges$impact, getImpact)
@@ -393,22 +379,12 @@ server <- function(input, output, session) {
       print(names(thisModel))
 
       # Now do it in stages with one assessment per stage
-
-
-
       thisModel$p_es$nodes$confidence <- 0.1 * thisModel$p_es$nodes$confidence
 
-
-      # save(pressStatus, thisModel, file="beforeWeight.RData")
-
-
-
       if (sum(pressStatus$status == "On") > 0) {
         thisModel$p_es <- rw$reWeightModel(thisModel$p_es, pressStatus)
       } # else nothing to do
 
-      # save(pressStatus, thisModel, file="afterWeight.RData")
-
       thisNet <- parser$buildGraph(thisModel$p_es, desc = list(inputCode = "p", outputCodes = c("ba", "op", "es")))
 
       sampleDists <- cpdist(
@@ -467,7 +443,6 @@ server <- function(input, output, session) {
 
   observeEvent(input$modelSelect, {
     .selections$model <<- match(input$modelSelect, models)
-    # .selections$runOnce <<- TRUE
   })
 
   observeEvent(reactiveValuesToList(input), {
@@ -510,7 +485,6 @@ server <- function(input, output, session) {
       )
 
       # This assumes all pressures are the same...
-
       setPressures(pressures)
       btnList <- apply(pressures, 1, makeRadioButtons)
     }
@@ -634,8 +608,6 @@ server <- function(input, output, session) {
 
     nodeNet <- nodes[(nodes$code %in% .selections$pressStatus$code[.selections$pressStatus$status %in% c("On")]), ]
 
-    # save(nodes, edges, nodeNet, file = "tmp.RData")
-
     if (nrow(nodeNet) > 0) {
       # do pressures
       edgeNet <- edges[edges$from %in% nodeNet$id, ]
@@ -677,36 +649,22 @@ server <- function(input, output, session) {
     makeBbnGraph(modelList[[.selections$model]])
   })
 
-  # observe({
-  #  visNetworkProxy("bbnGraphPlot") %>%
-  #    visStabilize(iterations = 10)
-  # })
-
   getModelName <- function() {
     paste0("data/", input$modelSelect, ".xlsx")
   }
 
   genPlot <- function(boxPlot, title, paletteLength) {
     if (nrow(boxPlot) > 0) {
-
-      # print(paste('Palette length', paletteLength))
-
-      # palette <- brewer.pal(paletteLength,  "Set3")
-
-      # palette <- c("red", "sienna3", "plum2", "rosybrown4",  "sandybrown", "yellow", "seashell3", "palegreen", "springgreen4",  "steelblue",   "azure")
-
       names(palette) <- 1:length(palette)
 
-      # print(paste("Box plot, colours", nrow(boxPlot), length(colours)))
-      # cat(colours)
       xform <- list(
         categoryorder = "array",
         categoryarray = boxPlot[, 1],
         zerolinewidth = 10
       )
-      #
+
-      plot_ly(boxPlot, x = boxPlot[, 1], y = ~Range, color = as.character(boxPlot$Group), colors = palette, type = "box") %>%
+      plotly::plot_ly(boxPlot, x = boxPlot[, 1], y = ~Range, color = as.character(boxPlot$Group), colors = palette, type = "box") %>%
-        layout(xaxis = xform, yaxis = list(dtick = 0.25, range = c(-1.25, 1.25)), showlegend = FALSE, title = title)
+        plotly::layout(xaxis = xform, yaxis = list(dtick = 0.25, range = c(-1.25, 1.25)), showlegend = FALSE, title = title)
     }
   }
 
@@ -722,15 +680,15 @@ server <- function(input, output, session) {
     }
   }
 
-  output$layer1 <- renderPlotly({
+  output$layer1 <- plotly::renderPlotly({
     prepPlot("ba", "Functional Groups")
   })
 
-  output$layer2 <- renderPlotly({
+  output$layer2 <- plotly::renderPlotly({
     prepPlot("op", "Ecosystem Processes")
   })
 
-  output$layer3 <- renderPlotly({
+  output$layer3 <- plotly::renderPlotly({
     prepPlot("es", "Ecosystem Services")
   })
 
@@ -831,8 +789,6 @@ server <- function(input, output, session) {
       dir.create(tmp)
       setwd(tmp)
 
-
-
       l <- list(
         pressures = .selections$pressStatus,
         nodes = modelList[[.selections$model]]$p_es$nodes,
@@ -842,12 +798,8 @@ server <- function(input, output, session) {
       )
       xl <- write.xlsx(l, "dataset.xlsx")
 
-      # zipFile <- zipr(file, c("dataset.xlsx"))
-
       file.copy("dataset.xlsx", file)
 
-      # print(paste("zip file complete", zipFile))
-
       setwd(oldDir)
       unlink(tmp)