r Shiny-将函数应用于反应数据表
[英]r shiny - apply function to reactive data table
问题描述
我希望能够将用户定义的函数应用于通过pickerInput选择的列pickerInput 。 我不确定是否需要actionButton 。
我的代码如下
X <- c("plyr", "dplyr", "tm", "readxl", "wordcloud", "SnowballC", "stringdist", "tidytext",
"rmarkdown", "knitr", "quanteda", "reshape", "stringr", "RecordLinkage",
"data.table", "rvest", "qdap", "shiny", "shinydashboard", "shinyWidgets", "DT")
lapply(X, FUN = function(X){
do.call("library", list(X))
})
###### BUILD REQUIRED FUNCTIONS TO CLEAN DATA ########
removeSPE <- function(x) gsub("[[:punct:]]", "", x)
cleanup <- function(x){
x <- as.character(x) # convert to character
x <- tolower(x) # make all lowercase
x <- sapply(x, removeSPE) # remove special characters
x <- trimws(x, "both") # since stopwords have been removed, there is extra white space left, this removes it
x <- gsub("(?<=\\b\\w)\\s(?=\\w\\b)", "", x, perl = TRUE) # removes whitespace btwn two single chars
return(x)
}
UI
##### APP BEGINS HERE WITH UI #####
ui <- dashboardPage(
dashboardHeader(title = "Record Linkage App"),
dashboardSidebar(
sidebarMenu(
## Tab 1 -- Specify Task
menuItem("Select Task And Upload Files", tabName = "task", icon = icon("file-text-o")),
## Tab 2 -- View Raw Data Files
menuItem("View Raw Data", tabName = "raw", icon = icon("file-excel")),
## Tab 3 -- View Processed Data Files
menuItem("View Processed Data", tabName = "processed", icon = icon("file-excel")),
## Tab 4 -- Select Training Set
menuItem("Select Training Set", tabName = "mltrain", icon = icon("file-text-o")),
## Tab 5 -- View Weight & Probabilities (choose which chart to view or both?)
menuItem("Visualize Distributions", tabName = "distributions", icon = icon("bar-chart-o")),
## Tab 6 -- View Results (review, match and trash files--need to be able to choose dataset)
## Want to be able to add checkboxes to select rows for inclusion in deletion later on
menuItem("View Result Files", tabName = "fileview", icon = icon("file-text-o"))
)), # close dashboard sidebar
#### Dashboard Body starts here
dashboardBody(
tabItems(
### Specify Task & Upload Files Tab
tabItem(tabName = "task",
radioButtons("task", "Select a Task:", c("Frame Deduplication", "Frame Record Linkage")),
fileInput("selection", "Upload Files:", multiple = T,
accept = c(".xlsx", ".xls", "text/csv", "text/comma-separated-values, text/plain", ".csv")),
helpText(paste("Please upload a file. Supported file types are: .txt, .csv and .xls.")),
br(),
helpText(paste("Note: Record Linkage requires two data frames."))
), # close first tabItem
tabItem(tabName = "raw",
helpText(paste("This tab displays the raw, unprocessed data frames selected in the previous tab.")),
helpText(paste("Select the columns you wish to display. These columns will be used for string comparisons")),
fluidRow(
column(width = 6,
uiOutput("pick_col1"),
dataTableOutput("content1")
),
column(width = 6,
uiOutput("pick_col2"),
dataTableOutput("content2")
)
)
), # close second tabItem
tabItem(tabName = "processed",
helpText(paste("This tab displays the processed data frames you saw in the previous tab.")),
br(),
helpText(paste("All data fields are now uniform and free of punctuation or special characters etc.")),
actionButton("clean1", "Clean data from table 1"),
actionbutton("clean2", "Clean data from table 2"),
fluidRow(
column(width = 6,
uiOutput("clean_tbl1"),
dataTableOutput("clean_content1")
),
column(width = 6,
uiOutput("clean_tbl2"),
dataTableOutput("clean_content1")
)
)
) # close third tabItem
) # close tabItems
) # close dashboardBody
) # closes dashboardpage
options(shiny.maxRequestSize = 100*1024^2)
服务器
server <- function(input, output, session) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
observe({
if (!is.null(input$selection$datapath[1]))
if (grepl(".csv$", input$selection$datapath[1])) {
data$file1 <- read.csv(input$selection$datapath[1], header = TRUE, sep = ",")
} else if (grepl(".xls$|.xlsx$", input$selection$datapath[1])) {
data$file1 <- read_excel(input$selection$datapath[1], col_names = TRUE)
}
})
observe({
if (!is.null(input$selection$datapath[2]))
if (grepl(".csv$", input$selection$datapath[2])) {
data$file2 <- read.csv(input$selection$datapath[2], header = TRUE, sep = ",")
} else if (grepl(".xls$|.xlsx$", input$selection$datapath[2])) {
data$file2 <- read_excel(input$selection$datapath[2], col_names = TRUE)
}
})
output$pick_col1 <- renderUI({
pickerInput(
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(data$file1),
selected = colnames(data$file1),
options = list(`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(data$file1)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE), # build buttons for collective selection
multiple = TRUE)
})
output$pick_col2 <- renderUI({
pickerInput(
inputId = "pick_col2",
label = "Select the columns of table 2 you wish to display:",
choices = colnames(data$file2),
selected = colnames(data$file2),
options = list(`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(data$file2)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE), # build buttons for collective selection
multiple = TRUE)
})
output$content1 <- renderDataTable({
data$file1[, req(input$pick_col1)]
})
output$content2 <- renderDataTable({
data$file2[, req(input$pick_col2)]
})
# here we want to take the columns selected and apply our
# pre defined functions: sweet, etc. to make the data unform and easier to analyze.
observeEvent(input$clean1, {
output$clean_content1 <- renderDataTable({
cleanup(selection)
})
})
observeEvent(input$clean2, {
output$clean_content2 <- renderDataTable({
cleanup(selection)
})
})
}
shinyApp(ui, server)
我的问题是：
- 如何将上面定义的函数
cleanup应用于pickerInput选择的列pickerInput？ -
actionButton是这样做的最好方法吗？ - 如果我需要使用通过
cleanup函数传递的数据，是否会使数据表的响应效率低下？
任何帮助将非常感激。
1 个解决方案
解决方案1
4 已采纳 2019-08-22 04:05:22
- 如何将上面定义的函数清除应用于pickerInput中选择的列集？
参见下面的示例代码
- actionButton是这样做的最好方法吗？
真的取决于你
- 如果我需要使用通过清理函数传递的数据，是否会使数据表的响应效率低下？
在不了解您的数据的情况下很难说
示例代码：
library(shiny)
library(shinyWidgets)
library(dplyr)
cleanup <- function(x) {
mean(x, na.rm = TRUE)
}
ui <- basicPage(
pickerInput(width = "75%",
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(iris)[1:4],
selected = colnames(iris)[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
),
tags$hr(),
column(width = 5, h2("Selected columns"), tableOutput("raw_data")),
column(width = 1),
column(
width = 5,
h2("Processed selected columns"),
actionButton("cleanup", "Clean up"),
tableOutput("mean_data")
)
)
server <- function(input, output) {
# show the selected columns (plus the grouping variable)
output$raw_data <- renderTable({
iris %>% select(Species, input$pick_col1) %>%
group_by(Species) %>%
top_n(n = 2)
})
# button to run the processing function.
# In this case just get the mean per Iris species
# make it just reactive (or include inside renderTable below)
# if actionButton is not desired
clean_df <- eventReactive(input$cleanup, {
iris %>% select(Species, input$pick_col1) %>%
group_by(Species) %>%
summarise_all(.funs =list(cleanup))
})
# show the processed columns
output$mean_data <- renderTable({
clean_df()
})
}
shinyApp(ui, server)
编辑：两个选项卡中的两个表具有两个输入选择器，没有操作按钮
library(shiny)
library(shinyWidgets)
library(dplyr)
cleanup <- function(x) {
mean(x, na.rm = TRUE)
}
ui <- basicPage(tabsetPanel(
id = "tabs",
tabPanel(
title = "Table 1",
value = "tab1",
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(iris)[1:4],
selected = colnames(iris)[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
),
wellPanel(h4("Selected columns"), tableOutput("raw_data1")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data1"))
),
tabPanel(
title = "Table 2",
value = "tab2",
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col2",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(mtcars),
selected = colnames(mtcars),
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(mtcars)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
),
wellPanel(h4("Selected columns"), tableOutput("raw_data2")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data2"))
)
))
server <- function(input, output) {
# show the selected columns (plus the grouping variable)
output$raw_data1 <- renderTable({
iris %>% select(Species, input$pick_col1) %>%
group_by(Species) %>%
top_n(n = 2)
})
# show the processed columns
output$mean_data1 <- renderTable({
iris %>% select(Species, input$pick_col1) %>%
group_by(Species) %>%
summarise_all(.funs = list(cleanup))
})
# show the selected columns (plus the grouping variable)
output$raw_data2 <- renderTable({
mtcars %>% mutate("Car" = rownames(.)) %>%
select(Car, input$pick_col2) %>%
group_by(cyl) %>%
top_n(n = 2)
})
# show the processed columns
output$mean_data2 <- renderTable({
mtcars %>% mutate("Car" = rownames(.)) %>%
select(Car, input$pick_col2) %>%
group_by(cyl) %>%
summarise_all(.funs = list(cleanup))
})
}
shinyApp(ui, server)
**编辑2：两个选项卡中的同一张表，处理该表的相同反应式，但它们基于活动选项卡响应不同的输入：**
library(shiny)
library(shinyWidgets)
library(dplyr)
cleanup <- function(x) {
mean(x, na.rm = TRUE)
}
ui <- basicPage(tabsetPanel(
id = "tabs",
tabPanel(
title = "Table 1",
value = "tab1",
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(iris)[1:4],
selected = colnames(iris)[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
),
wellPanel(h4("Selected columns"), tableOutput("raw_data1")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data1"))
),
tabPanel(
title = "Table 2",
value = "tab2",
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col2",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(iris)[1:4],
selected = colnames(iris)[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
),
wellPanel(h4("Selected columns"), tableOutput("raw_data2")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data2"))
)
))
server <- function(input, output) {
# decide what to render based on the selected tab
respond_to_tab <- reactive({
if (input$tabs == "tab1") {
selected_columns <- input$pick_col1
} else {
selected_columns <- input$pick_col2
}
return(selected_columns)
})
raw_data <- reactive({
iris %>% select(Species, respond_to_tab()) %>%
group_by(Species) %>%
top_n(n = 2)
})
mean_data <- reactive({
iris %>% select(Species, respond_to_tab()) %>%
group_by(Species) %>%
summarise_all(.funs = list(cleanup))
})
# show the selected columns (plus the grouping variable)
output$raw_data1 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data1 <- renderTable({
mean_data()
})
# show the selected columns (plus the grouping variable)
output$raw_data2 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data2 <- renderTable({
mean_data()
})
}
shinyApp(ui, server)
编辑3：通过renderUI呈现的选择器取决于用户选择的表。 否则作为EDIT 2起作用。请注意，还会加载一些新软件包。
library(shiny)
library(shinyWidgets)
library(dplyr)
library(stringr)
library(readxl)
library(readr)
cleanup <- function(x) {
mean(x, na.rm = TRUE)
}
ui <- basicPage(tabsetPanel(
id = "tabs",
tabPanel(
title = "File input",
value = "input",
fileInput(
"selection",
"Upload Files:",
multiple = T,
accept = c(
".xlsx",
".xls",
"text/csv",
"text/comma-separated-values, text/plain",
".csv"
)
)
),
tabPanel(
title = "Table 1",
value = "tab1",
uiOutput("picker1"),
wellPanel(h4("Selected columns"), tableOutput("raw_data1")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data1"))
),
tabPanel(
title = "Table 2",
value = "tab2",
uiOutput("picker2"),
wellPanel(h4("Selected columns"), tableOutput("raw_data2")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data2"))
)
))
server <- function(input, output) {
# handle the file import
read_input_file <- function(filepath) {
if (str_detect(filepath, regex(".csv$"))) {
out <- read_csv(filepath)
}
if (str_detect(filepath, regex(".xls$|.xlsx$"))) {
out <- read_excel(filepath)
}
return(out)
}
file1 <- reactive({
read_input_file(input$selection$datapath[1])
})
file2 <- reactive({
read_input_file(input$selection$datapath[2])
})
# pickers reactive to user input file
output$picker1 <- renderUI({
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
# still using iris (loaded from file), so 1:4 makes sense for the rest of the app logic
choices = colnames(file1())[1:4],
selected = colnames(file1())[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
)
})
output$picker2 <- renderUI({
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col2",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(file2())[1:4],
selected = colnames(file2())[1:4],
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(iris)) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
)
})
# decide what to render based on the selected tab
respond_to_tab <- reactive({
if (input$tabs == "tab1") {
selected_columns <- input$pick_col1
} else {
selected_columns <- input$pick_col2
}
return(selected_columns)
})
raw_data <- reactive({
iris %>% select(Species, respond_to_tab()) %>%
group_by(Species) %>%
top_n(n = 2)
})
mean_data <- reactive({
iris %>% select(Species, respond_to_tab()) %>%
group_by(Species) %>%
summarise_all(.funs = list(cleanup))
})
# show the selected columns (plus the grouping variable)
output$raw_data1 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data1 <- renderTable({
mean_data()
})
# show the selected columns (plus the grouping variable)
output$raw_data2 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data2 <- renderTable({
mean_data()
})
}
shinyApp(ui, server)
另一个编辑。 除了与虹膜相关的修复之外，此代码还具有另一个reactive ，可根据活动选项卡处理要处理的数据集。
library(shiny)
library(shinyWidgets)
library(dplyr)
library(stringr)
library(readxl)
library(readr)
# not used in this version
# it depends on the loaded datasets...
# need to define the function based on the expected input
cleanup <- function(x) {
mean(x, na.rm = TRUE)
}
ui <- basicPage(tabsetPanel(
id = "tabs",
tabPanel(
title = "File input",
value = "input",
fileInput(
"selection",
"Upload Files:",
multiple = T,
accept = c(
".xlsx",
".xls",
"text/csv",
"text/comma-separated-values, text/plain",
".csv"
)
)
),
tabPanel(
title = "Table 1",
value = "tab1",
uiOutput("picker1"),
wellPanel(h4("Selected columns"), tableOutput("raw_data1")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data1"))
),
tabPanel(
title = "Table 2",
value = "tab2",
uiOutput("picker2"),
wellPanel(h4("Selected columns"), tableOutput("raw_data2")),
wellPanel(h4("Processed selected columns"), tableOutput("mean_data2"))
)
))
server <- function(input, output) {
# handle the file import
read_input_file <- function(filepath) {
if (str_detect(filepath, regex(".csv$"))) {
out <- read_csv(filepath)
}
if (str_detect(filepath, regex(".xls$|.xlsx$"))) {
out <- read_excel(filepath)
}
return(out)
}
file1 <- reactive({
read_input_file(input$selection$datapath[1])
})
file2 <- reactive({
read_input_file(input$selection$datapath[2])
})
# pickers reactive to user input file
output$picker1 <- renderUI({
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col1",
label = "Select the columns of table 1 you wish to display:",
# still using iris (loaded from file), so 1:4 makes sense for the rest of the app logic
choices = colnames(file1()),
selected = colnames(file1()),
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(file1())) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
)
})
output$picker2 <- renderUI({
wellPanel(
pickerInput(
width = "75%",
inputId = "pick_col2",
label = "Select the columns of table 1 you wish to display:",
choices = colnames(file2()),
selected = colnames(file2()),
options = list(
`actions-box` = TRUE,
`selected-text-format` = paste0("count > ", length(colnames(file2())) - 1),
`count-selected-text` = "Alle",
liveSearch = TRUE,
liveSearchPlaceholder = TRUE
),
# build buttons for collective selection
multiple = TRUE
)
)
})
# decide what columns to render based on the selected tab
respond_to_tab <- reactive({
if (input$tabs == "tab1") {
selected_columns <- input$pick_col1
} else {
selected_columns <- input$pick_col2
}
return(selected_columns)
})
# decide what table to work with based on the selected tab
respond_to_tab_data <- reactive({
if (input$tabs == "tab1") {
x <- file1()
} else {
x <- file2()
}
return(x)
})
raw_data <- reactive({
respond_to_tab_data() %>% select(respond_to_tab()) %>%
head()
})
mean_data <- reactive({
respond_to_tab_data() %>% select(respond_to_tab()) %>%
tail()
})
# show the selected columns (plus the grouping variable)
output$raw_data1 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data1 <- renderTable({
mean_data()
})
# show the selected columns (plus the grouping variable)
output$raw_data2 <- renderTable({
raw_data()
})
# show the processed columns
output$mean_data2 <- renderTable({
mean_data()
})
}
shinyApp(ui, server)
r shiny 反应性汇总表
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.