我希望复制其中一张地图,您可以在其中猜测下一次总统选举的州级结果,并通过更改颜色背景向您展示您的场景结果。我的意思的一个例子可以在这里找到。
第一步是提供默认设置作为用户输入的起点。实现这一目标的一种方法是:
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
单击按钮更改列来使此地图具有交互性。例如,单击 California 会将填充颜色切换为蓝色,将result
编码切换为Dem
。
对我来说,明显的候选者是plotly
和leaflet
包,但它们似乎都没有提供我在这种情况下所需的功能。我使用 中的selectFeatures
函数获得了最接近的结果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)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句