Интерактивная карта избирательного колледжа Хлоропет в R

Question

Я собираюсь воспроизвести одну из этих карт, где вы сможете угадать результаты следующих президентских выборов на уровне штата и показать вам результаты вашего сценария путем изменения цветового фона. Пример того, что я имею в виду, можно найти здесь.

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

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,

Очевидные кандидаты на это для меня были plotly а также leaflet пакеты, но ни один из них, кажется, не предлагает функциональность, необходимую для этого случая. Я получил самое близкое использование selectFeatures функция от mapedit, но это только позволяет мне выбирать регионы, а не изменять их связанное кодирование.

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

У кого-нибудь есть указатели на возможное решение?

(Для протокола, моя реальная цель не имеет ничего общего с выборами, но я решил, что это самый понятный способ сообщить о моей проблеме)

Answer 1

Я создал для вас простое блестящее приложение в качестве отправной точки для вашего проекта.

Вы можете протестировать его по адресу:https://wietze314.shinyapps.io/stackru-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)