panels/F4_Maps/2_maps.panel-server.R

### ---------------------------------------------------###
###  Server Functions for the "Maps" Module  ###
### ---------------------------------------------------###
###
###  Date Created  : Feb 22, 2017.
###  Last Modified : May 20, 2018.
###
###
###  * Note: This is to be sourced within "server.R" *



## initialize gui
output$newmaps.panel <- renderUI({
  get.data.set()
  newmaps.panel.ui(get.data.set())
})


## parameters for plotting maps
args <- reactiveValues(
  x = NULL,
  varnames = list(
    colby = NULL,
    sizeby = NULL,
    g1 = NULL,
    g2 = NULL
  ),
  colby = NULL,
  sizeby = NULL,
  opacity = NULL,
  reverse.opacity = NULL,
  type = NULL,
  col.pt = "mediumvioletred",
  cex.pt = NULL,
  alpha = NULL,
  join = NULL,
  col.line = NULL,
  g1 = NULL,
  g1.level = NULL,
  g2 = NULL,
  g2.level = NULL,
  variable = NULL,
  col = NULL,
  col.fun = NULL,
  na.fill = NULL,
  name = NULL,
  main = NULL,
  cex = NULL,
  resizemethod = NULL,
  pch = NULL,
  symbolby = NULL,
  lwd.pt = NULL,
  reverse.palette = NULL,
  col.method = NULL
)


colourPalettes <-
  list(
    cat = c(
      #      if (.rcb)
      list(
        "contrast (max 8)" =
          function(n) {
            if (n > 8) {
              inzpar()$col.default$cat(n)
            } else {
              RColorBrewer::brewer.pal(n, "Set2")[1:n]
            }
          },
        "bright (max 9)" =
          function(n) {
            if (n > 9) {
              inzpar()$col.default$cat(n)
            } else {
              RColorBrewer::brewer.pal(n, "Set1")[1:n]
            }
          },
        "light (max 12)" =
          function(n) {
            if (n > 12) {
              inzpar()$col.default$cat(n)
            } else {
              RColorBrewer::brewer.pal(n, "Set3")[1:n]
            }
          }
      ),
      #      if (.viridis)
      list(
        viridis = viridis::viridis,
        magma = viridis::magma,
        plasma = viridis::plasma,
        inferno = viridis::inferno
      ),
      list(
        "Colourblind Friendly" = inzpar()$col.default$cat,
        "rainbow (hcl)" = function(n) hcl((1:n) / n * 360, c = 80, l = 50)
      )
    ),
    cont = c(
      #      if (.viridis)
      list(
        viridis = viridis::viridis,
        magma = viridis::magma,
        plasma = viridis::plasma,
        inferno = viridis::inferno
      ),
      list(
        "rainbow (hcl)" =
          function(n) hcl((1:n) / n * 320 + 60, c = 100, l = 50),
        blue =
          function(n) {
            sequential_hcl(n,
              h = 260, c. = c(80, 10), l = c(30, 95),
              power = 0.7
            )
          },
        green =
          function(n) {
            sequential_hcl(n,
              h = 135, c. = c(50, 10), l = c(40, 95),
              power = 0.4
            )
          },
        red =
          function(n) {
            sequential_hcl(n,
              h = 10, c. = c(80, 10), l = c(30, 95),
              power = 0.7
            )
          },
        "green-yellow" =
          function(n) {
            terrain_hcl(n,
              h = c(130, 30), c. = c(65, 0), l = c(45, 90),
              power = c(0.5, 1.5)
            )
          },
        "red-blue" =
          function(n) {
            terrain_hcl(n,
              h = c(0, -100), c. = c(80, 40), l = c(40, 75),
              power = c(1, 1)
            )
          },
        terrain = terrain_hcl,
        heat = heat_hcl,
        "blue/white/pink" =
          function(n) {
            diverge_hcl(n,
              h = c(180, 330), c = 59, l = c(75, 95),
              power = 1.5
            )
          },
        "blue/white/red" =
          function(n) {
            diverge_hcl(n,
              h = c(260, 0), c = 100, l = c(50, 90),
              power = 1
            )
          }
      )
    ),
    emphasize = function(n, k, cat = TRUE, ncat = 5,
                         fn = if (cat) {
                           inzpar()$col.default$cat
                         } else {
                           inzpar()$col.default$cont
                         }) {
      cols <- fn(n)
      if (!cat) {
        ks <- floor(seq(1, n, length = ncat + 1))
        k <- ks[k]:ks[k + 1]
      }
      cols[-k] <- iNZightPlots:::shade(cols[-k], 0.7)
      cols
    }
  )


plot.args <- reactive({
  plot.args <- modifyList(list(), reactiveValuesToList(args), keep.null = FALSE)
})




## arguments for a new version of map module (Regions)
args2 <- reactiveValues(
  updateplot = 0,
  updateplot1 = 0,
  combinedData = NULL,
  mapData = NULL,
  mapName = "",
  mapType = NULL,
  mapVars = NULL,
  mapSizeVar = NULL,
  mapSequenceVar = NULL,
  match.list = NULL,
  #  has.multipleobs = FALSE,

  plotTitle = "",
  plotAxes = FALSE,
  plotXLab = "Longitude",
  plotYLab = "Latitude",
  plotDatumLines = FALSE,
  plotProjection = NULL,
  plotTheme = FALSE,
  plotPalette = "Default",
  plotConstantAlpha = 1.0,
  plotConstantSize = 5.0,
  plotCurrentSeqVal = NULL,
  timer = NULL,
  multipleObsOption = NULL,
  plotSparklinesType = "Absolute",
  plotScaleLimits = NULL,
  plotLabelVar = NULL,
  plotLabelScale = 4,
  plotAxisScale = 11,
  mapRegionsPlot = NULL,
  mapExcludedRegions = TRUE,
  proj.df = iNZightMaps::iNZightMapProjections()
)


plot.args2 <- reactive({
  plot.args2 <- modifyList(list(), reactiveValuesToList(args2),
    keep.null = FALSE
  )
})



## get only numeric type variables
numericVars <- function() {
  temp <- get.data.set()
  colnames(temp)[sapply(temp, is.numeric)]
}

## get only character type variables
characterVars <- function() {
  temp <- get.data.set()
  colnames(temp)[!sapply(temp, is.numeric)]
}



## set up latitude_panel
output$latitude_panel <- renderUI({
  get.data.set()
  isolate({
    sel <- ""
    if ("latitude" %in% colnames(get.data.set())) {
      sel <- "latitude"
    } else if ("Latitude" %in% colnames(get.data.set())) {
      sel <- "Latitude"
    }
    get.vars <- parseQueryString(session$clientData$url_search)
    if (!is.null(get.vars$url)) {
      temp <- session$clientData$url_search
      get.vars$url <- sub(".*?url=(.*?)&.*", "\\1", temp)
    }
    if (length(get.vars) > 0 &&
      (any(names(get.vars) %in% "url") ||
        any(names(get.vars) %in% "example")) &&
      (any(names(get.vars) %in% "latitude") &&
        !get.vars$latitude %in% "")) {
      sel <- get.vars$latitude
    }
    if (length(get.vars) > 0 &&
      (any(names(get.vars) %in% "url") ||
        any(names(get.vars) %in% "example")) &&
      (any(names(get.vars) %in% "Latitude") &&
        !get.vars$Latitude %in% "")) {
      sel <- get.vars$Latitude
    }
    selectInput(
      inputId = "select_latitude",
      label = "Latitude:",
      choices = c("Select Latitude Information", colnames(get.data.set())),
      selected = sel,
      selectize = FALSE
    )
  })
})

## set up longitude_panel
output$longitude_panel <- renderUI({
  get.data.set()
  isolate({
    sel <- ""
    if ("longitude" %in% colnames(get.data.set())) {
      sel <- "longitude"
    } else if ("Longitude" %in% colnames(get.data.set())) {
      sel <- "Longitude"
    }
    get.vars <- parseQueryString(session$clientData$url_search)
    if (!is.null(get.vars$url)) {
      temp <- session$clientData$url_search
      get.vars$url <- sub(".*?url=(.*?)&.*", "\\1", temp)
    }
    if (length(get.vars) > 0 &&
      (any(names(get.vars) %in% "url") ||
        any(names(get.vars) %in% "example")) &&
      (any(names(get.vars) %in% "longitude") &&
        !get.vars$longitude %in% "")) {
      sel <- get.vars$longitude
    }
    if (length(get.vars) > 0 &&
      (any(names(get.vars) %in% "url") ||
        any(names(get.vars) %in% "example")) &&
      (any(names(get.vars) %in% "Longitude") &&
        !get.vars$Longitude %in% "")) {
      sel <- get.vars$Longitude
    }
    selectInput(
      inputId = "select_longitude",
      label = "Longitude:",
      choices = c("Select Longitude Information", colnames(get.data.set())),
      selected = sel,
      selectize = FALSE
    )
  })
})

## update mapsplot.obj when input$map_type == 1
observe({
  input$select_latitude
  input$select_longitude
  isolate({
    if (input$map_type == 1 &&
      !is.null(input$select_latitude) &&
      input$select_latitude %in% colnames(get.data.set()) &&
      !is.null(input$select_longitude) &&
      input$select_longitude %in% colnames(get.data.set())) {
      mapsplot.obj <- iNZightMaps::iNZightMap(
        lat = eval(parse(text = paste("~", input$select_latitude))),
        lon = eval(parse(text = paste("~", input$select_longitude))),
        data = get.data.set(),
        name = get.data.name()
      )
      args$x <- mapsplot.obj
    }
  })
})




## update args$colby, args$sizeby, args$opacifyby
observe({
  input$colourby
  isolate({
    if (!is.null(input$colourby) &&
      input$colourby %in% colnames(get.data.set())) {
      temp.data <- get.data.set()
      index <- which(colnames(temp.data) == input$colourby)
      args$colby <- temp.data[, index]
      args$varnames$colby <- input$colourby
    } else if (!is.null(input$colourby) &&
      input$colourby == "") {
      args$colby <- NULL
      args$varnames$colby <- NULL
    }
  })
})

observe({
  input$sizeby
  isolate({
    if (!is.null(input$sizeby) &&
      input$sizeby %in% colnames(get.data.set())) {
      temp.data <- get.data.set()
      index <- which(colnames(temp.data) == input$sizeby)
      args$sizeby <- temp.data[, index]
      args$varnames$sizeby <- input$sizeby
    } else if (!is.null(input$sizeby) &&
      input$sizeby == "") {
      args$sizeby <- NULL
      args$varnames$sizeby <- NULL
    }
  })
})

observe({
  input$opacifyby
  isolate({
    if (!is.null(input$opacifyby) &&
      input$opacifyby %in% colnames(get.data.set())) {
      temp.data <- get.data.set()
      index <- which(colnames(temp.data) == input$opacifyby)
      args$opacity <- input$opacifyby
      args$varnames$opacity <- input$opacifyby
    } else if (!is.null(input$opacifyby) &&
      input$opacifyby == "") {
      args$opacity <- NULL
    }
  })
})







## set up plot_maptype_panel and plot_colour_panel
output$plot_maptype_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "plot_maptype",
      label = "Map type:",
      choices = c("terrain", "terrain-background", "toner-lite", "toner"),
      selectize = FALSE
    )
  })
})



## set up plot_colourcheck_panel
output$plot_colourcheck_panel <- renderUI({
  get.data.set()
  isolate({
    checkboxInput(
      inputId = "map1_colourcheck",
      label = "Colour",
      value = input$map1_colourcheck
    )
  })
})




output$plot_colour_panel <- renderUI({
  get.data.set()
  input$map1_colourcheck
  ret <- NULL

  isolate({
    if (!is.null(input$map1_colourcheck) && input$map1_colourcheck) {
      ret <- list(
        fixedRow(
          column(3, h5("Point colour:")),
          column(6, selectInput(
            inputId = "plot_colour",
            label = NULL,
            choices = c(
              "mediumvioletred", "grey50", "black", "darkblue",
              "darkgreen",
              "darkmagenta", "darkslateblue", "hotpink4",
              "lightsalmon2", "palegreen3", "steelblue3"
            ),
            selectize = FALSE
          ))
        ),
        fixedRow(
          column(3, h5("Colour by:")),
          column(6, selectInput(
            inputId = "colourby",
            label = NULL,
            choices = c("", colnames(get.data.set())),
            selectize = FALSE
          ))
        )
      )
    }
  })

  ret
})


