library(tidyverse)
library(lubridate)
library(shiny)
library(DBI)
library(RMySQL)
library(plotly)
library(shinyWidgets)

# for a large database it's useful to keep unique well info as a file to speed up loading times:
unikalie <- read_rds(file = "unique.rds")

library(pool)
library(leaflet)

source('my_ui.R', local = TRUE)


# connection to database. SQLite database for demonstration purpose. 
# The database contains four simulated groundwater level time series with simulated errors located in two simulated stations
con <- dbConnect(RSQLite::SQLite(), "db.sqlite")


########################## SERVER ##########################
my_server <- function(input, output, session) {
  
  

  # a button to refresh repair plot
  atjaunot <- eventReactive(input$update, {
    runif(1)
  })
  

  # a button to refresh the list of wells. For this demonstration purpose it's not that relevant 
  # but is useful for real (e.g. MySQL) groundwater level database where some changes might happen over time (i.e. added new well)
  observeEvent(input$updateUnikalos, {
    showModal(modalDialog(title = h2("...please wait..."),
                          HTML("Please don't press Dismiss!<br>
                               The list of wells is refreshing from the database")))
    
    unique_wells <- dbReadTable(con, "well_info")
    unique_wells %>%
      select(station, well, name) %>%
      write_rds(file = "unique.rds")
    
    showModal(modalDialog(h1("Ready!"), HTML("Please refresh the page")))
    
  })
  
  
  # general table of groundwater observations for the selected well
  atlase0 <- reactive({
   
    if ((!is.na(isolate(input$station))) & (length(input$urbnr) != 0)) {
      
      dati <- tbl(con, "groundwater_levels")   
      
      data <- dati %>%
        filter(station == !!isolate(input$station)) %>%
        filter(well == !!input$urbnr) %>%
        collect()
      data %>%
        mutate(date = as_datetime(datetime),
               level = as.numeric(level))
    }
  })

  # selects all groundwater well within a selected station to show in "stations well plot"
  atlase_visiUrb <- reactive({
    if ((!is.na(isolate(input$station))) & (length(input$urbnr) != 0)) {
      
      dati <- tbl(con, "groundwater_levels")    
      
      data <- dati %>%
        filter(station == !!isolate(input$station)) %>%
        collect()
      
      data %>%
        mutate(date = as_datetime(datetime),
               level = as.numeric(level))
    }
  })
  
  
  # data for sharp change plot 
  atlase_gradients <- reactive({
    atlase0() %>%
      filter(!is.na(level)) %>%
      arrange(date) %>%
      mutate(Atrums_m_d = (level - lag(level, 1)) / ((date - lag(date, 1)) %>% as.numeric(units = "days")),
             Atrums_m_d_kk = case_when(Atrums_m_d >= 0 ~  1,
                                       Atrums_m_d < 0 ~  -1),
             Atrums_m_d_sqrt = (sqrt(abs(Atrums_m_d))) *  Atrums_m_d_kk) %>%
      select(-level, -Atrums_m_d_kk) %>%
      gather(parameter, level, matches('Atrums_m_d')) %>%
      bind_rows(atlase0()) 
  })
  
  
  # data for data table and statistics table
  atlase2 <- reactive({
    if ((!is.na(isolate(input$station))) & (length(input$urbnr) != 0)) {
      
      data <-  atlase0() 
      data
    }  
  })
  
  
  # data for automatic vs manual scatter plot
  atlase3 <- reactive({
    if ((!is.na(isolate(input$station))) & (length(input$urbnr) != 0)) {
      
      atlase3 <- atlase0() %>%
        select(measurement_type, level, date) %>%
        filter(measurement_type %in% c("automatic", "manual")) %>% 
        mutate(date = floor_date(date, unit = "1 day")) %>% 
        group_by(measurement_type, date) %>% 
        summarise(level = mean(level, na.rm = TRUE)) %>% 
        ungroup() %>% 
        spread(measurement_type, level) %>% 
        filter(!is.na(manual) ) %>%
        filter(!is.na(automatic))
    }
  })
  
  # data for Leaflet map
  atlase_karte <- reactive({
    dati <- tbl(con, "well_info") %>%
      collect()
    dati %>%
      mutate(info = paste0("well number: ", well, "</br>aquifer: ",aquifer,"</br>screen: ",f_top_rel,"-",f_bot_rel))
  })
  
  # data to show selected well on Leaflet map
  atlase_karte_atlasitais <- reactive({
    dati <- atlase_karte()
    dati %>%
      filter(station == !!input$station) %>%
      filter(well == !!input$urbnr)
  })
  
  # data containing corrections for the selected well
  atlase_edit_table <- reactive({
    # a button function so the plot refreshes upon button press:
    atjaunot()
    # the corrections:
    txt_all <- tbl(con, "repair_instructions") %>%
      filter(station == !!input$station) %>%
      filter(well == !!input$urbnr) %>%
      collect() 
  })
  

  
  
  # apply corrections on original data for the repair plot:
  atlase_edited <- reactive({
    # start with general table
    dt <- atlase0() 
    # collect corrections:
    txt_all <- atlase_edit_table()
    
    # iterate through all corrections for the selected well and apply them:
    if (nrow(txt_all) > 0 ) {
      for (i in 1:nrow(txt_all)) {
        txt <- as.list(txt_all[i,]) # to list for more easy handling
        
        # if dt_specific is empty, it means that a interval defined by dt_from and dt_to is used:
        if (is.na(txt$dt_specific)){
          komanda1 <- paste0("level = if_else(station == \"",txt$station,
                             "\" & well == \"",txt$well,
                             "\" & measurement_type == \"",txt$measurement_type,
                             "\" & date >= as_datetime(\"", txt$dt_from,
                             "\") & date <= as_datetime(\"", txt$dt_to,
                             "\"), true = ", txt$correction,
                             ", false = level)")
          darbiba <- eval(parse(text = paste0("quos(", komanda1, ")")))
          
        } else {
          # if dt_specific is defined, only the single observation is corrected:
          komanda2 <- paste0("level = if_else(station == \"",txt$station,
                             "\" & well == \"",txt$well,
                             "\" & measurement_type == \"",txt$measurement_type,
                             "\" & date == as_datetime(\"", txt$dt_specific,
                             "\"), true = ", txt$correction,
                             ", false = level)")
          darbiba <- eval(parse(text = paste0("quos(", komanda2, ")")))
          
        }
        # apply each prepared correction: 
        dt <- dt %>%
          mutate(!!!darbiba) 
        
      }
    }
    # return dt
    dt
    
  })
  

  
  # prepare data set with both original (old) observations and corrected (new) observations for the repair plot
  atlase_bildei <- reactive({
    # raw observations as level_old:
    level_old <- atlase0() %>%
      select(name, date, measurement_type,  level_old = level)
    
    # corrected observations as level_new:
    atlase_edited() %>%
      rename(level_new = level) %>%
      left_join(level_old, by = c("name", "measurement_type", "date")) %>% # join original (old) data
      select(date, measurement_type, level_old, level_new) %>%
      gather(key = avots, value = level, -date, -measurement_type)
      
  })
  
  
  
  # text for Manual vs Automatic scatterplot - deviation
  output$novirze <- renderText({
    paste("Error (Manual - Automatic) mean deviation is ", 
          atlase3() %>%
            mutate(deviation = automatic - manual) %>%
            pull(deviation) %>%
            mean(na.rm = TRUE) %>%
            round(., 3), " meters")
  })
  
  
  
  # unique well numbers for selection form
  urbnr <- reactive({
    ns_list <- unikalie %>%
      filter(station == !!input$station) %>%
      distinct(well) %>%
      pull(well)
    ns_list
  })
  
  # well metadata for the selected well
  urbnr_label <- reactive({
    ns_list <- tbl(con, "well_info") %>%
      collect()  %>%
      filter(station == !!input$station) %>%
        filter(well == !!input$urbnr)
    ns_list

  })
  
  
  # dynamically refreshes well numbers according to selected station:
  observeEvent(input$station, {
    updateSelectizeInput(session, 'urbnr', choices = urbnr())
  })
  
  # prepare well metadata for the selected well for proper rendering on page
  output$urbumu_info <- renderText({
    HTML(paste0("<b>",urbnr_label()$name,"</b><br/>",
                "well number: <b>", urbnr_label()$well, "</b><br/>",
                "aquifer: <b>", urbnr_label()$aquifer, "</b><br/>",
                "depth [m]: <b>", urbnr_label()$depth, "</b><br/>",
                "screen interval: <b>", urbnr_label()$f_top_rel, "-",urbnr_label()$f_bot_rel,"</b><br/>",
                "m asl.: <b>", urbnr_label()$z, "</b><br/>",
                "drilling year: <b>", urbnr_label()$year, "</b><br/>"))
  })
  
  # list of unique stations
  stacijas <- reactive({
    stacijas <- unikalie %>%
      distinct(station)
    stacijas
  })
  
  # update stations list for select form
  observe({
    updateSelectizeInput(session, 'station', choices = stacijas())
  })
  
  
  # data table:
  output$table <- 
    DT::renderDataTable(DT::datatable({
      atlase2()
    }))
  

  
  # Manual vs Automatic scatterplot:
  output$plot3 <- renderPlot({
    p <- ggplot(atlase3(), aes(automatic, manual))
    p <- p+geom_point()+
      geom_abline(slope = 1, col = 'red')
    p
  })
  
  #  Sharp change plot:
  output$plot_gradients <- renderPlot({
    p <- ggplot(atlase_gradients(), aes(date, level, col = measurement_type))
    
    if (input$linijas) p <- p + geom_line()
    if (input$punkti) p <- p+geom_point()
    if (input$scalesFree == 1) p <- p+facet_grid(rows = vars(parameter), scales = "free")
    if (input$scalesFree == 2) p <- p+ facet_grid(rows = vars(parameter), scales = "fixed")
    if (input$inversey) p <- p+scale_y_reverse()
    p+ylab("Groundwater level, m")+
      geom_col(data = atlase_gradients() %>% filter(parameter %in% c("Atrums_m_d", "Atrums_m_d_sqrt")),
                color = 'black')+
      theme(axis.text=element_text(size=12),
            axis.title=element_text(size=14,face="bold"),
            legend.title = element_text( size = 14),
            legend.text = element_text(size = 10),
            strip.text.y = element_text(size = 12))+
      scale_x_datetime(date_breaks = "1 year", date_labels = "%Y",  sec.axis = dup_axis())
  })
  

  
  # Repair plot:
  output$plot_edited_plotly <- plotly::renderPlotly({
    p <- ggplot(atlase_bildei())
    
    
    if (input$poga_specific) p <- p + geom_vline(data = atlase_edit_table() %>% filter(!is.na(dt_specific)), 
                                                 aes(xintercept = as.numeric(as_datetime(dt_specific))), col = 'coral', alpha = 0.3)
    if (input$poga_nolidz) {
      p <- p + geom_vline( data = atlase_edit_table() %>% filter(!is.na(dt_from)),
                           aes(NULL, NULL, xintercept = as.numeric(as_datetime(dt_from))),
                           linetype="dashed", alpha = 0.4, col = 'blue', size = 1)+
              geom_vline( data = atlase_edit_table() %>% filter(!is.na(dt_from)),
                          aes(NULL, NULL, xintercept = as.numeric(as_datetime(dt_to))),
                          linetype="dashed", alpha = 0.4, col = 'brown4', size = 1)
    }      
      
      
    
    if (input$linijas) p <- p + geom_line( aes(date, level, col = measurement_type), size = 0.2)
    if (input$punkti) p <- p+geom_point( aes(date, level, col = measurement_type), size = 0.7)
    if (input$scalesFree == 1) p <- p+facet_grid(rows = vars(avots), scales = "free")
    if (input$scalesFree == 2) p <- p+ facet_grid(rows = vars(avots), scales = "fixed")
    if (input$inversey) p <- p+scale_y_reverse(breaks = seq(0,50, 1)) # adjustable as necessary
    p+ylab("GWL below surface, m")+
      
      theme(axis.text=element_text(size=10),
            axis.title=element_text(size=10),
            legend.title = element_text( size = 14),
            legend.text = element_text(size = 12),
            strip.text = element_text(size = 10, face = 'bold'),
            strip.background = element_rect(fill="darkolivegreen2"))+
      scale_x_datetime(date_breaks = "1 year", date_labels = "%Y",  sec.axis = dup_axis())
      
  })
  
  
  
  # Stations wells plot:
  output$plot_visiUrb_plotly <- plotly::renderPlotly({
    p <- ggplot(atlase_visiUrb(), aes(date, level, col = measurement_type))
    
    
    if (input$linijas) p <- p + geom_line(size = 0.2)
    if (input$punkti) p <- p+geom_point(size = 0.7)
    if (input$scalesFree == 1) p <- p+facet_grid(rows = vars(well), scales = "free")
    if (input$scalesFree == 2) p <- p+ facet_grid(rows = vars(well), scales = "fixed")
    if (input$inversey) p <- p+scale_y_reverse()
    p+ylab("Groundwater level [m below ground]")+
      theme(axis.text=element_text(size=10),
            axis.title=element_text(size=10),
            legend.title = element_text( size = 12),
            legend.text = element_text(size = 8),
            strip.text = element_text(size = 10),
            strip.background = element_rect(fill="lightskyblue1"))+
      scale_x_datetime(date_breaks = "1 year", date_labels = "%Y",  sec.axis = dup_axis())
  }) 
  
  
  # histogram for the Repair plot:
  output$plot_hist <- renderPlot({
    p <- ggplot(atlase_bildei())+
      geom_histogram(aes(level), bins = input$bins)
    
    if (input$scalesFree == 1) p <- p+facet_grid( cols  = vars(avots), scales = "free")
    if (input$scalesFree == 2) p <- p+ facet_grid( cols = vars(avots), scales = "fixed")
  
    p+ylab("Groundwater level, m")+
      theme(axis.text=element_text(size=12),
            axis.title=element_text(size=14,face="bold"),
            legend.title = element_text( size = 14),
            legend.text = element_text(size = 10),
            strip.text.y = element_text(size = 12),
            strip.background = element_rect(fill="lightskyblue1"))
  })
  
  

  # data for Statistics table:
  data_smallTable <- reactive({
    if (!is.na(isolate(input$station)) && !is.na(input$urbnr)) {
      atlase2() %>% 
        group_by(measurement_type) %>%
        tally() %>%
        rename(count = n) 
      
    } 
    else iris # if there is a problem...
  })
  
  # Statistics table:
  output$smallTable <- renderTable({
    data_smallTable()
  }, 
  spacing = 'xs',
  striped = TRUE, bordered = TRUE,  
  hover = TRUE)
 

  # table of corrections for the Repair plot:
  output$tabulaLabojumi2 <- renderTable({
    atlase_edit_table()
  },
  caption = "Applied corrections fot the selected well:",
  caption.placement = getOption("xtable.caption.placement", "top"),
  caption.width = getOption("xtable.caption.width", NULL)
  )
  
  # clicked points in Sharp change plot:
  output$g3_click_info <- renderPrint({
    nearPoints(atlase_gradients(), input$g3_click, addDist = TRUE)
  })

  # brushed points in Sharp change plot:
  output$g3_brush_info <-  DT::renderDataTable(DT::datatable({
    brushedPoints(atlase_gradients() %>% 
                    mutate(dt = as.character(date)) %>%
                    select( dt, measurement_type, well, parameter, level, date), input$g3_brush)
  }))
  
  
  
  # icon for the selected well in Leaflet map:
  icon = makeIcon("spot.png", iconWidth = 40, iconHeight = 40)
  
  # Leaflet map:
  output$karte <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(data = atlase_karte(), 
                 lng = ~lon, 
                 lat = ~lat, 
                 label = ~name,
                 popup = ~info)%>%
      addMarkers(data = atlase_karte_atlasitais(), 
                 lng = ~lon,
                 lat = ~lat,
                 label = ~name,
                 popup = ~info,
                 icon = ~icon) 
  })
   
}



# Finally, prepare the application:
shinyApp(
  
  ui = my_ui,
  server = my_server
)

