Как я могу изменить глобальные переменные в RShiny, используя кнопки от пользователя?

Question

В последнее время я много боролся с примером ниже. В самом базовом формате у меня есть кнопка some_button и вывод result. Когда пользователь взаимодействует с платформой, я намерен запустить метод подбора кривой (из пакета minpack.lm) и использовать четыре параметра, выведенных из метода подбора кривой, для инициализации функции Convert(). Чтобы достичь этого, моя идея состояла в том, чтобы инициализировать пустую реактивную переменную для хранения коэффициентов (curvefit_coeff) и пустую функцию Convert(). Затем я использую observeEvent с параметром once, установленным на TRUE, чтобы он работал только один раз. Поэтому этот прогон должен инициализировать как мои curvefit_coeff, так и мои Convert() функции, - подумал я. Однако я не могу «вынуть» эти значения из observeEvent, кажется. Я попытался вывести их, используя winDialog, а также текстовый вывод result, но у меня всегда получалось следующее сообщение об ошибке:

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)

Answer 1

Хорошо, здесь происходит несколько вещей. Прежде всего, если вы хотите отобразить две вещи в выводе, у вас должны быть две разные выходные переменные. Далее вы получите сообщение об ошибке, непосредственно назначая вектор выходной переменной (ам). Если вы хотите отобразить то, что вы обычно видите при запуске чего-либо в консоли, вы должны использовать renderPrint в сочетании с textOutput. Если вы выполняете обработку и получаете cat -подобный вывод, вы бы хотели вместо этого использовать renderText. Наконец, вы не хотите переопределять значения reactive с помощью оператора присваивания (<-) изнутри observeEvent - вам нужно только обновить значение (что не делается с помощью оператора присваивания). Я бы предложил использовать reactiveValues для отслеживания всего, что вам нужно для этого набора операций и вывода, следующим образом.

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)

Блестящие приложения, не поддерживаемые в статических документах R Markdown *

^{Создано в 2019-10-06 при представлении пакета (v0.3.0)}