Перейдите в той же динамической c tabPanel в зависимости от условия if в блестящем приложении - PullRequest
0 голосов
/ 22 апреля 2020

У меня есть блестящее приложение ниже, в котором я создаю панели вкладок на основе столбца данных. Затем, основываясь на выбранной радиокнопке, я отображаю график или таблицу из наборов данных iris или mtcars.

Проблема в том, что если, например, я в режиме Table набора данных mtcars и нажимаю режим Plot, я хочу остаться на панели mtcars и увидеть график mtcars вместо возвращаясь к панели iris. Как мне этого добиться?

Uni<-data.frame(NAME=c("Iris","Mtcars"))

# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(DT)
dbHeader <- dashboardHeaderPlus(

  title = "Tabs"
)

ui <- dashboardPagePlus(
  dbHeader,
  dashboardSidebar(
    uiOutput("r")
  ),
  dashboardBody(
    useShinyjs(),
    tags$hr(),
    tabsetPanel(
      id ="tabA",
      type = "tabs",
      tabPanel("Front",icon = icon("accusoft")),
      tabPanel("Data", icon = icon("table"),
               uiOutput("dyntab")

      )
    )
  )
)

server <- function(input, output) {
  output$dyntab<-renderUI({
    do.call(tabsetPanel, 
            c(id='tabB', 
              type="tabs",
              lapply(1:nrow(Uni), function(i) {
                tabPanel(Uni[i,],icon = icon("table"),
                         if(input$radioV2=="Table"){
                           renderDataTable({
                             if(input$tabB=="Iris"){
                               datatable(iris)
                             }
                             else{
                               datatable(mtcars)
                             }
                           })

                         }
                         else{
                           renderPlot({
                             if(input$tabB=="Iris"){
                               plot(iris)
                             }
                             else{
                               plot(mtcars)
                             }
                           })
                         }
                         )
              }))
    )
  })

  output$r<-renderUI({
    if(input$tabA=="Front"){
      return(NULL)
    }
    else{
      radioButtons("radioV2", label = "Choose Mode",
                   choices = c("Table","Plot"), 
                   selected = "Table")
    }

  })
}

shinyApp(ui = ui, server = server)

1 Ответ

1 голос
/ 22 апреля 2020
  1. У вас было несколько вещей, во-первых, создание dyntab происходило каждый раз, когда вы меняете вкладку, которая теперь исправлена ​​для рендеринга только один раз при запуске
  2. Мы должен использовать shinyjs с его функциями show и hide, чтобы показать radioButtons вместо того, чтобы создавать его все время с renderUI
  3. Я все еще не на 100% использую Приведенный выше подход в dyntab, как вы можете видеть, я должен был создать id для div, чтобы show и hide, это происходит потому, что он назначает случайные id таблицам и графики, которые вы отображаете
  4. Я также воспользовался функцией hidden, чтобы скрыть div при запуске

Uni <- data.frame(NAME=c("Iris","Mtcars"))
options(stringsAsFactors = F)

# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(DT)
dbHeader <- dashboardHeaderPlus(
    title = "Tabs"
)

ui <- dashboardPagePlus(
    dbHeader,
    dashboardSidebar(
        hidden(
            radioButtons("radioV2", label = "Choose Mode",choices = c("Table","Plot"), selected = "Table")
        )
    ),
    dashboardBody(
        useShinyjs(),
        tags$hr(),
        tabsetPanel(
            id ="tabA",
            type = "tabs",
            tabPanel("Front",icon = icon("accusoft")),
            tabPanel("Data", icon = icon("table"), uiOutput("dyntab")

            )
        )
    )
)

server <- function(input, output, session) {

    observeEvent(input$tabA,{
        if(input$tabA == "Front"){
            hide("radioV2")
        }
        else{
            show("radioV2")
        }
    })

    output$dyntab <- renderUI({
        do.call(tabsetPanel,
                c(id='tabB',
                  type="tabs",
                  lapply(1:nrow(Uni), function(i) {
                      tabPanel(Uni[i,],icon = icon("table"),
                               div(id = paste0("Table",Uni$NAME[i]),DT::renderDataTable({
                                   if(Uni$NAME[i] == "Iris"){
                                       datatable(iris)  
                                   }else{
                                       datatable(mtcars)
                                   }

                               })),
                               hidden(div(id = paste0("Plot",Uni$NAME[i]),renderPlot({
                                   if(Uni$NAME[i] == "Iris"){
                                       plot(iris)  
                                   }else{
                                       plot(mtcars)
                                   }
                               })
                               ))
                      )
                  })
                )
        )
    })

    observeEvent(input$radioV2,{
        print(paste0(input$radioV2,input$tabB))
        if(input$radioV2 == 'Table'){
            show(paste0("Table",input$tabB))
            hide(paste0("Plot",input$tabB))
        }else{
            hide(paste0("Table",input$tabB))
            show(paste0("Plot",input$tabB))
        }
    })



}

shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...