I am building an RShiny app that I want to display some outputs based on the a dataframe.

The dataframe is generated within the app based on some UI inputs.

I have a function that I want to run over the dataframe.

I can achieve this once (or multiple times if I repeat the block of code)

But what I'd like to be able it so the function is run x times based on another UI input.

In my example the app should display two graphs. The first where the sample has 1 added to their age, and the second where this is done as many times as the user input.

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Ipsum Lorem"),
  
  # Sidebar with sliders for input numbers 
  sidebarLayout(
    sidebarPanel(
      
      sliderInput("n_Age",
                  "Base Number:",
                  min = 100, max = 500,
                  value = 100),
      
      sliderInput("projection",
                  "Number of repeated runs:",
                  min = 1,max = 5,
                  value = 2),
      
      actionButton("refresh", "New Random Sample")
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      
      tabsetPanel(type = "tabs",
                  
                  tabPanel("Plot", 
                           h4("Graphs of rando numbers"),
                           plotOutput("distPlot1"),

                           br(),hr(),br(),
                           plotOutput("distPlot2")),
                  
                  tabPanel("Table", 
                           h4("Table of invisible numbers"))
      )
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  dataInput1 <- reactive({
    
    input$refresh
    
    # creates base data.frame of IDs and ages from Base number
    df01 = data.table(1:input$n_Age, round((rnbinom(input$n_Age, 10, 0.28) 24),0))
    colnames(df01) = c("ID","Age")
    return (df01)
  })
  
  # creates the Ageing function
  fxx1 = function(a) {
    a$Age = a$Age   1
    a$ID = c(1:length(a$Age))
    a
  }
  
  # runs the Ageing function once 
  dataInput2 <- reactive({
    df01 = fxx1(dataInput1())
    return(df01)
  })
  
  # plots the results
  output$distPlot1 <- renderPlot({
    ggplot(dataInput2(), aes(Age)) 
      geom_bar(width = 0.75) 
      theme_minimal()
      })
  
  ##### THIS IS THE PROBLEM I THINK #####
  # runs the Ageing function x times based on projection slider 
  dataInput3 <- reactive({
    for (i in 1:(input$projection))
    {
      df01 = fxx1(dataInput2())
    }
    return(df01)
  })
  
  # plots the results
  output$distPlot2 <- renderPlot({
    ggplot(dataInput3(), aes(Age)) 
      geom_bar(width = 0.75) 
      theme_minimal()
      })

}

# Run the application 
shinyApp(ui = ui, server = server)

The above just produces two identical graphs.

I trailed the for loop outside of shiny and it works as I want it to, I think the problem is probably that the loop effectively resets each run, always using the same dataframe instead of the product of the previous run, but I can't think of any solutions. Also FYI the real function is a good bit more complicate than my example.

CodePudding user response：

Actually your plots are not identical. They are shifted by one year. But you are right, your for loop is doing nothing, as in each iteration df01 is computed as df01 = fxx1(dataInput2()). Instead I would suggest to init df01 as dataInput2() outside of the loop. Then, inside the loop do df01 <- fxx1(df01):

library(shiny)
library(ggplot2)
library(data.table)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Ipsum Lorem"),

  # Sidebar with sliders for input numbers
  sidebarLayout(
    sidebarPanel(
      sliderInput("n_Age",
        "Base Number:",
        min = 100, max = 500,
        value = 100
      ),
      sliderInput("projection",
        "Number of repeated runs:",
        min = 1, max = 5,
        value = 2
      ),
      actionButton("refresh", "New Random Sample")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      tabsetPanel(
        type = "tabs",
        tabPanel(
          "Plot",
          h4("Graphs of rando numbers"),
          plotOutput("distPlot1"),
          br(), hr(), br(),
          plotOutput("distPlot2")
        ),
        tabPanel(
          "Table",
          h4("Table of invisible numbers")
        )
      )
    )
  )
)

# creates the Ageing function
fxx1 <- function(a) {
  a$Age <- a$Age   1
  a$ID <- seq_along(a$Age)
  a
}

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  dataInput1 <- reactive({
    input$refresh

    # creates base data.frame of IDs and ages from Base number
    df01 <- data.table(1:input$n_Age, round((rnbinom(input$n_Age, 10, 0.28)   24), 0))
    colnames(df01) <- c("ID", "Age")
    return(df01)
  })

  # runs the Ageing function once
  dataInput2 <- reactive({
    df01 <- fxx1(dataInput1())
    return(df01)
  })

  # plots the results
  output$distPlot1 <- renderPlot({
    ggplot(dataInput2(), aes(Age))  
      geom_bar(width = 0.75)  
      theme_minimal()
  })

  # runs the Ageing function x times based on projection slider
  dataInput3 <- reactive({
    df01 <- dataInput2()
    for (i in seq_len(input$projection)) {
      df01 <- fxx1(df01)
    }
    return(df01)
  })

  # plots the results
  output$distPlot2 <- renderPlot({
    ggplot(dataInput3(), aes(Age))  
      geom_bar(width = 0.75)  
      theme_minimal()
  })
}

# Run the application
shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:8721