更新 R Shiny 中的图形反应
Update Graph in R Shiny react
我想了解为什么图表在从下面的代码生成的 RShiny 应用程序中没有更新。
我尝试做的事情:
- 从具有特定形状参数的 beta 分布生成 n_data 个观察样本。
- 绘制此样本的直方图及其均值。
- 这样做 e_samples 次并保持平均值,每秒显示一个更新的图表
- 绘制向量的直方图 e_samples 均值
library(shiny)
library(ggplot2)
# Design the interface
ui <- fluidPage(titlePanel("Population vs sample"),
sidebarLayout(
# Function to determine the layout
sidebarPanel(
sliderInput(
'shape1',
label = 'Population shape 1:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
sliderInput(
'shape2',
label = 'Population shape 2:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
textInput("n_data", label = "Sample size:",
value = '25'),
textInput("e_samples", label = "number of samples:",
value = '5'),
actionButton("RerunButton", "New sample", icon("play"))
),
mainPanel(plotOutput('Sample'))
))
# Set up the server
server <- function(input, output) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000)
cat(paste('vals', vals(), '\n'))
cat(paste('avgs', avgs(), '\n'))
if (vals() < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
vals(vals() + 1)
averages <- avgs()
averages[vals()] <- mean(temp$d)
avgs(averages)
sample_plot(
ggplot() +
geom_histogram(
data = temp,
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(temp$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
)
}
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}
shinyApp(ui = ui, server = server)
上面的代码只更新图表一次。为什么?
你所有不断变化的 reactiveValues
都会立即反复触发你的 observe
。这种情况连续发生五次,在 1000 毫秒过去之前。为防止这种情况发生,您需要为 reactiveValues
使用 isolate
。看看这是否给出了正确的行为:
# Set up the server
server <- function(input, output, session) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000, session)
#cat(paste('vals', vals(), '\n'))
#cat(paste('avgs', avgs(), '\n'))
if (isolate(vals()) < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
isolate(vals(vals() + 1))
averages <- isolate(avgs())
averages[vals()] <- mean(temp$d)
avgs(averages)
}
})
sample_plot <- reactive({
ggplot() +
geom_histogram(
data = s(),
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(s()$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}
我想了解为什么图表在从下面的代码生成的 RShiny 应用程序中没有更新。
我尝试做的事情:
- 从具有特定形状参数的 beta 分布生成 n_data 个观察样本。
- 绘制此样本的直方图及其均值。
- 这样做 e_samples 次并保持平均值,每秒显示一个更新的图表
- 绘制向量的直方图 e_samples 均值
library(shiny)
library(ggplot2)
# Design the interface
ui <- fluidPage(titlePanel("Population vs sample"),
sidebarLayout(
# Function to determine the layout
sidebarPanel(
sliderInput(
'shape1',
label = 'Population shape 1:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
sliderInput(
'shape2',
label = 'Population shape 2:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
textInput("n_data", label = "Sample size:",
value = '25'),
textInput("e_samples", label = "number of samples:",
value = '5'),
actionButton("RerunButton", "New sample", icon("play"))
),
mainPanel(plotOutput('Sample'))
))
# Set up the server
server <- function(input, output) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000)
cat(paste('vals', vals(), '\n'))
cat(paste('avgs', avgs(), '\n'))
if (vals() < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
vals(vals() + 1)
averages <- avgs()
averages[vals()] <- mean(temp$d)
avgs(averages)
sample_plot(
ggplot() +
geom_histogram(
data = temp,
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(temp$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
)
}
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}
shinyApp(ui = ui, server = server)
上面的代码只更新图表一次。为什么?
你所有不断变化的 reactiveValues
都会立即反复触发你的 observe
。这种情况连续发生五次,在 1000 毫秒过去之前。为防止这种情况发生,您需要为 reactiveValues
使用 isolate
。看看这是否给出了正确的行为:
# Set up the server
server <- function(input, output, session) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000, session)
#cat(paste('vals', vals(), '\n'))
#cat(paste('avgs', avgs(), '\n'))
if (isolate(vals()) < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
isolate(vals(vals() + 1))
averages <- isolate(avgs())
averages[vals()] <- mean(temp$d)
avgs(averages)
}
})
sample_plot <- reactive({
ggplot() +
geom_histogram(
data = s(),
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(s()$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}