How do I make bottom columns into headers with their values in R shiny?

Question

I have a CSV DTOutput("table1") file with several columns and their values in it or how it should be done using dput() in R shiny, I would like to add those to the bottom column as headers and values.

How I should bring it in R shiny? could someone assist me?

CSV Data

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

Expected Output

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

Here's an approach that displays separate DTs, one for each sub-table in the input csv. This works with the example csv, although it may need some fiddling to work with the full csv.

(I've removed the other functions in order to focus on rendering the tables.)

Here's the UI. The mainPanel now contains a single uiOutput, which will be populated with as many DTs as we eventually need. (Inspired by this answer.)

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

And here's the server. It walks through the input csv; every time it encounters a line that appears to contain headers, it starts a new dataframe. At the end, we have a list of all the sub-dataframes contained in the csv, and we display them all.

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

Answer 2

Not sure if this helps but I was able to get your desired output by filtering each column for rows containing one of the column names and cbinding them together.

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