output$plot_colpalette_panel <- renderUI({
  get.data.set()
  input$map1_colourcheck
  input$colourby
  ret0 <- NULL
  ret1 <- NULL
  #  ret = NULL

  isolate({
    if (!is.null(input$map1_colourcheck) && input$map1_colourcheck) {
      if (!is.null(input$colourby) && input$colourby %in% numericVars()) {
        ret0 <- fixedRow(
          column(3, h5("Palette:")),
          column(6, selectInput(
            inputId = "select.colour.palette",
            label = NULL,
            choices = c("inferno", names(colourPalettes$cont)[-4]),
            selectize = FALSE
          ))
        )
      } else if (!is.null(input$colourby) &&
        input$colourby %in% characterVars()) {
        ret0 <- fixedRow(
          column(3, h5("Palette:")),
          column(6, selectInput(
            inputId = "select.colour.palette",
            label = NULL,
            choices = names(colourPalettes$cat),
            selectize = FALSE
          ))
        )
      }

      if (!is.null(input$colourby) && input$colourby != "") {
        ret1 <- list(fixedRow(
          column(5, checkboxInput(
            inputId = "reversepalette",
            label = "Reverse palette",
            value = input$reversepalette
          )),
          column(5, checkboxInput(
            inputId = "usepercentiles",
            label = "Use Percentiles",
            value = input$usepercentiles
          ))
        ))
      }
    }


    ret <- list(
      ret0,
      ret1
    )
  })

  ret
})


observe({
  input$select.colour.palette
  isolate({
    if (!is.null(input$select.colour.palette)) {
      if (input$select.colour.palette %in% names(colourPalettes$cat)) {
        args$col.fun <- colourPalettes$cat[[input$select.colour.palette]]
      } else if (input$select.colour.palette %in% names(colourPalettes$cont)) {
        args$col.fun <- colourPalettes$cont[[input$select.colour.palette]]
      }
    }
  })
})


observe({
  input$reversepalette
  isolate({
    if (length(input$reversepalette) > 0) {
      args$reverse.palette <- input$reversepalette
    } else {
      args$reverse.palette <- NULL
    }
  })
})


observe({
  input$usepercentiles
  isolate({
    if (length(input$usepercentiles) > 0) {
      args$col.method <- ifelse(input$usepercentiles, "rank", "linear")
    } else {
      args$col.method <- NULL
    }
  })
})






## set up plot_plottitle_panel
output$plot_plottitle_panel <- renderUI({
  get.data.set()
  isolate({
    list(
      textInput("type1_plottitle",
        label = "Plot title:",
        value = input$type1_plottitle
      ),
      actionButton(
        inputId = "type1_plottitle_confirm",
        label = "Confirm Title",
        style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
      )
    )
  })
})

## update args$main when observe input$type1_plottitle_confirm
observe({
  input$type1_plottitle_confirm
  isolate({
    if (length(input$type1_plottitle) > 0 && input$type1_plottitle != "") {
      args$main <- input$type1_plottitle
    } else {
      args$main <- NULL
    }
  })
})


## set up plot_overallsize_panel
output$plot_overallsize_panel <- renderUI({
  get.data.set()
  isolate({
    sliderInput("type1_overallsize_slider",
      label = "Overall size scale:",
      min = 0.5,
      max = 2,
      value = 1, step = 0.05, ticks = FALSE
    )
  })
})

## update args$cex
observe({
  input$type1_overallsize_slider
  isolate({
    if (!is.null(input$type1_overallsize_slider)) {
      args$cex <- input$type1_overallsize_slider
    }
  })
})


## update args$type and args$col.pt
observe({
  input$plot_maptype
  isolate({
    if (!is.null(input$plot_maptype)) {
      args$type <- input$plot_maptype
    }
  })
})

observe({
  input$plot_colour
  isolate({
    if (!is.null(input$plot_colour)) {
      args$col.pt <- input$plot_colour
    }
  })
})



## set up plot_size_panel and plot_sizecheck_panel

output$plot_sizecheck_panel <- renderUI({
  get.data.set()

  isolate({
    checkboxInput(
      inputId = "map1_sizecheck",
      label = "Size",
      value = input$map1_sizecheck
    )
  })
})


output$plot_size_panel <- renderUI({
  get.data.set()
  input$map1_sizecheck
  ret <- NULL

  isolate({
    if (!is.null(input$map1_sizecheck) && input$map1_sizecheck) {
      ret <- list(
        fixedRow(
          column(3, h5("Overall:")),
          column(6, sliderInput(
            inputId = "pointsize",
            label = NULL,
            min = 0.05, max = 3.5,
            value = 1.1, step = 0.05, ticks = FALSE
          ))
        ),
        fixedRow(
          column(3, h5("Size by:")),
          column(6, selectInput(
            inputId = "sizeby",
            label = NULL,
            choices = c("", numericVars()),
            selectize = FALSE
          ))
        ),
        conditionalPanel(
          "input.sizeby != ''",
          fixedRow(
            column(3, h5("Resize method:")),
            column(6, selectInput(
              inputId = "resizemethod",
              label = NULL,
              choices = c("proportional", "emphasize"),
              selectize = FALSE
            ))
          )
        )
      )
    }
  })
  ret
})


## update args$resize.method
observe({
  input$resizemethod
  isolate({
    if (!is.null(input$resizemethod)) {
      args$resize.method <- input$resizemethod
    }
  })
})


## update args$cex.pt, args$alpha, args$join
observe({
  input$pointsize
  isolate({
    if (!is.null(input$pointsize)) {
      args$cex.pt <- input$pointsize
    }
  })
})



## set up plot_trans_panel and plot_transcheck_panel

output$plot_transcheck_panel <- renderUI({
  get.data.set()

  isolate({
    checkboxInput(
      inputId = "map1_transcheck",
      label = "Transparency",
      value = input$map1_transcheck
    )
  })
})

output$plot_trans_panel <- renderUI({
  get.data.set()
  input$map1_transcheck
  ret <- NULL

  isolate({
    if (!is.null(input$map1_transcheck) && input$map1_transcheck) {
      ret <- list(
        fixedRow(
          column(3, h5("Overall:")),
          column(6, sliderInput(
            inputId = "transparency",
            label = NULL,
            min = 0, max = 100,
            value = 0, step = 1, ticks = FALSE
          ))
        ),
        fixedRow(
          column(3, h5("Opacify by:")),
          column(6, selectInput(
            inputId = "opacifyby",
            label = NULL,
            choices = c("", numericVars()),
            selectize = FALSE
          ))
        ),
        checkboxInput(
          inputId = "reverseop",
          label = "Reverse Opacification",
          value = input$reverseop
        )
      )
    }
  })

  ret
})



## update args$reverse.opacity
observe({
  input$reverseop
  isolate({
    if (!is.null(input$reverseop)) {
      args$reverse.opacity <- input$reverseop
    }
  })
})


## set up plot_pointsymbol_panel and plot_symbolcheck_panel

output$plot_symbolcheck_panel <- renderUI({
  get.data.set()

  isolate({
    checkboxInput(
      inputId = "map1_symbolcheck",
      label = "Point Symbol",
      value = input$map1_symbolcheck
    )
  })
})


output$plot_pointsymbol_panel <- renderUI({
  get.data.set()
  input$map1_symbolcheck
  ret <- NULL

  isolate({
    if (!is.null(input$map1_symbolcheck) && input$map1_symbolcheck) {
      ret <- list(
        fixedRow(
          column(3, h5("Symbol:")),
          column(6, selectInput(
            inputId = "symbol",
            label = NULL,
            choices = c(
              "circle", "square", "diamond", "triangle",
              "inverted triangle"
            ),
            selectize = FALSE
          ))
        ),
        checkboxInput(
          inputId = "filledin",
          label = "Filled in symbols",
          value = input$filledin
        ),
        fixedRow(
          column(3, h5("Symbol by:")),
          column(6, selectInput(
            inputId = "symbolby",
            label = NULL,
            choices = c("", characterVars()),
            selectize = FALSE
          ))
        ),
        fixedRow(
          column(3, h5("Symbol line width:")),
          column(6, selectInput(
            inputId = "symbollwd",
            label = NULL,
            choices = c(1:4),
            selectize = FALSE,
            selected = 2
          ))
        )
      )
    }
  })

  ret
})


observe({
  input$symbol
  isolate({
    if (!is.null(input$symbol)) {
      args$pch <- switch(input$symbol,
        "circle"            = 21,
        "square"            = 22,
        "diamond"           = 23,
        "triangle"          = 24,
        "inverted triangle" = 25
      )
    }
  })
})


observe({
  input$filledin
  input$transparency
  isolate({
    if (!is.null(input$opacifyby) &&
      input$opacifyby %in% colnames(get.data.set()) &&
      !is.null(input$transparency)) {
      args$alpha <- 1 - input$transparency / 100
    } else if (!is.null(input$filledin) && !is.null(input$transparency)) {
      if (input$filledin && input$transparency == 0) {
        args$alpha <- 0.999
      } else {
        args$alpha <- 1 - input$transparency / 100
      }
    }
  })
})


observe({
  input$symbolby
  isolate({
    if (!is.null(input$symbolby)) {
      if (input$symbolby == "") {
        args$symbolby <- NULL
      } else {
        temp.data <- get.data.set()
        args$symbolby <- temp.data[[input$symbolby]]
        args$varnames$symbolby <- input$symbolby
      }
    }
  })
})


observe({
  input$symbollwd
  isolate({
    if (!is.null(input$symbollwd)) {
      args$lwd.pt <- input$symbollwd
    }
  })
})




observe({
  input$connectpoints
  isolate({
    if (!is.null(input$connectpoints)) {
      args$join <- input$connectpoints
    }
  })
})


## set up linescolour_panel
output$linescolour_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "linescolour",
      label = "Lines colour:",
      choices = c(
        "blue", "black", "red", "green4", "yellow",
        "pink", "grey", "orange"
      ),
      selectize = FALSE
    )
  })
})


## update args$col.line
observe({
  input$connectpoints
  input$linescolour
  isolate({
    if (!is.null(input$linescolour) &&
      input$connectpoints) {
      args$col.line <- input$linescolour
    }
  })
})


## set up mapssubset1_panel and mapssubset2_panel
## update mapssubset1_panel and mapssubset2_panel
## set up mapssubset1_slider_panel and mapssubset2_slider_panel
## update sliders for both subset1 and subset2
## update args$g1, args$g2, args$g1.level and args$g2.level

output$mapssubset1_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "mapssubset1",
      label = "Select subset variable 1:",
      choices = c("None", colnames(get.data.set())),
      selectize = FALSE
    )
  })
})


observe({
  input$mapssubset2
  isolate({
    data.temp <- get.data.set()
    ch <- colnames(data.temp)
    if (!is.null(input$mapssubset2) &&
      input$mapssubset2 == "None") {
      updateSelectInput(session, "mapssubset1",
        choices = c("None", ch), selected = input$mapssubset1
      )
      args$g2 <- NULL
      args$g2.level <- NULL
      args$varnames$g2 <- NULL
    } else if (!is.null(input$mapssubset2) &&
      input$mapssubset2 %in% colnames(get.data.set())) {
      ch <- ch[-which(ch %in% input$mapssubset2)]
      updateSelectInput(session, "mapssubset1",
        choices = c("None", ch), selected = input$mapssubset1
      )
      index <- which(input$mapssubset2 == colnames(data.temp))
      args$varnames$g2 <- colnames(data.temp)[index]
      args$g2.level <- "_ALL"
      if (input$map_type == 1) {
        g2 <- convert.to.factor(data.temp[, index])
        args$g2 <- g2
      } else if (input$map_type == 2) {
        if (!is.null(input$maplocation) &&
          !is.null(input$locationvariable) &&
          input$locationvariable %in% colnames(data.temp)) {
          temp <- plot.args()
          data.temp2 <- temp$x$data
          if (!is.numeric(data.temp2[, index]) &
            !is.ordered(data.temp2[, index])) {
            g2 <- factor(data.temp2[, index], ordered = TRUE)
          } else {
            g2 <- convert.to.factor(data.temp2[, index])
          }
          args$g2 <- g2
        }
      }
    }
  })
})


