R 闪亮 |链接输入选择以对数据框进行分组
R Shiny | Chaining input choices to group a dataframe
我正在编写一个闪亮的应用程序,它将帮助我的同事更仔细地检查 csv 文件。
第一个选项卡允许导入,第二个选项卡用于数据分组。
为了便于编码,如果没有上传 csv,则使用 mtcars
数据集。
它需要一个数据集,然后根据 select 编辑的列和分组编写摘要。
我已经设法开发了一个响应式输入,它采用您想要的列 select。然后仅使用 'selected' 列作为选项更新分组输入。但是,它似乎没有将其传递给创建摘要输出的函数。它会创建一个警告:
Warning: Error in : Must subset columns with a valid subscript vector.
x Subscript has the wrong type list
.
ℹ It must be numeric or character.
119:
散列代码导致闪亮的应用程序崩溃。
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
# observeEvent(input$selected, {
# data <- myData() %>% select(all_of(input$selected))
# updateSelectInput(session, 'groupby', choices= names(data))
# })
output$group_summary <- renderPrint({
myData() %>%
select(all_of(input$selected)) %>%
group_by(across(all_of(input$groupby))) %>%
summary()
})
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
我觉得这样更符合你的要求。选择器的主要问题是它们返回列表并且 all_of()
想要一个向量,因此将 input$selected
包装在 as.character()
中解决了这个问题。您会遇到的另一个问题是正在生成的摘要不受 group_by()
语句的影响。我修改了函数的那一部分,这样您就可以在 group_by
参数中获得每个组的摘要。仍然有一个 labels missing
警告,但我想你可以解决这个问题。
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
# Add to your server
observeEvent(input$browser,{
browser()
})
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
observeEvent(input$selected, {
data <- myData() %>% dplyr::select(all_of(as.character(input$selected)))
updateSelectInput(session, 'groupby', choices= names(data))
})
output$group_summary <- renderPrint({
if(length(input$groupby) >0){
tmp <- myData() %>%
dplyr::select(all_of(as.character(input$selected))) %>%
group_by(across(all_of(as.character(input$groupby))))
tk <- tmp %>% group_keys
tk <- tk %>% as.matrix() %>% apply(1, paste, collapse="-")
tmp <- tmp %>% group_split() %>% setNames(tk)
lapply(tmp, summary)
}
}, width=600)
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
actionButton("browser", label = ),
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
以下是我最终使用 rlang 解决它的方法。注意:下面的代码有一个 v$data 链....我想按顺序使用它。
#Grouping functionality.
observe({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- myData()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
updateSelectInput(session, 'selected',choices=names(data),selected = names(data)[1])
})
observeEvent(input$selected, {
updateSelectInput(session, 'groupby', choices= input$selected)
})
output$summary <- renderPrint({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summary()
})
grouped_summary_temp <- reactive({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data2 <- data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summarise(across(.fns=list(Min=min,Max=max,Mean=mean,Median=median,SD=sd)))
return(data2)
})
output$grouped_summary <- DT::renderDataTable({
DT::datatable(grouped_summary_temp(), filter='top')
})
我正在编写一个闪亮的应用程序,它将帮助我的同事更仔细地检查 csv 文件。
第一个选项卡允许导入,第二个选项卡用于数据分组。
为了便于编码,如果没有上传 csv,则使用 mtcars
数据集。
它需要一个数据集,然后根据 select 编辑的列和分组编写摘要。
我已经设法开发了一个响应式输入,它采用您想要的列 select。然后仅使用 'selected' 列作为选项更新分组输入。但是,它似乎没有将其传递给创建摘要输出的函数。它会创建一个警告:
Warning: Error in : Must subset columns with a valid subscript vector. x Subscript has the wrong type
list
. ℹ It must be numeric or character. 119:
散列代码导致闪亮的应用程序崩溃。
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
# observeEvent(input$selected, {
# data <- myData() %>% select(all_of(input$selected))
# updateSelectInput(session, 'groupby', choices= names(data))
# })
output$group_summary <- renderPrint({
myData() %>%
select(all_of(input$selected)) %>%
group_by(across(all_of(input$groupby))) %>%
summary()
})
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
我觉得这样更符合你的要求。选择器的主要问题是它们返回列表并且 all_of()
想要一个向量,因此将 input$selected
包装在 as.character()
中解决了这个问题。您会遇到的另一个问题是正在生成的摘要不受 group_by()
语句的影响。我修改了函数的那一部分,这样您就可以在 group_by
参数中获得每个组的摘要。仍然有一个 labels missing
警告,但我想你可以解决这个问题。
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
# Add to your server
observeEvent(input$browser,{
browser()
})
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
observeEvent(input$selected, {
data <- myData() %>% dplyr::select(all_of(as.character(input$selected)))
updateSelectInput(session, 'groupby', choices= names(data))
})
output$group_summary <- renderPrint({
if(length(input$groupby) >0){
tmp <- myData() %>%
dplyr::select(all_of(as.character(input$selected))) %>%
group_by(across(all_of(as.character(input$groupby))))
tk <- tmp %>% group_keys
tk <- tk %>% as.matrix() %>% apply(1, paste, collapse="-")
tmp <- tmp %>% group_split() %>% setNames(tk)
lapply(tmp, summary)
}
}, width=600)
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
actionButton("browser", label = ),
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
以下是我最终使用 rlang 解决它的方法。注意:下面的代码有一个 v$data 链....我想按顺序使用它。
#Grouping functionality.
observe({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- myData()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
updateSelectInput(session, 'selected',choices=names(data),selected = names(data)[1])
})
observeEvent(input$selected, {
updateSelectInput(session, 'groupby', choices= input$selected)
})
output$summary <- renderPrint({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summary()
})
grouped_summary_temp <- reactive({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data2 <- data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summarise(across(.fns=list(Min=min,Max=max,Mean=mean,Median=median,SD=sd)))
return(data2)
})
output$grouped_summary <- DT::renderDataTable({
DT::datatable(grouped_summary_temp(), filter='top')
})