modules::import(DT)
modules::import(shiny)
modules::import(shinyBS)
modules::import(shinyjs)
modules::import(shinydashboard)
modules::import(shinydashboardPlus)
modules::import(htmltools)
modules::import(DiagrammeR)
modules::import(magrittr)
modules::import(plotly)
modules::import(kableExtra)
modules::import(Rgraphviz)
modules::import(knitr)
modules::import(shinycssloaders)
modules::import(googleway)
modules::import(bnlearn)
modules::import(visNetwork)

parser <- modules::use('Parses.R')

layers <- c("Pressures to Bio-Assemblages", "Bio-Assemblages to Output Processes", "Output Processes to Ecosystem services")
transitions <- c("Pressures to Bio-Assemblages", "Pressures to Output Processes", "Pressures to Ecosystem services")
impacts <- c('Very High', '>=High', '>=Medium', '>=Low', 'All')
thresholds <- c(0.97, 0.9, 0.7, 0.17, 0)
impLabels <- c('Very High', 'High', 'Medium', 'Low', 'Very Low')

addResourcePath("js", "./www/js")

ui<-dashboardPage(
      dashboardHeader(title = "JNCC MESO online", 
        
        tags$li(
          id = "dropdownHelp",
          class = "dropdown",
          tags$head(
            tags$script(
              paste0(
                "$(document).ready(function(){",
                "  $('#dropdownHelp')",
                "  .find('ul')",
                "  .click(function(e) { e.stopPropagation(); });",
                "});"
              )
            )
          ),
          tags$a(
            href = "javascript:void(0);",
            class = "dropdown-toggle",
            `data-toggle` = "dropdown",
            icon("question")
          ),
          tags$ul(
            class = "dropdown-menu",
            style = "left: auto; right: 0; min-width: 200px",
            tags$li(
              tags$div(
                style = "margin-left: auto; margin-right: auto; width: 90%;",
                tags$a(
                  href = "Manual.pdf",
                  target = "_BLANK",
                  "Open user guide in a new tab"
                )
              )
            ),
            tags$li(
              tags$div(
                style = "margin-left: auto; margin-right: auto; width: 90%;",
                downloadLink(
                  "linkBackgroundData",
                  "Download excel sheets"
                )
              )
            )
          )
        )
      ),
      dashboardSidebar(
        sidebarMenu(id = "tabs",
            menuItem("Pressure Test", tabName = "1", icon = icon("arrow-down")),
            menuItem("Bayesian Network", tabName = "2", icon = icon("atom")),
            #menuItem("Habitats", tabName = "3", icon = icon("atlas")),
            #menuItem("Ingestion", tabName = "3", icon = icon("utensils")),
            selectInput("modelSelect", "Select MESO model", choices=c(""), selected=NULL, multiple=FALSE),
            uiOutput("pressureList")
            #selectInput("layerSelect", "Select Transition", 
            #            choices=transitions, 
            #            selected=NULL, multiple=FALSE)
        )
      ),
      dashboardBody(
        tabItems(
          tabItem(tabName = "1", h2('Impact Distribution'),
            fluidRow(
              column(
                width=6, 
                h4('Effect on bio-assemblage')
              ),
              column(
                width=6,
                actionButton("layer1Slider", "1", icon=icon("sliders-h"))
              )
            ),
            plotlyOutput("layer1", height="270px") %>% withSpinner(),
            h4('Effect on Output Processes'),
            plotlyOutput("layer2", height="270px") %>% withSpinner(),
            h4('Effect on Ecosystem services'),
            plotlyOutput("layer3", height="270px") %>% withSpinner()
          ),
          tabItem(tabName = "2",h2("Bayesian Network"),
            fluidPage(
              p('Graphical output of the Bayesian Network.  Note: large networks may never stabilise!'),
              fluidRow(
                column(
                  width=4,
                  checkboxInput("bbnDisplayNames", "Display Node names", value=FALSE)
                ),
                column(
                  width=4,
                  selectInput("bbnImpactSelect", "Impact Threshold", choices=impacts, selected='All')
                )
              ),
              fluidRow(
                visNetworkOutput("bbnGraphPlot")
              ),
              fluidRow(
                column(
                  width=6,
                  h4('Ecoservice nodes'),
                  DT::dataTableOutput('nodeTable')
                ),
                column(
                  width=6,
                  h4('Ecoservice influences'),
                  DT::dataTableOutput('edgeTable')
                )
              )
            )
          ),
          #tabItem(tabName = "3",h4("Habitats"),
          #    fluidPage(
          #      google_mapOutput(outputId = "map", width = "100%", height = "750px")
          #    )
          #), 
          tabItem(tabName = "3",h4("Ingestion"),
             fluidPage(
               p("Select a spreadsheet from your network for input into the JNCC Bayesian Network Analyser:"),
               fileInput("fileSelect", "Choose Excel Spreadsheet File (xlsx format)", multiple = FALSE, accept = "xlsx"),
               fluidRow(renderUI('status')),
               actionButton('loadAB', 'Load') # icon='upload')
             )
           )
        )
      )
)

server <- function(input, output, session) {
  #SERVER Constants
 
  print('Loading data')
  
  #set_key("AIzaSyAw8_btgGN1drf8qhCxNcotP6r11qEXA_M")
  dataStorage <- 'data/'
  
  models<-NULL
  pressures <- NULL
  
  
  #disable(input$loadAb)
  
  .loadStatus <- reactiveValues(
    valid = c(p=FALSE, ba=FALSE, op=FALSE, es=FALSE),
    msgs = NULL
  )
  
  .likelihoods <-reactiveValues(
    p_ba = NULL,
    ba_os = NULL,
    os_es = NULL
  )
  
  setPressures <- function(newPressures) {
    pressures <<- newPressures
  }
  
  validateSheets <- function() {
    req(inputs$selectFile)
    
    ##TO DO - run parser on it and output the errors to 
  }
  
  getAvailableModels <- function() {
    fileList <- list.files(dataStorage, pattern='.xlsx')
    
    print(fileList)
    modelList <- list()
    cnt<-1
    
    for (idx in 1:length(fileList)) {
      print(paste('attempting to load', paste0(dataStorage, fileList[idx])))

      tmp <- parser$parseSheet(paste0(dataStorage, fileList[idx]))

      if (!is.null(tmp)) {
        modelList[[cnt]] <- tmp
        models <<- c(models, substr(fileList[idx], 1, (nchar(fileList[idx])-5)))
        print(paste('Model file successfully loaded', fileList[idx]))
        cnt=cnt+1
      
      }
    }
    
    updateSelectInput(session, "modelSelect", choices=models)
    
    return(modelList)
  }
  
  
  .selections <- reactiveValues(
    model=1, 
    layer=1, 
    bbnImpact=1, 
    bbnNames=FALSE,
    pressStatus=NULL
  )
  
  #parse on load sheets in the input sheet folder - replace with R Data
  modelList <- getAvailableModels()
  
  calcLikelihood <- function(layer, pressStatus, confLevels) {
    
    isolate({

      if (layer==1) layerStr='ba' else if (layer==2) layerStr='op' else if (layer==3) layerStr='es'

      layerRange <- which(startsWith(modelList[[.selections$model]][[3]]$nodes$code, layerStr))
   
      nodeCodes <- modelList[[.selections$model]][[layer]]$nodes$code[layerRange]
      nodeNames <- modelList[[.selections$model]][[layer]]$nodes$name[layerRange]
      
      MEANPOS=1
      MEANNEG=0
      
      expr <- "list("
      for (p in 1:nrow(pressStatus)) {
        if (pressStatus$status[p] == 'On') {
          threshold = MEANPOS
        } else {
          threshold = MEANNEG
        }
          
        expr <- paste0(expr, "\"", pressStatus$code[p], "\"=", threshold, ", ")
      }
      expr <-substr(expr, 1, nchar(expr)-2)
      expr<-paste0(expr, ')')
      
      
      #build the graph
      #parser$buildGraph(p_es, desc=list(inputCode='p', outputCodes=c('ba', 'op', 'es')))

      sampleDists <- cpdist(
        fitted = modelList[[.selections$model]][[layer]]$cfit,
        nodes = bnlearn::nodes(modelList[[.selections$model]][[layer]]$cfit),
        evidence = eval(parse(text = expr)),
        method = "lw",
        n = 10000,
        debug=TRUE
      )
    })
    
    displayCols <- match(nodeCodes, colnames(sampleDists))
    sampleDists <- sampleDists[,displayCols]
    means <- apply(sampleDists, 2, mean)
    stdDev <- apply(sampleDists, 2, sd)
    
    return(data.frame(
           nodeNames = nodeNames,
           range = c(
                  apply(sampleDists, 2, min),
                  means - 2*stdDev,
                  means - stdDev,
                  means,
                  means + stdDev,
                  means + 2*stdDev,
                  apply(sampleDists, 2, max)
           ),
           stringsAsFactors=FALSE
         ))
  }

  renderStatus <- function(layer) {
    isolate({
      if (.loadStatus$valid[layer]) return('check-square') else return('times-circle')
    })
  }
  
  output$status <- renderUI({

    tagList(
      fluidRow(
        column(width=3, h4('Pressures')),
        column(width=3, h4('Bio-assemblages')),
        column(width=3, h4('Output processes')),
        column(width=3, h4('Ecosystem services'))
      ),
     fluidRow(
       column(width=3, icon(renderStatus(1))),
       column(width=3, icon(renderStatus(2))),
       column(width=3, icon(renderStatus(3))),
       column(width=3, icon(renderStatus(4)))
      )
    )
  })
  
    
  observeEvent(input$modelSelect, {
    .selections$model <<- match(input$modelSelect, models)
  })
  
  #observeEvent(input$layerSelect, {
  #  .selections$layer <<- match(input$layerSelect, transitions)
  #})
  
  observeEvent(reactiveValuesToList(input), {
    isolate(myList <- reactiveValuesToList(input))
    matches <- match(pressures$code,  names(myList))

    if (length(matches)>0) {
      status <-NULL
      for (n in 1:length(matches))  status[n] = myList[[matches[n]]]
      
      newStatus <- data.frame(code=pressures$code, status=status, stringsAsFactors = FALSE)
      
      if (!identical(newStatus, .selections$pressStatus)) {
        print('Running calc')
        .likelihoods$p_ba <<- calcLikelihood(1,  newStatus)
        .likelihoods$ba_os <<- calcLikelihood(2,  newStatus)
        .likelihoods$os_es <<- calcLikelihood(3, newStatus)
        
        .selections$pressStatus <<- newStatus
      }
      
    }
    sliderControls <- c("l1VH", "l1H", "l1M", "l1L", "l1VL", "l1Conf")
    matches <- match(sliderControls,  names(myList))
    if (length(matches)>0) {
      print(matches)
    }
  })
  
  #output$map <- renderGoogle_map({
  #  google_map(location = c(55, 0), zoom = 7)
  #})
  
  makeRadioButtons <- function(row) {
    radioButtons(row['code'], row['name'], choices=c('Off', 'On'), selected='Off', inline=TRUE)
  }
  
  output$linkBackgroundData <- downloadHandler(
    filename = "JNCC MESO.xlsx",
    content = function(file) {
      file.copy("JNCC MESO.xlsx", file)
    },
    contentType = "application/xlsx"
  )
  
  
  output$pressureList <- renderUI({
    #isolate({
    if (!is.null(modelList[[.selections$model]][[1]]$nodes)) {
      pressCodes <- which(startsWith(modelList[[.selections$model]][[1]]$nodes$code, 'p'))
      pressures <- data.frame(code = modelList[[.selections$model]][[1]]$nodes$code[pressCodes], 
                     name = modelList[[.selections$model]][[1]]$nodes$name[pressCodes], stringsAsFactors=FALSE)
      setPressures(pressures)
      btnList <- apply(pressures, 1, makeRadioButtons)
    }
  })
  
  observeEvent(input$bbnImpactSelect, {
    #filter nodes and edges to 
    .selections$bbnImpact <- thresholds[match(input$bbnImpactSelect, impacts)]
    print(paste("Setting bbn impact", .selections$bbnImpact))
  })
  
  observeEvent(input$bbnDisplayNames, {
    .selections$bbnNames <- input$bbnDisplayNames
    print(.selections$bbnNames)
  })
  
  observeEvent(input$layer1Slider, {
    showModal(
      modalDialog({
        tagList(
          sliderInput("l1VH", "Very High Sensitivity", 0.9, 1.0, 0.99, step=0.01),
          sliderInput("l1H", "High Sensitivity", 0.75, 1.0, 0.95, step=0.01),
          sliderInput("l1M", "Medium Sensitivity", 0.5, 0.75, 0.95, step=0.01),
          sliderInput("l1L", "Low Sensitivity", 0.15, 0.5, 0.2, step=0.01),
          sliderInput("l1VL", "Very Low Sensitivity", 0.01, 0.2, 0.15, step=0.01),
          sliderInput("pressStdDev", "Pressure SD", 0.1, 1, 0.5, step=0.1),
          sliderInput("baStdDev", "Bio-Assemblage SD", 0.1, 1, 0.5, step=0.1)
        )
      }, title='Layer 1 controls', size='s')
    )
  })
  
  
  

  
  output$nodeTable <- DT::renderDataTable(
    
    modelList[[.selections$model]][[.selections$layer]]$nodes,
      selection = 'single',options = list(searching = TRUE, pageLength = 10, editable=TRUE),server = TRUE, escape = FALSE,rownames= TRUE
    )

  output$edgeTable <- DT::renderDataTable(
    
    modelList[[.selections$model]][[.selections$layer]]$edges,
      selection = 'single',options = list(searching = TRUE, pageLength = 10, editable=TRUE),server = TRUE, escape = FALSE,rownames= TRUE
  )
  
  getLabel <- function(impact) {
    sign <- ifelse(impact<0, "-", "+")
    idx <- min(which((abs(impact)>=thresholds)==TRUE))
    return(paste0(sign, impLabels[idx]))
  }
  
  getLevels <- function(code) {
    if (startsWith(code, 'p')) return(1)
    else if (startsWith(code, 'ba')) return(2)
    else if (startsWith(code, 'op')) return(3)
    else if (startsWith(code, 'es')) return(4)
    else return(5)
  }
  
  
  output$bbnGraphPlot <- renderVisNetwork({
    #graphviz.plot(modelList[[.selections$model]][[.selections$layer]]$net)

    nodes <- modelList[[.selections$model]][[.selections$layer]]$nodes

    edges <- data.frame(
      id = rownames(modelList[[.selections$model]][[.selections$layer]]$edges),
      from=match(modelList[[.selections$model]][[.selections$layer]]$edges$input, nodes$name),
      to=match(modelList[[.selections$model]][[.selections$layer]]$edges$output, nodes$name),
      impact=modelList[[.selections$model]][[.selections$layer]]$edges$impact,
      label=sapply(modelList[[.selections$model]][[.selections$layer]]$edges$impact, getLabel),
      arrows="to",
      stringsAsFactors=FALSE
    ) 
    if (.selections$bbnNames) {labels <- nodes$name} else {labels <- nodes$code}

    nodeSpacing <- ifelse(.selections$bbnNames, 600, 150)
    
    nodes <- data.frame(
      id = rownames(nodes),
      label = labels,
      level = sapply(nodes$code, getLevels),
      code = nodes$code,
      stringsAsFactors=FALSE
    ) 
    
    
    
    edges <- edges[(abs(edges$impact)>=.selections$bbnImpact),]
    
    nodeNet <- nodes[(nodes$code %in% .selections$pressStatus$code[.selections$pressStatus$status %in% c('On')]),]
    
    save(nodes, edges, nodeNet, file = 'tmp.RData')
    
    
    if (nrow(nodeNet)>0) {

      #do pressures 
      edgeNet <- edges[edges$from %in% nodeNet$id, ]
      idx = 1
      repeat {
        nodesToAdd <- nodes[nodes$id %in% edgeNet$to, ]
        nodesToAdd <- nodesToAdd[!(nodesToAdd$id %in% nodeNet$id),]
        
        edgesToAdd <- edges[edges$from %in% nodesToAdd$id, ]
        edgesToAdd <- edgesToAdd[!(edgesToAdd$id %in% edgeNet$id),]
        
        idx <- idx + 1
        if ((idx>20) || ((nrow(nodesToAdd)==0) && (nrow(edgesToAdd)==0))) break
        nodeNet <- rbind(nodeNet, nodesToAdd)
        edgeNet <- rbind(edgeNet, edgesToAdd)

      } #until finished
    } else edgeNet <- edges
    
    visNetwork(nodeNet, edgeNet, width = "100%") %>% 
      visHierarchicalLayout(nodeSpacing=nodeSpacing) %>%
      visOptions(highlightNearest = TRUE) %>%
      #visPhysics(hierarchicalRepulsion = nodeSpacing) %>%
      visInteraction(navigationButtons = TRUE, dragNodes = TRUE, dragView = TRUE, zoomView = TRUE)
  })
  
  observe({
    visNetworkProxy("bbnGraphPlot") %>%
      visStabilize(iterations=10)
  })
  
  
  output$layer1 <- renderPlotly({
    if (length(.likelihoods$p_ba)>0) {
      
      .likelihoods$p_ba$nodeNames <- factor(.likelihoods$p_ba$nodeNames, levels = unique(.likelihoods$p_ba$nodeNames))
      
      xform <- list(categoryorder = "array",
                    categoryarray = .likelihoods$p_ba$nodeNames,
                    zerolinewidth=10)
      
      plot_ly(.likelihoods$p_ba, y = ~range, color = ~nodeNames, type = "box") %>%
        layout(xaxis = xform)
    
    } 
  })

  output$layer2 <- renderPlotly({
    if (length(.likelihoods$ba_os)>0) {
      
      .likelihoods$ba_os$nodeNames <- factor(.likelihoods$ba_os$nodeNames, levels = unique(.likelihoods$ba_os$nodeNames))
      
      xform <- list(categoryorder = "array",
                    categoryarray = .likelihoods$ba_os$nodeNames,
                    zerolinewidth=5)
      
      
      plot_ly(.likelihoods$ba_os, y = ~range, color = ~nodeNames, type = "box") %>%
        layout(xaxis = xform)
     
    }
  })

  output$layer3 <- renderPlotly({
    
    if (length(.likelihoods$os_es)>0) {
      
      .likelihoods$os_es$nodeNames <- factor(.likelihoods$os_es$nodeNames, levels = unique(.likelihoods$os_es$nodeNames))
      
      xform <- list(categoryorder = "array",
                    categoryarray = .likelihoods$os_es$nodeNames,
                    zerolinewidth=5)
      
      
      plot_ly(.likelihoods$os_es, y = ~range, color = ~nodeNames, type = "box") %>%
        layout(xaxis = xform) 
   
    }
  })
}

shinyApp(ui, server)