output$mapssubset1_slider_panel <- renderUI({
  get.data.set()
  input$delay1
  if (!is.null(input$mapssubset1) &&
    input$mapssubset1 %in% colnames(get.data.set())) {
    isolate({
      data.temp <- get.data.set()
      index <- which(input$mapssubset1 == colnames(data.temp))
      if (input$map_type == 1) {
        temp <- convert.to.factor(data.temp[, index])
      } else if (input$map_type == 2) {
        data.temp2 <- plot.args()$x$data
        if (!is.numeric(data.temp2[, index]) &
          !is.ordered(data.temp2[, index])) {
          temp <- factor(data.temp2[, index], ordered = TRUE)
        } else {
          temp <- convert.to.factor(data.temp2[, index])
        }
      }
      n.levels <- length(levels(temp))
      sliderInput(
        inputId = "mapssubset1_slider",
        label = paste("Subset '", input$mapssubset1, "':", "_MULTI"),
        min = 0, max = n.levels, value = 0, step = 1,
        animate = animationOptions(
          interval = ifelse(length(input$delay1) == 0, 600,
            1000 * input$delay1
          ),
          playButton = icon("play", "fa-2x"),
          pauseButton = icon("pause", "fa-2x")
        ),
        ticks = F
      )
    })
  }
})



observe({
  input$mapssubset1_slider
  isolate({
    if (!is.null(input$mapssubset1) &&
      input$mapssubset1 %in% colnames(get.data.set())) {
      data.temp <- get.data.set()
      index <- which(input$mapssubset1 == colnames(data.temp))
      if (input$map_type == 1) {
        temp <- convert.to.factor(data.temp[, index])
      } else if (input$map_type == 2) {
        data.temp2 <- plot.args()$x$data
        if (!is.numeric(data.temp2[, index]) &
          !is.ordered(data.temp2[, index])) {
          temp <- factor(data.temp2[, index], ordered = TRUE)
        } else {
          temp <- convert.to.factor(data.temp2[, index])
        }
      }
      level <- input$mapssubset1_slider
      args$varnames$g1 <- colnames(data.temp)[index]
      if (input$mapssubset1_slider == 0) {
        updateSliderInput(session, "mapssubset1_slider",
          label = paste("Subset '", input$mapssubset1, "': ", "_MULTI")
        )
        args$g1.level <- "_MULTI"
      } else {
        updateSliderInput(session, "mapssubset1_slider",
          label = paste(
            "Subset '", input$mapssubset1, "': ",
            levels(temp)[level]
          )
        )
        args$g1.level <- levels(temp)[level]
      }
      if (input$map_type == 1) {
        g1 <- convert.to.factor(data.temp[, index])
        args$g1 <- g1
      } else if (input$map_type == 2) {
        if (!is.null(input$maplocation) &&
          !is.null(input$locationvariable) &&
          input$locationvariable %in% colnames(data.temp)) {
        }
      }
    }
  })
})


output$speed_delay1 <- renderUI({
  get.data.set()

  isolate({
    fixedRow(
      (column(5, checkboxInput("select_delay1",
        label = "Time delay between plots (seconds):",
        value = input$select_delay1
      ))),
      column(3, conditionalPanel(
        "input.select_delay1",
        numericInput("delay1",
          "",
          value = 0.6,
          min = 0.1,
          max = 3.0,
          step = 0.1
        )
      ))
    )
  })
})




output$mapssubset2_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "mapssubset2",
      label = "Select subset variable 2:",
      choices = c("None", colnames(get.data.set())),
      selectize = FALSE
    )
  })
})


observe({
  input$mapssubset1
  isolate({
    data.temp <- get.data.set()
    ch <- colnames(data.temp)
    if (!is.null(input$mapssubset1) &&
      input$mapssubset1 %in% colnames(get.data.set())) {
      ch <- ch[-which(ch %in% input$mapssubset1)]
      updateSelectInput(session, "mapssubset2",
        choices = c("None", ch), selected = input$mapssubset2
      )
      index <- which(input$mapssubset1 == colnames(data.temp))
      args$varnames$g1 <- colnames(data.temp)[index]
      args$g1.level <- "_MULTI"
      if (input$map_type == 1) {
        g1 <- convert.to.factor(data.temp[, index])
        args$g1 <- g1
      } else if (input$map_type == 2) {
        if (!is.null(input$maplocation) &&
          !is.null(input$locationvariable) &&
          input$locationvariable %in% colnames(data.temp)) {
          temp <- plot.args()
          data.temp2 <- temp$x$data
          if (!is.numeric(data.temp2[, index]) &
            !is.ordered(data.temp2[, index])) {
            g1 <- factor(data.temp2[, index], ordered = TRUE)
          } else {
            g1 <- convert.to.factor(data.temp2[, index])
          }
          args$g1 <- g1
        }
      }
    } else if (!is.null(input$mapssubset1) &&
      input$mapssubset1 == "None") {
      updateSelectInput(session, "mapssubset2",
        choices = c("None", ch), selected = input$mapssubset2
      )
      args$g1 <- NULL
      args$g1.level <- NULL
      args$varnames$g1 <- NULL
    }
  })
})


output$mapssubset2_slider_panel <- renderUI({
  get.data.set()
  input$delay2
  if (!is.null(input$mapssubset2) &&
    input$mapssubset2 %in% colnames(get.data.set())) {
    isolate({
      data.temp <- get.data.set()
      index <- which(input$mapssubset2 == colnames(data.temp))
      if (input$map_type == 1) {
        temp <- convert.to.factor(data.temp[, index])
      } else if (input$map_type == 2) {
        data.temp2 <- plot.args()$x$data
        if (!is.numeric(data.temp2[, index]) &
          !is.ordered(data.temp2[, index])) {
          temp <- factor(data.temp2[, index], ordered = TRUE)
        } else {
          temp <- convert.to.factor(data.temp2[, index])
        }
      }
      n.levels <- length(levels(temp))
      sliderInput(
        inputId = "mapssubset2_slider",
        label = paste("Subset '", input$mapssubset2, "': ", "_ALL"),
        min = 0, max = n.levels + 1, value = 0, step = 1,
        animate = animationOptions(
          interval = ifelse(length(input$delay2) == 0, 600,
            1000 * input$delay2
          ),
          playButton = icon("play", "fa-2x"),
          pauseButton = icon("pause", "fa-2x")
        ),
        ticks = F
      )
    })
  }
})


observe({
  input$mapssubset2_slider
  isolate({
    if (!is.null(input$mapssubset2) &&
      input$mapssubset2 %in% colnames(get.data.set())) {
      data.temp <- get.data.set()
      index <- which(input$mapssubset2 == colnames(data.temp))
      if (input$map_type == 1) {
        temp <- convert.to.factor(data.temp[, index])
      } else if (input$map_type == 2) {
        data.temp2 <- plot.args()$x$data
        if (!is.numeric(data.temp2[, index]) &
          !is.ordered(data.temp2[, index])) {
          temp <- factor(data.temp2[, index], ordered = TRUE)
        } else {
          temp <- convert.to.factor(data.temp2[, index])
        }
      }
      n.levels <- length(levels(temp))
      level <- input$mapssubset2_slider
      args$varnames$g2 <- colnames(data.temp)[index]
      if (input$mapssubset2_slider == 0) {
        updateSliderInput(session, "mapssubset2_slider",
          label = paste("Subset '", input$mapssubset2, "': ", "_ALL")
        )
        args$g2.level <- "_ALL"
      } else if (input$mapssubset2_slider == (n.levels + 1)) {
        updateSliderInput(session, "mapssubset2_slider",
          label = paste("Subset '", input$mapssubset2, "': ", "_MULTI")
        )
        args$g2.level <- "_MULTI"
      } else {
        updateSliderInput(session, "mapssubset2_slider",
          label = paste(
            "Subset '", input$mapssubset2, "': ",
            levels(temp)[level]
          )
        )
        args$g2.level <- levels(temp)[level]
      }
      if (input$map_type == 1) {
        g2 <- convert.to.factor(data.temp[, index])
        args$g2 <- g2
      } else if (input$map_type == 2) {
        if (!is.null(input$maplocation) &&
          !is.null(input$locationvariable) &&
          input$locationvariable %in% colnames(data.temp)) {

        }
      }
    }
  })
})


output$speed_delay2 <- renderUI({
  get.data.set()
  isolate({
    fixedRow(
      (column(5, checkboxInput("select_delay2",
        label = "Time delay between plots (seconds):",
        value = input$select_delay2
      ))),
      column(3, conditionalPanel(
        "input.select_delay2",
        numericInput("delay2",
          "",
          value = 0.6,
          min = 0.1,
          max = 3.0,
          step = 0.1
        )
      ))
    )
  })
})



## set up selectmap_panel, inbuiltmap_panel

output$selectmap_panel <- renderUI({
  get.data.set()
  isolate({
    radioButtons(
      inputId = "selectshapefile",
      label = NULL,
      choices =
        c(
          "Use Inbuilt Map" = 1,
          "Import Shapefile" = 2
        ),
      selected = 1,
      inline = TRUE
    )
  })
})


output$inbuiltmap_panel <- renderUI({
  get.data.set()
  isolate({
    radioButtons(
      inputId = "selectinbuiltmap",
      label = NULL,
      choices =
        c(
          "Continents" = 1,
          "Countries" = 2,
          "World" = 3
        ),
      selected = 1,
      inline = TRUE
    )
  })
})


output$continentsoptions_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "continentsmap",
      label = NULL,
      choices = c(
        "Africa", "Asia", "Europe", "North America", "Oceania", "South America"
      ),
      multiple = FALSE,
      selectize = FALSE,
      size = 4
    )
  })
})


output$countriesoptions_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "countriesmap",
      label = NULL,
      choices = c(
        "New Zealand General Electoral Districts (2017)",
        "New Zealand DHBs (2012)",
        "New Zealand Regional Councils (2017)",
        "New Zealand Territorial Authorities (2017)",
        "US States",
        "US States (Contiguous)"
      ),
      multiple = FALSE,
      selectize = FALSE,
      size = 4
    )
  })
})


output$worldoptions_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "worldmap",
      label = NULL,
      choices = c(
        "World Map (Natural Earth) (incl. Antarctica)",
        "World Map (Thematic Mapping)"
      ),
      multiple = FALSE,
      selectize = FALSE,
      size = 4
    )
  })
})


## set up select variables panel

output$datavariable_panel <- renderUI({
  get.data.set()
  isolate({
    fixedRow(
      column(5, h5("Data Variable:")),
      column(7, selectInput(
        inputId = "datavariable",
        label = NULL,
        choices = colnames(vis.data()),
        selectize = F
      ))
    )
  })
})


output$mapvairable_panel <- renderUI({
  get.data.set()
  isolate({
    fixedRow(
      column(5, h5("Map Variable:")),
      column(7, selectInput(
        inputId = "mapvariable",
        label = NULL,
        choices = "",
        selectize = F
      ))
    )
  })
})


