Question

我有以下可重现的代码

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);

我想要的是不允许用户点击“查看数据”标签，除非他们点击了复选框？标签总是存在，理想情况下，我想将标签字体变灰，以指示用户不能点击它，除非满足条件（将记录在案例中），在这种情况下是勾选框。

由于

Answer 1

我不是js和css的专家，但我设法提出了一个有效的解决方案。

 ##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)

希望它有所帮助！

<强> [编辑]：我知道这个问题有一个公认的答案，但仍在编辑答案，以便以后可能对其他人有所帮助。

发布I回答时，即使禁用了导航栏，也没有意识到点击事件存在。

如果上面的js代码被替换为下面的代码，则删除click事件并且解决方案按预期工作：

##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

不可否认，下面的代码仍然允许用户点击＆＃34;查看数据＆＃34;选项卡，但是：

在＆＃34; check_box＆＃34;时隐藏此标签的内容是空的
自动导航到＆＃34;查看数据＆＃34;选项卡＆＃34; check_box＆＃34;被选中

也许这就足够了。

没有添加js或css。

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)

R shiny根据先前的选项卡条件调整导航栏中的选项卡

2 个答案: