addlegend R基于用户输入的传单 [英] addlegend R Leaflet-based-on-user-input
问题描述
我正在使用Shiny的varSelectInput函数来显示一个带有来自spacepolygondataframe的R Leaflet的地图，以便通过选择对象的变量来绘制相应变量的地图，并更改了其颜色.为此，我从条件varSelectInput中生成了R传单的ColorBin函数的反应对象.渲染地图时，所有这些操作均正常进行，因此，地图被绘制，从而更新了图例的颜色和标题.但是，在部署图例(addLegend)时，我没有得到预期的结果，因为它没有显示.就像我使用addPolygons函数所做的那样，我尝试在呈现地图时从反应式对象传递自变量，但是没有达到预期的结果.如下图所示: 在此处输入图片描述
I am using Shiny's varSelectInput function to display a map with R Leaflet from spatialpolygondataframe, so that by selecting a variable of the object the map of the corresponding variable is drawn and I changed its color. For this I have generated a reactive object of the ColorBin function of R leaflet from conditional varSelectInput. All this when rendering the map works correctly and consequently the map is painted, updating the color and the title of the legend. However, when deploying the legend (addLegend) I do not have the expected result, since it is not displayed. I tried to pass the argument from a reactive object when the map is rendered just as I did with the addPolygons function, but I did not achieve the expected result. as shown in the following figure: enter image description here
43/5000 我使用的代码如下:
43/5000 The code I have used is as follows:
library(shiny)
library(leaflet)
library(tidyverse)
ssd_map <- leaflet() %>% addProviderTiles("CartoDB.DarkMatter")%>% setView(-8.53, 42.90, zoom = 12)
ui <- fluidPage(
titlePanel("Santiago de Compostela"),
mainPanel(
varSelectInput(
inputId = "option",
label = "Elige la información a representar:",
data = dataframe1 %>% select(`Población Total`,`Población Masculina`,`Población Femenina`,`Población < 16 años`)
),
leafletOutput("map")
))
server <- function(input, output) {
colorpal <- reactive({
if(input$option == "Población Total") {
colorBin("Blues",data$`Población Total`,bins = 5)
} else if (input$option == "Población Masculina"){
colorBin("Reds",data$`Población Masculina`,bins = 5)
} else if (input$option == "Población Femenina"){
colorBin("Oranges",data$`Población Femenina`,bins = 5)
} else
colorBin("Greens",data$`Población < 16 años`,bins = 5)
})
leyenda <- reactive({
if(input$option == "Población Total") {
data$`Población Total`
} else if (input$option == "Población Masculina"){
data$`Población Masculina`
} else if (input$option == "Población Femenina"){
data$`Población Femenina`
} else
data$`Población < 16 años`
})
output$map <- renderLeaflet({
ssd_map
})
observe({
pal <- colorpal()
leg <- leyenda()
leafletProxy("map", data = dat1) %>%
clearShapes() %>%
clearControls() %>%
addPolygons(color = "#444444" ,
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
popup = ~paste(input$option) ,
fillColor = ~pal(eval(as.symbol(input$option))))%>%
addLegend(position = "topright", pal = pal , values =leg[input$option] ,
title = ~paste(input$option))
})
}
shinyApp(ui = ui, server = server)
推荐答案
您好，经过几次尝试，我已经达到以下解决方案:
Hello after several attempts, I have reached this solution:
图书馆(闪亮) 图书馆(传单) 库(leaflet.extras)
library(shiny) library(leaflet) library(leaflet.extras)
load("./Datos.Rdata")
load("./Datos.Rdata")
ui<-fluidPage( titlePanel("Santiago de Compostela")，
ui <- fluidPage( titlePanel("Santiago de Compostela"),
mainPanel(
selectInput("option", "Option:",
choices= c("Población Total","Población Masculina","Población Femenina","Población < 16 años")),
leafletOutput("map")
))
服务器<-功能(输入，输出){
server <- function(input, output) {
colorpal <- reactive({
if(input$option == "Población Total") {
colorBin("Blues",dat1$`Población Total`,bins = 5)
} else if (input$option == "Población Masculina"){
colorBin("Reds",dat1$`Población Masculina`,bins = 5)
} else if (input$option == "Población Femenina"){
colorBin("Oranges",dat1$`Población Femenina`,bins = 5)
} else
colorBin("Greens",dat1$`Población < 16 años`,bins = 5)
})
ventana <- reactive({
if(input$option == "Población Total") {
paste0("<b>", "Población Total: ", "</b>", as.character(dat1$`Población Total`))
} else if (input$option == "Población Masculina"){
paste0("<b>", "Población Masculina: ", "</b>", as.character(dat1$`Población Masculina`))
} else if (input$option == "Población Femenina"){
paste0("<b>", "Población Femenina: ", "</b>", as.character(dat1$`Población Femenina`))
} else
paste0("<b>", "Población < 16 años: ", "</b>", as.character(dat1$`Población < 16 años`))
})
output$map <- renderLeaflet({
leaflet() %>% setView(-8.53, 42.90, zoom = 10)%>%
addBootstrapDependency() %>%
# Base groups
addProviderTiles(providers$CartoDB.DarkMatter , group = "CartoDB.DarkMatter") %>%
addProviderTiles(providers$Esri.WorldImagery , group = "Esri.WorldImagery") %>%
addMiniMap(
tiles = providers$Esri.WorldImagery,
toggleDisplay = TRUE)
})
observe({
pal <- colorpal()
popup1 <-ventana()
proxy <- leafletProxy("map", data = dat1)
proxy %>% clearShapes() %>%clearControls()
if (input$option == "Población Total") {
proxy %>% addPolygons(color = "#444444" ,
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
popup = popup1 ,
fillColor = ~pal(dat1[[input$option]]))%>%
addLegend(position = "topright", pal = pal, values = dat1[[input$option]] ,
title = ~paste(input$option)) }
else if (input$option == "Población Masculina") {
proxy %>% addPolygons(color = "#444444" ,
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
popup = popup1 ,
fillColor = ~pal(dat1[[input$option]]))%>%
addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
title = ~paste(input$option)) }
else if (input$option == "Población Femenina") {
proxy %>% addPolygons(color = "#444444" ,
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
popup = popup1 ,
fillColor = ~pal(dat1[[input$option]]))%>%
addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
title = ~paste(input$option)) }
else
proxy %>% addPolygons(color = "#444444" ,
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
popup = popup1 ,
fillColor = ~pal(dat1[[input$option]]))%>%
addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
title = ~paste(input$option))
})
}
shinyApp(ui = ui，服务器=服务器)
shinyApp(ui = ui, server = server)
这篇关于addlegend R基于用户输入的传单的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
