#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, и он работает намного быстрее.