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

#r #shiny

#r #блестящий

Вопрос:

В принципе, я хочу сделать этот 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.)

  

Ответ №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))
  

Комментарии:

1. Спасибо за вашу помощь. есть ли у вас какие-либо советы о том, как я могу ускорить этот процесс? Я уже снизил время разности с .001 до .01, и он работает намного быстрее.