Change of calc position

MESOonline.R

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

app.R

@@ -48,8 +48,8 @@ ui<-dashboardPage(
              fluidRow(
               column(width=2,
                 h4('Pressure Test'),
-                uiOutput("pressureList"),
+                actionButton("calcAB", "Calc"),
-                actionButton("calcAB", icon('calculator'))
+                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,