如何防止地图重新加载
问题描述 投票：0回答：1
我创建了一个函数，允许我通过过滤结果、协变量和月份来生成地图。结果是圆形，协变量是多边形，月份是滑块。协变量是固定值，只有结果随着月份的变化而变化。因此，我不希望在更改月份时重新加载所有地图，而只更改圆圈的大小，并允许仅在更改协变量时重新加载地图。如果可能的话，我希望散点图（用
plotlyshinyUI(sidebarLayout(
sidebarPanel(width = 2,
div(style="font-size:10px;",
radioButtons(inputId="outcome",
label = "Choisir l'outcome",
choices=c("INCIDENCE","LETALITY")),
selectInput(inputId = "covariable",
label = "Choisir la covariable",
choices = c("IDH","UNDER 5 MORTALITY","AGE ABOVE 65",
"REFUGEES","POPULATION DENSITY",
"EQUALITY LEVEL")),
sliderTextInput(
inputId = "mois",
label = "Month:",
choices = c("APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER",
"OCTOBER","NOVEMBER"),
selected = "APRIL",
animate = animationOptions(interval = 2000,
playButton = icon('play', "fa-0.5x"),
pauseButton = icon('pause', "fa-0.5x")))
)),
mainPanel(width = 9,
tags$style(type = "text/css",
"html, body {width:100%;height:100%}",
".leaflet .legend {
font-size: 8px;
line-height: 10px;}",
".leaflet .legend i{
width: 8px;
height: 8px;
}"
),
(fluidRow
(column(7, "CARTOGRAPHY",leafletOutput("mymap")),
column(5, "SCATTER PLOT WITH SLOP",plotlyOutput("plot")))
))
))
shinyServer( function(input, output, session) {
##########################
#FOCTION DE REACTIVITE MOIS/OUTCOME/COVARIABLE
mois<-reactive({input$mois})
outcome <- reactive({input$outcome})
covariable <- reactive({input$covariable})
######################
#CREATION DES MAPS
#########################
output$mymap <- renderLeaflet({
production_carte(outcome = outcome(),covar = covariable(),
mois = mois() ) })
#############################
##CREATION DE LA PENTE DE CORRELATION
######################################
output$plot<-renderPlotly({
production_regression(outcome = outcome(),covar = covariable(),
mois = mois() )
})
})
这是我的应用程序的图片
在允许创建地图的函数下方：
#FONCTION PRODUCTION
#################################################################################
production_carte <- function(outcome,covar,mois) {
# coef_rad = 1
# outcome <- as.character(outcome)
# covar <- as.character(covar)
# mois <- as.character(mois)
title_covar =""
if (mois == "APRIL") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-04-01"))
} else if (mois == "MAY") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-05-01"))
} else if (mois == "JUNE") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-06-01"))
} else if (mois == "JULY") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-07-01"))
} else if (mois == "AUGUST") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-08-01"))
} else if (mois == "SEPTEMBER") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-09-01"))
} else if (mois == "OCTOBER") {
data_final_mois <- subset(data_final,data_final$date2 == ymd("2020-10-01"))
} else if (mois == "NOVEMBER") {
data_final_mois <- subset(data_final,data_final$date2 == ymd("2020-11-01"))
}
data_final_mois -> shape_covid_2
shape_covid_2$IDH <- as.numeric(shape_covid_2$IDH)
shape_covid_2$density <- as.numeric(as.character(shape_covid_2$density))
shape_covid_2$Death_blw_5 <- as.numeric(shape_covid_2$Death_blw_5)
shape_covid_2$rate_abv_65 <- as.numeric(shape_covid_2$rate_abv_65)
shape_covid_2$refugees <- as.numeric(shape_covid_2$refugees)
shape_covid_2$IHDI <- as.numeric(shape_covid_2$IHDI)
shape_covid_2$ratio_cas_pop<-as.numeric(shape_covid_2$ratio_cas_pop)
shape_covid_2$Letalite<-as.numeric(shape_covid_2$Letalite)
if ( covar == "IDH") {
covariable <- shape_covid_2$IDH
bins_idh <- c(0, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9)
pal_idh <- brewer.pal(name="BuGn",n=8)[2:8]
palette <- colorBin(pal_idh, domain =~covariable,bins = bins_idh,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"HDI :",round(shape_covid_2$IDH,2)) %>% lapply(htmltools::HTML)
title_covar <- paste("Human Development Indicator","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
} else if (covar == "POPULATION DENSITY") {
covariable <- shape_covid_2$density
bins_density <- c(2,20,60,100,200,300,400,650)
pal_density <- brewer.pal(name="BuPu",n=8)[2:8]
palette <- colorBin(pal_density, domain =~covariable,bins = bins_density,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>","Pop Density :",
round(shape_covid_2$density,2),"people/sq.km")
title_covar <- paste("Population Density (people/sq.km)","</b>","<br/>","Date :",
unique(shape_covid_2$date2),"</b>","<br/>","Source : World Databank")
} else if (covar == "EQUALITY LEVEL") {
covariable <- shape_covid_2$IHDI
bins_ineq <- c(0.2,0.3,0.4,0.5,0.6,0.7)
pal_ineq <- brewer.pal(name="YlGn",n=6)[2:6]
palette <- colorBin(pal_ineq, domain =~covariable,bins = bins_ineq,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Equality Level :",round(shape_covid_2$IHDI,2))
title_covar <- paste("Equality Level Indicator","</b>","<br/>","Date :",unique(shape_covid_2$date2),"Source : ?")
} else if (covar == "UNDER 5 MORTALITY") {
covariable <- shape_covid_2$Death_blw_5
bins_u5 <- c(10,20,30,40,60,80,100,120)
pal_u5 <- brewer.pal(name="YlOrRd",n=8)[2:8]
palette <- colorBin(pal_u5, domain =~covariable,bins = bins_u5,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Under 5 mortality :",round(shape_covid_2$Death_blw_5,2),"child/1000 birth")
title_covar <- paste("Under five mortality rate (child/1000 birth)","</b>","<br/>","Date:",unique(shape_covid_2$date2),"</b>","<br/>",
"Source : UNICEF")
} else if (covar == "AGE ABOVE 65") {
covariable <- shape_covid_2$rate_abv_65
bins_above_65 <- c(1,1.5,2,2.5,3,3.5,7,12)
pal_above_65 <- brewer.pal(name="YlGnBu",n=8)[2:8]
palette <- colorBin(pal_above_65, domain =~covariable,bins = bins_above_65,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Above 65 pop rate :",round(shape_covid_2$rate_abv_65,2),"%")
title_covar <- paste("Above 65 population rate (%)","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
} else if (covar == "REFUGEES") {
covariable <- shape_covid_2$refugees
bins_ref <- c(0,0.3,0.6,3,7.2,27,100,950)
pal_ref <- brewer.pal(name="PuRd",n=8)[2:8]
palette <- colorBin(pal_ref, domain =~covariable,bins = bins_ref,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"REFUGEES :",round(shape_covid_2$refugees,2),"Thousands")
title_covar <- paste("Refugees (Thousands people)","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
}
if ( outcome == "LETALITY") {
label_Letalite <- paste(shape_covid_2$NAME,"</b>","<br/>","LR:",round(shape_covid_2$Letalite,2),"%") %>% lapply(htmltools::HTML)
leaflet(shape_covid_2,options = leafletOptions(zoomSnap = 0.25, zoomDelta=0.25)) %>%
addScaleBar(position = "bottomright")%>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng=11.914,lat=-0.406,zoom=2.75) %>%
addPolygons(fillColor = ~palette(covariable),
stroke = TRUE,
weight = 0.3,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,popup = ~paste(popup_covar),
highlight = highlightOptions(
weight = 3,color = "#666",dashArray = "",
fillOpacity = 0.8,bringToFront = FALSE)) %>%
addCircles(lng=~lng,lat=~lat,radius= ~(shape_covid_2$Letalite)*50000,weight=1,color = 'black',fillOpacity = 1,
label = label_Letalite, labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "11px",
direction = "right")) %>%
addLegend(pal = palette, values = ~covariable, opacity = 0.7, title = title_covar, position = "bottomleft") -> carte
return(carte)
} else if (outcome == "INCIDENCE") {
label_incidence <- paste(shape_covid_2$NAME,"</b>","<br/>","IR :",round(shape_covid_2$ratio_cas_pop,1),
"per 100 000 people") %>% lapply(htmltools::HTML)
leaflet(shape_covid_2,options = leafletOptions(zoomSnap = 0.25, zoomDelta=0.25)) %>% addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng=11.914,lat=-0.406,zoom=2.75) %>%
addScaleBar(position = "bottomright")%>%
addPolygons(fillColor = ~palette(covariable),
stroke = TRUE,
weight = 0.3,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,popup = ~(popup_covar),
highlight = highlightOptions(
weight = 3,color = "#666",dashArray = "",
fillOpacity = 0.8,bringToFront = FALSE)) %>%
addCircles(lng=~lng,lat=~lat,radius= ~sqrt(shape_covid_2$ratio_cas_pop)*15000,weight=1,color = 'blue',fillOpacity = 1,
label = label_incidence, labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "11px", direction = "right")) %>%
addLegend(pal = palette, values = ~covariable, opacity = 0.7, title = title_covar, position = "bottomleft") -> carte
return(carte)
}
}
1个回答
0
投票
投票
每当反应函数中的输入发生变化时，就会评估整个函数。在您的情况下，甚至背景和图块也会重新评估。所以你要做的基本上就是隔离背景和图块的创建。为此，请将
leafletcreer_carte <- function(shape_covid_2){
leaflet(shape_covid_2,options = leafletOptions(zoomSnap = 0.25, zoomDelta=0.25)) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng=11.914,lat=-0.406,zoom=2.75) %>%
addScaleBar(position = "bottomright")
}
construire_shape_covid <- function(){
if (mois == "APRIL") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-04-01"))
} else if (mois == "MAY") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-05-01"))
} else if (mois == "JUNE") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-06-01"))
} else if (mois == "JULY") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-07-01"))
} else if (mois == "AUGUST") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-08-01"))
} else if (mois == "SEPTEMBER") {
data_final_mois <- subset(data_final,data_final$date2 ==ymd("2020-09-01"))
} else if (mois == "OCTOBER") {
data_final_mois <- subset(data_final,data_final$date2 == ymd("2020-10-01"))
} else if (mois == "NOVEMBER") {
data_final_mois <- subset(data_final,data_final$date2 == ymd("2020-11-01"))
}
data_final_mois -> shape_covid_2
shape_covid_2$IDH <- as.numeric(shape_covid_2$IDH)
shape_covid_2$density <- as.numeric(as.character(shape_covid_2$density))
shape_covid_2$Death_blw_5 <- as.numeric(shape_covid_2$Death_blw_5)
shape_covid_2$rate_abv_65 <- as.numeric(shape_covid_2$rate_abv_65)
shape_covid_2$refugees <- as.numeric(shape_covid_2$refugees)
shape_covid_2$IHDI <- as.numeric(shape_covid_2$IHDI)
shape_covid_2$ratio_cas_pop<-as.numeric(shape_covid_2$ratio_cas_pop)
shape_covid_2$Letalite<-as.numeric(shape_covid_2$Letalite)
}
new_production_carte <- function(outcome,covar,mois,carte_base) {
# coef_rad = 1
# outcome <- as.character(outcome)
# covar <- as.character(covar)
# mois <- as.character(mois)
title_covar =""
shape_covid_2 <- construire_shape_covid()
if ( covar == "IDH") {
covariable <- shape_covid_2$IDH
bins_idh <- c(0, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9)
pal_idh <- brewer.pal(name="BuGn",n=8)[2:8]
palette <- colorBin(pal_idh, domain =~covariable,bins = bins_idh,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"HDI :",round(shape_covid_2$IDH,2)) %>% lapply(htmltools::HTML)
title_covar <- paste("Human Development Indicator","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
} else if (covar == "POPULATION DENSITY") {
covariable <- shape_covid_2$density
bins_density <- c(2,20,60,100,200,300,400,650)
pal_density <- brewer.pal(name="BuPu",n=8)[2:8]
palette <- colorBin(pal_density, domain =~covariable,bins = bins_density,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>","Pop Density :",
round(shape_covid_2$density,2),"people/sq.km")
title_covar <- paste("Population Density (people/sq.km)","</b>","<br/>","Date :",
unique(shape_covid_2$date2),"</b>","<br/>","Source : World Databank")
} else if (covar == "EQUALITY LEVEL") {
covariable <- shape_covid_2$IHDI
bins_ineq <- c(0.2,0.3,0.4,0.5,0.6,0.7)
pal_ineq <- brewer.pal(name="YlGn",n=6)[2:6]
palette <- colorBin(pal_ineq, domain =~covariable,bins = bins_ineq,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Equality Level :",round(shape_covid_2$IHDI,2))
title_covar <- paste("Equality Level Indicator","</b>","<br/>","Date :",unique(shape_covid_2$date2),"Source : ?")
} else if (covar == "UNDER 5 MORTALITY") {
covariable <- shape_covid_2$Death_blw_5
bins_u5 <- c(10,20,30,40,60,80,100,120)
pal_u5 <- brewer.pal(name="YlOrRd",n=8)[2:8]
palette <- colorBin(pal_u5, domain =~covariable,bins = bins_u5,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Under 5 mortality :",round(shape_covid_2$Death_blw_5,2),"child/1000 birth")
title_covar <- paste("Under five mortality rate (child/1000 birth)","</b>","<br/>","Date:",unique(shape_covid_2$date2),"</b>","<br/>",
"Source : UNICEF")
} else if (covar == "AGE ABOVE 65") {
covariable <- shape_covid_2$rate_abv_65
bins_above_65 <- c(1,1.5,2,2.5,3,3.5,7,12)
pal_above_65 <- brewer.pal(name="YlGnBu",n=8)[2:8]
palette <- colorBin(pal_above_65, domain =~covariable,bins = bins_above_65,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"Above 65 pop rate :",round(shape_covid_2$rate_abv_65,2),"%")
title_covar <- paste("Above 65 population rate (%)","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
} else if (covar == "REFUGEES") {
covariable <- shape_covid_2$refugees
bins_ref <- c(0,0.3,0.6,3,7.2,27,100,950)
pal_ref <- brewer.pal(name="PuRd",n=8)[2:8]
palette <- colorBin(pal_ref, domain =~covariable,bins = bins_ref,na.color = "transparent")
popup_covar <- paste("</b>",
"<a href='", shape_covid_2$url,
"' target='_blank'>"
, shape_covid_2$NAME,"</a>","<br/>",
"REFUGEES :",round(shape_covid_2$refugees,2),"Thousands")
title_covar <- paste("Refugees (Thousands people)","</b>","<br/>","Date :",unique(shape_covid_2$date2),"</b>","<br/>","Source : United Nations Development Program")
}
if ( outcome == "LETALITY") {
label_Letalite <- paste(shape_covid_2$NAME,"</b>","<br/>","LR:",round(shape_covid_2$Letalite,2),"%") %>% lapply(htmltools::HTML)
carte_base %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng=11.914,lat=-0.406,zoom=2.75) %>%
addPolygons(fillColor = ~palette(covariable),
stroke = TRUE,
weight = 0.3,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,popup = ~paste(popup_covar),
highlight = highlightOptions(
weight = 3,color = "#666",dashArray = "",
fillOpacity = 0.8,bringToFront = FALSE)) %>%
addCircles(lng=~lng,lat=~lat,radius= ~(shape_covid_2$Letalite)*50000,weight=1,color = 'black',fillOpacity = 1,
label = label_Letalite, labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "11px",
direction = "right")) %>%
addLegend(pal = palette, values = ~covariable, opacity = 0.7, title = title_covar, position = "bottomleft") -> carte
return(carte)
} else if (outcome == "INCIDENCE") {
label_incidence <- paste(shape_covid_2$NAME,"</b>","<br/>","IR :",round(shape_covid_2$ratio_cas_pop,1),
"per 100 000 people") %>% lapply(htmltools::HTML)
carte_base %>%
addPolygons(fillColor = ~palette(covariable),
stroke = TRUE,
weight = 0.3,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,popup = ~(popup_covar),
highlight = highlightOptions(
weight = 3,color = "#666",dashArray = "",
fillOpacity = 0.8,bringToFront = FALSE)) %>%
addCircles(lng=~lng,lat=~lat,radius= ~sqrt(shape_covid_2$ratio_cas_pop)*15000,weight=1,color = 'blue',fillOpacity = 1,
label = label_incidence, labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "11px", direction = "right")) %>%
addLegend(pal = palette, values = ~covariable, opacity = 0.7, title = title_covar, position = "bottomleft") -> carte
return(carte)
}
}
然后进入你闪亮的服务器部分：
shape_covid_2 <- reactive(construire_shape_covid())
carte_fond <- reactive(creer_carte(shape_covid_2()))
output$mymap <- renderLeaflet({
production_carte(outcome = outcome(),covar = covariable(),
mois = mois(), carte_base = carte_fond() ) })
也许这行不通，因为我几乎无法正确阅读你的代码，但我想你会明白要点。
最新问题
- 嵌入 cloudflare 见解，包括使用 javascript 发送数据
- 为什么 numpy.array 在编辑里面的数据时这么慢？
- 基本模板引擎找不到CSS文件[重复]
- 如何简化又长又冗余的 jquery 代码？
- React Material UI VITE - 主题问题 - createTheme_default 不是函数
- 在 DataGrip 中自动将内容大写
- 将 i128 转换为 f64 的正确方法是什么
- JQuery 整理代码
- 自动将 datagrip 中的内容大写
- laravel + Intertia Vue 如何获取查询参数值？
- 应用程序脚本每小时清除和刷新需要帮助
- 浏览器中的CSS文件即使我编辑过它仍然很旧
- bochs源码中的BOCHSAPI是什么意思？
- 如何安装 jupyter - pywinpty 的构建轮子失败
- 如何在 MVC 程序 php 文件结构中使用基本模板引擎
- 如何使用 HTMLAudioElement 控件来播放 AudioBuffer 的内容？
- 从网址中提取时间序列，通过将鼠标悬停在该序列上，您可以看到该序列的值
- 为什么在 AWS S3 存储桶权限中，通过 ACL 阻止公共访问在禁用 ACL 的情况下处于活动状态 [已关闭]
- LazyVim：有没有一种简单的方法来启用自动深色/浅色切换？
- NuxtApp 助手返回“类型未知”
© www.soinside.com 2019 - 2024. All rights reserved.