Formatting Reactive Data.Frames in Shiny

Formatting reactive data.frames in Shiny

I am responding to my own question largely to say that I was being a nincompoop. Once the file is read in using reactiveFileReader() it becomes a "reactive source". As explained in the shiny tutorial here the reactive sources are modified from outside - a user entering a new value, or in this case, an update of the file. You can't modify it from inside the server.r.

So, for my case I used the col.names and colClasses options in read.csv() to get the original data in the best format that I could. I also made use of the very useful setAs function to get read.csv to understand how to format the date, as explained here: Specify date format for colClasses argument ... .

From there, any new columns that I needed to create from the data had to be done as a separate object using a reactive function like this:

NewThing<-reactive({ function(MyReacitveCSVdata()$colname) })

And then NewThing() in turn can be used however you wish. This is how you can get around issues such as character values in an otherwise numeric column. If you try to just bring it in using colClasses="numeric" you will get an error and the read.csv() will fail. Instead first import the column as "character" and then use reactive({}) with as.numeric() to assign it to a new object. Be sure to note that the new object cannot be a new column in the data.frame you brought in using reactiveFileReader(), instead it must be a new object that depends on that data.frame.

R shiny modify reactive data frame

I think this question can be closed thanks to the answer for @dieter-menne to another question about subsetting reactive data frames. The point is to create a new local variable, similar to @john-paul suggestion.

Please take a look at https://stackoverflow.com/a/20569512/709777

How to format data table values when using a reactive data frame?

The DT package offers several formatter functions to format table columns, e.g. in your case formatCurrency seems appropriate:

library(dplyr)
library(DT)
library(shiny)
library(tidyverse)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "grouping",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    DT::dataTableOutput("sums")
  )

server <- function(input, output, session) {
  data <- reactive({
    data.frame(
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
      Period_2 = c(1, 2, 3, 3, 1, 2),
      ColA = c(1000.01, 20, 30, 40, 50, 60),
      ColB = c(15.06, 25, 35, 45, 55, 65)
    )
  })
  
  summed_data <- reactive({
    data() %>%
      group_by(!!sym(input$grouping)) %>%
      select("ColA","ColB") %>%
      summarise(across(everything(), sum))
  })
  output$data <- renderTable(data())
  
  output$sums <- renderDT({
    summed_data() %>% 
      datatable(rownames = FALSE) %>% 
      formatCurrency(c("ColA", "ColB"), currency = '\U20AC', digits = 2)
  })
  
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:3057
#> Adding missing grouping variables: `Period_1`

Sample Image

Editing data frame after reactive upload in R shiny

The code in the server() function really should only set up reactive objects and respond to reactive events. You shouldn't have any data manipulation data in the body of the server() function itself because when that runs the data is not yet available. Something like this makes more sense

ui <- fluidPage(
  fluidPage(
    titlePanel("Uploading Files"),
    fileInput('myFile', 'Choose File'),
    tableOutput('contents')
  )
)
server <- function(input, output) {

  a1 <- reactive({
    req(input$myFile)
    read_excel(input$myFile$datapath)
  })

  newdata <- reactive({
    a1 <- a1()
    x <- as.POSIXct(a1$Month)

    a1$mo <- strftime(x, "%m")
    a1$yr <- strftime(x, "%Y")
    a1$qrt <- quarter(x, with_year = FALSE, fiscal_start = 01)

    newdata <- a1[grepl("Y", a1$`Quota Held Flag`),]

    #fixing participation column into categorical for donut chart
    newdata$Participation[is.na(newdata$Participation)] <- 0
    newdata$Participation <- factor(newdata$Participation, labels = c("0-99%","100%")) 

    #grouping data
    newdata %>%
      group_by(yr, mo, qrt)     
  })

  output$contents <- renderTable(        
    newdata()        
  )

}
shinyApp(ui = ui, server = server)

Notice how a1 reads the file that the user uploads. Then the newdata reactive object will update whenever a1 updates and will transform the data for you. Then we can hook up that to an output so it will actually be processed.

R Shiny: Formatting reactive data.frame from sql query

EDIT:

Simply replace this expression:

output$table <- DT::renderDataTable(sqlOutput(), server=TRUE, 
  rownames=TRUE, filter="top", options=list(pageLength=10))

With:

output$table <- DT::renderDataTable({
  intermed <- sqlOutput()
  intermed$HOEHE_TOLP <- as.factor(intermed$HOEHE_TOLP)
  datatable(intermed) %>% formatStyle("RUND2_MITT", color = 'red', 
    backgroundColor = 'lightyellow', fontWeight = 'bold')
}, server=TRUE, rownames=TRUE, filter="top", options=list(pageLength=10))

Here is a self contained example:

library(DT)
library(shiny)

ui <- fluidPage(
  actionButton("inst", "Instigate Reactive"),
  dataTableOutput("test")
)

server <- function(input, output){
  data <- eventReactive(input$inst, {
    iris
  })

  output$test <- renderDataTable({
    set <- data()
    set$Sepal.Length <- as.factor(set$Sepal.Length)
    datatable(set) %>% formatStyle("Petal.Length", color = 'red', 
                                   backgroundColor = 'lightyellow',
                                   fontWeight = 'bold')
  })
}

shinyApp(ui, server)

R Shiny: How to expand a reactive containing a list of data.frames with an uploaded data.frame?

A simple solution using reactiveValues based on @Limey's comment:

library(shiny)

# df available from start
df <- data.frame(Var = 1:10)

reactlog::reactlog_enable()

ui <- fluidPage(
  selectInput("select", label = "Select data", choices = c("df")),
  actionButton("upload", "Simulate Upload"),
  tableOutput("tabdata")
)

server <- function(input, output, session) {
  
  # empty reactiveValues rv to store all datasets in
  rv <- reactiveValues()
 
  # store the test df in rv
  rv$df <- df
  
  # 'upload' of second df and storing it in rv
   observeEvent(input$upload, {
     rv$df_upload <- data.frame(Var = 11:20)
  })
  
  # update selectInput choices 
  observe({
    updateSelectInput(session = session,
                      inputId = "select",
                      choices = names(rv),
                      selected = "df")
  })
  
  # output of selected dataset
  output$tabdata <- renderTable({
    rv[[input$select]]
  })

}

shinyApp(ui, server)

In R shiny how to render a reactive data table?

Mistake was to use show("table1") instead of tableOutput("table1") in the last observeEvent in the original MWE code posted above. Also two custom functions in the original MWE were erroneously omitted: "pct" and "vectorPlot". Revised MWE code below now uses the correct table output syntax and includes all required functions. Now it runs as intended. Thanks to YBS comment for pointing out the error.

library(shiny)
library(shinyMatrix)
library(shinyjs)

button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}

matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
              rows = list(extend = FALSE,  names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage

vectorBase <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
                        style="margin-top:-15px;margin-bottom:5px")),
    # Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
      uiOutput("Panels") 
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("By balances", value=2,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   button2('showVectorPlotBtn','Vector plots'),
                   button2('showVectorValueBtn','Vector values'),
                 ), # close fluid row
                 
                 div(style = "margin-top: 5px"),
                
                 # Shows outputs on each page of main panel   
                 uiOutput('showResults'),
        ),  # close tab panel
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  base_input  <- reactive(input$base_input)
  showResults <- reactiveValues()

  yield   <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
  
  # --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        matrix1Input("base_input"),
        div(style = "margin-top: 0px"), 
        useShinyjs(),
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  # --- Below produces vector plots as default view when first invoking App ----------------------------->
  output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
  
  # --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
  observeEvent(input$showVectorPlotBtn,
               {showResults$showme <- 
                 tagList(plotOutput("graph1"))
               },ignoreNULL = FALSE)
  
  # --- Below produces vector values table ------------------------------------------------------------->
  vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
  
  output$table1 <- renderTable({vectorsAll()})
  
  observeEvent(input$showVectorValueBtn,{showResults$showme <- tableOutput("table1")})
  
  # --- Below sends both vector plots and vector values to UI section above ---------------------------->
  output$showResults <- renderUI({showResults$showme})

}) # close server

shinyApp(ui, server)

How to reactively format data table columns?

The following seems to work. However, I'm not sure why your initial approach doesn't work - it looks good to me.

library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
library(tidyverse)

ui <-
  fluidPage(fluidRow(
    column(
      width = 8,
      h3("Data table:"),
      tableOutput("data"),
      h3("Sum the data table columns:"),
      radioButtons(
        inputId = "grouping",
        label = NULL,
        choiceNames = c("By period 1", "By period 2"),
        choiceValues = c("Period_1", "Period_2"),
        selected = "Period_1",
        inline = TRUE
      ),
      DT::dataTableOutput("sums")
    )
  ))

server <- function(input, output, session) {
  data <- reactive({
    data.frame(
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
      Period_2 = c(1, 2, 3, 3, 1, 2),
      ColA = c(1000.01, 20, 30, 40, 50, 60),
      ColB = c(15.06, 25, 35, 45, 55, 65)
    )
  })
  
  summed_data <- reactive({
    data() %>%
      group_by(!!sym(input$grouping)) %>%
      select("ColA", "ColB") %>% summarise(across(everything(), sum))
  })
  
  output$data <- renderTable(data())
  
  output$sums <- renderDT({
    print(names(summed_data())[1])
    datatable(
      data = summed_data(),
      rownames = FALSE,
      options = list(columnDefs = list(
        list(className = 'dt-left', targets = 0),
        list(className = 'dt-center', targets = seq_len(ncol(summed_data())) - 1)
      ))
    )
  })
}

shinyApp(ui, server)

How to display a simple dataframe with input in R Shiny

Method 1:

library(shiny)
shinyApp(
  ui = fluidPage(        
    fluidRow(
      column(6, sliderInput("exp", label = h5("Change this"), min=2, max=5, value = 2)),       
      column(12,
             tableOutput('table')
      )
    )
  ),
  server = function(input, output) {
    output$table <- renderTable({
      foo<-data.frame(matrix(ncol=8, nrow=1))
      colnames(foo)<-c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h')
      foo$a<-input$exp+2
      foo$b<-2
      foo$c<-3
      return(foo)
    })
  }
)

Method 2:

library(shiny)
shinyApp(
  ui = fluidPage(        
    fluidRow(
      column(6, sliderInput("exp", label = h5("Change this"), min=2, max=5, value = 2)),       
      column(12,
             tableOutput('table')
      )
    )
  ),
  server = function(input, output) {
    result <- eventReactive(input$exp, {
      foo<-data.frame(matrix(ncol=8, nrow=1))
      colnames(foo)<-c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h')
      foo$a<-input$exp+2
      foo$b<-2
      foo$c<-3
      return(foo)
    })  
    output$table <- renderTable({
      result()
    })
  }
)

Formatting Reactive Data.Frames in Shiny