R shiny 根据以前的选项卡条件在导航栏中设置选项卡

【问题标题】：R shiny Condition a tab in the navbar based on previous tabs conditionR shiny 根据以前的选项卡条件在导航栏中设置选项卡
【发布时间】：2017-11-03 07:38:14
【问题描述】：

我有以下可重现的代码

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

我想要的是不允许用户点击“查看数据”标签，除非他们点击了复选框？理想情况下，该选项卡将始终存在我想将选项卡字体变灰以指示用户除非满足条件（将记录在案）在这种情况下为复选框，否则他们无法单击它。

谢谢

【问题讨论】：

  • 看看this
  • @SBista 在我的示例中，我正在努力将 Navlist 解决方案转换为 NavbarPage？你能帮忙吗？这就是我想要的，感谢您的链接

标签： r tabs shiny conditional-statements


【解决方案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)

希望对你有帮助！

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

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

如果上面的 js 代码被替换为下面的，那么点击事件就会被移除并且解决方案会按预期工作：

##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');
} "

【讨论】：

    【解决方案2】：

    诚然，下面的代码仍然允许用户点击“查看数据”选项卡，但是：

    1. 当“check_box”为空时隐藏此选项卡的内容
    2. 选择“check_box”时自动导航到“查看数据”选项卡

    也许就够了。

    没有添加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)

    【讨论】：

    • 我选择了这就是答案，因为使用较早的答案，您仍然可以单击选项卡并导航到它。
    • @Cyrillm_44，只有在看到您的评论后才意识到这一点。已经编辑了我的答案，以便以后在这里偶然发现的其他人有用。
    猜你喜欢
    • 2021-02-19
    • 1970-01-01
    • 2017-03-17
    • 2018-05-29
    • 2020-11-07
    • 1970-01-01
    • 2013-08-28
    • 2013-06-16
    • 2021-11-05
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode