我试图用Leaflet生成一个Shiny应用程序，根据不同的输入标准呈现一个等值区域图。地图显示不同类型（ It was created by Open MPI configure 3.0.1, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ ./configure --prefix=/home/ubuntu/.openmpi
## --------- ##
## Platform. ##
## --------- ##
hostname = ip-172-31-11-138
uname -m = x86_64
uname -r = 4.4.0-1052-aws
uname -s = Linux
uname -v = #61-Ubuntu SMP Mon Feb 12 23:05:58 UTC 2018
/usr/bin/uname -p = unknown
/bin/uname -X = unknown
/bin/arch = unknown
/usr/bin/arch -k = unknown
/usr/convex/getsysinfo = unknown
/usr/bin/hostinfo = unknown
/bin/machine = unknown
/usr/bin/oslevel = unknown
/bin/universe = unknown
PATH: /home/ubuntu/bin
PATH: /home/ubuntu/.local/bin
PATH: /usr/local/sbin
PATH: /usr/local/bin
PATH: /usr/sbin
PATH: /usr/bin
PATH: /sbin
PATH: /bin
PATH: /usr/games
PATH: /usr/local/games
PATH: /snap/bin
## ----------- ##
## Core tests. ##
## ----------- ##
configure:5774: checking for perl
configure:5790: found /usr/bin/perl
"config.log" 16382L, 526563C
）和背景（input$type）的事件。指定其他类型或背景时，多边形将填充更新的事件数据。它有一个障碍正常工作。当我将日期输入从日期范围（input$background）切换到总统期（input$dateInput）时，总统期间的等值时间呈现一次，显示没有数据的多边形，然后再次填充多边形的多边形预选期间的正确数据（＆＃34; President1＆＃34;）。当按下Presidency选项卡时，如何避免两次这样的地图渲染？
问题还列出了RStudio社区的here。
可以在此处访问使用的原始数据和shapefile：https://github.com/cjbarrie/shiny_egy。
工作示例：
原始数据的名称：input$president
shapefile的名称：wikiraw
全局：
shapefile data.frame library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(rgdal)
library(rmapshaper)
library(sp)
library(dplyr)
library(lubridate)
wikiraw <-read.csv("~/wikisample_SO.csv")
shapefile <- readOGR("~/EGY_adm2.shp")
shapefile<-spTransform(shapefile, CRS("+init=epsg:4326"))
## Simplify shapefile to speed up rendering
shapefile <- ms_simplify(shapefile, keep = 0.01, keep_shapes = TRUE)
wikbounds<-bbox(shapefile)
wikiraw$incident_date <- as.Date(wikiraw$incident_date,
format = "%m/%d/%Y")
wikiraw$presidency <- rep(NA, nrow(wikiraw))
wikiraw$incident_date1 <- as.numeric(wikiraw$incident_date)
wikiraw$event <- rep(1,nrow(wikiraw))
## Generate presidency categorical var.
wikiraw$presidency <- cut(wikiraw$incident_date1,
breaks = c(-Inf, 15016, 15521, 15889, 16229, Inf),
labels = c("President1", "President2", "President3", "President4", "President5"),
right = FALSE)
的片段：
wikirawUI：
ID_2 incident_date incident_background incident_type presidency event
1 168 2013-11-26 Cultural Group President4 1
2 133 2013-11-29 Cultural Group President4 1
3 137 2014-01-25 Cultural Group President4 1
4 168 2011-01-28 Cultural Collective President1 1
5 168 2016-04-25 Cultural Group President5 1
6 163 2015-02-08 Political Individual President5 1
服务器：
ui <- dashboardPage(
dashboardHeader(title = "Map tool"),
dashboardSidebar(sidebarMenu(menuItem("Map", tabName = "map"),
selectInput("input_type", "Date input type",
c("Date", "Presidency")),
uiOutput("dateSelect"),
uiOutput("typeSelect"),
uiOutput("backgroundSelect"),
uiOutput("presidentSelect"))),
dashboardBody(tabItems(
tabItem(tabName = "map",
leafletOutput("mymap", height=500)))))
问题的Gif：
非常感谢任何帮助！
答案 0 :(得分：2)
如果将reactive更改为reactiveValue并在observe中分配数据怎么办？我不知道它是否能正常工作，因为我不知道期望使用哪种形状和颜色，但是我再也看不到这种双重渲染。
（使用问题数据和准备）
library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(rgdal)
library(rmapshaper)
library(sp)
library(dplyr)
library(lubridate)
ui <- dashboardPage(
dashboardHeader(title = "Map tool"),
dashboardSidebar(sidebarMenu(menuItem("Map", tabName = "map"),
selectInput("input_type", "Date input type",
c("Date", "Presidency")),
uiOutput("dateSelect"),
uiOutput("typeSelect"),
uiOutput("backgroundSelect"),
uiOutput("presidentSelect"))),
dashboardBody(tabItems(
tabItem(tabName = "map",
leafletOutput("mymap", height=500)))))
server <- function(input, output, session) {
output$dateSelect <- renderUI({
switch(input$input_type,
"Date" = dateRangeInput("dateInput", "Dates:",
min=min(wikiraw$incident_date), max = max(wikiraw$incident_date),
start = min(wikiraw$incident_date), end = max(wikiraw$incident_date)),
"Presidency" = checkboxGroupInput("president", "Presidency",
choices = levels(wikiraw$presidency),
selected = "President1"))
})
output$typeSelect <- renderUI({
selectInput("type", "Incident type",
choices = unique(wikiraw$incident_type), multiple = TRUE,
selected = wikiraw$incident_type[1])})
output$backgroundSelect <- renderUI({
checkboxGroupInput("background", "Incident background",
choices = unique(wikiraw$incident_background),
selected = wikiraw$incident_background[1])})
sel_reactval = reactiveValues(s = NULL)
# selected <- reactive({
observe({
wikiagg <- wikiraw %>% group_by(ID_2, incident_date, incident_type, incident_background, presidency) %>%
summarize(sum_event = sum(event))
if(input$input_type=="Date"){wikiagg <- filter(wikiagg,
incident_date >= min(input$dateInput),
incident_date <= max(input$dateInput),
incident_type%in%input$type,
incident_background%in%input$background)}
if(input$input_type=="Presidency"){wikiagg <- filter(wikiagg,
incident_type%in%input$type,
incident_background%in%input$background,
presidency%in%input$president)}
wikiagg <- wikiagg %>% group_by(ID_2) %>%
summarize(sum_event = sum(sum_event))
sel_reactval$s = wikiagg
# wikiagg
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(mean(wikbounds[1,]),
mean(wikbounds[2,]),
zoom=6
)
})
observe({
req(!is.null(input$dateInput))
req(nrow(as.data.frame(sel_reactval$s))!=0)
# if(!is.null(input$dateInput)){
# shapefile@data <- left_join(shapefile@data, selected(), by="ID_2")
shapefile@data <- left_join(shapefile@data, sel_reactval$s, by="ID_2")
##Define palette across range of data
wikiaggpal <- wikiraw %>% group_by(ID_2) %>%
summarize(sum_event = sum(event))
pal <- colorBin("YlOrRd", wikiaggpal$sum_event, bins=5, na.color = "#bdbdbd")
leafletProxy("mymap") %>%
addTiles() %>%
clearShapes() %>%
addPolygons(data = shapefile, fillColor = ~pal(sum_event), fillOpacity = 1,
color = "white", weight = 2)
# }
})
}
shinyApp(ui, server)