Как сделать реактивную блестящую карту с фреймом данных пространственных полигонов - PullRequest
0 голосов
/ 11 мая 2018

Я хочу создать реактивную блестящую карту мира с r, используя фрейм данных пространственных полигонов. Идея состоит в том, чтобы иметь ползунок с разными годами, который можно перемещать и использовать в качестве входа для раскраски стран. Моя проблема заключается в том, чтобы сделать данные реагирующими, когда я запускаю код, который прикреплен под ползунком, берутся входные значения (например, для всех стран значение 2004) и сообщение об ошибке "Предупреждение в pal (input $ year) ): Некоторые значения были за пределами цветовой шкалы и будут рассматриваться как NA ". При создании приложения "статическим" (запись sp_Suicide $ 2004 вместо ввода $ year) карта отображается правильно. Как связать входные данные ползунка таким образом, чтобы они обращались к данным для каждой страны, а не просто использовали год в качестве входных данных? Заранее большое спасибо за любые ответы!

library(shiny)
library(leaflet)
library(data.table)
library(sp)

#read data in (data table)
Suicide<-fread("Final_Suicide_Data.csv", header=T)

#read shapefile in
world<-readOGR(dsn=".", layer="TM_WORLD_BORDERS-0.3")

#Merge Suicide data to shapefile
sp_Suicide<-sp::merge(world, Suicide, all.x=T, by.x='UN', by.y='un') #SpatialPolygonDataFrame

#make shiny application
ui <- fluidPage(

   # Application title
   titlePanel("Suicide"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
     leafletOutput("suicidemap"),
      sidebarPanel(
         sliderInput("year",
                     "Year:",
                     min = 2004,
                     max = 2015,
                     value = 11,
                     sep="")

      )
   )
)



server <- function(input, output, session) {
  output$suicidemap<-renderLeaflet({
    leaflet(data=sp_Suicide)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(fillColor=~pal(input$year),
                  fillOpacity = 0.7,
                  color="#BDBDC3",
                  weight=1) %>%
      addLegend("bottomleft",
                pal=pal,
                values=~input$year,
                title="")   

  })
}

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

UPDATE: Большое спасибо за обширный ответ :) Далее я воссоздаю пример того, как выглядят данные, которые я использую.

UN<-c(4,8,12)
Country<-c('Afghanistan', 'Albania', 'Algeria')
`2004`<-c(6.68, 7.69, 4.84)
`2005`<-c(6.68, 7.7, 4.84)
`2006`<-c(6.74, 7.15, 4.56)
`2007`<-c(6.81, 6.61, 4.27)
`2008`<-c(6.87, 6.07, 3.97)
`2009`<-c(6.93, 5.54, 3.69)
`2010`<-c(7, 5, 3.4)
`2011`<-c(7.02, 4.76, 3.34)
`2012`<-c(7.04, 4.52, 3.28)
`2013`<-c(7.06, 4.28, 3.22)
`2014`<-c(7.08, 4.04, 3.16)
`2015`<-c(7.1, 3.8, 3.1)
SuicideData<-data.frame(UN, Country, `2004`, `2005`, `2006`, `2007`, `2008`,    `2009`, `2010`, `2011`, `2012`, `2013`, `2014`, `2015`)
names(SuicideData)<-c("UN", "Country", "2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013", "2014", "2015")

Кроме того, это шейп-файл, который я (пытаюсь) использовать: Ссылка на шейп-файл .

Я попытался запустить ваш код, но он все равно не работает. Возможно ли, что данные, которые я использую в качестве входных данных, должны быть отформатированы по-другому? Я пытаюсь продолжить ваш интересный подход - объединить только входные данные с шейп-файлом!

1 Ответ

0 голосов
/ 12 мая 2018

Трудно дать правильный ответ без воспроизводимого примера. Но, если я правильно понимаю, что вы пытаетесь сделать, вы, кажется, пропустили несколько шагов. Ниже выложен пример кода, и, надеюсь, он поможет в качестве шаблона и руководства.

Допустим, у нас есть набор данных (suidata) агрегированных годовых самоубийств (sum_suicides) по годам (year) и шейп-файл (worldshap) с общим идентификатором для каждого из них для страны (например, " ID "), который мы можем использовать для слияния. Один из способов добиться этого будет:

ui <- fluidPage(

  # Application title
  titlePanel("Suicide"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    leafletOutput("suicidemap"),
    sidebarPanel(
      sliderInput("year",
                  "Year:",
                  min = 2004,
                  max = 2015,
                  value = 2011, #value is the starting value so should be value within date range
                  sep="",
                  ticks = FALSE)))) # False for aesthetics because otherwise displays irregular tick intervals

Сначала нам нужно выбрать нужные данные (на основе ввода ползунка) в реактивной функции (обратите внимание, что на этом этапе мы ничего не объединяли в отличие от вашего примера выше):

server <- function(input, output, session) {
selected <- reactive({
suidata <- filter(suidata,
year == input$year)
suidata
})

Здесь мы просто передаем функции selected подмножество данных, которое зависит от того, для чего был задан вход ползунка. Например, если в 2011 году данные, отправленные для визуализации листовой карты ниже, будут просто подмножеством данных за 2011 год. Однако до этого мы хотим установить базовую карту. Он содержит все элементы карты Leaflet, которые нам нужны - например, плитки из CartoDB, заданные значения long, lat и zoom (то есть вы должны заменить эти значения), а также легенду. Я предполагаю, что ошибка возникает потому, что вы неправильно определяете палитру. Мой совет - установить палитру в глобальном разделе (т. Е. За пределами блестящего приложения и сделать это во всем диапазоне данных). В конце я приведу пример того, как это сделать.

output$suicidemap <- renderLeaflet({
  leaflet() %>% 
    addTiles("CartoDB.Positron") %>% 
    setView(long, lat, zoom= x)%>%
    addLegend("bottomright", pal=pal, values=suidata$sum_suicides, title = "Title of legend")
})

В реактивном наблюдателе мы затем объединяем шейп-файл с выбранными данными (обратите внимание на важные скобки после выбранных (потому что технически это функция, которую мы вызываем). Затем она вызовет данные указанного года и построит их.

observe({
  if(!is.null(input$year)){
      shapefile@data <- left_join(shapefile@data, selected(), by="ID")
      leafletProxy("suicidemap", data = shapefile) %>%
        addTiles() %>% 
        clearShapes() %>% 
        addPolygons(data = shapefile, fillColor = ~pal(sum_suicides), fillOpacity = 0.7, 
                    color = "white", weight = 2)
    }})

}

# Run the application 
shinyApp(ui, server)

Определение палитры - скажем, мы хотим, чтобы легенда была постоянной на карте, отображая самые высокие и самые низкие теоретические значения, тогда нам нужно было бы определить палитру в этом диапазоне. Если мы посмотрим на годовые показатели, наибольшее значение будет иметь страна с наибольшим числом ежегодных самоубийств и наименьшее количество стран с самым низким числом ежегодных самоубийств. Таким образом, мы определяем нашу глобальную палитру как:

pal <- colorBin("YlOrRd", suidata$sum_suicides, bins=5, na.color = "#bdbdbd")

Надеюсь, это пригодится:)

...