根据闪亮应用程序中的行长度停用操作按钮

时间:2021-01-12 16:00:52

标签: r shiny dt

我有下面的 shiny 应用程序,其中当用户单击数据表的一行时,另一个数据框 df 中会出现一个子集并显示文本。

当我按下 Next actionbutton() 时,文本会显示子集数据框下一行的数据。

当我按下 Previous actionbutton() 时,文本会显示子集数据框前一行的数据。

但是当行是第一行时,actionbutton() 'Previous' 应该被停用,因为没有前一行;当行是最后一行时,actionbutton() 'Next' 应该被停用,因为没有下一行。所以当他们在这些条件下被点击时,消息应该保持不变。

library(shiny)

shinyApp(
  ui <- fluidPage(DT::dataTableOutput('tableId'),
                  textOutput("celltext"),
                  actionButton("next","Next"),
                  actionButton("prv","Previous")),
  
  server <- function(input, output) {
    rv <- reactiveValues(text=NULL)
    dt <- reactiveValues(data=NULL)
    rnum <- reactiveVal(0)
    output$tableId = DT::renderDataTable(
      iris[,c(1,5)],  selection = list(target = 'row',mode="single")
    )
    species<-c("setosa","setosa","virginica","virginica","setosa","setosa","virginica","virginica")
    flower<-c("a","b","c","d","e","f","g","h")
    score<-c(7,5,6,9,1,2,3,4)
    df<-data.frame(species,flower,score)
    
    observeEvent(input$tableId_rows_selected, {
      if(is.null(input$tableId_rows_selected)){
        return(NULL)
      }
      else{
        row <- input$tableId_rows_selected
        dat<-df[df$species %in% iris[row,5],]
        dt$data <-dat[order(dat$score,decreasing = T),]
        rv$text <- paste("flower",dt$data[1,2],"has score",dt$data[1,3])
        rnum(1)
        
        output$celltext <- renderText({
          if(length(input$tableId_rows_selected))  rv$text
          else ''
        })
      }
      
      
    })
    
    observeEvent(input[['prv']], {
      rnum(rnum()-1)
      rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
    })
    observeEvent(input[['next']], {
      rnum(rnum()+1)
      rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
    })
  }
)

2 个答案:

答案 0 :(得分:2)

试试这个

send()

答案 1 :(得分:1)

我知道真正禁用 ui 元素的唯一方法是使用 shinyjs 包。通过这种方式,您不仅可以防止函数被执行,而且用户可以看到下一个/上一个操作是不可能的。

我的示例执行以下操作:

  1. 当然,加载 Shinyjs,并且 register 作为 fluidPage 的第一个元素。
  2. 它将按钮初始化为禁用状态。只要用户没有选择任何行,按钮就没有任何作用。当然,我们也可以隐藏它们。
  3. 选择一行后,两个按钮的禁用状态将相应设置(请参阅第一个 observeEvent()
  4. 每次点击上一个/下一个按钮都会重新评估按钮的状态(按钮上的最后两个 observeEvent())。
    library(shiny)
    library(shinyjs)
    
    shinyApp(
      ui <- fluidPage(useShinyjs(),  # Set up shinyjs
                      DT::dataTableOutput('tableId'),
                      textOutput("celltext"),
                      disabled(actionButton("next","Next")),
                      disabled(actionButton("prv","Previous"))
                      ),
      
      server <- function(input, output) {
        rv <- reactiveValues(text=NULL)
        dt <- reactiveValues(data=NULL)
        rnum <- reactiveVal(0)
        output$tableId = DT::renderDataTable(
          iris[,c(1,5)],  selection = list(target = 'row',mode="single")
        )
        species<-c("setosa","setosa","virginica","virginica","setosa","setosa","virginica","virginica")
        flower<-c("a","b","c","d","e","f","g","h")
        score<-c(7,5,6,9,1,2,3,4)
        df<-data.frame(species,flower,score)

        
        observeEvent(input$tableId_rows_selected, {
          if(is.null(input$tableId_rows_selected)){
            return(NULL)
          }
          else{
            row <- input$tableId_rows_selected
            dat<-df[df$species %in% iris[row,5],]
            dt$data <-dat[order(dat$score,decreasing = T),]
            rv$text <- paste("flower",dt$data[1,2],"has score",dt$data[1,3])
            rnum(1)
            
            output$celltext <- renderText({
              if(length(input$tableId_rows_selected))  rv$text
              else ''
            })
            
            shinyjs::toggleState(id = "prv", condition = rnum() > 1)
            shinyjs::toggleState(id = "next", condition = rnum() < nrow(dt$data))
          }
          
          
        })
        
        observeEvent(input[['prv']], {
          req(dt$data) # make sure this is only exeuted with a valid object `dt$data` 
          
          rnum(rnum()-1)
          rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
          shinyjs::toggleState(id = "prv", condition = rnum() > 1)
          shinyjs::toggleState(id = "next", condition = rnum() < nrow(dt$data))
        })
        observeEvent(input[['next']], {
          req(dt$data) # make sure this is only exeuted with a valid object `dt$data` 
          
                rnum(rnum()+1)
          rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
          
          shinyjs::toggleState(id = "prv", condition = rnum() > 1)
          shinyjs::toggleState(id = "next", condition = rnum() < nrow(dt$data))
        })
      }
    )