时间戳

首页 > 解决方案 > R中的交互式Chloropeth选举学院地图

r - R中的交互式Chloropeth选举学院地图

问题描述

我希望复制其中一张地图，您可以在其中猜测下一次总统选举的州级结果，并通过更改颜色背景向您显示您的场景结果。我的意思的一个例子可以在这里找到。

第一步是提供默认设置作为用户输入的起点。实现这一目标的一种方法是：

library(maps)
library(tidyverse)

usa <- map_data("state")
probs <- c(0.30,0.40,0.30)  
results <- c("Rep", "Dem", "Toss-Up")


usa %>%
  group_by(region) %>%
  mutate(result = sample(results, size = n(), prob = probs, replace = T)) > electoral_map

ggplot() + 
  geom_map(data = electoral_map, map = usa, aes(long, lat, map_id = region,
                                            fill = result), color = "black") +
  scale_fill_manual(values=c("blue", "red", "grey"))

在此处输入图像描述

result下一步 - 也是最关键的 - 步骤是通过单击按钮让列更改来使此地图具有交互性。例如，单击加利福尼亚会将填充颜色切换为蓝色，并将result编码切换为Dem.

对我来说，明显的候选者是plotlyandleaflet包，但它们似乎都没有提供我在这种情况下所需的功能。我使用 中的selectFeatures函数得到了最接近的结果mapedit，但这只能让我选择区域，而不是更改它们的关联编码。

对于后续计算，重要的是记录用户所做的更改以供进一步使用。最终目标是拥有类似于上面提供的链接的闪亮应用程序，用户的输入会改变双方确保的选举团投票总数。

有没有人对可能的解决方案有意见？

（为了记录，我的实际目标与选举无关，但我认为这是表达我的问题的最容易理解的方式）

标签： rleafletmapsr-mapedit

解决方案

我为您制作了一个简单的闪亮应用程序，作为您项目的起点。

您可以在以下位置对其进行测试： https ://wietze314.shinyapps.io/stackoverflow-rig-the-election/

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(maps)
library(ggplot2)
library(dplyr)
library(sp)

# Define UI for application that draws a map
ui <- fluidPage(

  # Application title
  titlePanel("Rig the election of the USA"),

  # Show a plot of the generated distribution
  mainPanel(
    plotOutput("usaPlot", click = "usaPlot_click"),
    textOutput("debug")
  )
)

usa <- map_data("state")
probs <- c(0.30,0.40,0.30)  
results <- c("Rep", "Dem", "Toss-Up")

start_map <- usa



# Define server logic required to change the election results
server <- function(input, output) {

  # make a variable to store the election results in  
  electoral_map <- reactiveValues( 
    regions = start_map %>% select(region) %>%
      distinct() %>% mutate(result = sample(results, size = n(), prob = probs, replace = T))
  )

  # render the map  
  output$usaPlot <- renderPlot({
    # generate bins based on input$bins from ui.R

    ggplot() + 
      geom_map(data = start_map %>% inner_join(electoral_map$regions, by = 'region'), 
               map = usa, 
               aes(long, lat, map_id = region, fill = result), color = "black") +
      scale_fill_manual(values=c("blue", "red", "grey"))

  })

  # find the region that was clicked (point.in.polygon)
  # change the result of the election

  observeEvent(input$usaPlot_click,{

    x <- input$usaPlot_click$x
    y <- input$usaPlot_click$y

    selectedregion <- usa %>%
      group_by(region) %>%
      mutate(selected = point.in.polygon( x,y,long,lat)) %>%
      filter(selected == 1) %>% 
      select(region) %>% distinct() %>% unlist()

    if(length(selectedregion)==1){
      currentresult <- electoral_map$regions[electoral_map$regions == selectedregion,'result']

      nextresult <- if_else(currentresult == "Dem","Rep","Dem")
      electoral_map$regions[electoral_map$regions == selectedregion,'result'] <- nextresult

      # report what you have done
      output$debug <- renderText(paste0("You visited at ",
                                        round(x),", ",round(y),
                                        " and rigged the election results of ",selectedregion, " and changed it to ",
                                        nextresult))
    } else {
      # if no region has been selected
      output$debug <- renderText("Fish don't vote!!!")
    }

  })


}



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

推荐阅读