如何将底列变成标题，其值在 R 中闪亮？

Question

我有一个 CSV DTOutput("table1") 文件，其中包含几列及其值，或者应该如何在 R Shiny 中使用 dput() 完成，我想将它们作为标题和值添加到底部列。

我应该如何将它带入 R 闪亮？有人可以帮助我吗？

CSV 数据

ID  Type   Range
21  A1     100
22  C1     200
23  E1     300
ID Range  Type    Period
24 500    A2      2005
26 100    G2      2008
28 300    C3      2010

预期输出

ID  Type   Range ID Range Type Period
21  A1     100   24  500  A2   2005
22  C1     200   26  100  G2   2008
23  E1     300   28  150  C3   2010

app.R

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


###function for deleting the rows
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
}
###_______________________________________________
### function for inserting a new column

fillvalues <- function(data, values, columName){
  df_fill <- data
  vec <- strsplit(values, ",")[[1]]
  df_fill <- tibble::add_column(df_fill, newcolumn = vec, .after = columName)
  df_fill
}

##function for removing the colum

removecolumn <- function(df, nameofthecolumn){
  df[ , -which(names(df) %in% nameofthecolumn)]
}

### use a_splitme.csv for testing this program

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      actionButton("Splitcolumn", "SplitColumn", class = "btn-warning" ),
      uiOutput("selectUI"),
      
      
      actionButton("replacevalues", label = 'Replace values', class= "btn-Secondary"),
      actionButton("removecolumn", "Remove Column"),
      actionButton("Undo", 'Undo', style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
      actionButton("deleteRows", "Delete Rows"),
      textInput("textbox", label="Input the value to replace:"),
      actionButton('downloadbtn', label= 'Download'),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(session, input, output) {
  rv <- reactiveValues(data = NULL, orig=NULL)
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    
    validate(need(ext == "csv", "Please upload a csv file"))
    
    rv$orig <- read.csv(file$datapath, header = input$header)
    rv$data <- rv$orig
  })
  
  output$selectUI<-renderUI({
    req(rv$data)
    selectInput(inputId='selectcolumn', label='select column', choices = names(rv$data))
  })
  
  
  observeEvent(input$Splitcolumn, {
    rv$data <- splitColumn(rv$data, input$selectcolumn)
  })
  
  observeEvent(input$deleteRows,{
    if (!is.null(input$table1_rows_selected)) {
      rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
    }
  })
  
  output$table1 <- renderDT(
    rv$data, selection = 'none', server = F, editable = T
  )
  #includes extra column after the 'select column' and replaces the values specified 'Input the value to replace:'
  observeEvent(input$replacevalues, {
    rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
  })
  #Removing the specifield column through select column
  observeEvent(input$removecolumn, {
    rv$data <- removecolumn(rv$data,input$selectcolumn)
  })
  observeEvent(input$Undo, {
    rv$data <- rv$orig
  })
  #Storing the csv file through download button
  observeEvent(input$downloadbtn,{
    write.csv(rv$data,'test.csv')
    print ('file has been downloaded')
  })
  observeEvent(input$downloadbtn, {
    showModal(modalDialog(
      title = "Download Status.",
      paste0("csv file has been downloaded",input$downloadbtn,'.'),
      easyClose = TRUE,
      footer = NULL
    ))
  })
}

shinyApp(ui, server)

Answer 1

不确定这是否有帮助，但我能够通过过滤每一列中包含一个列名的行并将它们绑定在一起来获得您想要的输出。

