From bfb1afbd3b737166179d75677d13f45bcbd19e0e Mon Sep 17 00:00:00 2001 From: spegg Date: Thu, 7 Feb 2019 15:43:34 +0000 Subject: [PATCH] Change of calc position --- MESOonline.R | 218 --------------------------------------------------- app.R | 5 +- 2 files changed, 2 insertions(+), 221 deletions(-) delete mode 100644 MESOonline.R diff --git a/MESOonline.R b/MESOonline.R deleted file mode 100644 index 5ed54d6..0000000 --- a/MESOonline.R +++ /dev/null @@ -1,218 +0,0 @@ -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')}) \ No newline at end of file diff --git a/app.R b/app.R index 0ac85d8..d4cac44 100644 --- a/app.R +++ b/app.R @@ -48,8 +48,8 @@ ui<-dashboardPage( fluidRow( column(width=2, h4('Pressure Test'), - uiOutput("pressureList"), - actionButton("calcAB", icon('calculator')) + actionButton("calcAB", "Calc"), + uiOutput("pressureList") ), column(width=10, h4('Effect on bio-assemblage'), @@ -233,7 +233,6 @@ server <- function(input, output, session) { sampleDists <- cpdist( fitted = modelList[[.selections$model]][[layer]]$cfit, nodes = bnlearn::nodes(modelList[[.selections$model]][[layer]]$cfit), - #evidence = eval(parse(text = expr)), evidence = eval(parse(text = expr)), method = "lw", n = 10000,