Initial Script

.hgignore

@@ -0,0 +1,4 @@
+syntax: glob
+.RData
+.Rhistory
+archive

MESOonline.R

@@ -0,0 +1,218 @@
+library(DT)
+library(shiny)
+library(shinyBS)
+library(shinyjs)
+library(shinydashboard)
+library(htmltools)
+library(DiagrammeR)
+library(magrittr)
+library(plotly)
+library(shiny)
+library(googleway)
+library(Rgraphviz) 
+
+addResourcePath("js", "./www/js")
+
+source('Parses.R')
+
+# shinyInput <- function(FUN, len, id, ...) {
+#   inputs <- character(len)
+#   for (i in seq_len(len)) {
+#     inputs[i] <- as.character(FUN(paste0(id, i), ...))
+#   }
+#   inputs
+# }
+
+ui<-dashboardPage(
+      dashboardHeader(title = "JNCC MESO online"),
+      dashboardSidebar(
+        sidebarMenu(id = "tabs",
+            menuItem("Pressure Test", tabName = "1", icon = icon("align-left", lib = "glyphicon")),
+            menuItem("Bayesian Network", tabName = "2", icon = icon("plug")),
+            menuItem("Habitats", tabName = "3", icon = icon("map")),
+            selectInput(ns("modelSelect"), "Select MESO model", choices=ns("output$selModels"), selected=NULL, multiple=FALSE)
+        )
+      ),
+      dashboardBody(
+        tabItems(
+          tabItem(tabName = "1",h4("Pressure Test"),
+                  fluidPage(
+                    fluidRow(
+                      column(width=3,
+                        radioButtons(ns("pressure1"), 'Sediment type', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure2"), 'Seabed type', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure3"), 'Material extraction', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure4"), 'Abrasion of seabed', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure5"), 'Penetration of seabed', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure6"), 'Siltation', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure7"), 'Wave exposure', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure8"), 'Suspended sediment', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure9"), 'Generic contamination', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure10"), 'Deoxygenation', choices=c('On', 'Off'), inline=TRUE),
+                        radioButtons(ns("pressure11"), 'Removal of target species', choices=c('On', 'Off'), inline=TRUE),
+                        actionButton(ns("calcAB"), "Calc")
+                      ),
+                      column(width=9, 
+                        plotlyOutput(ns("layer1"), height="300px") %>% withSpinner(),
+                        plotlyOutput(ns("layer2"), height="300px") %>% withSpinner(),
+                        plotlyOutput(ns("layer3"), height="300px") %>% withSpinner()
+                      )
+                    )
+                  )
+          ),
+          tabItem(tabName = "2",h4("Bayesian Network"),
+              fluidPage(
+                fluidRow(
+                  plotOutput(ns("bbnGraphPlot"))
+                ),
+                fluidRow(
+                  column(
+                    width=6,
+                    DT::dataTableOutput(ns('nodeTable'))
+                  ),
+                  column(
+                    width=6,
+                    DT::dataTableOutput(ns('edgeTable'))
+                  )
+                )
+              )
+          ),
+          tabItem(tabName = "3",h4("Habitats"),
+              fluidPage(
+                google_mapOutput(outputId = "map", width = "100%", height = "400px")
+              )
+          )
+        )
+      )
+}
+
+server <- function(input, output, session) {
+  #SERVER Constants
+  
+  print('Loading data')
+  
+  set_key("AIzaSyAw8_btgGN1drf8qhCxNcotP6r11qEXA_M")
+  dataStorage <- 'data/'
+  
+  models<-NULL
+  selectedModel <- NULL
+  
+  availableModels <- function() return(models)
+  
+  observeEvent(input$modelSelect, {
+    selectedModel <<- match(input$modelSelect, models)
+  })
+  
+  output$map <- renderGoogle_map({
+    google_map(location = c(0, 55), zoom = 10)
+  })
+  
+  #parse on load sheets in the input sheet folder
+  
+  modelList <- list()
+  fileList <- list.files(dataStorage, pattern='.xlsx')
+  
+  print(fileList)
+  
+  for (idx in 1:length(fileList)) {
+    tmp <- parseSheets(fileList[idx], plot=FALSE)
+    
+    if (!is.null(tmp)) {
+      modelList[[cnt]] <- tmp
+      models <<- c(models, substring(fileList[idx], start=1, stop=nchar(fileList[idx])-5))
+      print(paste('Model file successfully loaded', fileList[idx]))
+      cnt=cnt+1
+    }
+  }
+  
+  output$nodeTable <- DT::renderDataTable(modelList[[selectedModel]]$pressEcoServMap$nodes,
+      selection = 'single',options = list(searching = FALSE,pageLength = 10),server = TRUE, escape = FALSE,rownames= TRUE)
+
+  output$edgeTable <- DT::renderDataTable(modelList[[selectedModel]]$pressEcoServMap$edges,
+      selection = 'single',options = list(searching = FALSE,pageLength = 10),server = TRUE, escape = FALSE,rownames= TRUE)
+  
+  
+  output$bbnGraphPlot <- renderPlot({
+      graphviz.plot(modelList[[selectedModel]]$p_es$net)
+  })
+  
+  output$layer1 <- renderPlotly({
+    calcLikelihood(plot=TRUE)
+  })
+  
+  output$layer2 <- renderPlotly({
+    calcLikelihood(plot=TRUE)
+  })
+  
+  output$layer3 <- renderPlotly({
+    calcLikelihood(plot=TRUE)
+  })
+  
+  # TaskRow <- eventReactive(input$select_button,{
+  #   taskList[SelectedRow(),2:ncol(taskList)]
+  # })
+  # 
+  # points <- eventReactive(input$recalc, {
+  #   cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
+  # }, ignoreNULL = FALSE)
+  # 
+  # cities <- read.csv(textConnection("
+  #   City,Lat,Long,Pop
+  #   Boston,42.3601,41.0589,645966
+  #   Hartford,41.7627,42.6743,125017
+  #   New York City,40.7127,44.0059,8406000
+  #   Philadelphia,39.9500,45.1667,1553000
+  #   Pittsburgh,40.4397,39.9764,305841
+  #   Providence,41.8236,41.4222,177994
+  # "))
+  
+  # output$mymap <- renderLeaflet({
+  #   leaflet(cities) %>% addTiles() %>%
+  #     addCircles(lng = ~Long, lat = ~Lat, weight = 1,
+  #                radius = ~sqrt(Pop) * 30, popup = ~City
+  #     )
+  # })
+  
+  # output$mymap1 <- renderUI({
+  #   require(maptools)
+  #   
+  #   data(meuse)
+  #   coordinates(meuse) = ~x+y
+  #   proj4string(meuse) <- CRS("+init=epsg:28992")
+  #   
+  #   data(meuse.grid)
+  #   coordinates(meuse.grid)<-c('x','y')
+  #   meuse.grid<-as(meuse.grid,'SpatialPixelsDataFrame')
+  #   im<-as.image.SpatialGridDataFrame(meuse.grid['dist'])
+  #   cl<-ContourLines2SLDF(contourLines(im))
+  #   str(cl)
+  #   proj4string(cl) <- CRS('+init=epsg:28992')
+  #   
+  #   #m <- plotGoogleMaps(meuse, filename = 'myMap1.html', openMap = FALSE, streetViewControl = TRUE)
+  #   
+  #   # Combine point and line data
+  #   m<-plotGoogleMaps(meuse, mapTypeId='TERRAIN', openMap = FALSE) 
+  #   #mapMeusePoints<- plotGoogleMaps(cl, mapTypeId='TERRAIN', openMap = FALSE)
+  #   comboMap<- plotGoogleMaps(cl,add=TRUE, previousMap=m, openMap = FALSE, layerName='Lines')
+  #   finalMap<- plotGoogleMaps(comboMap, filename = '/home/spegg/R projects/draw/www/myMap1.htm', openMap = FALSE)
+  #   
+  #   tags$iframe(
+  #     srcdoc = paste(readLines('/home/spegg/R projects/draw/www/myMap1.htm'), collapse = '\n'),
+  #     width = "100%",
+  #     height = "600px"
+  #   )
+  # })
+  # 
+  # output$popup <- renderUI({
+  #   bsModal("taskModal", paste0("Task information for: ",SelectedRow()), "", size = "large",
+  #           column(12,                   
+  #                  DT::renderDataTable(TaskRow())
+  #           ),
+  #           column(6,
+  #                  actionButton("openTask", "Open Task")
+  #           )
+  #   )
+  # })
+}
+
+shinyApp(ui('JNCC'), function(...) {callModule(server, 'JNCC')})