observeEvent(input$Splitcolumn, {


    df <-rv$data %>% 
      select(-1)

    # get existing column names from dataframe
    temp <- names(df)

    # find rows in first column that contain a column name
    inds <- which(df[1] == temp[1] | df[1] == temp[2] | df[1] ==  temp[3])

    # gather rows in first column that are after the row with column name
    df2 <- df[sort(unique(inds+1:nrow(df))), ] %>% select(1)

    # change df2 column name to row name
    new1 = df %>%  slice(inds:inds) %>%  select(1)
    names(df2)[1] <- paste0(as.character(new1[[1]]))
    
    #- repeat for rest of columns 
    inds2 <- which(df$Type == temp[1] | df$Type == temp[2] | df$Type ==  temp[3])
    new1 = df %>%  slice(inds2:inds2) %>%  select(2)
    df3 <- df[sort(unique(inds2+1:nrow(df))), ] %>% select(2)
    names(df3)[1] <- paste0(as.character(new1[[1]]))
    #
    inds3 <- which(df[3] == temp[1] | df[3] == temp[2] | df[3] ==  temp[3])
    new1 = df %>%  slice(inds3:inds3) %>%  select(3)
    df4 <-  df[sort(unique(inds3+1:nrow(df))), ] %>%  select(3)
    names(df4)[1] <- paste0(as.character(new1[[1]]))
    #
    inds4 <- which(df[4] == 'Period')
    new1 = df %>%  slice(inds4:inds4) %>%  select(4)
    df5 <-  df[sort(unique(inds4+1:nrow(df))), ] %>%   select(4)
    names(df5)[1] <- paste0(as.character(new1[[1]]))
    
    #- cbind new dfs and remove na
    newdf <- cbind(df2,df3,df4,df5) %>% 
      filter(., !is.na(.[1]))

    #- filter original df to remove rows present in new df using ID column.
    df <- df %>% filter(., !ID%in%newdf$ID) %>% 
      filter(., !ID%in%temp[1]) %>% 
      select(., 1,2,3)
    newdf <- cbind(df, newdf)
    rv$data <- newdf
    #rv$data <- splitColumn(rv$data, input$selectcolumn)
  })


    

Answer 2

这是一种显示单独 DT 的方法，一个用于输入 csv 中的每个子表。这适用于示例 csv，尽管它可能需要一些摆弄才能使用完整的 csv。

（我已经删除了其他函数，以便专注于呈现表格。）

这是用户界面。 mainPanel 现在包含一个 uiOutput，它将填充我们最终需要的尽可能多的 DT。 （灵感来自this answer。）

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      uiOutput("selectUI"),
    ),
    mainPanel(
      uiOutput("tables")
    )
  )
)

这是服务器。它遍历输入 csv；每次遇到包含标题的行时，它都会启动一个新的数据帧。最后，我们有一个包含在 csv 中的所有子数据帧的列表，我们将它们全部显示出来。

server <- function(session, input, output) {
  
  rv <- reactiveValues(data = NULL, orig=NULL)
  
  observeEvent(input$file1, {
    
    # Validate the input file.
    file = input$file1
    ext = tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    
    # Read in the raw csv.
    raw.df = read.csv(file$datapath, header = input$header)
    rv$orig = raw.df
    
    # Initialize a list that will hold all the dataframes.
    dfs = list()
    
    # A vector of all the column names we've observed so far.
    all.colnames = colnames(raw.df)
    
    # Iterate over rows in the raw csv.  If we find a row where at least one
    # value matches one of the column names we've observed, assume that this row
    # is actually a header.  In that case, add all previous rows (since the last
    # header we saw) to a new dataframe.  The re-read the csv starting from the
    # line with the new header.
    current.row = 1
    total.headers = 1
    while(current.row <= nrow(raw.df)) {
      possible.colnames = unname(unlist(raw.df[current.row,]))
      if(length(intersect(all.colnames, possible.colnames)) > 0) {
        all.colnames = union(all.colnames, possible.colnames)
        dfs[[length(dfs) + 1]] = raw.df[1:(current.row-1),]
        raw.df = read.csv(file$datapath, skip = current.row + total.headers - 1,
                          header = input$header)
        current.row = 0
        total.headers = total.headers + 1
      }
      current.row = current.row + 1
    }
    dfs[[length(dfs) + 1]] = raw.df
    
    # Add the split dataframes to the reactive values.
    rv$data = dfs
    
    # Display however many tables we found.
    output$tables = renderUI({
      table.list = lapply(
        1:length(dfs),
        function(i) {
          table.name = paste("table", i, sep = "")
          column(width = 6, renderDT(dfs[[i]]))
        }
      )
      tagList(table.list)
    })
    
  })
  
}