Search code examples
rshinyglobal-variables

How can I modify global variables in RShiny using button inputs from the user?


I've been struggling a lot lately with the example below. In its most basic format, I have a button some_button and an output result. When the user interacts with the platform, my intention is to run a curve fit method (from minpack.lm package) and use the four parameters output from the curve fit method to initialize a Convert() function. In order to achieve this, my idea was to initialize an empty reactive variable for storing the coefficients (curvefit_coeff) and an empty Convert() function. Then, I use observeEvent with its once parameter set to TRUE ensuring that it will run only once. This one run should therefore initialize both my curvefit_coeff, as well as my Convert() functions - I thought. However, I am unable to "take out" these values from the observeEvent it seems. I tried outputting them using a winDialog and also my result text output but I always ended up with the following error message:

Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
library(shiny)
library(minpack.lm)

ui <- fluidPage(
  actionButton("some_button", "Press me!"),
  textOutput("result")
)


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

  # I tried to initialize my two variables in question as globals within the server function
  curvefit_coeff <- reactive({ })
  Convert <- function(x) { }

  # This function fits a curve and returns the four parameters of the fitted curve
  CurveFit <- function(pp) {
    ds <- data.frame("x" = c(0.01, pp, 999, 1000), "y" = c(0, 0.5, 0.999, 1))

    nlmInitial <- list(a = 0.5, power1 = -1, b = -1, power2 = 0.5)
    m <- nlsLM(y ~ a*I(x^power1) + b*I(x^power2),
               data = ds,
               start = nlmInitial,
               trace = F,
               control = nls.lm.control(maxiter = 1024))

    summary(m)$coefficients[,1]
  }

  # At the very first time the button is pressed, do the curve fit and using the parameters 
  # from the curve fit, initialize the Convert() function that will be used later on
  observeEvent(input$some_button, {

    winDialog("ok", message = "Button pressed!")

    curvefit_coeff <- reactive({ CurveFit(pp = 50) })

    Convert  <- function(x) {
      (curvefit_coeff()[1])*x^(curvefit_coeff()[2]) + (curvefit_coeff()[3])*x^(curvefit_coeff()[4])
    } 

  },ignoreInit = FALSE, once = TRUE)


  # When I try to access either the coefficients from the curve fit or the Convert() 
  # function itself, I get an error:
  output$result <- curvefit_coeff()
  output$result <- Convert(3)

}

shinyApp(ui, server)

Solution

  • Ok, there's a few things going on here. First of all, if you want to display two things in the output, you should have two different output variables. Next, the error message is coming from you directly assigning a vector to the output variable(s). When you want to display what you'd normally see from running something in the console, you should be using renderPrint in conjunction with textOutput. If you do processing and have cat-like output, you'd want to use renderText instead. Finally, you don't want to be redefining reactive values with the assignment operator (<-) from within observeEvent - you only want to update the value (which isn't done with the assignment operator). My suggestion would be to use reactiveValues to track everything you need for this set of operations and output as follows.

    library(shiny)
    library(minpack.lm)
    
    ui <- fluidPage(
      actionButton("some_button", "Press me!"),
      textOutput("result1"),
      textOutput("result2")
    )
    
    
    server <- function(input, output, session) {
    
      # I tried to initialize my two variables in question as globals within the server function
      curve_fit <- reactiveValues(coeffs = NA,
                                  Convert = function(x) return(NA))
    
      # This function fits a curve and returns the four parameters of the fitted curve
      CurveFit <- function(pp) {
        ds <- data.frame("x" = c(0.01, pp, 999, 1000), "y" = c(0, 0.5, 0.999, 1))
    
        nlmInitial <- list(a = 0.5, power1 = -1, b = -1, power2 = 0.5)
        m <- nlsLM(y ~ a*I(x^power1) + b*I(x^power2),
                   data = ds,
                   start = nlmInitial,
                   trace = F,
                   control = nls.lm.control(maxiter = 1024))
    
        summary(m)$coefficients[,1]
      }
    
      # At the very first time the button is pressed, do the curve fit and using the parameters 
      # from the curve fit, initialize the Convert() function that will be used later on
      observeEvent(input$some_button, {
        curve_fit[['coeffs']] <- CurveFit(pp = 50)
      })
    
      observeEvent(curve_fit[['coeffs']], {
        curve_fit[['Convert']]  <- function(x) {
          (curve_fit[['coeffs']][1])*x^(curve_fit[['coeffs']][2]) + (curve_fit[['coeffs']][3])*x^(curve_fit[['coeffs']][4])
        }
      })
    
    
      # When I try to access either the coefficients from the curve fit or the Convert() 
      # function itself, I get an error:
      output$result1 <- renderPrint({
        if(all(is.na(curve_fit[['coeffs']]))) return('Button not pressed.')
        curve_fit[['coeffs']]
        })
      output$result2 <- renderPrint({
        if(is.na(curve_fit$Convert(3))) return('Button not pressed.')
        curve_fit$Convert(3)
        })
    
    }
    
    shinyApp(ui, server)
    
    Shiny applications not supported in static R Markdown documents

    Created on 2019-10-06 by the reprex package (v0.3.0)