Parses.R

@@ -0,0 +1,328 @@
+
+modules::import(openxlsx)
+modules::import(bnlearn)
+modules::import(stringr)
+modules::import(graph)
+modules::import(ggplot2)
+modules::import(stats)
+modules::import(plotly)
+modules::import(utils)
+
+
+#Improvements needed: make the selection of first row/column of nodes programmatic
+FIRST_NODE_COL <- 3
+
+mappings <- c('TestScenario', 'Map_P_BA', 'Map_BA_OP', 'Map_OP_ES')
+nodeTypes <- c('Input.Nodes', 'Internal.Nodes', 'Published.Nodes')
+states <- c('impact', 'confidence', 'growth', 'recovery')
+refs <-c(1:length(mappings))
+
+setEmpties <- function(val) {
+  if (is.na(val)) return(0) else return(val)
+}
+
+readXL <- function(fName, sheetN, startRow=1) {
+  xl <- read.xlsx(fName, sheet = sheetN, startRow)    #, rowNames = import)
+  return(data.frame(xl, stringsAsFactors = FALSE, row.names = NULL))
+}
+
+delNA <- function(vec) {
+  return(vec[!is.na(vec)])
+}
+
+parseScenario <- function(press, prefix = 'p') {
+  pressNames <- colnames(press)[2:length(colnames(press))]
+  coefs <- matrix(data=NA, nrow=length(pressNames), ncol=2, dimnames=list(NULL, c('growth', 'confidence')))
+  for (col in 2:ncol(press)) {
+    coefs[col-1,] <-  as.numeric(split(press[1, col]))[match(c('growth', 'confidence'), states)]
+  }
+  press[is.na(press)] <- 0
+  if (sum(duplicated(pressNames))>0) {
+    cat('Duplicated pressure node names found')
+    print(pressNodes[duplicated(pressNames)])
+  }
+  
+  return(list(
+    timeSeq=press, 
+    nodes=data.frame(name = pressNames, 
+                     code=paste0(prefix, seq(1:length(pressNames))), 
+                     growth = coefs[,'growth'], 
+                     confidence=coefs[,'confidence'], 
+                     stringsAsFactors = FALSE),
+    edges=data.frame(input=NULL, output=NULL, impact=NULL)
+  ))
+}
+
+getInitial <- function(string, letter) {
+  return(tolower(substr(string, start=1, stop=1)))
+}
+
+split <- function(cell) {
+  params <- unlist(strsplit(cell, ','))
+  values <- rep(0, length(states))
+  
+  for (n in 1:length(params)) {
+     kvp <- unlist(strsplit(params[n], '='))
+     ref <- match(getInitial(trimws(kvp[1])), getInitial(states))
+     if ((ref>0)  & (ref<=length(values))) {
+       values[ref] <- kvp[2]
+     } else {
+       print(paste('Unrecognised parameter(s):',params[n]))
+     }
+
+  }
+  return(values)
+
+}
+
+cleanTitles <- function(titleV) {
+  return(str_replace_all(titleV, c(' ' = '.', '-' = '')))
+}
+
+getOutNodes <- function(codes, codeList) {
+  v <- vector(mode='logical', length=length(codes))
+  for (idx in 1:length(codes)) {
+    v[idx] <- (sum(startsWith(codes[idx], codeList))>0)
+  }
+  return(v)
+}
+
+buildGraph <- function(model, desc) {
+
+  #model contains the following
+  # node table, edge table
+  
+  #descriptor (desc) contains:
+  #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 ="")
+
+  #do the internal nodes
+  edges <- ""
+
+  outNodes <- model$nodes$code[getOutNodes(model$nodes$code, desc$outputCodes)]
+  outDist <- vector(mode="list", length=length(outNodes))
+
+  for (idx in 1:length(outNodes)) {
+    nodeRef <- match(outNodes[idx], model$nodes$code)
+
+    rows <- which(model$edges$output == outNodes[idx])
+    inputsStr <- paste0(model$edges$input[which(model$edges$output == outNodes[idx])], sep=":", collapse="")
+    edges <- paste0(edges, paste0("[", outNodes[idx], "|", substr(inputsStr, start=1, stop=(nchar(inputsStr)-1)), "]"))
+
+    #Make the coefficient of the distribution
+    coefVal <- setNames(c(model$nodes$growth[nodeRef], model$edges$impact[rows]), 
+                        c("(Intercept)", model$edges$input[rows])
+                        )
+    #str(coefVal)
+    outDist[[idx]] <- list(coef = coefVal, 
+                         sd = model$nodes$confidence[nodeRef])
+  }
+  
+  print('about to build network')
+
+  net <- model2network(paste0(inputText, edges))
+  
+  print('network build successful')
+
+  inDist <- vector(mode="list", length=length(inputNodes))
+
+  for (idx in 1:length(inputNodes)) {
+    inRef <- match(inputNodes[idx], model$nodes$code)
+    coefVal <- setNames(model$nodes$growth[inRef], "(Intercept)")
+    inDist[[idx]] <- list(coef = coefVal, sd = model$nodes$confidence[inRef])
+  }
+
+  allDists = as.list(setNames(c(inDist, outDist), c(inputNodes, outNodes)))
+  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')
+  
+  model$edges$input <- model$nodes$name[match(model$edges$input, model$nodes$code)]
+  model$edges$output <- model$nodes$name[match(model$edges$output, model$nodes$code)]
+  
+  return(
+    list(
+      nodes = model$nodes,
+      edges = model$edges,
+      net = net,
+      cfit = cfit,
+      allDists = allDists,
+      summDists = summDists
+    )
+  )
+}
+
+
+getValidNodes <- function(mapping, prevOutputs, prefix) {
+  
+  #Find row id for input nodes, internal and published
+  inputNodes <- mapping[2:nrow(mapping),1]
+  
+  #check that all input nodes are in the previous table
+  inputNodes <- delNA(mapping[mapping[,"Node.Type"] == 'input', "Nodes"])
+  if (length(inputNodes)>0) {
+    if (sum(inputNodes %in% prevOutputs$name)<length(inputNodes)) {
+      cat('Missing entries for input nodes in previous output columns')
+      print(inputNodes[!inputNodes %in% prevOutputs$name])
+    }
+  } else print('Invalid sheet - table must have at least one input row containing names from previous table')
+  
+
+  #Check the row headings concur with previous names
+  validInputs <- delNA(inputNodes[which(unique(inputNodes) %in% prevOutputs$name)])
+  if (length(validInputs)==0) print('Invalid sheet - table must have at least one input row containing names from previous table')
+  
+  
+  inputInts <- delNA(inputNodes[mapping$Node.Type!='link'])
+
+  if (sum(duplicated(inputInts))>0) {
+    cat('Duplicated input node names found')
+    print(inputNodes[duplicated(inputNodes)])
+  }
+  
+  outNodes <- delNA(colnames(mapping)[FIRST_NODE_COL:ncol(mapping)])
+  if (sum(duplicated(outNodes))>0) {
+    cat('Duplicated output node names found')
+    print(outNodes[duplicated(outNodes)])
+  }
+  
+  
+  #check that all internal nodes are in the columns
+  intNodes <- delNA(mapping[mapping[,"Node.Type"] == 'internal', "Nodes"])
+  if (length(intNodes)>0) {
+    if (sum(intNodes %in% outNodes)<length(intNodes)) {
+      cat('Missing entries for internal nodes in output columns')
+      print(intNodes[!intNodes %in% outNodes])
+    }
+  }
+  
+  coefs <- matrix(data=NA, nrow=length(outNodes), ncol=2, dimnames=list(NULL, c('growth', 'confidence')))
+  for (idx in 1:length(outNodes)) {
+    col <- match(outNodes[idx], colnames(mapping))
+    coefs[idx,] <-  as.numeric(split(mapping[1, col]))[match(c('growth', 'confidence'), states)]
+  }
+
+  return(data.frame(
+    code=c(prevOutputs$code, paste0(prefix, seq(1:length(outNodes)))), 
+    name=c(prevOutputs$name, outNodes),
+    growth=c(prevOutputs$growth, coefs[,"growth"]),
+    confidence=c(prevOutputs$confidence, coefs[,"confidence"]),
+    stringsAsFactors=FALSE
+  ))
+}
+
+getCode <- function(name, nodeDF) {
+  nodeDF$code[match(name, nodeDF$name)]
+}
+
+getValidEdges <- function(mapping, nodeDF, prevEdge=NULL, prefix) {
+  str(nodeDF)
+  edgeCols <- c('inputNode', 'outputNode', 'impact')
+  edgeM <- matrix(data=NA, nrow=0, ncol=length(edgeCols), dimnames=list(NULL, edgeCols))
+  
+  #to start let just get the statements and print them out....
+  for (col in FIRST_NODE_COL:ncol(mapping)) {
+    count=0
+    
+    for (row in 2:nrow(mapping)) {
+
+      if (!is.na(mapping[row, col])) {
+        edgeM <- rbind(edgeM, 
+          c(getCode(mapping[row, 1], nodeDF), 
+            getCode(colnames(mapping)[col], nodeDF), 
+            split(mapping[row,col])[match('impact', states)]
+           )
+        )
+        count=count+1
+      }
+      #if (count==0) print(paste('No edges found for output', colnames(mapping)[col]))
+    }
+  }
+  if (is.null(prevEdge)) return (
+    data.frame(
+      input = edgeM[,"inputNode"],
+      output = edgeM[,"outputNode"],
+      impact = as.numeric(edgeM[,"impact"]),
+      stringsAsFactors = FALSE
+    )
+  ) else return (
+    data.frame(
+      input = c(prevEdge$input, edgeM[,"inputNode"]),
+      output = c(prevEdge$output, edgeM[,"outputNode"]),
+      impact = c(prevEdge$impact, as.numeric(edgeM[,"impact"])),
+      stringsAsFactors = FALSE
+    )
+  )
+}
+
+parseMapping <- function(mapping, prevOutputs, prefix) {
+  
+  mapping <- mapping[,-1]
+  mapping[,1] <- cleanTitles(mapping[,1])
+  
+  nodeDF <- getValidNodes(mapping, prevOutputs$nodes, prefix)
+  edgeDF <- getValidEdges(mapping, nodeDF, prevEdge=prevOutputs$edges, prefix)
+
+  return(list(
+    #New structure
+    nodes=nodeDF,
+    edges=edgeDF
+  ))
+
+}
+
+parseSheet <- function(fName) {
+  #get sheet names
+  
+  print(paste('starting sheet load', fName))
+  
+  if (file.exists(fName)) {
+    names <- openxlsx::getSheetNames(fName)
+    
+    if (length(names)>0) {
+      
+      sheets <- sort(delNA(match(names, mappings)))
+      
+      cat('starting sheet parse')
+      print(sheets)
+      
+      if (sum(sheets==refs)==length(refs)) {
+        #read all mapping tables
+        scenario <-  parseScenario(readXL(fName,mappings[1], startRow=1), prefix='p')
+        p_ba <-  parseMapping(readXL(fName,mappings[2], startRow=1), scenario, prefix='ba')
+        p_op <- parseMapping(readXL(fName,mappings[3], startRow=1), p_ba, prefix='op')
+        p_es <- parseMapping(readXL(fName,mappings[4], startRow=1), p_op, prefix='es')
+        
+        print('building graphs')
+
+        p_baNet <- buildGraph(p_ba, desc=list(inputCode='p', outputCodes='ba'))
+        p_opNet <- buildGraph(p_op, desc=list(inputCode='p', outputCodes=c('ba', 'op')))
+        p_esNet <- buildGraph(p_es, desc=list(inputCode='p', outputCodes=c('ba', 'op', 'es')))
+        
+        print('sheet load completed')
+        return(
+          list(
+            pressBioAss = p_baNet,
+            pressOpProc = p_opNet,
+            pressEcoServ = p_esNet
+          )
+        )
+
+      } else {
+        print(paste('Sheets found include', mappings[sheets]))
+        cat('Missing sheets are:')
+        print(refs[-sheets])
+      }
+    }
+  }
+}