## update datavariable_panel and mapvairable_panel
## after shapefiles selected and "import map" clicked
observe({
  get.data.set()
  input$importmap
  #  input$datavariable
  #  input$mapvariable
  #  input$sequencevariable
  isolate({
    temp.data <- get.data.set()

    if (!is.null(input$selectinbuiltmap) && input$selectinbuiltmap %in% 1:3) {
      if (input$selectinbuiltmap == 1) {
        dirpath <- "shapefiles/continents/"
        filename <- switch(input$continentsmap,
          "Africa" = "africa.rds",
          "Asia" = "asia.rds",
          "Europe" = "europe.rds",
          "North America" = "northamerica.rds",
          "Oceania" = "oceania.rds",
          "South America" = "southamerica.rds"
        )
      } else if (input$selectinbuiltmap == 2) {
        dirpath <- "shapefiles/countries/"
        filename <- switch(input$countriesmap,
          "New Zealand General Electoral Districts (2017)" =
            "nzl/constituency-2018.rds",
          "New Zealand DHBs (2012)" = "nzl/dhb-2012.rds",
          "New Zealand Regional Councils (2017)" =
            "nzl/regional-council-2018.rds",
          "New Zealand Territorial Authorities (2017)" =
            "nzl/territorial-authority-2018.rds",
          "US States" = "usa/states-2016.rds",
          "US States (Contiguous)" = "usa/states-contig-2016.rds"
        )
      } else if (input$selectinbuiltmap == 3) {
        dirpath <- "shapefiles/world/"
        filename <- switch(input$worldmap,
          "World Map (Natural Earth) (incl. Antarctica)" =
            "natural-earth-4.0.rds",
          "World Map (Thematic Mapping)" = "thematic-mapping-0.3.rds"
        )
      }

      ## obtain the filepath and read the map file
      filepath <- paste(dirpath, filename, sep = "")
      mapData <- iNZightMaps::retrieveMap(filepath)
      args2$mapData <- mapData
      map.vars <- as.data.frame(
        stringsAsFactors = TRUE,
        mapData
      )[, !(colnames(mapData) %in% "geometry"), drop = FALSE]
      ## get the choices for mapvairable_panel
      mapvars.update <- colnames(
        map.vars[, !(apply(map.vars, 2, anyDuplicated,
          incomparables = c(NA, "")
        )), drop = FALSE]
      )

      ## Find the pair of variables with the highest number of matches
      best.vars <- iNZightMaps::findBestMatch(temp.data, map.vars)
      best.data.var <- best.vars[1]
      best.map.var <- best.vars[2]

      if (length(input$mapvariable) > 0 && length(input$datavariable) > 0 &&
        input$mapvariable == best.map.var &&
        input$datavariable == best.data.var) {
        temp <- plot.args2()
        args2$updateplot <- temp$updateplot + 1
      }

      ## update mapvairable_panel after map file selected
      updateSelectInput(session, "mapvariable",
        choices = mapvars.update, selected = best.map.var
      )
      ## update datavariable_panel
      updateSelectInput(session, "datavariable", selected = best.data.var)
    }
  })
})


## observe shapefiles loaded by users
observeEvent(input$loadshapefiles, {
  temp.data <- get.data.set()

  isolate({
    filepath <- input$loadshapefiles$datapath
    mapData <- iNZightMaps::retrieveMap(filepath)
    args2$mapData <- mapData
    map.vars <- as.data.frame(
      stringsAsFactors = TRUE,
      mapData
    )[, !(colnames(mapData) %in% "geometry"), drop = FALSE]
    ## get the choices for mapvairable_panel
    mapvars.update <- colnames(
      map.vars[, !(apply(map.vars, 2, anyDuplicated,
        incomparables = c(NA, "")
      )), drop = FALSE]
    )

    ## Find the pair of variables with the highest number of matches
    best.vars <- iNZightMaps::findBestMatch(temp.data, map.vars)
    best.data.var <- best.vars[1]
    best.map.var <- best.vars[2]

    ## update mapvairable_panel after map file selected
    updateSelectInput(session, "mapvariable",
      choices = mapvars.update, selected = best.map.var
    )
    ## update datavariable_panel
    updateSelectInput(session, "datavariable", selected = best.data.var)
  })
})



## everything reset to default when a new dataset is loaded
observe({
  get.data.set()

  isolate({
    args2$combinedData <- NULL
    #    mapData = NULL,

    #    mapName = "",
    #    mapType = NULL,
    #    mapVars = NULL,
    #    mapSizeVar = NULL,
    #    mapSequenceVar = NULL,

    args2$match.list <- NULL

    #  has.multipleobs = FALSE,
    #    plotTitle = "",
    #    plotAxes = FALSE,
    #    plotXLab = "",
    #    plotYLab = "",
    #    plotDatumLines = FALSE,
    #    plotProjection = NULL,
    #    plotTheme = FALSE,
    #    plotPalette = "Default",
    #    plotConstantAlpha = 1.0,
    #    plotConstantSize = 1.0,
    #    plotCurrentSeqVal = NULL,
    #    timer = NULL,

    #    multipleObsOption = NULL,
    #    plotSparklinesType = "Absolute",
    #    plotScaleLimits = NULL,
    #    plotLabelVar = NULL,

    #    plotLabelScale = 4,
    #    plotAxisScale = 11,

    #    proj.df = iNZightMaps::iNZightMapProjections()
  })
})






## update "combinedData" information after loading data
observe({
  get.data.set()
  input$datavariable
  input$mapvariable
  input$sequencevariable
  #  input$unmatched
  #  args2$mapData

  args2$updateplot
  args2$match.list

  isolate({
    temp.data <- get.data.set()
    temp <- plot.args2()
    mapData <- temp$mapData
    match.list <- temp$match.list
    sequence.var <- NULL

    if (!is.null(mapData) && !is.null(match.list) &&
      !is.null(input$datavariable) &&
      input$datavariable %in% colnames(temp.data) &&
      !is.null(input$mapvariable) && input$mapvariable != "") {
      if (match.list$multiple.obs) {
        has.multipleobs <- TRUE
        if (!is.null(input$sequencevariable) &&
          input$sequencevariable %in% colnames(temp.data)) {
          sequence.var <- input$sequencevariable
        }
      } else {
        has.multipleobs <- FALSE
      }

      args2$combinedData <- suppressWarnings(iNZightMaps::iNZightMapPlot(
        data = temp.data,
        map = mapData,
        type = "region",
        by.data = input$datavariable,
        by.map = input$mapvariable,
        simplification.level = 0.01,
        multiple.obs = has.multipleobs,
        sequence.var = sequence.var
      ))

      args2$updateplot1 <- temp$updateplot1 + 1
    }
  })
})


output$sequencevariable_panel <- renderUI({
  get.data.set()
  input$datavariable
  input$mapvariable
  input$loadshapefiles
  ret <- NULL

  isolate({
    temp.data <- get.data.set()
    temp <- plot.args2()
    match.list <- temp$match.list
    if (!is.null(match.list)) {
      if (match.list$multiple.obs) {
        textpanel <- h5(strong(
          "Multiple observations for each region were found!"
        ))
        timevar <- grepl("(year|date)", colnames(temp.data), ignore.case = TRUE)

        if (any(timevar)) {
          ret <- list(
            textpanel,
            fixedRow(
              column(5, h5("Sequence Variable:")),
              column(7, selectInput(
                inputId = "sequencevariable",
                label = NULL,
                choices = colnames(vis.data()),
                selected = colnames(vis.data())[timevar][1],
                selectize = F
              ))
            )
          )
        } else {
          ret <- list(
            textpanel,
            fixedRow(
              column(5, h5("Sequence Variable:")),
              column(7, selectInput(
                inputId = "sequencevariable",
                label = NULL,
                choices = colnames(vis.data()),
                selectize = F
              ))
            )
          )
        }
      } else {
        textpanel <- ""
      }
    }
  })
  ret
})


## setup unmateched data panel

output$unmatched_panel <- renderUI({
  get.data.set()
  #  input$importmap
  #  input$datavariable
  #  input$mapvariable

  #  input$loadshapefiles
  args2$match.list

  ret <- NULL
  isolate({
    temp <- plot.args2()

    if (!is.null(temp$match.list)) {
      match.list <- temp$match.list
      table.nonmatched <- match.list$data.vect[!(match.list$data.matched)]
      ret <- list(
        h4("Unmatched Data"),
        h5("Observations in the dataset with no corresponding region in the map file"),
        selectInput(
          inputId = "unmatched",
          label = NULL,
          choices = table.nonmatched,
          multiple = FALSE,
          selectize = FALSE,
          size = 3
        )
      )
    }

    ret
  })
})


output$unmatchedcounts_panel <- renderText({
  get.data.set()
  #  input$importmap
  #  input$datavariable
  #  input$mapvariable

  #  input$loadshapefiles

  args2$match.list

  ret <- NULL
  isolate({
    temp <- plot.args2()
    if (!is.null(temp$match.list)) {
      match.list <- temp$match.list
      matchedcount <- sum(match.list$data.matched)
      unmatchedcount <- sum(!match.list$data.matched)
      ret <- paste("Matched Count:", matchedcount, "\n",
        "Unmatched Count:", unmatchedcount,
        sep = ""
      )
    }

    ret
  })
})



## set up advancedmapoptions_panel
output$advancedmapoptions_panel <- renderUI({
  get.data.set()

  #  proj.df = iNZightMaps::iNZightMapProjections()
  ret <- NULL
  isolate({
    advancedmapoptions.title <- checkboxInput(
      inputId = "advancedmapoptions_title",
      label = strong("Advanced Map Options"),
      value = input$advancedmapoptions_title
    )

    advancedmapoptions.contents <- conditionalPanel(
      condition = "input.advancedmapoptions_title",
      fixedRow(
        column(3, h5("Projection:")),
        column(6, selectInput(
          inputId = "advancedmapoptions_projection",
          label = NULL,
          choices = plot.args2()$proj.df$Name,
          selected = input$advancedmapoptions_projection,
          selectize = F
        ))
      ),
      uiOutput("checkregion_panel")
    )
    ret <- list(
      advancedmapoptions.title,
      advancedmapoptions.contents
    )
  })

  ret
})


## set up checkregion_panel
output$checkregion_panel <- renderUI({
  get.data.set()
  input$datavariable
  input$mapvariable
  input$sequencevariable
  input$importmap
  input$loadshapefiles

  ret <- NULL

  isolate({
    temp <- plot.args2()
    if (!is.null(temp$combinedData)) {
      options <- suppressWarnings(
        iNZightMaps::iNZightMapRegions(temp$combinedData)
      )
      ret <- selectInput(
        inputId = "check_regions",
        label = NULL,
        choices = options,
        selected = options,
        multiple = TRUE,
        selectize = FALSE,
        size = 4
      )
    }
  })

  ret
})



## observe checkregion_panel
observe({
  input$check_regions
  isolate({
    temp <- plot.args2()
    options <- suppressWarnings(
      iNZightMaps::iNZightMapRegions(temp$combinedData)
    )
    if (!is.null(input$check_regions) && length(input$check_regions) > 0 &&
      length(input$check_regions) != length(options)) {
      args2$mapRegionsPlot <- input$check_regions
      args2$mapExcludedRegions <- TRUE
    } else {
      args2$mapRegionsPlot <- NULL
    }
  })
})


## observe advancedmapoptions_projection
observe({
  input$advancedmapoptions_projection
  isolate({
    projection.index <- match(
      input$advancedmapoptions_projection, plot.args2()$proj.df$Name
    )

    args2$plotProjection <- plot.args2()$proj.df[projection.index, "PROJ4"]
  })
})



