R glänzend Zustand eine Lasche in der Navigationsleiste auf der Grundlage früherer Registerkarten Zustand

Question

Ich habe folgende reproduzierbaren Code

Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014)) 
Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084)) 

library('leaflet') 
library('shiny') 


##### My take on Example 2 
ui <- navbarPage(title = "navigation bar", 
tabPanel("Home", fluidPage(bootstrapPage(
checkboxInput("check_box", label = "Click me to continue", FALSE), 
## Main text 
mainPanel(
tags$div() 
) 

))), 
tabPanel("View Data", 
    bootstrapPage(
    mainPanel(
    ), 
    leafletOutput("map", width ="100%", height = "600px") 
    ) 
) 
) 


server = function(input, output){ 

mymap <- reactive({ 
    leaflet() %>% addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", attribution = NULL, layerId = NULL, group = NULL, options = tileOptions()) %>% 
    clearShapes() %>% 
    clearMarkers() %>%  
    fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
}) 

output$map <- renderLeaflet({ 
    mymap()  
}) 
myfun <- function(map) { 
    print("adding points") 
    map %>% clearShapes() %>% 
    clearControls() %>% 
    clearMarkers() %>% 
    addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1) 
} 

AddStrataPoly <- function(map) { 
    print("adding polygons")  
    for(i in 1:length(unique(Poly$Strat))) { 
    map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1)) 
    } 
    map 
} 

observe({ 
    leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
}) 
} 

    shinyApp(ui, server); 

Was würde Ich mag es, Benutzer nicht zulassen, dass in den „View Data“ Registerkarte klicken, es sei denn sie haben hat das Kontrollkästchen angeklickt? Die Registerkarte wird immer im Idealfall vorhanden sein. Ich möchte die Tab-Schriftart grau formatieren, um Benutzern anzuzeigen, dass sie nicht darauf klicken können, es sei denn, eine Bedingung wird erfüllt (was dokumentiert wird), in diesem Fall ein Häkchen.

Dank

Answer 1

Ich bin kein Experte in js und CSS, aber ich habe es geschaffen, mit einer Lösung zu kommen, die funktionieren.

##Data 
Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014)) 
Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084)) 

    library('leaflet') 
    library('shiny') 
    library(shinyjs) 


    ##JS Code for enabling and diabling 
    jscode <- "shinyjs.disabletab =function(name){ 
    $('ul li:has(a[data-value= \"Data\"])').addClass('disabled'); 

    } 

    shinyjs.enabletab =function(name){ 
    $('ul li:has(a[data-value= \"Data\"])').removeClass('disabled'); 
    } " 


    #UI 
    ui <- navbarPage(title = "navigation bar", 

        tabPanel("Home", fluidPage(bootstrapPage(
         checkboxInput("check_box", label = "Click me to continue", FALSE), 
         ## Main text 
         mainPanel(
         tags$div() 
         ) 

        ))), 

        tabPanel(title = "View Data", 
           value = "Data", 
           bootstrapPage(
           mainPanel(
           ), 
           leafletOutput("map", width ="100%", height = "600px") 
          ) 
        ), 

        #To use js code in the app 
        useShinyjs(), 
        extendShinyjs(text = jscode) 
    ) 


    server = function(input, output, session){ 

     mymap <- reactive({ 
     leaflet() %>% addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", attribution = NULL, layerId = NULL, group = NULL, options = tileOptions()) %>% 
      clearShapes() %>% 
      clearMarkers() %>%  
      fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
     }) 

     output$map <- renderLeaflet({ 
     mymap()  
     }) 
     myfun <- function(map) { 
     print("adding points") 
     map %>% clearShapes() %>% 
      clearControls() %>% 
      clearMarkers() %>% 
      addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1) 
     } 

     AddStrataPoly <- function(map) { 
     print("adding polygons")  
     for(i in 1:length(unique(Poly$Strat))) { 
      map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1)) 
     } 
     map 
     } 

     observe({ 
     leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
     }) 


     observeEvent(input$check_box,{ 

     if(input$check_box){#If true enable, else disable 
      js$enabletab("abc") 
     }else{ 
      js$disabletab("abc") 
     } 

     }) 

    } 

    shinyApp(ui, server) 

Hoffe es hilft!

[EDIT]: Ich weiß, dass es eine akzeptierte Antwort auf diese Frage, aber immer noch die Bearbeitung der Antwort, so dass es später für jemand anderen nützlich sein könnte.

Beim Veröffentlichen der I-Antwort wurde nicht erkannt, dass das Klickereignis auch dann existiert, wenn die Navigationsleiste deaktiviert ist.

Wenn der oben js Code mit dem unter dem Click-Ereignisse ersetzt wird, wird entfernt und Lösung funktioniert wie erwartet:

##JS Code for enabling and diabling 
jscode <- "shinyjs.disabletab =function(name){ 
$('ul li:has(a[data-value= \"Data\"])').addClass('disabled'); 
$('.nav li.disabled a').prop('disabled',true) 
} 

shinyjs.enabletab =function(name){ 
$('.nav li.disabled a').prop('disabled',false) 
$('ul li:has(a[data-value= \"Data\"])').removeClass('disabled'); 
} " 

Answer 2

Zwar läßt der Code unten noch einen Benutzer in den „View Data“ klicken Tab, aber:

1. versteckt den Inhalt dieser Register, wenn "check_box" leer
2. automatisch "View Data" Registerkarte navigiert, wenn "check_box" ausgewählt ist

Vielleicht wäre es genug.

Keine js oder css hinzugefügt.

Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014)) 
Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084)) 

library('leaflet') 
library('shiny') 


##### My take on Example 2 
## the "id" needs to be added to navbarPage arguments 
ui <- navbarPage(title = "navigation bar", id = "navigation", selected = "Home", 
       tabPanel("Home", fluidPage(bootstrapPage(
        checkboxInput("check_box", label = "Click me to continue", FALSE), 
        ## Main text 
        mainPanel(
        tags$div() 
        )   
       ))), 
       tabPanel("View Data", 

          ## the content of "View Data" tabPanel is wrapped into conditionalPanel 
          ## what hides the map until "check_box" is marked 
          conditionalPanel(condition = "input.check_box == 1", 
              bootstrapPage(
              mainPanel(), 
              leafletOutput("map", width ="100%", height = "600px") 
              ) 
         ) 
       ) 
) 

# argument "session" needs to be added 
server = function(session, input, output){ 

    mymap <- reactive({ 
    leaflet() %>% addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", attribution = NULL, layerId = NULL, group = NULL, options = tileOptions()) %>% 
     clearShapes() %>% 
     clearMarkers() %>%  
     fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
    }) 

    output$map <- renderLeaflet({ 
    mymap()  
    }) 
    myfun <- function(map) { 
    print("adding points") 
    map %>% clearShapes() %>% 
     clearControls() %>% 
     clearMarkers() %>% 
     addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1) 
    } 

    # the observer below navigates automatically to "View Data" when "check_box" is selected 
    observe({ 
    if(input$check_box) 
     updateTabsetPanel(session, inputId = "navigation", selected = "View Data") 

    }) 

    AddStrataPoly <- function(map) { 
    print("adding polygons")  
    for(i in 1:length(unique(Poly$Strat))) { 
     map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1)) 
    } 
    map 
    } 

    observe({ 
    leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
    }) 
} 



shinyApp(ui, server)