app.R

@@ -0,0 +1,267 @@
+modules::import(DT)
+modules::import(shiny)
+modules::import(shinyBS)
+modules::import(shinyjs)
+modules::import(shinydashboard)
+modules::import(htmltools)
+modules::import(DiagrammeR)
+modules::import(magrittr)
+modules::import(plotly)
+modules::import(kableExtra)
+modules::import(Rgraphviz)
+modules::import(knitr)
+modules::import(shinycssloaders)
+modules::import(googleway)
+modules::import(Rgraphviz)
+modules::import(bnlearn)
+
+parser <- modules::use('Parses.R')
+
+layers <- c("Pressures to Bio-Assemblages", "Bio-Assemblages to Output Processes", "Output Processes to Eco-system services")
+transitions <- c("Pressures to Bio-Assemblages", "Pressures to Output Processes", "Pressures to Eco-system services")
+addResourcePath("js", "./www/js")
+
+ui<-dashboardPage(
+      dashboardHeader(title = "JNCC MESO online"),
+      dashboardSidebar(
+        sidebarMenu(id = "tabs",
+            menuItem("Pressure Test", tabName = "1", icon = icon("arrow-down")),
+            menuItem("Bayesian Network", tabName = "2", icon = icon("atom")),
+            menuItem("Habitats", tabName = "3", icon = icon("atlas")),
+            selectInput("modelSelect", "Select MESO model", choices=c(""), selected=NULL, multiple=FALSE),
+            selectInput("layerSelect", "Select Transition", 
+                        choices=transitions, 
+                        selected=NULL, multiple=FALSE)
+        )
+      ),
+      dashboardBody(
+        tabItems(
+          tabItem(tabName = "1",
+                 fluidRow(
+                  column(width=2,
+                    h4('Pressure Test'),
+                    radioButtons("pressure1", 'Sediment type', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure2", 'Seabed type', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure3", 'Material extraction', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure4", 'Abrasion of seabed', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure5", 'Penetration of seabed', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure6", 'Siltation', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure7", 'Wave exposure', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure8", 'Suspended sediment', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure9", 'Generic contamination', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure10", 'Deoxygenation', choices=c('On', 'Off'), inline=TRUE),
+                    radioButtons("pressure11", 'Removal of target species', choices=c('On', 'Off'), inline=TRUE),
+                    actionButton("calcAB", "Calc")
+                  ),
+                  column(width=10, 
+                    h4('Effect on bio-assemblage'),
+                    plotlyOutput("layer1", height="270px") %>% withSpinner(),
+                    h4('Effect on Output Processes'),
+                    plotlyOutput("layer2", height="270px") %>% withSpinner(),
+                    h4('Effect on Eco-system services'),
+                    plotlyOutput("layer3", height="270px") %>% withSpinner()
+                  )
+               )
+          ),
+          tabItem(tabName = "2",h4("Bayesian Network"),
+              fluidPage(
+                fluidRow(
+                  plotOutput("bbnGraphPlot")
+                ),
+                fluidRow(
+                  column(
+                    width=6,
+                    h4('Ecoservice nodes'),
+                    DT::dataTableOutput('nodeTable')
+                  ),
+                  column(
+                    width=6,
+                    h4('Ecoservice influences'),
+                    DT::dataTableOutput('edgeTable')
+                  )
+                )
+              )
+          ),
+          tabItem(tabName = "3",h4("Habitats"),
+              fluidPage(
+                google_mapOutput(outputId = "map", width = "100%", height = "750px")
+              )
+          )
+        )
+      )
+)
+
+server <- function(input, output, session) {
+  #SERVER Constants
+ 
+  print('Loading data')
+  
+  set_key("AIzaSyAw8_btgGN1drf8qhCxNcotP6r11qEXA_M")
+  dataStorage <- 'data/'
+  
+  models<-NULL
+  
+  getAvailableModels <- function() {
+    fileList <- list.files(dataStorage, pattern='.xlsx')
+    
+    print(fileList)
+    modelList <- list()
+    cnt<-1
+    
+    for (idx in 1:length(fileList)) {
+      print(paste('attempting to load', paste0(dataStorage, fileList[idx])))
+      tmp <- parser$parseSheet(paste0(dataStorage, fileList[idx]))
+      
+      if (!is.null(tmp)) {
+        modelList[[cnt]] <- tmp
+        
+        #tidy up the list for displaying
+        
+        models <<- c(models, substr(fileList[idx], 1, (nchar(fileList[idx])-5)))
+        print(paste('Model file successfully loaded', fileList[idx]))
+        cnt=cnt+1
+        
+        
+      }
+    }
+    
+    updateSelectInput(session, "modelSelect", choices=models)
+    
+    return(modelList)
+  }
+  
+  
+  .selections <- reactiveValues(model=1, layer=1)
+  
+  #parse on load sheets in the input sheet folder
+  modelList <- getAvailableModels()
+  
+  calcLikelihood <- function(layer) {
+    
+    isolate({
+      if (layer==1) layerStr='ba' else if (layer==2) layerStr='op' else layerStr ='es'
+      nodeList <- modelList[[.selections$model]][[.selections$layer]]$nodes
+      str(nodeList)
+      nodeNames <- nodeList$name[startsWith(nodeList$code, layerStr)]
+      mean = runif(length(nodeNames), min=-1, max=1)
+      sd = runif(length(nodeNames), min=-0.25, max=0.25)
+      
+      df <- data.frame(
+        nodeNames = nodeNames,
+        range = c((mean - (3*sd)), (mean - (2*sd)), (mean - sd), mean,
+                  (mean + sd), (mean + (2*sd)), (mean + (3*sd))),
+        stringsAsFactors=FALSE
+      )
+      print(df)
+    })
+    return(
+      df
+    )
+    # isolate({   
+    #   
+    #   if (layer==1) layerStr='ba' else if (layer==2) layerStr='op' else if (layer==3) layerStr='es'
+    #     
+    #   layerRange <- which(startsWith(modelList[[.selections$model]][[layer]]$nodes, layerStr))
+    #   distList <- modelList[[.selections$model]][[layer]]$summDist[,layerRange]
+    #   nodeNames <- modelList[[.selections$model]][[layer]]$nodes$name[layerRange]
+    #     
+    #   }
+      
+    #   print(paste('Length of layer & node names',layer, length(nodeNames)))
+    #
+    #   distList <- modelList[[.selections$model]][[layer]]$summDist
+    #   colNames <- c('min', 'q1', 'q1', 'mean', 'q3', 'q3', 'max')
+    #   distM <- matrix(data=NA, nrow=ncol(distList), ncol=length(colNames))
+    #   
+    #   print(paste('Length of distributions',nrow(distM)))
+
+    #   for (col in 1:ncol(distList)) {
+    #     valsAsStrs <- unlist(strsplit(distList[,col], ":"))
+    #     valIdxs <- seq(from=2, to=length(valsAsStrs), by=2)
+    #     distVals <- as.numeric(valsAsStrs[valIdxs])
+    #     distM[col,] <- c(distVals[1], distVals[2], distVals[2], distVals[4], distVals[5], distVals[5], distVals[6])
+    #   }
+    # })
+    #
+    #  df <- data.frame(
+    #        nodeNames = nodeNames,
+    #        dist = distM,
+    #        stringsAsFactors=FALSE
+    #      )
+    #  print(df)
+    # 
+    # return(
+    #   df   
+    #    )
+  }
+  
+  
+  .likelihoods <-reactiveValues(
+    p_ba = calcLikelihood(1),
+    ba_os = calcLikelihood(2),
+    os_es = calcLikelihood(3)
+  )
+ 
+  observeEvent(input$modelSelect, {
+    .selections$model <<- match(input$modelSelect, models)
+    #print(.selections$model)
+  })
+  
+  observeEvent(input$layerSelect, {
+    .selections$layer <<- match(input$layerSelect, transitions)
+    #print(.selections$layer)
+  })
+  
+  observeEvent(input$calcAB, {
+    #print(paste('Action button pressed', input$calcAB))
+    
+      .likelihoods$p_ba <<- calcLikelihood(1)
+      .likelihoods$ba_os <<- calcLikelihood(2)
+      .likelihoods$os_es <<- calcLikelihood(3)
+
+  })
+  
+  output$map <- renderGoogle_map({
+    google_map(location = c(55, 0), zoom = 7)
+  })
+  
+ 
+  
+  
+  output$nodeTable <- DT::renderDataTable(
+    
+    modelList[[.selections$model]][[.selections$layer]]$nodes,
+      selection = 'single',options = list(searching = TRUE, pageLength = 10),server = TRUE, escape = FALSE,rownames= TRUE
+    )
+
+  output$edgeTable <- DT::renderDataTable(
+    
+    modelList[[.selections$model]][[.selections$layer]]$edges,
+      selection = 'single',options = list(searching = TRUE, pageLength = 10),server = TRUE, escape = FALSE,rownames= TRUE
+  )
+  
+  output$bbnGraphPlot <- renderPlot({
+    graphviz.plot(modelList[[.selections$model]][[.selections$layer]]$net)
+  })
+  
+  output$layer1 <- renderPlotly({
+    plot_ly(.likelihoods$p_ba, y = ~range, color = ~nodeNames, type = "box")
+  })
+
+  output$layer2 <- renderPlotly({
+    #print(.likelihoods)
+    
+    if (.selections$layer>1) {
+      plot_ly(.likelihoods$ba_os, y = ~range, color = ~nodeNames, type = "box")
+    }
+  })
+
+  output$layer3 <- renderPlotly({
+    
+    if (.selections$layer>2) {
+      plot_ly(.likelihoods$os_es, y = ~range, color = ~nodeNames, type = "box")
+    }
+  })
+}
+
+shinyApp(ui, server)

www/js/custom.js

@@ -0,0 +1,204 @@
+
+var avsdev = {
+  pivot: {
+    dataFile: null,
+    rowKey: 25,
+    colKey: 400,
+    active: false
+  },
+  geoView: {
+    active: false,
+    firstRun: true
+  },
+  cc: {
+"DZA":"DZA - Algeria","AGO":"AGO - Angola","BEN":"BEN - Benin","BWA":"BWA - Botswana","BFA":"BFA - Burkina Faso","BDI":"BDI - Burundi","CMR":"CMR - Cameroon","CPV":"CPV - Cape Verde","CAF":"CAF - Central African Republic","TCD":"TCD - Chad","COM":"COM - Comoros","COD":"COD - Democratic Republic of the Congo","DJI":"DJI - Djibouti","EGY":"EGY - Egypt","GNQ":"GNQ - Equatorial Guinea","ERI":"ERI - Eritrea","ETH":"ETH - Ethiopia","GAB":"GAB - Gabon","GMB":"GMB - Gambia","GHA":"GHA - Ghana","GIN":"GIN - Guinea","GNB":"GNB - Guinea-Bissau","CIV":"CIV - Côte d'Ivoire","KEN":"KEN - Kenya","LSO":"LSO - Lesotho","LBR":"LBR - Liberia","LBY":"LBY - Libya","MDG":"MDG - Madagascar","MWI":"MWI - Malawi","MLI":"MLI - Mali","MRT":"MRT - Mauritania","MUS":"MUS - Mauritius","MAR":"MAR - Morocco","MOZ":"MOZ - Mozambique","NAM":"NAM - Namibia","NER":"NER - Niger","NGA":"NGA - Nigeria","COG":"COG - Republic of the Congo","RWA":"RWA - Rwanda","SHN":"SHN - Saint Helena","STP":"STP - Sao Tome and Principe","SEN":"SEN - Senegal","SYC":"SYC - Seychelles","SLE":"SLE - Sierra Leone","SOM":"SOM - Somalia","ZAF":"ZAF - South Africa","SSD":"SSD - South Sudan","SDN":"SDN - Sudan","SWZ":"SWZ - Swaziland","TZA":"TZA - Tanzania","TGO":"TGO - Togo","TUN":"TUN - Tunisia","UGA":"UGA - Uganda","ESH":"ESH - Western Sahara","ZMB":"ZMB - Zambia","ZWE":"ZWE - Zimbabwe"
+  }
+};
+
+function debounce(func, wait, immediate) {
+	var timeout;
+	return function() {
+		var context = this, args = arguments;
+		clearTimeout(timeout);
+		timeout = setTimeout(function() {
+			timeout = null;
+			if (!immediate) func.apply(context, args);
+		}, wait);
+		if (immediate && !timeout) func.apply(context, args);
+	};
+}
+
+
+$(document).on('shiny:inputchanged', function(event){
+
+  if (event.name == 'selectView') {
+    avsdev.pivot.active = false;
+    avsdev.geoView.active = false;
+
+    if (event.value == "Geo Image") {
+      avsdev.geoView.active = true;
+      if (avsdev.geoView.firstRun) {
+        zoomGeoView();
+        avsdev.geoView.firstRun = false;
+      }
+    }
+    if (event.value == "Pivot Table") {
+      avsdev.pivot.active = true;
+      drawPivot();
+    }
+  }
+
+  if (event.name == '.clientdata_output_geoView-mapImage_hidden') {
+    avsdev.geoView.active = !event.value;
+    if (avsdev.geoView.firstRun) {
+      zoomGeoView();
+      avsdev.geoView.firstRun = false;
+    }
+  }
+});
+
+
+
+//  GEO
+
+
+_zoomGeoView = function(){
+  if (avsdev.geoView.active === false) {
+    return;
+  }
+
+  var img = $($("#geoView-mapImage").children("img")[0]);
+
+  if (img.hasClass("zoomed")) {
+
+    if (document.querySelector('#geoView-mapImage img')) {
+      document.querySelector('#geoView-mapImage img').dispatchEvent(new CustomEvent('wheelzoom.destroy'));
+      img.removeClass("zoomed");
+    }
+  }
+
+  if (!img.hasClass("zoomed")) {
+    wheelzoom(img);
+    img.addClass("zoomed");
+  }
+};
+zoomGeoView = debounce(function(){ _zoomGeoView() }, 500);
+
+/*
+$(document).on('shiny:sessioninitialized', function(event){
+  console.log("shiny:sessioninitialized")
+  zoomGeoView()
+});
+*/
+
+$(document).on('shiny:value', function(event){
+  if (event.name == 'geoView-mapImage') {
+    zoomGeoView();
+  }
+});
+
+
+// PIVOT
+
+_drawPivot = function() {
+  if (avsdev.pivot.active === false) {
+    return;
+  }
+
+  $.getJSON(avsdev.pivot.dataFile, function(data) {
+    data = $(data).each(function(id, v){
+      v.Country = avsdev.cc[v.Country];
+    });
+    data = $.makeArray(data);
+
+    var renderers = $.extend($.pivotUtilities.renderers, $.pivotUtilities.plotly_renderers);
+    renderers = $.extend(renderers, $.pivotUtilities.avsdev_renderers);
+
+    $("#pivot-pivotRender").pivotUI(data, {
+      rows: ["Grid Dist."],
+      cols: ["Pop Density"],
+      aggregatorName: "Sum",
+      vals: ["Population"],
+      renderers: renderers,
+      rendererName: "Coloured Pivot Table",
+      hiddenFromDragDrop: ["Population"],
+      hiddenFromAggregators: ["Grid Dist.", "Country", "Pop Density"],
+      onRefresh: function(config) {
+        var config_copy = JSON.parse(JSON.stringify(config));
+        //delete some values which are functions
+        delete config_copy.aggregators;
+        delete config_copy.renderers;
+        //delete some bulky default values
+        delete config_copy.rendererOptions;
+        delete config_copy.localeStrings;
+        //console.log(JSON.stringify(config_copy, undefined, 2));
+
+        var grid = $("td[data-rowkey]").filter(function() {
+            return $(this).data("rowkey") <= avsdev.pivot.rowKey;
+        });
+        var solar = $("td[data-rowkey]").filter(function() {
+            return $(this).data("rowkey") > avsdev.pivot.rowKey;
+        }).filter(function() {
+            return $(this).data("colkey") <= avsdev.pivot.colKey;
+        });
+        var target = $("td[data-rowkey]").filter(function() {
+            return $(this).data("rowkey") > avsdev.pivot.rowKey;
+        }).filter(function() {
+            return $(this).data("colkey") > avsdev.pivot.colKey;
+        });
+
+        grid.addClass("power-grid");
+        solar.addClass("power-solar");
+        target.addClass("power-target");
+
+        var gridVal = grid.map(function() {
+          return $(this).data("value");
+        }).get().reduce(function(a, b) { return a + b; }, 0);
+
+        var solarVal = solar.map(function() {
+          return $(this).data("value");
+        }).get().reduce(function(a, b) { return a + b; }, 0);
+
+        var miniVal = target.map(function() {
+          return $(this).data("value");
+        }).get().reduce(function(a, b) { return a + b; }, 0);
+
+        var totalVal = gridVal + solarVal + miniVal;
+        var offGrid = parseInt($($("#summary-summaryTable table td")[6]).text())
+
+        $($("#summary-summaryTable table td")[1]).text(Math.round(totalVal - offGrid).toLocaleString('en'));
+        $($("#summary-summaryTable table td")[2]).text(Math.round(offGrid - solarVal - miniVal).toLocaleString('en'));
+        $($("#summary-summaryTable table td")[3]).text(Math.round(solarVal).toLocaleString('en'));
+        $($("#summary-summaryTable table td")[4]).text(Math.round(miniVal).toLocaleString('en'));
+        $($("#summary-summaryTable table td")[5]).text(Math.round(totalVal).toLocaleString('en'));
+      }
+    });
+  });
+
+  //console.log($("td").find(`[data-colKey > 500]`))
+  //$("#loading-pivot img").toggleClass("collapse");
+  //$("#pivot").toggleClass("collapse");
+};
+drawPivot = debounce(function(){ _drawPivot() }, 750);
+
+Shiny.addCustomMessageHandler("render-pivot",
+  function(message) {
+    avsdev.pivot.dataFile = message.countryTotPath[0] + ".json";
+    drawPivot();
+  }
+);
+
+
+$(document).on('shiny:inputchanged', function(event){
+  if (event.name == 'control-selectCountry') {
+    drawPivot();
+  } else if (event.name == 'control-selectGrid') {
+    avsdev.pivot.rowKey = event.value;
+    drawPivot();
+  } else if (event.name == 'control-selectPopDensity') {
+    avsdev.pivot.colKey = event.value;
+    drawPivot();
+  } else if (event.name == 'control-selectData') {
+    drawPivot();
+  }
+});

www/js/draw.html

@@ -0,0 +1,58 @@
+var laydown = {
+  diagram: {
+    dataFile: null
+  }
+}
+
+var graph = new joint.dia.Graph;
+
+var paper = new joint.dia.Paper({
+    el: document.getElementById('myholder'),
+    model: graph,
+    width: 600,
+    height: 100,
+    gridSize: 1
+});
+
+var rect = new joint.shapes.standard.Rectangle();
+var rect2 = rect.clone();
+var link = new joint.shapes.standard.Link();
+
+drawDiagram = function() {
+	rect.position(100, 30);
+	rect.resize(100, 40);
+	rect.attr({
+	    body: {
+		fill: 'blue'
+	    },
+	    label: {
+		text: 'Hello',
+		fill: 'white'
+	    }
+	});
+	rect.addTo(graph);
+
+
+	rect2.translate(300, 0);
+	rect2.attr('label/text', 'World!');
+	rect2.addTo(graph);
+
+
+	link.source(rect);
+	link.target(rect2);
+	link.addTo(graph);
+}
+
+
+
+Shiny.addCustomMessageHandler("render-pivot",
+  function(message) {
+    laydown.diagram.dataFile = message.laydown + ".json";
+    drawDiagram();
+  }
+);
+
+
+$(document).on('shiny:inputchanged', function(event){
+   //TO BE INTEGRATED
+});

www/js/draw.js

@@ -0,0 +1,124 @@
+var dataFile = null;
+
+addPort = function() {
+  
+}
+
+drawDiagram = function() {
+  var graph = new joint.dia.Graph();
+
+  var paper = new joint.dia.Paper({
+    el: document.getElementById('laydown'),
+    model: graph,
+    width: 1600,
+    height: 1000,
+    gridSize: 1
+  });
+  
+
+  //Declare an array of rectangles - assign icon, name, 
+  //for each asset in datafile.assets add a rectangle
+  var row=0;
+  var col=0;
+  var space=" ";
+  var port = {
+    // id: 'abc', // generated if `id` value is not present
+    group: 'a',
+    args: {}, // extra arguments for the port layout function, see `layout.Port` section
+    label: {
+        position: {
+            name: 'right',
+            args: { y: 6 } // extra arguments for the label layout function, see `layout.PortLabel` section
+        },
+        markup: '<text class="label-text" fill="blue"/>'
+    },
+    attrs: { text: { text: 'port1' } },
+    //markup: '<rect width="16" height="16" x="-8" strokegit ="red" fill="gray"/>'
+  };
+
+  var assetRects = [];
+  
+  dataFile.assets.id.forEach(function(n) {
+    var rect = new joint.shapes.standard.Rectangle({
+      position: {x:  (160*col+120), y: (240*row +120) },
+      size: {width: 120, height: 80},
+      ports: {
+        groups: {
+          'a': { position: 'top'},
+          'b': { position: 'bottom'}
+        },
+        items: [port]
+      }
+    });
+    
+    name = dataFile.assets.stencil[n-1].concat(space, dataFile.assets.testRole[n-1]);
+    //rect.position(240*row, 160*col);
+	  //rect.resize(120, 80);
+	  rect.attr({
+	    body: {
+		    fill: 'blue'
+	    },
+	    label: {
+		    text: name,
+		    fill: 'white'
+	    }
+	  });
+	  assetRects.push(rect);
+    rect.addTo(graph);
+    col++;
+    if (col==5) {
+      col=0;
+      row++;
+    }
+  });
+  
+  var linkArray = [];
+  
+  console.log(dataFile.logConns);
+  thisObj="Links ";
+  //Declare an array of links - assign names
+  dataFile.logConns.id.forEach(function(lc) {
+  //for (var id in dataFile.logConns) {
+    fromAsset = dataFile.logConns.fromId[lc-1];
+    toAsset= dataFile.logConns.toId[lc-1];
+    //console.log(thisObj.concat(lc, " ; ", fromAsset, " : ",toAsset, " : ", fromAsset, " ; ", assetRects[toAsset]));
+    var link = new joint.shapes.standard.Link();
+    link.source(assetRects[fromAsset-1]);
+	  link.target(assetRects[toAsset-1]);
+	  link.router('manhattan');
+    link.connector('jumpover');
+	  linkArray.push(link);
+	  link.addTo(graph);
+  });
+  
+  paper.options.defaultRouter = {
+    name: 'manhattan',
+    args: {
+        elementPadding: 10
+    }
+  };
+
+  paper.on('cell:pointerclick', function(cellView) {
+    cellView.highlight();
+    console.log(cellView);
+  });
+	
+};
+
+Shiny.addCustomMessageHandler("render-laydown",
+    function(message){
+      try {
+        console.log("Draw diagram");
+        dataFile = message;
+        drawDiagram();
+      } catch(e) {
+        console.log("error object:");
+        console.log(e);
+      }
+    }
+);
+
+
+$(document).on('shiny:inputchanged', function(event){
+   //TO BE INTEGRATED
+});

www/js/getMouse.js

@@ -0,0 +1,61 @@
+/**
+  * Retrieve the coordinates of the given event relative to the center
+* of the widget.
+*
+  * @param event
+*   A mouse-related DOM event.
+* @param reference
+*   A DOM element whose position we want to transform the mouse coordinates to.
+* @return
+*    A hash containing keys 'x' and 'y'.
+*/
+function getRelativeCoordinates(event, reference) {
+    var x, y;
+    event = event || window.event;
+    var el = event.target || event.srcElement;
+    console.log(el);
+    if (!window.opera && typeof event.offsetX != 'undefined') {
+      // Use offset coordinates and find common offsetParent
+      var pos = { x: event.offsetX, y: event.offsetY };
+      
+      // Send the coordinates upwards through the offsetParent chain.
+      var e = el;
+      while (e) {
+        e.mouseX = pos.x;
+        e.mouseY = pos.y;
+        pos.x += e.offsetLeft;
+        pos.y += e.offsetTop;
+        e = e.offsetParent;
+      }
+      
+      // Look for the coordinates starting from the reference element.
+      var ref = reference;
+      var offset = { x: 0, y: 0 };
+      while (ref) {
+        if (typeof ref.mouseX != 'undefined') {
+          x = ref.mouseX - offset.x;
+          y = ref.mouseY - offset.y;
+          break;
+        }
+        offset.x += ref.offsetLeft;
+        offset.y += ref.offsetTop;
+        ref = ref.offsetParent;
+      }
+      
+      // Reset stored coordinates
+      ref = el;
+      while (ref) {
+        ref.mouseX = undefined;
+        reference.mouseY = undefined;
+        ref = ref.offsetParent;
+      }
+    }
+    else {
+      // Use absolute coordinates
+      var pos = getAbsolutePosition(reference);
+      x = event.pageX  - pos.x;
+      y = event.pageY - pos.y;
+    }
+    // Subtract distance to middle
+    return { x: x, y: y };
+  }