## set up advancedplotoptions_panel
output$advancedplotoptions_panel <- renderUI({
  get.data.set()
  input$datavariable
  input$mapvariable
  input$sequencevariable


  ret <- NULL
  isolate({
    temp <- plot.args2()

    if (!is.null(temp$combinedData)) {
      advancedplotoptions.title <- checkboxInput(
        inputId = "advancedplotoptions_title",
        label = strong("Advanced Plot Options"),
        value = input$advancedplotoptions_title
      )

      advancedplotoptions.contents <- conditionalPanel(
        condition = "input.advancedplotoptions_title",
        list(
          fixedRow(
            column(3, h5("Plot Title:")),
            column(6, textInput("advancedplotoptions_plottitle",
              label = NULL,
              value = input$advancedplotoptions_plottitle
            ))
          ),
          fixedRow(
            column(3, h5("Map Palette:")),
            column(6, selectInput(
              inputId = "advancedplotoptions_mappalette",
              label = NULL,
              choices = c(
                "Default", "Viridis",
                "Magma", "Plasma",
                "Inferno", "BrBG",
                "PiYG", "PRGn",
                "Accent", "Dark2",
                "Paired", "Pastel1",
                "Set1", "Blues",
                "BuGn", "BuPu", "GnBu"
              ),
              selected = input$advancedplotoptions_mappalette,
              selectize = F
            ))
          ),
          fixedRow(
            column(3, NULL),
            column(2, checkboxInput(
              inputId = "advancedplotoptions_dark",
              label = "Dark",
              value = input$advancedplotoptions_dark
            )),
            column(2, checkboxInput(
              inputId = "advancedplotoptions_gridlines",
              label = "Grid Lines",
              value = input$advancedplotoptions_gridlines
            )),
            column(2, checkboxInput(
              inputId = "advancedplotoptions_axislabels",
              label = "Axis Labels",
              value = input$advancedplotoptions_axislabels
            ))
          ),
          fixedRow(
            column(3, NULL),
            column(6, conditionalPanel(
              condition = "input.advancedplotoptions_axislabels & input.advancedplotoptions_title",
              fixedRow(
                column(6, h5("x-axis Label:")),
                column(6, textInput("advancedplotoptions_xaxislabel",
                  label = NULL,
                  value = temp$plotXLab
                ))
              ),
              fixedRow(
                column(6, h5("y-axis Label:")),
                column(6, textInput("advancedplotoptions_yaxislabel",
                  label = NULL,
                  value = temp$plotYLab
                ))
              )
            ))
          ),
          fixedRow(
            column(3, h5("Map Scales:")),
            column(6, selectInput(
              inputId = "advancedplotoptions_mapscales",
              label = NULL,
              choices = c(
                "Independent scales",
                "Same for all plots",
                "Scales fixed at 0-1",
                "Scales fixed at 0-100",
                "Scales fixed at custom range"
              ),
              selected = input$advancedplotoptions_mapscales,
              selectize = F
            ))
          ),
          conditionalPanel(
            condition = "input.advancedplotoptions_mapscales == 'Scales fixed at custom range'",
            fixedRow(
              column(3, textInput("scales_min",
                label = NULL,
                value = ""
              )),
              column(3, textInput("scales_max",
                label = NULL,
                value = ""
              )),
              column(3, actionButton(
                inputId = "scales_confirm",
                label = "Confirm",
                style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
              ))
            )
          ),
          fixedRow(
            column(3, h5("Plot title font size:")),
            column(6, sliderInput("plottitlefontsize_slider",
              label = NULL,
              min = 7,
              max = 17,
              value = 11, step = 1, ticks = FALSE
            ))
          ),
          fixedRow(
            column(3, checkboxInput(
              inputId = "regionlabels_click",
              label = "Region Labels:",
              value = input$advancedplotoptions_dark
            )),
            column(6, conditionalPanel(
              condition = "input.regionlabels_click & input.advancedplotoptions_title",
              selectInput(
                inputId = "advancedplotoptions_regionlabels",
                label = NULL,
                choices = c(
                  "Current Variable",
                  iNZightMaps::iNZightMapVars(temp$combinedData,
                    map.vars = TRUE
                  )
                ),
                selected = input$advancedplotoptions_regionlabels,
                selectize = F
              ),
              fixedRow(
                column(5, h5("Label font size:")),
                column(7, sliderInput("regionlabels_slider",
                  label = NULL,
                  min = 1,
                  max = 10,
                  value = 4, step = 0.5, ticks = FALSE
                ))
              )
            ))
          )
        )
      )

      ret <- list(
        advancedplotoptions.title,
        advancedplotoptions.contents
      )
    }
  })

  ret
})


## observe scales_confirm
observe({
  input$scales_confirm
  isolate({
    if (!is.null(input$scales_min) && length(input$scales_min) > 0 &&
      !is.null(input$scales_max) && length(input$scales_max) > 0) {
      args2$plotScaleLimits <- as.numeric(c(input$scales_min, input$scales_max))
    }
  })
})


## observe plottitlefontsize_slider
## observe regionlabels_slider
observe({
  input$plottitlefontsize_slider
  isolate({
    args2$plotAxisScale <- input$plottitlefontsize_slider
  })
})


## observe regionlabels_slider
observe({
  input$regionlabels_slider
  isolate({
    args2$plotLabelScale <- input$regionlabels_slider
  })
})


## observe regionlabels_click and advancedplotoptions_regionlabels
observe({
  input$regionlabels_click
  input$advancedplotoptions_regionlabels

  isolate({
    if (!is.null(input$regionlabels_click) && input$regionlabels_click) {
      if (!is.null(input$advancedplotoptions_regionlabels) &&
        length(input$advancedplotoptions_regionlabels) > 0) {
        if (input$advancedplotoptions_regionlabels == "Current Variable") {
          args2$plotLabelVar <- "use_colour_var"
        } else {
          args2$plotLabelVar <- input$advancedplotoptions_regionlabels
        }
      }
    } else {
      args2$plotLabelVar <- NULL
    }
  })
})


## observe advancedplotoptions_mapscales
observe({
  input$advancedplotoptions_mapscales
  isolate({
    if (!is.null(input$advancedplotoptions_mapscales) &&
      length(input$advancedplotoptions_mapscales) > 0) {
      if (!is.null(input$vartodisplay) && length(input$vartodisplay) > 0) {
        args2$plotScaleLimits <- switch(input$advancedplotoptions_mapscales,
          "Independent scales" = NULL,
          "Same for all plots" = iNZightMaps::getMinMax(
            plot.args2()$combinedData, input$vartodisplay
          ),
          "Scales fixed at 0-1" = c(0, 1),
          "Scales fixed at 0-100" = c(0, 100)
        )
      }
    }
  })
})



## observe advancedplotoptions_mappalette
observe({
  input$advancedplotoptions_mappalette
  isolate({
    args2$plotPalette <- input$advancedplotoptions_mappalette
  })
})


## observe advancedplotoptions_dark
observe({
  input$advancedplotoptions_dark
  isolate({
    args2$plotTheme <- input$advancedplotoptions_dark
  })
})

## observe advancedplotoptions_gridlines
observe({
  input$advancedplotoptions_gridlines
  isolate({
    args2$plotDatumLines <- input$advancedplotoptions_gridlines
  })
})



## observe advancedplotoptions_axislabels
observe({
  input$advancedplotoptions_axislabels
  isolate({
    args2$plotAxes <- input$advancedplotoptions_axislabels
  })
})


## observe advancedplotoptions_xaxislabel and advancedplotoptions_yaxislabel
observe({
  input$advancedplotoptions_xaxislabel
  isolate({
    if (length(input$advancedplotoptions_xaxislabel) > 0) {
      args2$plotXLab <- input$advancedplotoptions_xaxislabel
    }
  })
})

observe({
  input$advancedplotoptions_yaxislabel
  isolate({
    if (length(input$advancedplotoptions_yaxislabel) > 0) {
      args2$plotYLab <- input$advancedplotoptions_yaxislabel
    }
  })
})


## set up variabletodisplay_panel
output$variabletodisplay_panel <- renderUI({
  get.data.set()
  input$importmap
  input$datavariable
  input$mapvariable

  ret <- NULL
  isolate({
    temp <- plot.args2()
    if (!is.null(temp$combinedData)) {
      var.vect <- iNZightMaps::iNZightMapVars(temp$combinedData)
      ret <- list(
        h4("Select Variable/s to Display"),
        h5("(Use Ctrl+Click to select multiple variables)"),
        selectInput(
          inputId = "vartodisplay",
          label = NULL,
          choices = var.vect,
          multiple = TRUE,
          selected = input$vartodisplay,
          selectize = FALSE,
          size = 4
        )
      )
    }

    ret
  })
})


## set up multipleobsoption_panel

output$multipleobsoption_panel <- renderUI({
  get.data.set()
  #  plot.args2()
  input$datavariable
  input$mapvariable

  ret <- NULL
  isolate({
    temp.data <- get.data.set()
    temp <- plot.args2()

    if (!is.null(temp$match.list) && temp$match.list$multiple.obs) {
      ret <- list(
        h5(strong("Dataset has multiple observations for regions:")),
        radioButtons(
          inputId = "multipleobsoption",
          label = NULL,
          choices =
            c(
              "Single Value" = 1,
              "All Values" = 2,
              "Aggregate" = 3
            ),
          selected = input$multipleobsoption,
          inline = TRUE
        ),

        ## a slider for the sequence variables

        conditionalPanel(
          condition = "input.multipleobsoption == 1",
          fixedRow(
            column(3, textOutput("printseqvar")),
            column(6, uiOutput("seqvar_slider_panel"))
          ),
          fixedRow(
            column(3, NULL),
            column(6, uiOutput("seqvar_slidertimer_panel"))
          )
        ),
        conditionalPanel(
          condition = "input.multipleobsoption == 2",
          fixedRow(
            column(3, h5("")),
            column(6, radioButtons(
              inputId = "Sparklinesoption",
              label = NULL,
              choices = c("Sparklines" = 1),
              selected = 1,
              inline = TRUE
            ))
          ),
          fixedRow(
            column(3, h5("Line Chart Type:")),
            column(6, selectInput(
              inputId = "linecharttypeoption",
              label = NULL,
              choices = c("Absolute", "Relative", "Percent Change"),
              selected = input$linecharttypeoption,
              selectize = F
            ))
          )
        ),
        conditionalPanel(
          condition = "input.multipleobsoption == 3",
          selectInput(
            inputId = "aggregateoption",
            label = NULL,
            choices = c("Mean", "Median"),
            selected = input$aggregateoption,
            selectize = F
          )
        )
      )
    }
  })

  ret
})


## print out sequence variable and show slider
output$printseqvar <- renderText({
  get.data.set()
  input$sequencevariable
  input$seqvar_slider
  isolate({
    temp <- plot.args2()
    unique.singlevals <- unique(as.data.frame(
      stringsAsFactors = TRUE,
      temp$combinedData[["region.data"]]
    )[, temp$combinedData$sequence.var])
    unique.singlevals <- unique.singlevals[!is.na(unique.singlevals)]
    if (!is.null(input$sequencevariable) &&
      length(input$sequencevariable) > 0) {
      paste(
        "Value of", input$sequencevariable, ":",
        unique.singlevals[input$seqvar_slider]
      )
    }
  })
})

output$seqvar_slider_panel <- renderUI({
  get.data.set()
  input$sequencevariable
  input$slidertimer
  ret <- NULL
  isolate({
    temp <- plot.args2()

    if (!is.null(temp$match.list) && temp$match.list$multiple.obs) {
      unique.singlevals <- unique(as.data.frame(
        stringsAsFactors = TRUE,
        temp$combinedData[["region.data"]]
      )[, temp$combinedData$sequence.var])
      unique.singlevals <- unique.singlevals[!is.na(unique.singlevals)]
      n.unique.singlevals <- length(unique.singlevals)
      if (!is.null(input$sequencevariable) &&
        length(input$sequencevariable) > 0) {
        ret <- sliderInput("seqvar_slider",
          label = NULL,
          min = 1,
          max = n.unique.singlevals,
          value = n.unique.singlevals, step = 1,
          animate = animationOptions(
            interval = ifelse(length(input$slidertimer) == 0, 600,
              1000 * input$slidertimer
            ),
            playButton = icon("play", "fa-2x"),
            pauseButton = icon("pause", "fa-2x")
          ),
          ticks = FALSE
        )
      }
    }
  })

  ret
})




output$seqvar_slidertimer_panel <- renderUI({
  get.data.set()
  isolate({
    fixedRow(
      (column(6, checkboxInput("seqvar_slidertimer",
        label = "Time delay between plots (seconds):",
        value = input$seqvar_slidertimer
      ))),
      column(6, conditionalPanel(
        "input.seqvar_slidertimer",
        numericInput("slidertimer",
          "",
          value = 0.6,
          min = 0.1,
          max = 3.0,
          step = 0.1
        )
      ))
    )
  })
})


