如何從自定義函數獲取匯總表以對用戶輸入的變量做出反應？

Question

這是我第一次嘗試使用 Shiny。

我有一個帶有 4 個變量的模擬患者級數據集：

• 組：分類，采用值 A、B 和 C。代表研究中使用的 3 種不同處理類型。
• week ：數值變量，取值為 1、4、8。代表后續周。
• painscore ：數字變量，評分范圍為1-10，1表示無痛，10 表示極度疼痛。
• dependscore ：數字變量，1-10 分，1 表示不依賴止痛葯，10 表示極度依賴。

嘗試構建一個簡單的應用程序，它接受兩個輸入：星期和變量，並提供兩個輸出：

1. 所選周所選變量的分數分布箱線圖。 x 軸將代表組的 3 個級別（A、B 和 C）。
2. 匯總表顯示了觀察數、中位數、第 25 個百分位數、第 75 個百分位數和缺失數。

我能夠創建交互式箱線圖，但無法創建匯總表。 我能夠使用來自 doBy 的 summaryBy 函數在 RMarkdown 中創建此表的靜態版本，但我無法在 Shiny 中實現它。 嘗試遵循此處和此處的建議，但我遺漏了一些東西。

這是我的可重復性代碼。 原諒大量的注釋，（我是一個完整的初學者）它們更適合我自己而不是其他任何人。

#libraries--------------------

library(shiny)
library(tidyverse)
library(knitr)
library(doBy)


#----------------------------

#input data
set.seed(123)
mydf <- data.frame( group     =   rep(rep(c("A","B","C"), each = 3), times = 3),
                    week      =   rep(rep(c(1,4,8), each = 9)),
                    painscore =   sample(1:10, 27, replace = TRUE),
                    dependscore = sample(1:10, 27, replace = TRUE) )

#--------------------------

#define custom function to calculate summary statistics for column of interest. 
#function explained in a little more detail when applied in the server function.

fun <- function(x) { 
    c( n = length(x),
       m = median(x), 
       firstq = round(quantile(x)[2], 1), 
       lastq = round(quantile(x)[4], 1), 
       missing = mean(is.na(x)))
}

#-------------------------


#UI
ui <- fluidPage(

     titlePanel("Shiny Boxplot and Table"),

    #User can provide two different inputs
    sidebarLayout(
        sidebarPanel(
            #1. allow user to pick week using radiobuttons
            radioButtons(inputId = "pickedwk",
                        label = "week you want to display",
                        choices = c(1,4,8),
                        selected = 1), 
            #2. user can pick variable to visualize using dropdownboxes
            selectInput(inputId = "var",
                        label = "variable to visualize",
                        list("How much pain did you feel today?" = "painscore",
                             "How dependent are you on medication?" = "dependscore")), 
            #helpertext
            helpText("Enter week/variable choices here") 
                     ),

     #Spaceholders for output
         mainPanel(
                     plotOutput("boxplot"), #boxplot placeholder
                     htmlOutput("descriptives") #kable html table placeholder
                  )
                )
             )
#-------------------------
#Server
server <- function(input, output) {




    #create dataset that subsets down to the week picked by user.
    weeksub <- reactive({
        mydf %>% filter(week == input$pickedwk[1])
                        }) 
    #1. use reactive datasubset to render boxplot.
    output$boxplot <- renderPlot({ 
        ggplot(weeksub(), aes_string(x = "group", y = input$var)) + #input$var works here
        geom_boxplot(fill = "red", outlier.shape = 15, outlier.color = "black") +
        scale_y_continuous(name = as.character(input$var)) +
        scale_x_discrete(name = "group") +
        ggtitle(paste("Distribution of", as.character(input$var), "by treatment group"))  
    })



    #2. use same reactive datasubset to render kable descriptive statistics for the variable picked.

    output$descriptives <- renderText({

        kable(summaryBy(input$var ~ group, data = as.data.frame(weeksub()), FUN = fun),
      #note: here, I'm using the summaryBy function from package doBy. It takes the form var~ categoricalvar
      # so, either painscore ~ group, or dependscore ~ group depending on what the user picked, and uses
      #my custom function to return a table of count, median, 25th percentile, 75th percentile and missing count for 
      #the 3 levels of the group variable (for A, B, and C)
        col.names = c("Number", "Median", "1Q", "3Q", "Missing"))

    })



}#server function ends


# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您的代碼中有幾個問題：

• 公式符號不知道如何處理input$var 。 summaryBy支持一種效果更好的替代語法。 （您也可以使用as.formula和paste來構建公式。）
• 您缺少col.names的“組”列
• 您必須從kable生成 HTML 並將其作為 HTML 傳遞給 UI。

將您的表輸出更改為：

  output$descriptives <- renderUI({
    HTML(kable(summaryBy(list(input$var, 'group'), data = as.data.frame(weeksub()), FUN = fun),
          col.names = c('Group', "Number", "Median", "1Q", "3Q", "Missing"),
          format='html'
          ))
  })