R中的交互式传单热图显示了两个数据集之间的变化

时间:2018-08-13 16:36:15

标签: r shiny leaflet

我正在努力使传单的热图起作用。该地图的目的是显示从旧值转变为新值时所需服务人口的百分比变化。

问题是我收到一条错误消息

  

不知道如何从类data.frame的对象获取路径数据

我不知道如何解决这个问题。目前我的数据是这种形式

   Id ethnicity hispanic value state
    1 Black No 15 AL
    2 White Yes 21 AL
    3 Black Yes 25 AL
    4 Asian No 24 AL
    5 Black No 22 AL
    6 Black No 15 AL
    7 White Yes 21 AL
    8 Black Yes 25 AL
    9 Asian No 24 AL
    10 White Yes 21 AL
    11 White No 20 AL
    12 White No 21 AL
    13 Black No 25 AL
    14 Asian No 24 AL
    15 Black No 22 AL
    16 Black No 16 AL
    17 Asian Yes 20 AL
    18 Black Yes 19 AL

我在代码中的位置在这里。我可以使用针形图使其完美地工作,但是热量图使我遇到了一些严重的问题。

library("tigris")

states <- states(cb = TRUE)
View (states)
class( states )

data <- read.csv (file ="data.csv")
colnames(data)[colnames(data)=="ZIP_REAL"] <- "region"
data_F <- merge (data, data_ll, by = "region")
data_F <- merge (data_F, states, by = "STUSPS")


data_OLD <- subset (data_F, Value >= 20)
data_X <-   subset (data_F, Value >= 22)

bins <- c(100, 25, 15, 5, -5, -15, -25, -100)
pal <- colorBin("RdYlBu", domain = states$change, bins = bins, na.color="black")

ui <- fluidPage(
                selectInput(inputId = "Ethnicity", 
                            label = "Ethnicity", 
                            choices = c("Asian","Black", "Amiercan_Indian", "White", "All")),
            selectInput(inputId = "Hispanic", 
                            label = "Hispanic", 
                            choices = c("Yes","No")),
            selectInput(inputId = "TS.FeeGrant", 
                            label = "Fee Grant", 
                            choices = c("Yes","No"))
                    ,
  leafletOutput(outputId = "map")
)

server <- function(input, output, session){ 

  df <- reactive({
     old <- nrow(subset(data_OLD, (Ethnicity == input$Ethnicity & 
                    Hispanic == input$Hispanic))) %>% 
                    group_by(state) %>% 
                    summarise(Freq=n())
     NewX <- nrow(subset(data_X, (Ethnicity == input$Ethnicity & 
                    Hispanic == input$Hispanic))) %>% 
                    group_by(state) %>% 
                    summarise(Freq=n())


     change <- ((NewX$Freq - old$Freq)/(old$Freq)) * 100



  })  


output$map <- renderLeaflet({
leaflet(data_F) %>%
  setView(-96, 37.8, 4) %>%
  addProviderTiles("MapBox", options = providerTileOptions(
    id = "mapbox.light",
    accessToken = Sys.getenv('MAPBOX_ACCESS_TOKEN'))) %>%
  addPolygons(
    fillColor = colorBin("RdYlBu", domain = df, 
            bins = c(100, 25, 15, 5, -5, -15, -25, -100), na.color="black"),
    weight = 2,
    opacity = 1,
    color = "white",
    dashArray = "3",
    fillOpacity = 0.7,
    highlight = highlightOptions(
      weight = 5,
      color = "#666",
      dashArray = "",
      fillOpacity = 0.7,
      bringToFront = TRUE),
    label = labels,
    labelOptions = labelOptions(
      style = list("font-weight" = "normal", padding = "3px 8px"),
      textsize = "15px",
      direction = "auto")) %>%
  addLegend(pal = pal, values = ~df, opacity = 0.7, title = "Presentation",
    position = "bottomright")
    })
}

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

没有实际数据很难说,但在我看来,您正在将df的{​​{1}}参数的domain传递到fillColor。而是尝试传递诸如addPolygons()之类的向量。

Rstudio documentation中的示例:

df$change