From 9739770393c182e9758fa744f624e1d2dbb4fa43 Mon Sep 17 00:00:00 2001 From: Craig Williams Date: Thu, 7 Apr 2022 09:38:11 +0100 Subject: [PATCH] Strip comments, save files and whitespace blocks --- Parses.R | 25 +++------------------ app.R | 66 ++++++++------------------------------------------------ 2 files changed, 12 insertions(+), 79 deletions(-) diff --git a/Parses.R b/Parses.R index 8516969..8663e59 100644 --- a/Parses.R +++ b/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") - - - # print("about to build network") - # print(paste0(inputText, edges)) - - + # save(modelDefn, file = "buildGraph.RData") 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 diff --git a/app.R b/app.R index ca4bbb3..9b56dba 100644 --- a/app.R +++ b/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") %>% - layout(xaxis = xform, yaxis = list(dtick = 0.25, range = c(-1.25, 1.25)), showlegend = FALSE, title = title) + + plotly::plot_ly(boxPlot, x = boxPlot[, 1], y = ~Range, color = as.character(boxPlot$Group), colors = palette, type = "box") %>% + 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)