如何将底部列设为标题，其值在 R 中闪亮？

Question

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

我应该如何将它引入 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

应用程序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)
  })