0
votes

I have been searching for hours on a solution for a simulation tool that should concatenate graph parts (the last part should be shown reactive before pressing an "add" action button). The dataframe of the completed graph (all concatenated parts) should be downloadable as csv.

Basically i want to combine functionality like described here Add (multiple) values to a data frame with R shiny (adding rows to a dataframe) and here http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html (reactive sliders) without ending up in an endless loop.

I am able to make my output .csv file longer with the action button, but not all added simulations are stored correctly nor do I succeed to update my x input value (where the next part of the graph should start).

Here's my code. Any help is much appreciated. Tom

server.R

shinyServer(function(input, output, clientData, session){
#set up model input parameters
  observe({
  #Define input variables
   x <- input$xc
   a <- input$ac
   b <- input$bc
   l <- input$lc
#Control  value, min, max, and step
   updateSliderInput(session, "xr", value = x, min = x-10, max = x+10, step = 0.1)
   updateSliderInput(session, "ar", value = a, min = a-10, max = x+10, step = 0.1)
   updateSliderInput(session, "br", value = b, min = b-10, max = x+10, step = 0.1)
   updateSliderInput(session, "lr", value = l, min = l-10, max = l+10, step = 0.1)
})

#Calculate additional variables
observe({
   xs <- input$xr
   xe <-xs+input$lr
   al <-input$ar
   bl <-input$br
   xl <-xs:xe
   yl<-xl*al+bl

#create the continiously updated data from the inputs
dataset0<-reactive({
  df<-as.data.frame(cbind(xl,yl))
  return(df)
})

#set the data to be added aside
addData <- reactiveValues()
addData$dataset0 <- dataset0()  

#when the action button is pressed, freeze the data from the model and store them
observe(if (input$addDataset>0) {
  newFrame <- isolate(addData$dataset0)
  #THIS IS NOT WORKING: SAVE LAST X VALUE AS NEW MODEL START
  newx0 <- isolate(addData$dataset0[length(addData$dataset0[,1]),1])
  #update data
  isolate(addData$dataset0 <- rbind(addData$dataset0, newFrame))
  #THIS IS NOT WORKING: CHANGING THE INPUT CAUSES INFINITE LOOP
  #updateNumericInput(session,"xc",value=newx0)
})

#set the freezed data aside
dataset<-reactive({
  df<-as.data.frame(addData$dataset0)
  return(df)
})  

#show some output
output$newx<-renderText(addData$newx0())
output$plot<-renderPlot({plot(dataset()$y~dataset()$x)})
output$table1 <- renderTable(head({addData$dataset0},3), include.rownames=FALSE)
output$table2 <- renderTable(tail({addData$dataset0},3), include.rownames=FALSE)

#download the dataset
output$downloadDataset <- downloadHandler(
  filename = function() {paste('dataset','.csv', sep='')},
  content = function(file) {write.table(dataset(), dec = ",", sep = ";", row.names = FALSE, file)}
) 
})
})

ui.R

shinyUI(fluidPage(
titlePanel("Simulator input"),
fluidRow(
column(2, wellPanel(
#numeric default inputs, changing them updates the sliders
  numericInput("xc", "choose x:", min=0, max=100, value=1, step=0.1),
  numericInput("ac", "choose a:", min=0, max=100, value=1, step=0.1),
  numericInput("bc", "choose b:", min=0, max=100, value=1, step=0.1),
  numericInput("lc", "choose l:", min=0, max=100, value=50, step=0.1)
)),

column(2, wellPanel(
#sliders updated through the numeric inputs, their value are used in the graph
  sliderInput("xr", "choose x:", min=0, max=100, value=1, step=0.1),
  sliderInput("ar", "choose a:", min=0, max=100, value=1, step=0.1),
  sliderInput("br", "choose b:", min=0, max=100, value=1, step=0.1),
  sliderInput("lr", "choose l:", min=0, max=100, value=50, step=0.1)
)),

#the actionButton serves to add a graph part and lines to the data frame
actionButton("addDataset", "Add to Dataset"),
downloadButton('downloadDataset', 'Download'),

# Show a table summarizing the values entered
mainPanel(
  plotOutput("plot"),
  textOutput("newx"),
  tableOutput("table1"),
  tableOutput("table2")
)
)
))

here are two subsequent graph parts, separately downloaded and merged in excel, this should be done in the app itself...

1
Many thanks for the usefull feedback on observe/observeEvent and req. Downloadhandler also works.Tom Geens

1 Answers

3
votes

I made some edits to the reactivity being used in your server file and I think it achieves the functionality you described in your question. The observe statement you were using to define xs, xe, etc. is unnecesary since you only use the values after the addDataset button is clicked. It looked as if the observe statement you were using to update your dataset was an attempt to mimic the functionality of the observeEvent function (which takes as it's first argument the event to react to).

Your definition of addData$dataset0 <- dataset0() isn't in an environment that would "listen" for a change in dataset0() (a listener could be a function such as the render fucntions, reactive, eventReactive, observe, or observeEvent).

Additional edits:

as.data.frame(cbind(xl,yl)) can be accomplished simply with data.frame(xl,yl)

req is used here to wait for addData$dataset0 to not be NULL. Use ?shiny::req for more information, but basically if the arguments to req are NULL, FALSE, or other values that are "falsey" execution is halted for the statement.

Notes:

As a general rule I think it's best to avoid using observe if possible. It has the potential to greatly slow down shiny applications.

I did not test the downloadHandler functionality.`

server.R:

shinyServer(function(input, output, clientData, session){
  #set up model input parameters
  observe({
    #Define input variables
    x <- input$xc
    a <- input$ac
    b <- input$bc
    l <- input$lc
    #Control  value, min, max, and step
    updateSliderInput(session, "xr", value = x, min = x-10, max = x+10, step = 0.1)
    updateSliderInput(session, "ar", value = a, min = a-10, max = x+10, step = 0.1)
    updateSliderInput(session, "br", value = b, min = b-10, max = x+10, step = 0.1)
    updateSliderInput(session, "lr", value = l, min = l-10, max = l+10, step = 0.1)
  })
  
  
  addData <- reactiveValues()
  addData$dataset0 <- NULL 
  
    observeEvent(input$addDataset,{

      xs <- input$xr
      xe <- xs+input$lr
      al <- input$ar
      bl <- input$br
      xl <- xs:xe
      yl <- xl*al+bl
      
      newRow <- data.frame(x=xl,y=yl)
      addData$dataset0 <- rbind(addData$dataset0, newRow)
    })
    
    #show some output
    output$newx <- renderText({
      req(addData$dataset0)
      addData$dataset0$x[nrow(addData$dataset0)]
      })
    output$plot <- renderPlot({
      req(addData$dataset0)
      plot(addData$dataset0$y~addData$dataset0$x)
      })
    output$table1 <- renderTable({
      req(addData$dataset0)
      head(addData$dataset0,3) 
      }, include.rownames=FALSE)
    output$table2 <- renderTable({
      req(addData$dataset0)
      tail(addData$dataset0,3)
      }, include.rownames=FALSE)
    
    #download the dataset
    output$downloadDataset <- downloadHandler(
      filename = function() {paste('dataset','.csv', sep='')},
      content = function(file) {write.table(addData$dataset0, dec = ",", sep = ";", row.names = FALSE, file)}
    ) 
})