使用renderUI在ShinyR中创建选项卡时如何在不同对象中重用数据集

Question

我开发了一个Shiny应用程序，在不同的选项卡下包含了几个绘图和数据。制表符是使用另一个参数动态创建的，但是每次我必须将数据子集化以准备绘图时。假设我使用``mpg''子数据，我在``mpg''选项卡中绘制了2种不同类型的图形，并且我不想在绘制图形时每次都对数据进行子集化（目前我每次都设置了子集）。我只想对数据进行一次子集。感谢一些帮助

write.csv(mtcars,'mtcars.csv')

write.csv（mtcars，'mtcars.csv'）

library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(data.table)

ui <- pageWithSidebar(
    headerPanel = headerPanel('data'),
    sidebarPanel = sidebarPanel(fileInput(
            'mtcars', h4('Uplaodmtcardata in csv format')
    ),
    uiOutput('tabnamesui')),
    mainPanel(uiOutput("tabsets"))
 )

server <- function(input, output, session) {
    mtcarsFile <- reactive({
            input$mtcars
    })


    xxmtcars <-
            reactive({
                    read.table(
                            file = mtcarsFile()$datapath,
                            sep = ',',
                            header = T,
                            stringsAsFactors = T
                    )
            })

    tabsnames <- reactive({
            names(xxmtcars())
    })

    output$tabnamesui <- renderUI({
            req(mtcarsFile())
            selectInput(
                    'tabnamesui',
                    h5('Tab names'),
                    choices = as.list(tabsnames()),
                    multiple = T
                    # selected = SalesGlobalDataFilter1Val()
            )


    })

    tabnamesinput <- reactive({
            input$tabnamesui
    })

    output$tabsets <- renderUI({
            req(mtcarsFile())
            tabs <-
                    reactive({
                            lapply(tabnamesinput(), function(x)
                                    tabPanel(title = basename(x)

,fluidRow(splitLayout(cellWidths = c("50%", "50%"),

plotOutput(paste0('plot1',x)),

plotOutput(paste0('plot2',x)
                                    ))),fluidRow(splitLayout(cellWidths = 
c("50%", "50%"),

plotOutput(paste0('plot3',x)),

plotOutput(paste0('plot4',x)
                                                             ))),
                                    dataTableOutput(paste0('table',x))))
                    })
            do.call(tabsetPanel, c(tabs()))
    })



    observe(
            lapply(tabnamesinput(), function(x) {
                    output[[paste0('table',x)]] <- 
   renderDataTable({as.data.table((select(xxmtcars(),x)))#CODE REPEATED


                    })}))

    observe(
            lapply(tabnamesinput(), function(x) {
                    output[[paste0('plot1',x)]] <- 
   renderPlot({as.data.table((select(xxmtcars(),x)))%>%plot()#CODE REPEATED


                    })
            })
    )

    observe(
            lapply(tabnamesinput(), function(x) {
                    output[[paste0('plot2',x)]] <- 
     renderPlot({as.data.table((select(xxmtcars(),x)))%>%plot()#CODE #REPEATED


                    })
            })
    )

    observe(
            lapply(tabnamesinput(), function(x) {
                    output[[paste0('plot3',x)]] <- 
    renderPlot({as.data.table((select(xxmtcars(),x)))%>%plot()#CODE REPEATED


                    })
            })
    )


    observe(
            lapply(tabnamesinput(), function(x) {
                    output[[paste0('plot4',x)]] <- 
   renderPlot({as.data.table((select(xxmtcars(),x)))%>%plot()#CODE REPEATED


                    })
            })
    )

    }

runApp(list(ui = ui, server = server))

Answer 1

您可以将子数据保存到reactive对象中，并在需要时调用它。

library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(data.table)

ui <- pageWithSidebar(
  headerPanel = headerPanel('data'),
  sidebarPanel = sidebarPanel(fileInput(
    'mtcars', h4('Uplaodmtcardata in csv format')
  ),
  uiOutput('tabnamesui')),
  mainPanel(uiOutput("tabsets"))
)

server <- function(input, output, session) {
  mtcarsFile <- reactive({
    input$mtcars
  })


  xxmtcars <-
    reactive({
      read.table(
        file = mtcarsFile()$datapath,
        sep = ',',
        header = T,
        stringsAsFactors = T
      )
    })

  tabsnames <- reactive({
    names(xxmtcars())
  })

  output$tabnamesui <- renderUI({
    req(mtcarsFile())
    selectInput(
      'tabnamesui',
      h5('Tab names'),
      choices = as.list(tabsnames()),
      multiple = T
      # selected = SalesGlobalDataFilter1Val()
    )


  })

  tabnamesinput <- reactive({
    input$tabnamesui
  })

  output$tabsets <- renderUI({
    req(mtcarsFile())
    tabs <-
      reactive({
        lapply(tabnamesinput(), function(x)
          tabPanel(title = basename(x)

                   ,fluidRow(splitLayout(cellWidths = c("50%", "50%"),

                                         plotOutput(paste0('plot1',x)),

                                         plotOutput(paste0('plot2',x)
                                         ))),fluidRow(splitLayout(cellWidths = 
                                                                    c("50%", "50%"),

                                                                  plotOutput(paste0('plot3',x)),

                                                                  plotOutput(paste0('plot4',x)
                                                                  ))),
                   dataTableOutput(paste0('table',x))))
      })
    do.call(tabsetPanel, c(tabs()))
  })

  # Save your sub data here
  subsetdata<-reactive({
    list_of_subdata<-lapply(tabnamesinput(), function(x) {
      as.data.table((select(xxmtcars(),x)))
    })
    names(list_of_subdata)<-tabnamesinput()
    return(list_of_subdata)
  })

  observe(
    lapply(tabnamesinput(), function(x) {
      output[[paste0('table',x)]] <- 
        renderDataTable({
          subsetdata()[[x]]
        })}))

  observe(
    lapply(tabnamesinput(), function(x) {
      for(i in paste0("plot",1:4)){
        output[[paste0(i,x)]] <-
          renderPlot({subsetdata()[[x]]%>%plot()#CODE REPEATED
          })
      }
    })
  )

}

runApp(list(ui = ui, server = server))