Я хочу создать реактивный фрейм данных, который может быть запущен для заполнения результатами цикла for

Question

По сути, я хочу сделать этот R-сюжет интерактивным. http://rblogbyjordan.com/posts/solving-a-differential-equation-numerically-with-r/

У меня проблемы с фреймом данных результатов

---

Выход: html_document

время работы: блестящий

library(shiny)
library(ggplot2)

Определить пользовательский интерфейс для приложения

ui <- fluidPage(# Application title
  titlePanel("Pendulum."),

  # Sidebar with a slider input for mass
  sidebarLayout(
    sidebarPanel(
      sliderInput(
        "mass",
        "Mass:",
        min = 1,
        max = 50,
        value = 25
      ),
      sliderInput(
        "length",
        "Length:",
        min = 1,
        max = 50,
        value = 3
      ),
      sliderInput(
        "theta0",
        "Starting Theta:",
        min = 1,
        max = 180,
        value = 60
      ),
      sliderInput(
        "theta_dot0",
        "Starting Theta dot:",
        min = 0,
        max = 10,
        value = 0
      ),
      sliderInput(
        "time",
        "how long do you want to observe the pendulum:",
        min = 1,
        max = 30,
        value = 15
      )
    ),

    # Show a plot of the generated distribution
    mainPanel(plotOutput("linePlot"))
  ))

Определение логики сервера

server <- function(input, output) {


  #constants 
  g <- 9.82 #Gravitational constant
  mu <- .1 # Mu represents the loss of energy due to air resistance+


  # reactive function that finds theta dub dot
  theta_dubdot <- reactive(function(theta, theta_dot) {
    return(-mu * theta_dot - (input$mass * g / input$length) * sin(theta)) 
  })

  # reactive function that finds theta 
  find_theta <- reactive(function(t.end) {
    theta <- input$theta0
    theta_dot <- input$theta_dot0
    delta.t <- .001
    for (t in seq(from = 0, to = t.end, by = delta.t)) {
      theta <- theta + theta_dot * delta.t
      theta_dot <- theta_dot + theta_dubdot()(theta, theta_dot) * delta.t 
    }
    return(theta)
  })

  # creating a data frame to hold the results
  rv <- reactiveValues(
          result = data.frame("t" = seq(0, input$time , .1),
               "theta" = seq(0, input$time , .1)))

  # fill the data frame with the results every time input$time is changed
  observeEvent(input$time,{
    index <- 0
    for (i in seq(0, input$time, .1)) {
      index <- index + 1
      rv$result()[index, ]$theta <- find_theta()(i) 
    }

  })


  output$linePlot <- renderPlot
  ({
    # draw the plot with the specified parameters
    ggplot(rv$result(), aes_string(t, theta * input$length)) +
      geom_line() +
      theme_dark() +
      xlab("time") +
      ylab("Theta * Length")  # creating the plot

  })
}

Запустите приложение

shinyApp(ui = ui, server = server)

ожидаемые результаты будут интерактивным графиком, который изменяется в зависимости от начальных параметров

фактический результат - ошибка:

Warning: 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.)
  59: stop
  58: .getReactiveEnvironment()$currentContext
  57: .subset2(x, "impl")$get
  56: $.reactivevalues
  50: server [#27]
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.)

Answer 1

Джордан,

Я отладил ваш код, как показано ниже.Обратитесь к комментарию в server.R для изменений, которые я сделал.По сути, reactiveValues() может принимать только статические значения, поскольку они являются реактивными исходными объектами.Таким образом, ваш rv$result должен быть определен с reactive().Для получения более подробной информации обратитесь к этой документации: https://shiny.rstudio.com/articles/reactivity-overview.html. Надеюсь, это поможет.

# Load required packages --------------------------------------------------
library(shiny)
library(ggplot2)

# Build ui.R --------------------------------------------------------------
defaultTime <- 1  ## Changed it to 1 for rapid debugging
ui <- fluidPage(# Application title
  titlePanel("Pendulum."),
  # Sidebar with a slider input for mass
  sidebarLayout(
    sidebarPanel(
      sliderInput(
        "mass",
        "Mass:",
        min = 1,
        max = 50,
        value = 25
      ),
      sliderInput(
        "length",
        "Length:",
        min = 1,
        max = 50,
        value = 3
      ),
      sliderInput(
        "theta0",
        "Starting Theta:",
        min = 1,
        max = 180,
        value = 60
      ),
      sliderInput(
        "theta_dot0",
        "Starting Theta dot:",
        min = 0,
        max = 10,
        value = 0
      ),
      sliderInput(
        "time",
        "how long do you want to observe the pendulum:",
        min = 1,
        max = 30,
        value = defaultTime
      )
    ),

    # Show a plot of the generated distribution
    mainPanel(plotOutput("linePlot"))
  ))

# Build server.R ----------------------------------------------------------
server <- function(input, output) {
  #constants 
  g <- 9.82 #Gravitational constant
  mu <- .1 # Mu represents the loss of energy due to air resistance+

  # reactive function that finds theta dub dot
  theta_dubdot <- reactive(function(theta, theta_dot) {
    return(-mu * theta_dot - (input$mass * g / input$length) * sin(theta)) 
  })

  # reactive function that finds theta 
  find_theta <- reactive(function(t.end) {
    theta <- input$theta0
    theta_dot <- input$theta_dot0
    delta.t <- .001
    for (t in seq(from = 0, to = t.end, by = delta.t)) {
      theta <- theta + theta_dot * delta.t
      theta_dot <- theta_dot + theta_dubdot()(theta, theta_dot) * delta.t 
    }
    return(theta)
  })

  # creating a data frame to hold the results
  # rv <- reactiveValues(
  #   result = data.frame("t" = seq(0, input$time , .1),
  #                       "theta" = seq(0, input$time , .1)))

  # fill the data frame with the results every time input$time is changed
  # observeEvent(input$time,{
  #   index <- 0
  #   for (i in seq(0, input$time, .1)) {
  #     index <- index + 1
  #     rvResult()[index, ]$theta <- find_theta()(i) 
  #   }
  #   
  # }) 

  ### rv$result uses input$time so it needs to be reactive() not reactiveValues()
  rvResult <- reactive({
    req(input$time)
    outputDF <- data.frame("t" = seq(0, input$time , .1),
                           "theta" = seq(0, input$time , .1))
    index <- 0
    for (i in seq(0, input$time, .1)) {
      index <- index + 1
      computedTheta <- find_theta()(i)
      print(computedTheta)
      outputDF$theta[index] <- computedTheta 
    }
    return(outputDF)
  })

  output$linePlot <- renderPlot({
    print(rvResult())
    # draw the plot with the specified parameters
    ggplot(rvResult(), aes(t, theta * input$length)) +
      geom_line() +
      theme_dark() +
      xlab("time") +
      ylab("Theta * Length")  # creating the plot
  })
}

# Launch the Shiny app ----------------------------------------------------
shinyApp(ui = ui, server = server, options = list(launch.browser = TRUE))