updateTabsetPanel и updateSelectINput с htmlOutput - PullRequest
Новая
       103

updateTabsetPanel и updateSelectINput с htmlOutput

0 голосов
/ 05 августа 2020

Я получил это блестящее приложение с textInput и htmlOutput. Пользователь может найти статью и записать название статьи в текстовое поле. Всякий раз, когда статья находится в моем наборе данных, статья + некоторая информация будут отображаться в виде таблицы в htmlOutput.

Я хочу добиться того, чтобы всякий раз, когда textInput от пользователя совпадает со статьей из набора данных, который затем отображается в htmlOutput, статья должна быть интерактивной. И когда пользователь нажимает на эту интерактивную статью, откроется вторая tabPanel.

Итак, я изменил столбец статьи на результат html с атрибутом ссылки и добавил # tab-6240-1 из исходного кода в этот атрибут ссылки. Но ничего не происходит, и я понял, что всякий раз, когда я перезапускаю свое приложение, идентификатор из исходного кода будет меняться. 

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)

На следующем шаге я хотел бы обновить selectInput во второй tabPanel с помощью updateSelectInput. Выбранная статья должна быть точно такой же, что и пользователь, щелкнувший на первой вкладке. Панель

Любая справка очень полезна

1 Ответ

1 голос
/ 05 августа 2020

Вот один из подходов, если я правильно понимаю.

Не забудьте добавить id для tabsetPanel, чтобы вы могли динамически менять вкладки в server.

Вместо гиперссылок попробуйте использовать в таблице actionButton для выбора разных статей. Вы можете создавать их динамически с помощью пользовательской функции (см. Соответствующий пример здесь ).

Затем вы можете добавить 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)
...