Связывание всплывающего окна листовки с другой вкладкой Панели в блестящем - PullRequest
Новая
       23

Связывание всплывающего окна листовки с другой вкладкой Панели в блестящем

0 голосов
/ 20 декабря 2018

У меня есть приложение, в котором у меня есть несколько tabPanels в макете navbarPage.В одной из моих вкладок у меня есть листовка с полигонами, нанесенными на карту.Я хочу иметь возможность щелкать по многоугольнику, отображать всплывающее окно с href в окне, и если щелкнуть по href .. приложение направляет вас на другую панель tab, где вы можете увидеть конкретный график для этого многоугольника.Сюжет реагирует на выпадающее меню.Я сталкивался с этими двумя ссылками: Добавить ссылку на другую tabPanel в другой tabPanel и Связывание между вкладками в блестящем , но я не могу заставить его работать ... И я тоже не могуиметь представление о том, как я могу также ссылаться на выпадающее меню и сюжет.Буду признателен за любую помощь или руководство.Пожалуйста, дайте мне знать, если то, что я хочу, неясно.Вот то, что я пробовал до сих пор, но безуспешно

Пример данных: 

df<-structure(list(stdate = structure(c(17485, 17483, 16678, 17211, 
17210, 14098, 16674, 16674, 14096, 17484, 16679, 14096, 14096, 
17484, 16678, 14096, 14096, 14096, 14096, 16679, 16773, 16678, 
16680, 14096, 14096, 14040, 14047, 14048, 14056, 14056, 17514, 
14062, 14062, 17527, 17528, 14054, 14070, 15817, 14054, 14055, 
14054, 16510, 16511, 16513, 16511, 16681, 14076, 14077, 17308, 
16050, 16051, 14126, 17329, 15929, 15929, 16681, 15931, 17329, 
17416, 16616), class = "Date"), HUC14 = c("02030103100030", "02030104050060", 
"02030105090020", "02020007010010", "02030105030060", "02030105010040", 
"02030104100010", "02030104100010", "02030103140030", "02030103110020", 
"02040206070030", "02030103140070", "02030103140030", "02030104090050", 
"02040104240020", "02030103140030", "02030103140080", "02030103140070", 
"02030103140050", "02030105100060", "02020007040050", "02030105110110", 
"02040301060030", "02030103140030", "02030103140020", "02030103140070", 
"02030105140030", "02030104020020", "02040202110050", "02040202110030", 
"02020007040050", "02040206030030", "02040206030040", "02020007030040", 
"02030103170050", "02030103170040", "02030105120140", "02040202030070", 
"02030103170020", "02040202040010", "02030103170030", "02040301090010", 
"02040202120050", "02020007030040", "02040202080010", "02040201080010", 
"02030103140030", "02030103140070", "02040206140060", "02040206080040", 
"02040105240040", "02030103020100", "02030103030110", "02040105070040", 
"02030104050060", "02040206150060", "02040206030010", "02030103020100", 
"02040105050010", "02030104070070"), val = c(5.7, 7.4, 23.2, 
2, 1, 22.5, 17.1, 17.8, 23.4, 7.5, 27.1, 21.8, 22.4, 7.8, 17.3, 
23.9, 20.3, 23.2, 23.2, 23.7, 5.7, 23.9, 21.9, 22.7, 24.4, 24.7, 
21.7, 19.6, 25.2, 24.4, 0.5, 22.7, 21.1, 0.2, 0.8, 19, 26, 10, 
19.9, 21.7, 22.3, 5.4, 10.1, 0.6, 8, 23.6, 24.1, 23.7, 17.5, 
5.4, 1.6, 22.5, 23.7, 21.1, 23.3, 27.2, 22.7, 22.8, 17.1, 17.1
)), row.names = c(NA, -60L), class = c("tbl_df", "tbl", "data.frame"
), .Names = c("stdate", "HUC14", "val"))

Ссылка для доступа к шейп-файлу доступа: shapefile

Код: 

library(shiny)
library(ggplot2)
library(leaflet)
library(sf)


NJ_HUCs<-st_read(getwd(),layer = "2014_NJ_Integrated_Report_AU")%>%
 st_transform(NJ_HUCs, crs="+init=epsg:4326")%>%
  st_zm(NJ_HUCs, drop = T, what = "ZM")%>%
  ms_simplify(.)

names(st_geometry(NJ_HUCs)) = NULL
### Get HUC column to match df ###
NJ_HUCs$HUC14TXT<-gsub("HUC","",NJ_HUCs$HUC14TXT)
### Creates UI ###
ui<-navbarPage("test app",
  tabPanel(
    "Map",tags$head(tags$script(HTML('
                                    var customHref = function(tabName) {
                                     var dropdownList = document.getElementsByTagName("a");
                                     for (var i = 0; i < dropdownList.length; i++) {
                                     var link = dropdownList[i];
                                     if(link.getAttribute("data-value") == tabName) {
                                     link.click();
                                     };
                                     }
                                     };
                                     '))),
    fluidRow(
    leafletOutput("temp_map", height = "95vh"))),
  tabPanel(
    "Plot",sidebarLayout(
      sidebarPanel(width = 3,selectInput("huc_input","Select HUC14:",
                                         choices = df$HUC14)),
    mainPanel(plotOutput("plot1")))))
### Creates server ###
server <- function(input, output,session) {

  ### Make dataset reactive ###
  df_reactive<-reactive({
    df%>%
      filter(HUC14 == input$huc_input)
  })
  ### Make leaflet map ###
  output$temp_map<-renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 7))%>%
      addTiles(group = "OSM (default)") %>%
      setView(lng = -74.4 ,lat =40, zoom = 8)%>%
      addPolygons(data= NJ_HUCs,color = "#636060",weight = 1,smoothFactor = 1,
                  opacity = 0.5, fillOpacity = 0.1,group = "HUC14s",fillColor = "white",
                  highlightOptions = highlightOptions(color = "blue",
                                                      weight = 2,bringToFront = TRUE),
                  popup = paste0("<a onclick=","customHref('",NJ_HUCs$hrefValue,"')>",NJ_HUCs$HUC14TXT,"</a"))})

  ### Make plot ###
    output$plot1<-renderPlot({
      ggplot(data = df_reactive(),aes(stdate,val))+
        geom_point()+
        scale_x_date(date_breaks = "2 years",date_labels = "%Y")

    })



}

shinyApp(ui = ui, server = server)
...