如何从自定义函数中获取摘要 table 以响应用户输入的变量?
How do I get a summary table from a custom function to react to user input of variables?
这是我第一次尝试使用 Shiny。
我有一个包含 4 个变量的模拟患者级数据集:
- 组:分类,采用值 A、B 和 C。代表研究中使用的 3 种不同治疗类型。
- week:数值变量,取值 1、4,8.Represents 后续周。
- painscore:数值变量,评分范围为 1-10,1 表示无痛,10 表示极度疼痛。
- dependscore:数值变量,评分范围为 1-10,1 表示不依赖止痛药,10 表示极度依赖。
尝试构建一个接受两个输入的简单应用:星期和变量,并提供两个输出:
- 所选周内所选变量的分数分布箱线图。 x 轴表示组的 3 个级别(A、B 和 C)。
- 摘要table 显示观察值数、中位数、第 25 个百分位数、第 75 个百分位数和缺失数。
我能够创建交互式箱线图,但我无法创建摘要table。我能够使用 doBy 的 summaryBy 函数在 RMarkdown 中创建此 table 的静态版本,但我无法在 Shiny 中实现它。尝试遵循建议 and 但我遗漏了一些东西。
这是我的重现性代码。请原谅大量的注释,(我是一个完全的初学者)它们更适合我自己而不是其他任何人。
#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)
您的代码中有几个问题:
- 公式符号不知道如何处理
input$var
。 summaryBy
支持更好用的替代语法。 (您也可以使用 as.formula
和 paste
来构建公式。)
- 您缺少
col.names
中的 "Group" 列
- 您必须从
kable
生成 HTML 并将其作为 HTML 传递给 UI。
将您的 table 输出更改为:
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'
))
})
这是我第一次尝试使用 Shiny。
我有一个包含 4 个变量的模拟患者级数据集:
- 组:分类,采用值 A、B 和 C。代表研究中使用的 3 种不同治疗类型。
- week:数值变量,取值 1、4,8.Represents 后续周。
- painscore:数值变量,评分范围为 1-10,1 表示无痛,10 表示极度疼痛。
- dependscore:数值变量,评分范围为 1-10,1 表示不依赖止痛药,10 表示极度依赖。
尝试构建一个接受两个输入的简单应用:星期和变量,并提供两个输出:
- 所选周内所选变量的分数分布箱线图。 x 轴表示组的 3 个级别(A、B 和 C)。
- 摘要table 显示观察值数、中位数、第 25 个百分位数、第 75 个百分位数和缺失数。
我能够创建交互式箱线图,但我无法创建摘要table。我能够使用 doBy 的 summaryBy 函数在 RMarkdown 中创建此 table 的静态版本,但我无法在 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)
您的代码中有几个问题:
- 公式符号不知道如何处理
input$var
。summaryBy
支持更好用的替代语法。 (您也可以使用as.formula
和paste
来构建公式。) - 您缺少
col.names
中的 "Group" 列
- 您必须从
kable
生成 HTML 并将其作为 HTML 传递给 UI。
将您的 table 输出更改为:
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'
))
})