How to execute a paste function inside a reactive dataframe?-CodePudding

I am somewhat familiar with the paste() function in base R. I am trying to learn Shiny and reactivity and don't understand how to execute a paste() inside a reactive Shiny function.

In running the demo code at the bottom, this is what first appears in the rendered "Reactive results" panel:

  choice subclass
1      A        1
2      A        1
3      A        2
4      B        1
5      B        3

I'd like to paste the row number of each row in front of each "choice" column element, followed by a "." and a space, so that the "Reactive results" panel output looks like this:

     choice subclass
1      1. A        1
2      2. A        1
3      3. A        2
4      4. B        1
5      5. B        3

How would I execute a paste() in this reactive example?

Demo code:

library(shiny)

data <- data.frame(choice = c("A","A","A","B","B"),subclass = c(1,1,2,1,3))

ui <- fluidPage(
  
  h5(strong("Base data frame:")), 
  verbatimTextOutput("data"),
  radioButtons(inputId = "showData",
               label = h5(strong("Multiply base DF subclass by factor of:")),
               choiceNames = c('One','Two'),
               choiceValues = c('One','Two'),
               selected = 'One',
               inline = TRUE
              ),
  h5(strong("Reactive results:")), 
  verbatimTextOutput("choices1")
  )

server <- function(input, output, session) {
 
  output$data <- renderPrint(data)
  
  rv <- reactiveValues(choices1=c()) 
  
  observeEvent(input$showData, {
      if(input$showData == 'One'){rv$choices1 <- data[]} 
      else {rv$choices1[,2] <- 2 * data[ ,2]}
      }
    )
  
  output[["choices1"]] <- renderPrint({rv$choices1})

}

shinyApp(ui, server)

CodePudding user response：

Your app looks a bit complicated to me. But as I don't know about your desired final result I stick with your code and only did some slight changes in your observeEvent to achieve your desired result:

library(shiny)

data <- data.frame(choice = c("A", "A", "A", "B", "B"), subclass = c(1, 1, 2, 1, 3))

ui <- fluidPage(
  h5(strong("Base data frame:")),
  verbatimTextOutput("data"),
  radioButtons(
    inputId = "showData",
    label = h5(strong("Multiply base DF subclass by factor of:")),
    choiceNames = c("One", "Two"),
    choiceValues = c("One", "Two"),
    selected = "One",
    inline = TRUE
  ),
  h5(strong("Reactive results:")),
  verbatimTextOutput("choices1")
)

server <- function(input, output, session) {
  output$data <- renderPrint(data)

  rv <- reactiveValues(choices1 = c())

  observeEvent(input$showData, {
    rv$choices1 <- data
    rv$choices1$choice <- paste0(row.names(rv$choices1), ". ", rv$choices1$choice)
    if (input$showData == "Two") {
      rv$choices1[, 2] <- 2 * rv$choices1[, 2]
    }
  })

  output[["choices1"]] <- renderPrint({
    rv$choices1
  })
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:4262

CodePudding user response：

Suggested modifications, in two parts.

First,

use str_glue instead of paste, and mutate to modify the dataframe,
replace choiceNames and choiceValues with a single argument choices, as they are equal,
rewrite output[["choices1"]] as output$choices1,
replace reactiveValues and observeEvent with a single reactive: reactivity is automatic, you don't have to reimplement it with an oberveEvent.

Here is the code:

library(shiny)
library(dplyr)
library(magrittr)
library(stringr)

data <- data.frame(choice = c("A", "A", "A", "B", "B"),
                   subclass = c(1, 1, 2, 1, 3))

ui <- fluidPage(
  h5(strong("Base data frame:")),
  verbatimTextOutput("data"),
  radioButtons(inputId = "showData",
               label = h5(strong("Multiply base DF subclass by factor of:")),
               choices = c("One", "Two"),
               selected = "One",
               inline = TRUE
  ),
  h5(strong("Reactive results:")),
  verbatimTextOutput("choices1")
)

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

  output$data <- renderPrint(data)

  rv <- reactive({
    df <- data %>% mutate(choice = str_glue("{row_number()}. {choice}"))
    if (input$showData == "Two") {
      df %<>% mutate(subclass = 2 * subclass)
    }
    df
  })

  output$choices1 <- renderPrint(rv())

}

shinyApp(ui, server)

Second simplification: the reactive is useless as it's only used once, in renderPrint. So put everything in renderPrint. It's still reactive.

library(shiny)
library(dplyr)
library(magrittr)
library(stringr)

data <- data.frame(choice = c("A", "A", "A", "B", "B"),
                   subclass = c(1, 1, 2, 1, 3))

ui <- fluidPage(
  h5(strong("Base data frame:")),
  verbatimTextOutput("data"),
  radioButtons(inputId = "showData",
               label = h5(strong("Multiply base DF subclass by factor of:")),
               choices = c("One", "Two"),
               selected = "One",
               inline = TRUE
  ),
  h5(strong("Reactive results:")),
  verbatimTextOutput("choices1")
)

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

  output$data <- renderPrint(data)

  output$choices1 <- renderPrint({
    df <- data %>% mutate(choice = str_glue("{row_number()}. {choice}"))
    if (input$showData == "Two") {
      df %<>% mutate(subclass = 2 * subclass)
    }
    df
  })
}

shinyApp(ui, server)