Create new dataframe - substract one column for the other

Question

I am trying to make a Shiny application where user can choose columns to subtract one from another and write a name of the column. I got stuck with printing the dataframe, probably because Shiny does not want to consider column the way I would like to. Does any one know how to select column by input variable?

Generally, I would like to include in df only Samples that user specify, like in the print screen provided (Sample3/4 which are NULL should be ignored). Does anyone has any suggestions how to deal with the problem?

Here is a part of my code:

    library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(
          width = 3,
          div(style = "white-space: nowrap;", 
              div(style = "white-space: nowrap;", 

                  h5(textInput("name1", label = "Sample 1 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam1", label = "Sample 1",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla1", label = "Blank 1",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name2", label = "Sample 2 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam2", label = "Sample 2",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla2", label = "Blank 2",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name3", label = "Sample 3 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam3", label = "Sample 3",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla3", label = "Blank 3",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",


                  h5(textInput("name4", label = "Sample 4 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam4", label = "Sample 4",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla4", label = "Blank 4",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              actionButton("update", "Update", class = "btn-primary",style='padding:4px; font-size:120%')
          )))),
    mainPanel(
      DT::dataTableOutput("contents"),
      plotOutput("plot_preview", height = "auto")
    )))

server <- function(input, output, session) {

  Layout <- c("A", " B", " A", "B")

  col1 <- c(0.84, 0.65, 0.97, 0.81)
  col2 <- c(0.43,0.55,0.53,0.66)
  col3 <- c(0.74, 0.75, 0.87, 0.71)

  df <- data.frame(Layout, col1, col2, col3) 

  cols <- colnames(df) 
  cols <- c("NULL", cols[2:4])

  updateSelectInput(session, "sam1", choices=cols)
  updateSelectInput(session, "sam2", choices=cols)
  updateSelectInput(session, "sam3", choices=cols)
  updateSelectInput(session, "sam4", choices=cols)
  updateSelectInput(session, "bla1", choices=cols)
  updateSelectInput(session, "bla2", choices=cols)
  updateSelectInput(session, "bla3", choices=cols)
  updateSelectInput(session, "bla4", choices=cols)

 ## take a colum choosed before and substract the blank - save as one column 
 observeEvent(input$update, 
              {mydatanew <- reactive(
                mydatanew <- data.frame(input$name1 = input$sam1 - input$bla1, input$name2 = input$sam2 - input$bla2))

              output$contents2 <- DT::renderDataTable( DT::datatable(mydatanew()))
             }
              )


  output$contents <- DT::renderDataTable(df)

}

shinyApp(ui, server)

And a sample user input:

You can't use `$` with variable column names, but you can use `[[`. Suggested duplicate of the [Dynamically select data frame columns R-FAQ](https://stackoverflow.com/q/18222286/903061). (At least partially a dupe - good background reading regardless.) — Gregor Thomas, Feb 13 '18 at 14:45
Also, I'm not really sure what you're going for in the `mydatanew <-` line, do you mean to be doing comparisons with `==`? Or do you want argument assignment with `=`? — Gregor Thomas, Feb 13 '18 at 14:47
Is there supposed to be a separate `contents2` output? Or are you trying to replace the original table? I'm not sure what the desired behavior is here. — MrFlick, Feb 13 '18 at 14:49

Florian · Accepted Answer · 2018-02-13T14:59:09.700

You could use a reactiveVal to hold your dataframe and update it. Use the observeEvent to add columns and store the modified dataframe back into the reactiveVal.

Also, to make things a little easier, you can call an input as input[[x]], where x is a string. So we can loop over the inputs instead of typing everything out. You could probably also use that for your updateSelectInput statements. It would also maybe be nice to reset the selectInput elements after you press the actionButton. You can do that by placing lines like lapply(1:4,function(x) {updateSelectInput(session,paste0('bla',x),selected='NULL')}) at the end of your observeEvent.

Below is a working example. Hope this helps!

library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(
          width = 3,
          div(style = "white-space: nowrap;", 
              div(style = "white-space: nowrap;", 

                  h5(textInput("name1", label = "Sample 1 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam1", label = "Sample 1",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla1", label = "Blank 1",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name2", label = "Sample 2 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam2", label = "Sample 2",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla2", label = "Blank 2",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name3", label = "Sample 3 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam3", label = "Sample 3",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla3", label = "Blank 3",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",


                  h5(textInput("name4", label = "Sample 4 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam4", label = "Sample 4",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla4", label = "Blank 4",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              actionButton("update", "Update", class = "btn-primary",style='padding:4px; font-size:120%')
          )))),
    mainPanel(
      DT::dataTableOutput("contents"),
      plotOutput("plot_preview", height = "auto")
    )))

server <- function(input, output, session) {

  Layout <- c("A", " B", " A", "B")

  col1 <- c(0.84, 0.65, 0.97, 0.81)
  col2 <- c(0.43,0.55,0.53,0.66)
  col3 <- c(0.74, 0.75, 0.87, 0.71)

  df <- data.frame(Layout, col1, col2, col3) 

  cols <- colnames(df) 
  cols <- c("NULL", cols[2:4])

  updateSelectInput(session, "sam1", choices=cols)
  updateSelectInput(session, "sam2", choices=cols)
  updateSelectInput(session, "sam3", choices=cols)
  updateSelectInput(session, "sam4", choices=cols)
  updateSelectInput(session, "bla1", choices=cols)
  updateSelectInput(session, "bla2", choices=cols)
  updateSelectInput(session, "bla3", choices=cols)
  updateSelectInput(session, "bla4", choices=cols)

  reval_df <- reactiveVal(df)

  ## take a colum choosed before and substract the blank - save as one column 
  observeEvent(input$update, {
    df <- reval_df()
    for (i in 1:4)
    {
      if(input[[paste0('sam',i)]]!='NULL' & input[[paste0('bla',i)]]!='NULL')
      {
        print(i)
        df[[input[[paste0('name',i)]]]] = df[[input[[paste0('sam',i)]]]]- df[[input[[paste0('bla',i)]]]]
      }
    }
    reval_df(df)

    # reset inputs
    lapply(1:4,function(x) {updateSelectInput(session,paste0('bla',x),selected='NULL')})
    lapply(1:4,function(x) {updateSelectInput(session,paste0('name',x),selected='NULL')})
    lapply(1:4,function(x) {updateSelectInput(session,paste0('sam',x),selected='NULL')})


  })


  output$contents <- DT::renderDataTable(reval_df())

}

shinyApp(ui, server)

Create new dataframe - substract one column for the other

1 Answers1