## observe multipleobsoption and seqvar_slider
observe({
  input$multipleobsoption
  input$seqvar_slider

  isolate({
    temp <- plot.args2()
    if (!is.null(temp$match.list) && temp$match.list$multiple.obs) {
      if (length(input$multipleobsoption) > 0 && input$multipleobsoption == 1) {
        unique.singlevals <- unique(as.data.frame(
          stringsAsFactors = TRUE,
          temp$combinedData[["region.data"]]
        )[, temp$combinedData$sequence.var])
        unique.singlevals <- unique.singlevals[!is.na(unique.singlevals)]

        args2$multipleObsOption <- "singleval"
        if (!is.null(input$seqvar_slider) && length(input$seqvar_slider) > 0) {
          args2$plotCurrentSeqVal <- unique.singlevals[input$seqvar_slider]
          args2$combinedData <- iNZightMaps::iNZightMapAggregation(
            temp$combinedData,
            "singlevalue",
            single.value = unique.singlevals[input$seqvar_slider]
          )
        }

        ## update the plot title
        if (!is.null(input$vartodisplay) && length(input$vartodisplay) == 1) {
          args2$plotTitle <- paste(
            input$vartodisplay, " (",
            unique.singlevals[input$seqvar_slider], ")"
          )
          updateTextInput(session, "advancedplotoptions_plottitle",
            value = paste(
              input$vartodisplay, " (",
              unique.singlevals[input$seqvar_slider], ")"
            )
          )
        }
      }
    }
  })
})


## observe multipleobsoption and linecharttypeoption
observe({
  input$multipleobsoption
  input$linecharttypeoption

  isolate({
    if (length(input$multipleobsoption) > 0 && input$multipleobsoption == 2) {
      args2$multipleObsOption <- "allvalues"
      args2$combinedData$type <- "sparklines"
      args2$plotCurrentSeqVal <- NULL
      args2$plotSparklinesType <- input$linecharttypeoption

      if (!is.null(input$vartodisplay) && length(input$vartodisplay) > 0) {
        vars.to.keep <- sapply(as.data.frame(
          stringsAsFactors = TRUE,
          plot.args2()$combinedData$region.data
        )[, input$vartodisplay, drop = FALSE], is.numeric)
        if (sum(vars.to.keep) > 0) {
          updateSelectInput(session, "vartodisplay",
            selected = input$vartodisplay[vars.to.keep]
          )
        } else {
          updateSelectInput(session, "vartodisplay", selected = NULL)
        }
      }
    }
  })
})



## observe multipleobsoption and aggregateoption
observe({
  input$multipleobsoption
  input$aggregateoption

  isolate({
    #    temp = plot.args2()
    if (length(input$multipleobsoption) > 0 && input$multipleobsoption == 3) {
      args2$multipleObsOption <- "aggregate"
      args2$plotCurrentSeqVal <- input$aggregateoption
      args2$combinedData <- iNZightMaps::iNZightMapAggregation(
        args2$combinedData,
        tolower(input$aggregateoption)
      )
    }
  })
})





## set up plotas_panel
output$plotas_panel <- renderUI({
  get.data.set()
  #  plot.args2()
  input$multipleobsoption
  input$datavariable
  input$mapvariable
  input$sequencevariable

  ret <- NULL
  isolate({
    temp <- plot.args2()

    if (!is.null(temp$combinedData)) {
      ## conditional when "Single Value" or "Aggregate" is selected
      if ((!is.null(input$multipleobsoption) &&
        length(input$multipleobsoption) > 0 && input$multipleobsoption != 2) ||
        (!is.null(temp$match.list) && !temp$match.list$multiple.obs)) {
        ret <- list(
          fixedRow(
            column(3, h5("Plot as:")),
            column(6, radioButtons(
              inputId = "plotas_options",
              label = NULL,
              choices = c("Regions" = 1, "Centroids" = 2),
              selected = input$plotas_options,
              inline = TRUE
            ))
          ),
          conditionalPanel(
            condition = "input.plotas_options == 2",
            fixedRow(
              column(3, h5("Size by:")),
              column(6, selectInput(
                inputId = "plotas_sizeby",
                label = NULL,
                choices = c(" ", sort(
                  iNZightMaps::iNZightMapVars(
                    temp$combinedData, TRUE
                  )[temp$combinedData$var.types %in% c("numeric", "integer")]
                )),
                selected = input$plotas_sizeby,
                selectize = F
              ))
            )
          )
        )
      }
    }
  })

  ret
})

## observe plotas_sizeby
observe({
  input$plotas_sizeby
  isolate({
    if (length(input$plotas_sizeby) > 0) {
      if (input$plotas_sizeby == " ") {
        args2$mapSizeVar <- NULL
      } else {
        args2$mapSizeVar <- input$plotas_sizeby
      }
    }
  })
})



## set up sizeandtransparency_panel
output$sizeandtransparency_panel <- renderUI({
  get.data.set()
  #  plot.args2()
  input$multipleobsoption
  input$plotas_options
  ret <- NULL

  isolate({
    temp <- plot.args2()
    ## conditional when "allvalues" is selected

    if ((length(input$multipleobsoption) > 0 && input$multipleobsoption == 2)) {
      ret <- list(
        fixedRow(
          column(3, h5("Transparency:")),
          column(6, sliderInput("advancedplotoptions_transparency",
            label = NULL,
            min = 0,
            max = 1,
            value = input$advancedplotoptions_transparency, step = 0.1,
            ticks = FALSE
          ))
        ),
        fixedRow(
          column(3, h5("Size:")),
          column(6, sliderInput("advancedplotoptions_size",
            label = NULL,
            min = 1,
            max = 10,
            value = temp$plotConstantSize, step = 1, ticks = FALSE
          ))
        )
      )
    } else if (length(input$plotas_options) > 0 && input$plotas_options == 2 &&
      (length(input$multipleobsoption) > 0 &&
        (input$multipleobsoption == 1 | input$multipleobsoption == 3) ||
        !is.null(temp$match.list) && !temp$match.list$multiple.obs)) {
      ret <- fixedRow(
        column(3, h5("Size:")),
        column(6, sliderInput("advancedplotoptions_size",
          label = NULL,
          min = 1,
          max = 10,
          value = temp$plotConstantSize, step = 1, ticks = FALSE
        ))
      )
    }
  })

  ret
})


## set up maplocation_panel and locationvariable_panel

output$maplocation_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "maplocation",
      label = "Map Location:",
      choices = c("Select Map Location", "world"),
      selected = "world",
      selectize = FALSE
    )
  })
})

output$locationvariable_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "locationvariable",
      label = "Location Variable:",
      choices = c("Select Location Variable", characterVars()),
      selectize = FALSE
    )
  })
})


## update mapsplot.obj when input$map_type == 2
observe({
  input$maplocation
  input$locationvariable
  isolate({
    temp.data <- get.data.set()
    if (input$map_type == 2 &&
      !is.null(input$maplocation) &&
      !is.null(input$locationvariable) &&
      input$locationvariable %in% colnames(temp.data)) {
      mapsplot.obj <- iNZightShapeMap(
        data = temp.data,
        location = input$maplocation,
        data.region = input$locationvariable
      )
      args$x <- mapsplot.obj
    }
  })
})


## set up plottingvariable_panel
## update args$variable
output$plottingvariable_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "plottingvariable",
      label = NULL,
      choices = c("Select Variable", numericVars()),
      selectize = FALSE
    )
  })
})

observe({
  input$plottingvariable
  isolate({
    if (!is.null(input$plottingvariable) &&
      input$plottingvariable %in% colnames(get.data.set())) {
      args$variable <- eval(parse(text = paste("~", input$plottingvariable)))
    }
  })
})


## set up plot_region_colour_panel, missingvaluecolour_panel
## and plotlabels_panel
## update args$col, args$na.fill and args$name
output$plot_region_colour_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "plot_region_colour",
      label = "Colour:",
      choices = c(
        "red", "darkblue", "darkgreen", "darkmagenta",
        "darkslateblue", "hotpink4", "lightsalmon2",
        "palegreen3", "steelblue3",
        "heat", "terrain"
      ),
      selectize = FALSE
    )
  })
})


output$missingvaluecolour_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "missingvaluecolour",
      label = "Missing value colour:",
      choices = c("grey50", "lightslategrey", "white", "black", "red"),
      selectize = FALSE
    )
  })
})


output$plotlabels_panel <- renderUI({
  get.data.set()
  isolate({
    selectInput(
      inputId = "plotlabels",
      label = "Plot Labels:",
      choices = c(c(
        "None", paste(input$locationvariable, "name"),
        "Value", "Both"
      )),
      selectize = FALSE
    )
  })
})


observe({
  input$plot_region_colour
  isolate({
    if (!is.null(input$plot_region_colour) &&
      input$plot_region_colour %in% c("heat", "terrain")) {
      args$col.fun <- input$plot_region_colour
    } else if (!is.null(input$plot_region_colour) &&
      !(input$plot_region_colour %in% c("heat", "terrian"))) {
      args$col.fun <- NULL
    }
    args$col <- input$plot_region_colour
  })
})


observe({
  input$missingvaluecolour
  isolate({
    if (!is.null(input$missingvaluecolour)) {
      args$na.fill <- input$missingvaluecolour
    }
  })
})


observe({
  input$plotlabels
  isolate({
    if (!is.null(input$plotlabels)) {
      if (input$plotlabels == "None") {
        args$name <- ""
      } else if (input$plotlabels == "Value") {
        args$name <- "v"
      } else if (input$plotlabels == "Both") {
        args$name <- "b"
      } else {
        args$name <- "r"
      }
    }
  })
})


## save maps
output$savemaps <- downloadHandler(
  filename = function() {
    paste("Maps", input$savemapstype, sep = ".")
  },
  content = function(file) {
    if (input$savemapstype == "jpg") {
      jpeg(file)
    } else if (input$savemapstype == "png") {
      png(file)
    } else if (input$savemapstype == "pdf") {
      pdf(file, useDingbats = FALSE)
    }


    if (input$map_type == 1) {
      condition1 <- !is.null(input$select_latitude) &&
        input$select_latitude %in% colnames(get.data.set()) &&
        !is.null(input$select_longitude) &&
        input$select_longitude %in% colnames(get.data.set())
      if (condition1) {
        temp <- plot.args()
        tryCatch(
          {
            do.call(plot, temp)
          },
          error = function(e) {
            print(e)
          }, finally = {}
        )
      }
    } else if (input$map_type == 2) {
      condition2 <- !is.null(input$maplocation) &&
        input$maplocation != "" &&
        !is.null(input$locationvariable) &&
        input$locationvariable %in% colnames(get.data.set()) &&
        !is.null(input$plottingvariable) &&
        input$plottingvariable %in% colnames(get.data.set())
      if (condition2) {
        temp <- plot.args()
        tryCatch(
          {
            do.call(plot, temp)
          },
          error = function(e) {
            print(e)
          }, finally = {}
        )
      }
    }

    dev.off()
  }
)


## observe advancedplotoptions_plottitle
observe({
  input$advancedplotoptions_plottitle
  isolate({
    args2$plotTitle <- input$advancedplotoptions_plottitle
  })
})

## update plot title
observe({
  input$vartodisplay
  input$multipleobsoption
  input$seqvar_slider

  isolate({
    temp <- plot.args2()
    if (!is.null(input$vartodisplay) && length(input$vartodisplay) > 0) {
      if (length(input$vartodisplay) > 1) {
        args2$plotTitle <- ""
        updateTextInput(session, "advancedplotoptions_plottitle", value = "")
      } else {
        if (!is.null(temp$match.list) && temp$match.list$multiple.obs) {
          if (length(input$multipleobsoption) > 0 &&
            input$multipleobsoption == 1) {
            #                  temp = plot.args2()
            args2$plotTitle <- paste(
              input$vartodisplay,
              " (", temp$plotCurrentSeqVal, ")"
            )
            updateTextInput(session, "advancedplotoptions_plottitle",
              value = paste(
                input$vartodisplay, " (",
                temp$plotCurrentSeqVal, ")"
              )
            )
          } else if (length(input$multipleobsoption) > 0 &&
            input$multipleobsoption == 3) {
            args2$plotTitle <- value <- paste(
              input$vartodisplay,
              " (", input$aggregateoption, ")"
            )
            updateTextInput(session, "advancedplotoptions_plottitle",
              value = paste(
                input$vartodisplay, " (",
                input$aggregateoption, ")"
              )
            )
          } else {
            args2$plotTitle <- input$vartodisplay
            updateTextInput(session, "advancedplotoptions_plottitle",
              value = input$vartodisplay
            )
          }
        } else {
          args2$plotTitle <- input$vartodisplay
          updateTextInput(session, "advancedplotoptions_plottitle",
            value = input$vartodisplay
          )
        }
      }
    }
  })
})



