我希望能够将用户定义的函数应用于通过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中所选的列集？actionButton是最好的方法吗？cleanup函数传递的数据，是否会使数据表的响应效率低下？任何帮助将不胜感激。
答案 0 :(得分：4)
请参见下面的示例代码
由您决定
在不了解您的数据的情况下很难说
示例代码：
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呈现的选择器取决于用户选择的表。否则将作为EDIT2。请注意，还会加载一些新软件包。
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)