Карта листовки R - Изменение легенды на основе выбранной группы слоев - PullRequest
0 голосов
/ 01 июня 2018

Я делаю карту буклета R (не Shiny), и у меня есть две контрольные группы, и на основании выбора я бы хотел, чтобы другая легенда стала видимой.В настоящее время мне удается одновременно видеть обе легенды.

Ниже приведен код для листовки-карты, и результат можно увидеть на изображении.

Two legends are always visible

leaflet() %>% addSearchOSM() %>% 
  addProviderTiles(providers$CartoDB.Positron,
                   options = providerTileOptions(noWrap = TRUE),
                   group = "kaart") %>%
  # addFullscreenControl() %>%
  addCircleMarkers(data = table@data,
             lat = ~lng, 
             lng = ~lat,
             color = ~palverbruikplaats(Verbruiksplaats),
             label = bepaalPopup(),
             group = "Verbruikplaatscircles"
             )%>%
  addCircleMarkers(data = table@data,
                   lat = ~lng, 
                   lng = ~lat,
                   color = ~palstatus(`Status omschrijving`),
                   label = bepaalPopup(),
                   group = "statuscircles"
                    )%>%
  leaflet::addLegend("bottomleft", pal = palverbruikplaats, values = verbruikplaatsuniek, title = "Legenda") %>%
  leaflet::addLegend("bottomleft", pal = palstatus, values = statusuniek, title = "Legenda") %>%
  addLayersControl(baseGroups = c("Verbruikplaatscircles", "statuscircles"),
                      options = layersControlOptions(collapsed = FALSE))

Ответы [ 2 ]

0 голосов
/ 01 июня 2018

вам нужно сделать так, чтобы значения легенд были реактивными

addLegend("bottomright", pal = pal, values = maindata@data[,req_var1()],

вы можете объявить req_var1 () на сервере перед вызовом

req_var1<-reactive({if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){
    paste(input$Curr2,"Curr",sep="_")
  } else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
    paste(input$Curr2,"CWP",sep="_")
  }
  }) 

, а такжеприятель может быть объявлен как

pal1 <- reactive({if(input$ColorType=="Percentile"){

    colorQuantile(
    palette = "Spectral",
    domain = tempdata()@data[,req_var1()],
    probs = if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){seq(0,1,by=0.25)
    } else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
      seq(0,1,by=0.5)
    }
    ## In case of Current written premium the variation is very less so while executing color mapping code is throwing error.
    ## This is because the some of quantiles values are not differentiable.
    ## So in colorQuantile function we have given two different prob values depending on metric selection.
    ) 
  } else if(input$ColorType=="Absolute Value"){colorNumeric(
    palette = "Spectral",
    domain = tempdata()@data[,req_var1()])
  }else{print("Plese select Any one color map")}
  }) 
0 голосов
/ 01 июня 2018

В вашем addLayersControl вы хотели установить аргумент overlayGroups вместо baseGroups?

library(leaflet)
leaflet() %>%
  addTiles(group = "OpenStreetMap") %>%
  addCircleMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers1", color ="red") %>%
  addMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers2") %>%
  addLegend(values = 1, group = "Markers1", position = "bottomleft", labels = "1", colors= "red") %>%
  addLegend(values = 2, group = "Markers2", position = "bottomleft", labels = "2" ,colors= "blue") %>%  
  addLayersControl(overlayGroups = c("Markers1", "Markers2"),
                   options = layersControlOptions(collapsed = FALSE))

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...