[英]updateTabsetPanel and updateSelectINput with htmlOutput
我得到了这个带有 textInput 和 htmlOutput 的 shiny 应用程序。 用户想要查找一篇文章并将文章的名称写入文本字段。 只要文章在我的数据集中,文章+一些信息就会在 htmlOutput 中显示为表格。
我想要实现的是,每当来自用户的 textInput 与数据集中的文章匹配时,该文章然后显示在 htmlOutput 中,该文章应该是可点击的。 当用户点击该可点击文章时,第二个 tabPanel 将打开。
因此,我将文章列更改为带有链接属性的 html output 并将源代码中的#tab-6240-1 添加到该链接属性中。 但是什么也没发生,我意识到每当我重新启动我的应用程序时,源代码中的 id 都会改变。
library(tidyverse)
library(shiny)
library(kableExtra)
library(formattable)
data = tibble(article=c(rep("article one",3), rep("article two",3), rep("article three",3)),
sales=c(100,120,140,60,80,100,200,220,240))
ui = fluidPage(
fluidRow(
column(width = 6,
textInput(inputId = "text", label = "Suchfeld")),
column(width = 6,
tabsetPanel(
tabPanel(title = "one",
htmlOutput(outputId = "table")),
tabPanel(title = "two",
selectInput(inputId = "article", label = "Look up articles", choices = data$article, multiple = F, selectize = T))))
)
)
server = function(input, output, session){
data_r = reactive({
data %>%
filter(str_detect(article, input$text))
})
output$table = function(){
data_r() %>%
mutate(article = cell_spec(article, "html", link = "#tab-6240-1")) %>%
kable("html", escape=F, align="l", caption = "") %>%
kable_styling(bootstrap_options=c("striped", "condensed", "bordered"), full_width=F)
}
#updateSelectInput()
}
shinyApp(ui = ui, server = server)
在下一步中,我想用 updateSelectInput 更新第二个 tabPanel 中的 selectInput。 所选文章应与用户在第一个 tabPanel 中单击的文章完全相同
任何帮助都非常有用
如果我理解正确,这是一种方法。
确保为您的tabsetPanel
包含一个id
,以便您可以在server
中动态更改选项卡。
而不是超链接,请尝试在您的表中使用actionButton
到 select 不同的文章。 您可以使用自定义 function 动态创建它们(请参见此处的相关示例)。
然后,您可以添加一个observeEvent
来捕获对actionButton
的点击,确定选择了哪个按钮,然后切换选项卡并相应地更改selectInput
。
library(tidyverse)
library(shiny)
library(kableExtra)
library(formattable)
data = tibble(article=c(rep("article one",3), rep("article two",3), rep("article three",3)),
sales=c(100,120,140,60,80,100,200,220,240))
ui = fluidPage(
fluidRow(
column(width = 6,
textInput(inputId = "text", label = "Suchfeld")),
column(width = 6,
tabsetPanel(id = "tabPanel",
tabPanel(title = "one",
htmlOutput(outputId = "table")),
tabPanel(title = "two",
selectInput(inputId = "article", label = "Look up articles", choices = data$article, multiple = F, selectize = T))))
)
)
server = function(input, output, session){
shinyInput <- function(FUN, len, id, labels, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), label = labels[i], ...))
}
inputs
}
data_r = reactive({
data %>%
filter(str_detect(article, input$text)) %>%
mutate(action = shinyInput(actionButton, n(), 'button_', labels = article, onclick = 'Shiny.onInputChange(\"select_button\", this.id)'))
})
output$table = function(){
data_r() %>%
#mutate(article = cell_spec(article, "html", link = "#tab-6240-1")) %>%
select(action, sales) %>%
kable("html", escape=F, align="l", caption = "") %>%
kable_styling(bootstrap_options=c("striped", "condensed", "bordered"), full_width=F)
}
observeEvent(input$select_button, {
selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
updateTabsetPanel(session, inputId = "tabPanel", selected = "two")
updateSelectInput(session, inputId = "article", selected = data_r()[selectedRow,1])
})
}
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.