Как повторно использовать набор данных в разных объектах, когда renderUI используется для создания вкладок в ShinyR

Question

Я разработал Shiny-приложение, включающее несколько графиков и данных на разных вкладках. Таблицы создаются динамически с использованием другого параметра. Но каждый раз, когда мне приходится подготавливать данные для подготовки графиков.Скажем, используя подмножество «mpg», я построил 2 разных типа графиков на вкладке «mpg», и я не хочу поднастраивать данные каждый раз (в настоящее время я делаю это каждый раз), когда рисую график. Для всех вычислений в одной вкладке,Я хотел бы поместить данные только один раз. Ценю некоторую помощь

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))