#! /usr/bin/Rscript
library(shiny)
library(leaflet)
library(leaflet.extras)
library(dplyr)
library(shinyWidgets)
library(htmltools)

pinbase <- "https://doc.petras.space/public/pin-icon-"
pins <- c("black", "blue", "red", "pink", "green", "purple", "white")
pinsuf <- ".svg"
pinurl <- function(col) {
  sprintf("%s%s%s", pinbase, col, pinsuf)
}

Geo2017 <- readRDS("Geo2017.rds")
Geo2017$Snargle <- c(TRUE, rep(FALSE, 5))

DHBs <- sort(unique(Geo2017$dhb_name))
DHBs <- c(DHBs[DHBs != "Missing"], "Missing")

dhbcar <- c(
  "Auckland District Health Board" = "green",
  "Bay of Plenty District Health Board" = "blue",
  "Canterbury District Health Board" = "blue",
  "Capital and Coast District Health Board" = "pink",
  "Counties Manukau District Health Board" = "pink",
  "Hawkes Bay District Health Board" = "pink",
  "Hutt Valley District Health Board" = "green",
  "Lakes District Health Board" = "red",
  "Mid Central District Health Board" = "blue",
  "Nelson Marlborough District Health Board" = "purple",
  "Northland District Health Board" = "blue",
  "South Canterbury District Health Board" = "green",
  "Southern District Health Board" = "pink",
  "Tairawhiti District Health Board" = "green",
  "Taranaki District Health Board" = "pink",
  "Waikato District Health Board" = "purple",
  "Wairarapa District Health Board" = "red",
  "Waitemata District Health Board" = "red",
  "West Coast District Health Board" = "red",
  "Whanganui District Health Board" = "green",
  "Missing" = "black"
)

dhbcol <- function(DHB) {
    sdf <- dhbcar[DHB]
    names(sdf) <- NULL
    sdf
}

snargcol <- function(snarg) {
    ifelse(snarg, "red", "blue")
}

piconlist <- iconList(
  black  = makeIcon(pinurl("black"),  iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  blue   = makeIcon(pinurl("blue"),   iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  red    = makeIcon(pinurl("red"),    iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  pink   = makeIcon(pinurl("pink"),   iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  green  = makeIcon(pinurl("green"),  iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  purple = makeIcon(pinurl("purple"), iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30),
  white  = makeIcon(pinurl("white"),  iconWidth = 30, 
                    iconHeight = 30, iconAnchorX = 15, iconAnchorY = 30)
)

popups <- function(data) {
sprintf("<strong>%s</strong><br/>%s<br/>DHB: %s<br/>%s",
        htmlEscape(data$name),
        htmlEscape(data$address),
        htmlEscape(data$dhb_name),
        ifelse(data$Snargle,
               "Snargleflagen practice",
               "Non-snargleflagen practice"))
}


ui <- fillPage(title = "New Zealand GP Practice Locations 2017",
    tags$style(type = "text/css", 
               "#medmap {
                 height: 100% !important;
                 /*posiiton: absolute;*/
                 top: 0;
                 left: 0;
               }
               .dropdowncont {
                 position: fixed;
                 top: 0;
                 right: 0;
                 z-index: 10;
               }
               .dropdowncont ul {
                 overflow-y: auto;
                 max-height: calc(100vh - 100px);
               }"),
    div(class = "dropdowncont",
    dropdownButton(
      radioButtons("selcol", "Colour by",
                   choices = c("None" = "None",
                               "DHB affiliation" = "DHB",
                               "Snargleflagen" = "Snargleflagen")),
      hr(),
      radioButtons("overlay", "Show overlay",
                   choices = c("None" = "None",
                               "DHB boundaries" = "DHB-boundaries")),
      p(style="text-align: right;", "(Note: slow on first load)"),
      hr(),
      actionLink("closedrop", label = "close", icon = icon("close"),
                 style="float:right"),
      circle=FALSE, inputId = "ddown", right = TRUE,
      label = "Options", inline = FALSE, icon = icon("gear"), status = "danger")),
    leafletOutput(outputId = "medmap")
)

# Store group name of overlays that have been loaded
loaded.overlays <- c()

server <- function(input, output, session) {
    output$medmap <- renderLeaflet({
        gl <- leaflet(Geo2017)
        gl <- addTiles(gl)
        gl <- addMarkers(gl, lng = Geo2017$lon,
                   lat = Geo2017$lat,
                   popup = popups(Geo2017),
                   icon = piconlist["blue"],
                   label = Geo2017$name,
                   group = "locations",
                   labelOptions = labelOptions(textsize = "12px")
                   )
        gl <- addSearchFeatures(gl, targetGroups = "locations")
        gl
    })

    observeEvent(input$closedrop, {
      toggleDropdownButton("ddown")
    })

    observeEvent(input$selcol, {
      gl <- leafletProxy("medmap") %>%
          clearGroup("locations")
      if (input$selcol == "Snargleflagen") {
          gl <- addMarkers(gl, lng = Geo2017$lon,
                     lat = Geo2017$lat,
                     popup = popups(Geo2017),
                     icon = piconlist[snargcol(Geo2017$Snargle)],
                     label = Geo2017$name,
                     group = "locations",
                     labelOptions = labelOptions(textsize = "12px")
                     )
      } else if (input$selcol == "DHB") {
          gl <- addMarkers(gl, lng = Geo2017$lon,
                     lat = Geo2017$lat,
                     popup = popups(Geo2017),
                     icon = piconlist[dhbcol(Geo2017$dhb_name)],
                     label = Geo2017$name,
                     group = "locations",
                     labelOptions = labelOptions(textsize = "12px")
                     )
      } else {
          gl <- addMarkers(gl, lng = Geo2017$lon,
                     lat = Geo2017$lat,
                     popup = popups(Geo2017),
                     icon = piconlist["blue"],
                     label = Geo2017$name,
                     group = "locations",
                     labelOptions = labelOptions(textsize = "12px")
                     )
      }
    })

    observeEvent(input$overlay, {
      gl <- leafletProxy("medmap")
      for (g in loaded.overlays) {
        hideGroup(gl, g)
      }
      if (input$overlay == "DHB-boundaries") {
        if (input$overlay %in% loaded.overlays) {
          showGroup(gl, input$overlay)
        } else {
          dhb2015 <- readRDS("dhb2015.rds") 
          dhb2015 <- subset(dhb2015, dhb2015$DHB2015_Co != "99")
          addPolygons(gl, data = dhb2015, fill = FALSE, 
                                          color = "#000000", weight = 2,
                                          group = input$overlay)
          loaded.overlays <<- c(loaded.overlays, input$overlay)
        }
      }
    })
}

# Run the application 
shinyApp(ui = ui, server = server)
