r shiny - 将函数应用于反应数据表

Question

我希望能够将用户定义的函数应用于通过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)
}

用户界面

##### 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)

我的问题是：

1. 如何将上面定义的函数cleanup 应用于pickerInput 中选定的列集？
2. actionButton 是最好的方法吗？
3. 如果我需要使用通过cleanup 函数传递的数据，是否会使数据表反应式效率低下？

任何帮助将不胜感激。

Answer 1

1. 如何将上面定义的函数清理应用到在 pickerInput 中选择的列集？

参见下面的示例代码

1. actionButton 是最好的方法吗？

完全取决于你

1. 如果我需要使用我通过清理函数传递的数据，是否会使数据表响应式效率低下？

如果不了解您的数据就很难说

示例代码：

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)

另一个编辑。除了与 iris 相关的修复之外，此代码还有另一个 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)