shiny+leafletで地図アプリっぽいもの②


possum-foragingのデータを利用してshiny+leafletで地図アプリっぽいもの作成してみた。

library(shiny)
library(dplyr)
library(lubridate)
library(stringr)
library(leaflet)
library(leaflet.providers)

ui <- fillPage(
  leafletOutput(outputId="map", height="100%"),
  absolutePanel(
    selectInput(inputId="Study.Site", label="Study.Site", choices=NULL),
    selectInput(inputId="Animal.code", label="Animal.code", choices=NULL, multiple=TRUE),
    dateRangeInput(inputId="date", label="date", start=NULL, end=NULL, min=NULL, max=NULL),
    top=10, draggable=TRUE
  )
)

server <- function(input, output, session) {
  X <- read.csv(file="data/yockney-et-al-data-for-poned1439135.csv")
  X <- X %>%
    mutate(NZDT_datetime=dmy_hm(NZDT_datetime)) %>%
    arrange(NZDT_datetime) %>%
    mutate(Latitude=if_else(Latitude>0, -1*Latitude, Latitude)) %>%
    mutate(Animal.code=str_to_upper(Animal.code), Season=str_to_upper(Season))

  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles()
  })

  observe({
    Study.Site <- unique(X$Study.Site)
    updateSelectInput(session=session, inputId="Study.Site", choices=Study.Site, selected=Study.Site[1])
  })

  observe({
    x <- X %>% filter(Study.Site %in% input$Study.Site)
    Animal.code <- unique(x$Animal.code)
    updateSelectInput(session=session, inputId="Animal.code", choices=Animal.code, selected=Animal.code)
  })

  observe({
    x <- X %>% filter(Animal.code %in% input$Animal.code) %>% filter(NZDT_datetime>=input$date[1] & NZDT_datetime<=input$date[2])
    c <- colorNumeric(palette="Dark2", domain=1:length(input$Animal.code))
    l <- leafletProxy(mapId="map", session=session, data=x) %>%
      clearShapes() %>%
      clearMarkers()
    for(i in 1:length(input$Animal.code)){
      y <- x %>% filter(Animal.code %in% input$Animal.code[i])
      l <- l %>%
        addPolylines(lng=y$Longitude, lat=y$Latitude, weight=1, color=c(i)) %>%
        addCircles(lng=y$Longitude, lat=y$Latitude, radius=0.1, color=c(i)) %>%
        addMarkers(lng=y$Longitude[nrow(y)], lat=y$Latitude[nrow(y)], popup=input$Animal.code)
    }
    l
  })

  observeEvent(eventExpr=input$Study.Site, handlerExpr={
    x <- X %>% filter(Study.Site %in% input$Study.Site)
    l <- leafletProxy(mapId="map", session=session, data=x)
    l %>% setView(lng=mean(x$Longitude), lat=mean(x$Latitude), zoo=15)

    updateDateRangeInput(session=session, inputId="date", start=min(x$NZDT_datetime), end=max(x$NZDT_datetime), min=min(x$NZDT_datetime), max=max(x$NZDT_datetime))
  })
}

shinyApp(ui=ui, server=server)