如何在 R shiny 中取消合并数据 table 中的列

How to unmerge columns in a data table in R shiny

下面的 R shiny 应用程序包含许多选项,包括 'Unmerge Columns' by space 和用特定值替换值。

目前它适用于替换值,但不适用于 'Unmerge Column.' 我收到以下错误通知。

错误:

Warning: Error in [[: object of type 'closure' is not subsettable

注意:我创建了一个名为 'splitColumn' 的单独方法并将其调用到服务器函数。当用户单击 'Unmerge Column' 按钮时,它取消合并列并为我提供下面提到的预期输出

输入 CSV:

ID  Type Range
21  A1B1  100
22  C1D1  200
23  E1F1  300

预期结果

ID  unmerged_Typ1 Unmerged_Type2     Range
21  A1               B1              100
22  C1               D1              200
23  E1               F1              300

app.R

library(shiny)
library(reshape2)
library(DT)
library(tibble)
library(tidyverse)

#This function does unmerging the column values by its space
splitColumn <- function(data, column_name) {
  newColNames <- c("Unmerged_type1", "Unmerged_type2")
  newCols <- colsplit(data[[column_name]], " ", newColNames)
  after_merge <- cbind(data, newCols)
  after_merge[[column_name]] <- NULL
  after_merge
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      
      selectInput("col", "Column to search:", NULL),
      actionButton("unmerge", "Unmerge Column", class = "btn-warning" ),
      textInput("old", "Replace:"),
      textInput("new", "By:"),
      actionButton("replace", "Replace!"),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(input, output, session) {
  my_data <- reactiveVal(NULL)
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    my_data(read.csv(file$datapath, header = input$header))
    updateSelectInput(session, "col", choices = names(my_data()))
  })
  
  observeEvent(input$replace, {
    req(input$col)
    dat <- req(my_data())
    traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
    my_data(dat %>%
              mutate(!!rlang::sym(input$col) := 
                       replace(!!rlang::sym(input$col),
                               as.character(!!rlang::sym(input$col)) == input$old,
                               input$new) %>% 
                       traf()))
  })
  
  output$table1 <- renderDT(
    req(my_data())
  )
  output$selectUI<-renderUI({
    req(my_data)
    selectInput(inputId='selectcolumn', label='select column', choices = names(my_data))
  })
  observeEvent(input$unmerge, {
    my_data <- splitColumn(my_data, input$selectcolumn)
  })
}

shinyApp(ui, server)

谁能帮我解决这个问题

你在这里遇到了一些问题。最好使用 reactiveValues 对象。随着数据的变化,您的 selectInput 用于取消合并需要相应地更新 ID;我附上了未合并的按钮值。最后,您没有在 ui 一侧显示 selectUI。试试这个

library(shiny)
library(reshape2)
library(DT)
library(tibble)
library(tidyverse)

#This function does unmerging the column values by its space
splitColumn <- function(data, column_name) {
  newColNames <- c("Unmerged_Type1", "Unmerged_Type2")
  newCols <- colsplit(data[[column_name]], " ", newColNames)
  after_merge <- cbind(data, newCols)
  after_merge[[column_name]] <- NULL
  after_merge
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      
      uiOutput("selectUI"),
      actionButton("unmerge", "Unmerge Column", class = "btn-warning" ),
      selectInput("col", "Column to search:", NULL),
      textInput("old", "Replace:"),
      textInput("new", "By:"),
      actionButton("replace", "Replace!"),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(input, output, session) {
  my <- reactiveValues(data=NULL)
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    my$data <- read.csv(file$datapath, header = input$header)
    updateSelectInput(session, "col", choices = names(my$data ))
  })
  
  observeEvent(input$replace, {
    req(input$col)
    dat <- req(my$data )
    traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
    my$data <- dat %>%
                 mutate(!!rlang::sym(input$col) := 
                       replace(!!rlang::sym(input$col),
                               as.character(!!rlang::sym(input$col)) == input$old,
                               input$new) %>% 
                       traf())
  })
  
  output$table1 <- renderDT(
    req(my$data )
  )
  
  output$selectUI<-renderUI({
    #req(my$data)
    selectInput(paste0('selectcolumn',input$unmerge+1), label='select column to unmerge', choices = names(my$data))
  })
  observeEvent(input$unmerge, {
    my$data <- splitColumn(my$data, as.character(input[[paste0('selectcolumn',input$unmerge)]]))
  })
}

shinyApp(ui, server)