在R Shiny中生成图形和表格集

pkln4tw6  于 2023-05-20  发布在  其他
关注(0)|答案(1)|浏览(155)

我想在一个闪亮的应用程序中显示几十个变量的汇总表和图形。
现在在服务器上我有这样的代码:

# Smoking ----
  ### is_smoker_table1 -----
  output$is_smoker_table1 <- renderTable(
    make_table1(is_smoker, `History of Smoking`)
  )

  ### is_smoker_ggplot -----
  output$is_smoker_ggplot <- renderPlot(
    make_gg_bar(is_smoker, `History of Smoking`)
  )

  ### per_day_table1 -----
  output$per_day_table1 <- renderTable(
    make_table1(per_day, `Cigarettes per day`)
  )

  ### per_day_ggplot -----
  output$per_day_ggplot <- renderPlot(
    make_gg_bar(per_day, `Cigarettes per day`)
  )

在GUI中,我有这样的代码:

## Smoking ----
          tabPanel(
            "Smoking",
            fluidRow(
              box( ### is_smoker ----
                width = 12, title = "Smoking Status",
                tableOutput("is_smoker_table1"),
                plotOutput("is_smoker_ggplot")
              )
            ),
            fluidRow(
              box(### per_day ----
                width = 12, title = "Cigarettes per day",
                tableOutput("per_day_table1"),
                plotOutput("per_day_ggplot")
              )
            )
          ),

我讨厌做几十次复制和粘贴的想法。
我看到了一个有用的SO post,它使用lapply()生成所有服务器对象,然后将它们一系列地打印出来。
我认为最终这样的代码会起作用:

the_summary <- function(old_name, new_name) {
  
  the_table1 <- renderTable(
    make_table1(old_name, new_name)
  )
  
  the_ggplot <- renderPlot(
    make_gg_bar(old_name, new_name)
  )
  
  list(the_table1 = the_table1, the_ggplot = the_ggplot)
}

#extract the table
output$is_smoker_table1 <- the_summary(is_smoker, `History of Smoking`)[[1]]

#extract the graphic 
output$is_smoker_ggplot <- the_summary(is_smoker, `History of Smoking`)[[2]]

但这只是稍微好一点。我的map()lapply()技能很弱,所以我不知道如何有效地做到这一点。
有没有一个直接的方法来做到这一点?

t98cgbkg

t98cgbkg1#

这是一个将每个output id及其占位符存储在列表中的示例,可以使用lapply呈现:

library(shiny)
library(bs4Dash)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  uiOutput("uiElements")
 )

server <- function(input, output, session) {
  
#The first list will be used to render the uiElements of the app:
  itemsUI <- list(title = c("Smoking Status", "Cigarettes per day"),
       tableOutputId = c("is_smoker_table1", "per_day_table1"),
       plotOutputId = c("is_smoker_ggplot", "per_day_ggplot"))
  
 output$uiElements <- renderUI({
   tabPanel(
    "Smoking",
    lapply(1:length(itemsUI[[1]]), 
           function(i) {
             fluidRow(
               box( ### is_smoker ----
                    width = 12, title = itemsUI$title[[i]],
                    tableOutput(itemsUI$tableOutputId[[i]]),
                    plotOutput(itemsUI$plotOutputId[[i]]))
               ) 
           }
           )
    )
 })

 #The second list will be used to render the outputs:
 table1 = mtcars %>% select(mpg, cyl)
 table2 = mtcars %>% select(disp, hp)
 
 plot1 = ggplot(mtcars, aes(mpg, cyl)) + geom_point()
 plot2 = ggplot(mtcars, aes(disp, hp)) + geom_point()
 
 itemsOutput <- list(
   tables = list(table1, table2),
   plots = list(plot1, plot2))
 
 
 lapply(1:length(itemsOutput$tables), function(i){
   output[[itemsUI$tableOutputId[i]]] <- renderTable({itemsOutput$tables[[i]]})
   output[[itemsUI$plotOutputId[i]]] <- renderPlot({itemsOutput$plots[[i]]})
 })
  
  
}

相关问题