## plot when map information obtained
output$maps_plot <- renderPlot({
  get.data.set()

  ## coordinate
  #  input$type1_plottitle_confirm



  args2$plotTitle
  plot.args()

  args2$updateplot1

  input$datavariable
  input$mapvariable

  input$vartodisplay

  input$advancedmapoptions_projection
  input$advancedplotoptions_mappalette
  input$advancedplotoptions_dark
  input$advancedplotoptions_gridlines

  input$advancedplotoptions_transparency
  input$advancedplotoptions_size

  input$plotas_options
  input$plotas_sizeby

  input$multipleobsoption
  input$aggregateoption
  input$linecharttypeoption
  input$advancedplotoptions_regionlabels
  input$regionlabels_click
  input$regionlabels_slider
  input$plottitlefontsize_slider
  input$seqvar_slider

  input$advancedplotoptions_mapscales
  input$scales_confirm

  input$advancedplotoptions_axislabels

  input$check_regions

  #  input$loadshapefiles

  isolate({
    if (input$map_type == 1) {
      condition1 <- !is.null(input$select_latitude) &&
        input$select_latitude %in% colnames(get.data.set()) &&
        !is.null(input$select_longitude) &&
        input$select_longitude %in% colnames(get.data.set())
      if (condition1) {
        temp <- plot.args()
        tryCatch(
          {
            do.call(plot, temp)
          },
          warning = function(w) {
            print(w)
          },
          error = function(e) {

          }, finally = {}
        )
      }
    } else if (input$map_type == 2) {
      temp.data <- get.data.set()
      temp <- plot.args2()
      mapData <- temp$mapData

      if (!is.null(mapData) &&
        !is.null(input$datavariable) &&
        input$datavariable %in% colnames(temp.data) &&
        !is.null(input$mapvariable)) {
        ## update "match.list" information after loading data
        match.list <- iNZightMaps::matchVariables(
          temp.data[, input$datavariable],
          as.data.frame(
            stringsAsFactors = TRUE,
            mapData
          )[, input$mapvariable]
        )

        args2$match.list <- match.list


        if (!is.null(temp$combinedData) &&
          !is.null(input$vartodisplay) &&
          all(input$vartodisplay %in% colnames(temp.data))) {
          args2$combinedData$type <- ifelse(
            length(input$plotas_options) > 0 && input$plotas_options == 2,
            "point", "region"
          )

          args2$mapType <- ifelse(
            length(input$plotas_options) > 0 && input$plotas_options == 2,
            "point", "region"
          )

          if (length(input$multipleobsoption) > 0 &&
            input$multipleobsoption == 2) {
            args2$combinedData$type <- "sparklines"
          }

          ## multiple varibles to display ?
          if (length(input$vartodisplay) > 1) {
            multiple.variables <- TRUE
          } else {
            multiple.variables <- FALSE
          }

          if (is.null(temp$multipleObsOption)) {
            if (multiple.variables) {
              aggregate.logical <- TRUE
            } else {
              aggregate.logical <- FALSE
            }
          } else {
            if (multiple.variables && temp$multipleObsOption != "allvalues") {
              aggregate.logical <- TRUE
            } else {
              aggregate.logical <- FALSE
            }
          }

          ## update plotConstantSize (size for points)
          if (!is.null(input$advancedplotoptions_size) &&
            length(input$advancedplotoptions_size) > 0) {
            args2$plotConstantSize <- input$advancedplotoptions_size
          }


          ## update plotConstantAlpha
          if (!is.null(input$advancedplotoptions_transparency) &&
            length(input$advancedplotoptions_transparency) > 0) {
            args2$plotConstantAlpha <-
              1 - input$advancedplotoptions_transparency
          }

          temp <- plot.args2()
          grid::grid.draw(plot(temp$combinedData,
            main = temp$plotTitle,
            axis.labels = temp$plotAxes,
            xlab = temp$plotXLab,
            ylab = temp$plotYLab,
            datum.lines = temp$plotDatumLines,
            projection = temp$plotProjection,
            multiple.vars = multiple.variables,
            colour.var = input$vartodisplay,
            size.var = temp$mapSizeVar,
            aggregate = aggregate.logical,
            darkTheme = temp$plotTheme,
            alpha.const = temp$plotConstantAlpha,
            size.const = temp$plotConstantSize,
            current.seq = temp$plotCurrentSeqVal,
            palette = temp$plotPalette,
            sparkline.type = temp$plotSparklinesType,
            scale.limits = temp$plotScaleLimits,
            label.var = temp$plotLabelVar,
            scale.label = temp$plotLabelScale,
            scale.axis = temp$plotAxisScale,
            regions.to.plot = temp$mapRegionsPlot,
            keep.other.regions = temp$mapExcludedRegions
          ))
        } else {
          matchplot.colours <- c("#d95f02", "#1b9e77", "#7570b3")
          tryCatch(
            plot(sf::st_geometry(mapData$geometry),
              col = matchplot.colours[match.list$map.matched + 1]
            ),
            error = function(e) {}
          )

          legend("topleft",
            legend = c(
              "Data present for region",
              "Data missing for region"
            ),
            fill = matchplot.colours[2:1]
          )
        }
      }
    }
  })
})



## to display the interactive maps
output$interactive.maps <- renderUI({
  get.data.set()

  input$export.extra.mapvars.html

  args2$plotTitle
  plot.args()

  args2$updateplot1

  input$datavariable
  input$mapvariable

  input$vartodisplay

  input$advancedmapoptions_projection
  input$advancedplotoptions_mappalette
  input$advancedplotoptions_dark
  input$advancedplotoptions_gridlines

  input$advancedplotoptions_transparency
  input$advancedplotoptions_size

  input$plotas_options
  input$plotas_sizeby

  input$multipleobsoption
  input$aggregateoption
  input$linecharttypeoption
  input$advancedplotoptions_regionlabels
  input$regionlabels_click
  input$regionlabels_slider
  input$plottitlefontsize_slider
  input$seqvar_slider

  input$advancedplotoptions_mapscales
  input$scales_confirm

  input$advancedplotoptions_axislabels

  input$check_regions
  isolate({
    if (input$map_type == 2) {
      temp.data <- get.data.set()
      temp <- plot.args2()
      mapData <- temp$mapData

      if (!is.null(mapData) &&
        !is.null(input$datavariable) &&
        input$datavariable %in% colnames(temp.data) &&
        !is.null(input$mapvariable)) {
        ## update "match.list" information after loading data
        match.list <- iNZightMaps::matchVariables(
          temp.data[, input$datavariable],
          as.data.frame(
            stringsAsFactors = TRUE,
            mapData
          )[, input$mapvariable]
        )

        args2$match.list <- match.list

        if (!is.null(temp$combinedData) &&
          !is.null(input$vartodisplay) &&
          all(input$vartodisplay %in% colnames(temp.data))) {
          args2$combinedData$type <- ifelse(
            length(input$plotas_options) > 0 && input$plotas_options == 2,
            "point", "region"
          )

          args2$mapType <- ifelse(
            length(input$plotas_options) > 0 && input$plotas_options == 2,
            "point", "region"
          )

          if (length(input$multipleobsoption) > 0 &&
            input$multipleobsoption == 2) {
            args2$combinedData$type <- "sparklines"
          }

          ## multiple varibles to display ?
          if (length(input$vartodisplay) > 1) {
            h4("iNZight doesn't handle interactive maps for multiple variables ... yet!
               Please select only one variable")
          } #            multiple.variables = TRUE
          else {
            multiple.variables <- FALSE

            if (is.null(temp$multipleObsOption)) {
              if (multiple.variables) {
                aggregate.logical <- TRUE
              } else {
                aggregate.logical <- FALSE
              }
            } else {
              if (multiple.variables && temp$multipleObsOption != "allvalues") {
                aggregate.logical <- TRUE
              } else {
                aggregate.logical <- FALSE
              }
            }

            ## update plotConstantSize (size for points)
            if (!is.null(input$advancedplotoptions_size) &&
              length(input$advancedplotoptions_size) > 0) {
              args2$plotConstantSize <- input$advancedplotoptions_size
            }


            ## update plotConstantAlpha
            if (!is.null(input$advancedplotoptions_transparency) &&
              length(input$advancedplotoptions_transparency) > 0) {
              args2$plotConstantAlpha <- 1 - input$advancedplotoptions_transparency
            }

            temp <- plot.args2()
            x <- plot(temp$combinedData,
              main = temp$plotTitle,
              axis.labels = temp$plotAxes,
              xlab = temp$plotXLab,
              ylab = temp$plotYLab,
              datum.lines = temp$plotDatumLines,
              projection = temp$plotProjection,
              multiple.vars = multiple.variables,
              colour.var = input$vartodisplay,
              size.var = temp$mapSizeVar,
              aggregate = aggregate.logical,
              darkTheme = temp$plotTheme,
              alpha.const = temp$plotConstantAlpha,
              size.const = temp$plotConstantSize,
              current.seq = temp$plotCurrentSeqVal,
              palette = temp$plotPalette,
              sparkline.type = temp$plotSparklinesType,
              scale.limits = temp$plotScaleLimits,
              label.var = temp$plotLabelVar,
              scale.label = temp$plotLabelScale,
              scale.axis = temp$plotAxisScale,
              regions.to.plot = temp$mapRegionsPlot,
              keep.other.regions = temp$mapExcludedRegions
            )

            pdf(NULL)
            addr <- iNZightPlots::exportHTML(
              x = x,
              mapObj = temp$combinedData,
              file = tempfile(fileext = ".html")
            )

            addr <- unclass(addr)
            temp.dir <- substring(addr, 1, regexpr("file", addr) - 1)
            addResourcePath("path", temp.dir)
            filename <- substring(addr, regexpr("file", addr))
            tags$div(
              tags$a(
                href = paste("path/", filename, sep = ""),
                "Open in a new window",
                target = "_blank"
              ),
              tags$iframe(
                seamless = "seamless",
                src = paste("path/", filename, sep = ""),
                height = 600, width = 1200
              )
            )
          }
        }
      }
    } else if (input$map_type == 1) {
      condition1 <- !is.null(input$select_latitude) &&
        input$select_latitude %in% colnames(get.data.set()) &&
        !is.null(input$select_longitude) &&
        input$select_longitude %in% colnames(get.data.set())
      if (condition1) {
        local.dir <- iNZightPlots:::exportHTML.function(createmap.html,
          ## data = data_html(),
          extra.vars = extra.mapvars_html(),
          width = 10, height = 6
        )

        local.dir <- unclass(local.dir)
        temp.dir <- substr(
          unclass(local.dir), 1,
          nchar(unclass(local.dir)) - 11
        )
        addResourcePath("path", temp.dir)
        tags$div(
          tags$a(
            href = "path/index.html",
            "Open in a new window",
            target = "_blank"
          ),
          tags$iframe(
            seamless = "seamless",
            src = "path/index.html",
            height = 600, width = 1200
          )
        )
      }
    }
  })
})






## the download button for the interactive plot
output$interactive.plot.download <- renderUI({
  get.data.set()
  input$map_type
  isolate({
    if (input$map_type == 1) {
      ret <- fixedRow(
        column(
          width = 2,
          NULL
        ),
        column(
          width = 3,
          uiOutput("extra_mapvars_check_panel")
        ),
        column(
          width = 4,
          conditionalPanel(
            "input.extra_mapvars_check",
            uiOutput("extra.mapvars.html")
          )
        ),
        column(
          width = 3,
          downloadButton(
            outputId = "save_interactive_mapplot1",
            label = "Download Plot"
          )
        )
      )
    } else if (input$map_type == 2) {
      ret <- fixedRow(
        column(
          width = 9,
          NULL
        ),
        column(
          width = 3,
          downloadButton(
            outputId = "save_interactive_mapplot2",
            label = "Download Plot"
          )
        )
      )
    }
    ret
  })
})


output$extra_mapvars_check_panel <- renderUI({
  get.data.set()
  input$select_latitude
  input$select_longitude
  isolate({
    if (!is.null(input$select_latitude) &&
      input$select_latitude != "Select Latitude Information" &&
      !is.null(input$select_longitude) &&
      input$select_longitude != "Select Longitude Information") {
      ret <- checkboxInput("extra_mapvars_check",
        strong("Select additional variables:"),
        value = input$extra_mapvars_check
      )
    } else {
      ret <- NULL
    }

    ret
  })
})


output$extra.mapvars.html <- renderUI({
  get.data.set()
  isolate({
    ch <- colnames(get.data.set())
    if (!is.null(input$select_latitude) &&
      input$select_latitude != "Select Latitude Information" &&
      !is.null(input$select_longitude) &&
      input$select_longitude != "Select Longitude Information") {
      ch <- ch[-which(ch %in% c(input$select_latitude, input$select_longitude))]
    }


    selectInput(
      inputId = "export.extra.mapvars.html",
      label = NULL,
      choices = ch,
      multiple = TRUE,
      selected = input$export.extra.mapvars.html,
      size = 3,
      selectize = FALSE
    )
  })
})

## update extra.mapvars.html.panel
observe({
  input$select_latitude
  input$select_longitude
  input$extra_mapvars_check
  isolate({
    ch <- colnames(get.data.set())
    if (!is.null(input$select_latitude) &&
      input$select_latitude != "Select Latitude Information" &&
      !is.null(input$select_longitude) &&
      input$select_longitude != "Select Longitude Information") {
      ch <- ch[-which(ch %in% c(input$select_latitude, input$select_longitude))]
    }
    updateSelectInput(session, "export.extra.mapvars.html",
      choices = ch, selected = NULL
    )
  })
})


extra.mapvars_html <- reactive({
  if (length(input$export.extra.mapvars.html) > 0) {
    return(input$export.extra.mapvars.html)
  } else {
    return(NULL)
  }
})





## reaction to the "save_interactive_mapplot" button
output$save_interactive_mapplot1 <- downloadHandler(
  filename = substring(tempfile(
    pattern = "file", tmpdir = "",
    fileext = ".html"
  ), 2),
  content = function(file) {
    condition1 <- !is.null(input$select_latitude) &&
      input$select_latitude %in% colnames(get.data.set()) &&
      !is.null(input$select_longitude) &&
      input$select_longitude %in% colnames(get.data.set())
    if (condition1) {
      local.dir <- iNZightPlots:::exportHTML.function(createmap.html,
        width = 10, height = 6
      )

      src <- normalizePath(local.dir)
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, "index.html")
      file.copy("index.html", file)
    }
  }
)


