在闪亮的应用程序中根据行长度停用操作按钮
Deactivate actionbuttons based on row length in a shiny app
我有下面的 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])
})
}
)
试试这个
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)
rnumm <- 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)
rnumm(nrow(dat))
output$celltext <- renderText({
if(length(input$tableId_rows_selected)) rv$text
else ''
})
}
})
observeEvent(input[['prv']], {
if (rnum()>1) rnum(rnum()-1)
rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
})
observeEvent(input[['next']], {
if (rnum()<rnumm()) rnum(rnum()+1)
rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
})
}
)
我知道真正禁用 ui 元素的唯一方法是使用 shinyjs
包。这样,您不仅可以防止执行该功能,而且用户可以看到无法执行 next/previous 操作。
我的示例执行以下操作:
- 加载 shinyjs,当然,并且 register 是
fluidPage
的第一个元素作为 required.
- 它将按钮初始化为禁用。只要用户没有选择任何行,按钮就没有任何作用。当然,我们也可以隐藏它们。
- 选中一行后,相应设置两个按钮的禁用状态(先看
observeEvent()
.
- 每次单击 prev/next 按钮都应重新评估按钮的状态(按钮上的最后两个
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))
})
}
)
我有下面的 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])
})
}
)
试试这个
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)
rnumm <- 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)
rnumm(nrow(dat))
output$celltext <- renderText({
if(length(input$tableId_rows_selected)) rv$text
else ''
})
}
})
observeEvent(input[['prv']], {
if (rnum()>1) rnum(rnum()-1)
rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
})
observeEvent(input[['next']], {
if (rnum()<rnumm()) rnum(rnum()+1)
rv$text <- paste("flower",dt$data[rnum(),2],"has score",dt$data[rnum(),3])
})
}
)
我知道真正禁用 ui 元素的唯一方法是使用 shinyjs
包。这样,您不仅可以防止执行该功能,而且用户可以看到无法执行 next/previous 操作。
我的示例执行以下操作:
- 加载 shinyjs,当然,并且 register 是
fluidPage
的第一个元素作为 required. - 它将按钮初始化为禁用。只要用户没有选择任何行,按钮就没有任何作用。当然,我们也可以隐藏它们。
- 选中一行后,相应设置两个按钮的禁用状态(先看
observeEvent()
. - 每次单击 prev/next 按钮都应重新评估按钮的状态(按钮上的最后两个
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))
})
}
)