MESO/MESOonline.R

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')})