output$save_interactive_mapplot2 <- downloadHandler(
  filename = substring(tempfile(
    pattern = "file", tmpdir = "",
    fileext = ".html"
  ), 2),
  content = function(file) {
    temp.data <- get.data.set()
    temp <- plot.args2()
    mapData <- temp$mapData

    if (!is.null(mapData) &&
      !is.null(input$datavariable) &&
      input$datavariable %in% colnames(temp.data) &&
      !is.null(input$mapvariable)) {
      ## update "match.list" information after loading data
      match.list <- iNZightMaps::matchVariables(
        temp.data[, input$datavariable],
        as.data.frame(stringsAsFactors = TRUE, mapData)[, input$mapvariable]
      )

      args2$match.list <- match.list

      if (!is.null(temp$combinedData) &&
        !is.null(input$vartodisplay) &&
        all(input$vartodisplay %in% colnames(temp.data))) {
        args2$combinedData$type <- ifelse(
          length(input$plotas_options) > 0 && input$plotas_options == 2,
          "point", "region"
        )

        args2$mapType <- ifelse(
          length(input$plotas_options) > 0 && input$plotas_options == 2,
          "point", "region"
        )

        if (length(input$multipleobsoption) > 0 &&
          input$multipleobsoption == 2) {
          args2$combinedData$type <- "sparklines"
        }

        ## multiple varibles to display ?
        if (length(input$vartodisplay) > 1) {
          h4("iNZight doesn't handle interactive maps for multiple variables ... yet!
               Please select only one variable")
        } #            multiple.variables = TRUE
        else {
          multiple.variables <- FALSE

          if (is.null(temp$multipleObsOption)) {
            if (multiple.variables) {
              aggregate.logical <- TRUE
            } else {
              aggregate.logical <- FALSE
            }
          } else {
            if (multiple.variables && temp$multipleObsOption != "allvalues") {
              aggregate.logical <- TRUE
            } else {
              aggregate.logical <- FALSE
            }
          }

          ## update plotConstantSize (size for points)
          if (!is.null(input$advancedplotoptions_size) &&
            length(input$advancedplotoptions_size) > 0) {
            args2$plotConstantSize <- input$advancedplotoptions_size
          }


          ## update plotConstantAlpha
          if (!is.null(input$advancedplotoptions_transparency) &&
            length(input$advancedplotoptions_transparency) > 0) {
            args2$plotConstantAlpha <-
              1 - input$advancedplotoptions_transparency
          }

          temp <- plot.args2()
          x <- plot(temp$combinedData,
            main = temp$plotTitle,
            axis.labels = temp$plotAxes,
            xlab = temp$plotXLab,
            ylab = temp$plotYLab,
            datum.lines = temp$plotDatumLines,
            projection = temp$plotProjection,
            multiple.vars = multiple.variables,
            colour.var = input$vartodisplay,
            size.var = temp$mapSizeVar,
            aggregate = aggregate.logical,
            darkTheme = temp$plotTheme,
            alpha.const = temp$plotConstantAlpha,
            size.const = temp$plotConstantSize,
            current.seq = temp$plotCurrentSeqVal,
            palette = temp$plotPalette,
            sparkline.type = temp$plotSparklinesType,
            scale.limits = temp$plotScaleLimits,
            label.var = temp$plotLabelVar,
            scale.label = temp$plotLabelScale,
            scale.axis = temp$plotAxisScale,
            regions.to.plot = temp$mapRegionsPlot,
            keep.other.regions = temp$mapExcludedRegions
          )

          pdf(NULL)
          temp.name <- tempfile(fileext = ".html")
          addr <- iNZightPlots::exportHTML(
            x = x,
            mapObj = temp$combinedData,
            file = temp.name
          )


          src <- normalizePath(addr)
          owd <- setwd(tempdir())
          on.exit(setwd(owd))
          file.copy(src, temp.name)
          file.copy(temp.name, file)
        }
      }
    }
  }
)




# function for creating html files (maps with coordinate)

createmap.html <- function() {
  condition1 <- !is.null(input$select_latitude) &&
    input$select_latitude %in% colnames(get.data.set()) &&
    !is.null(input$select_longitude) &&
    input$select_longitude %in% colnames(get.data.set())
  if (condition1) {
    temp <- plot.args()
    tryCatch(
      {
        do.call(plot, temp)
      },
      error = function(e) {
        print(e)
      }, finally = {}
    )
  }
}



## refresh the map after click the "refresh" button
observe({
  input$refreshmap

  isolate({
    output$maps_plot <- renderPlot({
      get.data.set()

      ## coordinate
      #  input$type1_plottitle_confirm



      args2$plotTitle
      plot.args()

      args2$updateplot1

      input$datavariable
      input$mapvariable

      input$vartodisplay

      input$advancedmapoptions_projection
      input$advancedplotoptions_mappalette
      input$advancedplotoptions_dark
      input$advancedplotoptions_gridlines

      input$advancedplotoptions_transparency
      input$advancedplotoptions_size

      input$plotas_options
      input$plotas_sizeby

      input$multipleobsoption
      input$aggregateoption
      input$linecharttypeoption
      input$advancedplotoptions_regionlabels
      input$regionlabels_click
      input$regionlabels_slider
      input$plottitlefontsize_slider
      input$seqvar_slider

      input$advancedplotoptions_mapscales
      input$scales_confirm

      input$advancedplotoptions_axislabels

      input$check_regions

      #  input$loadshapefiles

      isolate({
        if (input$map_type == 1) {
          condition1 <- !is.null(input$select_latitude) &&
            input$select_latitude %in% colnames(get.data.set()) &&
            !is.null(input$select_longitude) &&
            input$select_longitude %in% colnames(get.data.set())
          if (condition1) {
            temp <- plot.args()
            tryCatch(
              {
                do.call(plot, temp)
              },
              error = function(e) {
                print(e)
              }, finally = {}
            )
          }
        } else if (input$map_type == 2) {
          temp.data <- get.data.set()
          temp <- plot.args2()
          mapData <- temp$mapData

          if (!is.null(mapData) &&
            !is.null(input$datavariable) &&
            input$datavariable %in% colnames(temp.data) &&
            !is.null(input$mapvariable)) {
            ## update "match.list" information after loading data
            match.list <- iNZightMaps::matchVariables(
              temp.data[, input$datavariable],
              as.data.frame(
                stringsAsFactors = TRUE,
                mapData
              )[, input$mapvariable]
            )

            args2$match.list <- match.list


            if (!is.null(temp$combinedData) &&
              !is.null(input$vartodisplay) &&
              all(input$vartodisplay %in% colnames(temp.data))) {
              args2$combinedData$type <- ifelse(
                length(input$plotas_options) > 0 && input$plotas_options == 2,
                "point", "region"
              )

              args2$mapType <- ifelse(
                length(input$plotas_options) > 0 && input$plotas_options == 2,
                "point", "region"
              )

              if (length(input$multipleobsoption) > 0 &&
                input$multipleobsoption == 2) {
                args2$combinedData$type <- "sparklines"
              }

              ## multiple varibles to display ?
              if (length(input$vartodisplay) > 1) {
                multiple.variables <- TRUE
              } else {
                multiple.variables <- FALSE
              }

              if (is.null(temp$multipleObsOption)) {
                if (multiple.variables) {
                  aggregate.logical <- TRUE
                } else {
                  aggregate.logical <- FALSE
                }
              } else {
                if (multiple.variables &&
                  temp$multipleObsOption != "allvalues") {
                  aggregate.logical <- TRUE
                } else {
                  aggregate.logical <- FALSE
                }
              }

              ## update plotConstantSize (size for points)
              if (!is.null(input$advancedplotoptions_size) &&
                length(input$advancedplotoptions_size) > 0) {
                args2$plotConstantSize <- input$advancedplotoptions_size
              }


              ## update plotConstantAlpha
              if (!is.null(input$advancedplotoptions_transparency) &&
                length(input$advancedplotoptions_transparency) > 0) {
                args2$plotConstantAlpha <- 1 - input$advancedplotoptions_transparency
              }


              temp <- plot.args2()
              grid::grid.draw(plot(temp$combinedData,
                main = temp$plotTitle,
                axis.labels = temp$plotAxes,
                xlab = temp$plotXLab,
                ylab = temp$plotYLab,
                datum.lines = temp$plotDatumLines,
                projection = temp$plotProjection,
                multiple.vars = multiple.variables,
                colour.var = input$vartodisplay,
                size.var = temp$mapSizeVar,
                aggregate = aggregate.logical,
                darkTheme = temp$plotTheme,
                alpha.const = temp$plotConstantAlpha,
                size.const = temp$plotConstantSize,
                current.seq = temp$plotCurrentSeqVal,
                palette = temp$plotPalette,
                sparkline.type = temp$plotSparklinesType,
                scale.limits = temp$plotScaleLimits,
                label.var = temp$plotLabelVar,
                scale.label = temp$plotLabelScale,
                scale.axis = temp$plotAxisScale,
                regions.to.plot = temp$mapRegionsPlot,
                keep.other.regions = temp$mapExcludedRegions
              ))
            } else {
              matchplot.colours <- c("#d95f02", "#1b9e77", "#7570b3")
              plot(sf::st_geometry(mapData$geometry),
                col = matchplot.colours[match.list$map.matched + 1]
              )
              legend("topleft",
                legend = c(
                  "Data present for region",
                  "Data missing for region"
                ),
                fill = matchplot.colours[2:1]
              )
            }
          }
        }
      })
    })
  })
})
iNZightVIT/Lite documentation built on Oct. 11, 2024, 6:03 a.m.