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