Initial Script
This commit is contained in:
218
MESOonline.R
Normal file
218
MESOonline.R
Normal file
@@ -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')})
|
||||
Reference in New Issue
Block a user