R shiny modify a specific element in a reactive table

Question

I have a small shiny app that is designed to read in from a data set, and then calculate the average time per element, grouped by category. My dataset is a more complicated version of:

item time category
apple 13 cat1
bobcat 6 cat2
cement 15 cat1
doomsday 15 cat1
elephant 7 cat2

after reading in that file, I generate a table describing the percent of total time attributed to each category. This part is working beautifully.

category | PercentTime

cat1 | 76.79

cat2 | 23.21

To complicate things a bit, I have an input field where the user can estimate some percentage of time that they spend on a specific category--intended to capture an estimate on time that is not represented in the data set. Then, I generate a second table which recalculates what those percentages of time allocated to each category would be, adjusted for the percentage of time that is estimated to be part of that category. If we input a value of 50% of time going towards cat2 that was not represented in the data, I would expect the table to be modified to:

category | PercentTime

cat1 | 38.39

cat2 | 61.61

where 61.61 = 11.61 + 50

I am presently able to generate a table comprised of the correct percentages of time in each category excluding the addition of the user input percentage. So what I am getting adds up to less than 100%:

category | PercentTime

cat1 | 38.39

cat2 | 11.61

I'd like to tweak that one specific PercentTime element for cat2 by adding the input value to the calculated percent time, so it's the correct number (61.61).

Shiny app code:

library(shiny)
library(readxl)
library(dplyr)
library(ggplot2)

ui = fluidPage(
  sidebarPanel(
    fileInput('file1', 'inputtext'),
    numericInput('UnknownPercent', 'labeltext', 50)),
  
  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("tab1", 
                         tableOutput("data_only"),
                         tableOutput("data_inc_unknown_percent"))
    )
  )
)

server = function(input, output) {
  
  G2T <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}
    
    isolate({ 
      G2T_raw <- read.csv(inFile$datapath)
    })
    G2T_raw
  })
  
  TotalTime <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}
    
    isolate({ 
      TotalTime <- G2T() %>%
        summarise(TotalTime = sum(time))
      })
    TotalTime
  })
  
  CatTable <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}
    
    isolate({ 
      TotalTime <- G2T() %>%
        summarise(TotalTime = sum(time))
      CatTable <- G2T() %>%
        group_by(category) %>%
        summarise(PercentTime = sum(time) / TotalTime * 100)
    })
    CatTable
  })
  
  CatTablePlus <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}
    
    isolate({ 
      TotalTime <- G2T() %>%
        summarise(TotalTime = sum(time))
      CatTablePlus <- G2T() %>%
        group_by(category) %>%
        summarise(PercentTime = ((sum(time) / TotalTime()) * (100 - input$UnknownPercent[1])))
      CatTablePlus <- as.data.frame(CatTablePlus)
    })
    CatTablePlus
  })
  
  
  
  output$data_only <- renderTable({
    req(input$file1)
    CatTable()  
  }) 
  
  output$data_inc_unknown_percent <- renderTable({
    req(input$file1) 
    CatTablePlus()
  }) 
}
runApp(list(ui = ui, server = server))

I cannot for the life of me figure out how to add my user input percentage to that [category = cat2, time] element of my table. I have tried:

Moving the table manipulation logic to different places, either the renderTable section, or keeping it in the reactive section
Treating my generated table as something with modifiable elements, using a command like CatTablePlus[CatTablePlus$category == "cat1", "PercentTime"] <- CatTablePlus[CatTablePlus$category == "cat1", "PercentTime"] + input$UnknownPercent[1]. Depending on how I approach this, I either perform the operation of adding UnknownPercent[1] to all of the PercentTime elements, or get errors like Error: 'row.names' should specify one of the variables in my output.
Creating new local variables in the place of the reactive table objects
Coercing my reactive table into different types such as data.frame

How can I adjust a single element in a Shiny renderTable object, reactively, as a user adjusts a numericInput value?

Just a quick check, Do you have only two categories in your data also? — amrrs
I have five categories in the actual data set, and I'm modifying 2 of those 5 ultimately. — omgitsjessie
Then the below code would work well for the shiny part but the logic for the 5 category case must be updated for the second table. btw, did you try the code? — amrrs
Yes I did. Runs like a dream :) . This has been maddening me for weeks, I really appreciate the help. — omgitsjessie

amrrs amrrs · Accepted Answer · 2017-12-28T10:27:53

I've done a couple of changes with your code and also have commented out some part of yours.

Used eventReactive to track the input numericInput change and render dataframe accordingly.
Assuming that you would have only two categories, hard-coded the percentage shifting logic.

Updated Code:

    library(shiny)
library(readxl)
library(dplyr)
library(ggplot2)

ui = fluidPage(
  sidebarPanel(
    fileInput('file1', 'inputtext'),
    numericInput('UnknownPercent', 'labeltext', 50)),

  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("tab1", 
                         tableOutput("data_only"),
                         tableOutput("data_inc_unknown_percent"))
    )
  )
)

server = function(input, output) {

  G2T <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}

    isolate({ 
      G2T_raw <<- read.csv(inFile$datapath)
    })
    G2T_raw
  })

  TotalTime <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}

    isolate({ 
      TotalTime <- G2T() %>%
        summarise(TotalTime = sum(time))
    })
    TotalTime
  })

  CatTable <- reactive({
    if(input$file1 == 0){return()}
    inFile <- input$file1
    if (is.null(inFile)){return(NULL)}

    isolate({  
      CatTable <- G2T() %>% group_by(category) %>%
        summarise(time = sum(time)) %>% ungroup(category) %>% mutate(time = (time / sum(time))*100)
    })
    CatTable
  })

  CatTablePlus <- eventReactive(input$UnknownPercent,{ 


     # TotalTime <-  G2T() %>%
      #  summarise(TotalTime = sum(time))

      # G2T() %>%
      #  group_by(category) %>%
       # summarise(PercentTime = ((sum(time) / TotalTime) * (100 - input$UnknownPercent[1])))

    unknownpct_table <- CatTable() 

    #unknownpct_table$time[unknownpct_table$category == 'cat2'] <- 100 -  unknownpct_table$time[unknownpct_table$category == 'cat1']

    unknownpct_table$time[unknownpct_table$category == 'cat1'] <- unknownpct_table$time[unknownpct_table$category == 'cat1'] -  unknownpct_table$time[unknownpct_table$category == 'cat1'] * (input$UnknownPercent[1] /100)
    unknownpct_table$time[unknownpct_table$category == 'cat2'] <- 100 -  unknownpct_table$time[unknownpct_table$category == 'cat1']

    unknownpct_table

  })



  output$data_only <- renderTable({
    req(input$file1)
    CatTable()
  }) 

  output$data_inc_unknown_percent <- renderTable({
    req(input$file1) 
    CatTablePlus()
  }) 
}
runApp(list(ui = ui, server = server))

R shiny modify a specific element in a reactive table

1 Answers