是否有可能有一个加载栏或微调器，实时工作需要 运行 闪亮？
Is it possible to have a loading bar or spinner with the real time that job takes to be run in shiny?
我有兴趣在我的 Shiny 应用程序中添加微调器或加载栏。我已经找到并尝试了这些包：shinycssloaders、waiter、shinycustomloader、shinybusy 但是大多数人实现微调器或加载栏的方式包括 1 ) for 循环或 2) 暂停执行一段时间 (sys.sleep) 几秒钟。
1)
withProgress(message = 'Making plot', value = 0, {
# Number of times we'll go through the loop
n <- 10
for (i in 1:n) {
# Increment the progress bar, and update the detail text.
incProgress(1/n, detail = paste("Loading", i*10, "%"))
# Pause for 0.1 seconds to simulate a long computation.
Sys.sleep(0.5)
}
v$plot <- myplot()
Sys.sleep(3)
plot()
但是，它的执行方式是：首先它会花一些时间执行for循环或者sys.sleep（用你决定的时间或者你想要的项目数）放在循环中）和稍后，它显示情节（情节需要花费时间来显示）。
我一直在尝试寻找（没有成功）是否有办法做同样的事情，而不是 putting/selecting 一个特定的时间，使用 plot/table将花钱展示。
有人知道 Shiny 是否可行吗？
以防万一有人想要一个例子，这里就是一个（虽然它很快，因为它没有使用巨大的数据框。这个想法是情节将花费更多时间来显示).
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
非常感谢
此致
进度条根本不需要for循环。它的工作方式是每个命令都像一个黑盒子，因此在函数调用中检查函数的作用并提供反馈，例如：如果您创建了一个数据框，并且数据框在其创建过程中的位置是不可能的。你可以做的是将你的函数分成更小的函数，然后像这样调用它们：
withProgress(message = 'Making plot', value = 0, {
incProgress(1/5, detail = paste("Here we go!"))
doLogTransform(...)
incProgress(1/5, detail = paste("Done with the log"))
doSqurt(...)
incProgress(1/5, detail = paste("Done with the log"))
p <- ggplot2::ggplot(...) # your generic plot
incProgress(1/5, detail = paste("Done with the plot"))
p <- p + labs(...) # your axis labels
incProgress(1/5, detail = paste("Done with cosmetics"))
...
}
通过这种方法，您可以将构建情节的每个步骤分成更小的块，并且在它们之间更新进度条。
这里是你修改后的代码：
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
shiny::withProgress(
message = "Let's plot",
value = 0,
{
cool_data = filtered_data()
shiny::incProgress(
amount = 1/5,
message = "transformation done")
v$plot <- ggplot2::ggplot(
data = cool_data,
mapping = ggplot2::aes_string(
x = input$x_axis,
y = input$y_axis
)
)
shiny::incProgress(
amount = 1/5,
message = "generating plot done")
v$plot <- v$plot + ggplot2::geom_point()
shiny::incProgress(
amount = 1/5,
message = "adding points done")
v$plot <- v$plot + xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
shiny::incProgress(
amount = 1/5,
message = "prettifying plot done")
}
)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
这些包中的大多数不需要预先计算旋转器到 运行 所需的时间。
这里有一个 shinycssloaders 的例子。
library(shiny)
library(DT)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
shinycssloaders::withSpinner(plotOutput("plot")),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2){
data <- log2(data+1)
}
if(input$sqrt){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
我有兴趣在我的 Shiny 应用程序中添加微调器或加载栏。我已经找到并尝试了这些包：shinycssloaders、waiter、shinycustomloader、shinybusy 但是大多数人实现微调器或加载栏的方式包括 1 ) for 循环或 2) 暂停执行一段时间 (sys.sleep) 几秒钟。
1)
withProgress(message = 'Making plot', value = 0, {
# Number of times we'll go through the loop
n <- 10
for (i in 1:n) {
# Increment the progress bar, and update the detail text.
incProgress(1/n, detail = paste("Loading", i*10, "%"))
# Pause for 0.1 seconds to simulate a long computation.
Sys.sleep(0.5)
}
v$plot <- myplot()
Sys.sleep(3)
plot()
但是，它的执行方式是：首先它会花一些时间执行for循环或者sys.sleep（用你决定的时间或者你想要的项目数）放在循环中）和稍后，它显示情节（情节需要花费时间来显示）。
我一直在尝试寻找（没有成功）是否有办法做同样的事情，而不是 putting/selecting 一个特定的时间，使用 plot/table将花钱展示。
有人知道 Shiny 是否可行吗？
以防万一有人想要一个例子，这里就是一个（虽然它很快，因为它没有使用巨大的数据框。这个想法是情节将花费更多时间来显示).
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
非常感谢
此致
进度条根本不需要for循环。它的工作方式是每个命令都像一个黑盒子，因此在函数调用中检查函数的作用并提供反馈，例如：如果您创建了一个数据框，并且数据框在其创建过程中的位置是不可能的。你可以做的是将你的函数分成更小的函数，然后像这样调用它们：
withProgress(message = 'Making plot', value = 0, {
incProgress(1/5, detail = paste("Here we go!"))
doLogTransform(...)
incProgress(1/5, detail = paste("Done with the log"))
doSqurt(...)
incProgress(1/5, detail = paste("Done with the log"))
p <- ggplot2::ggplot(...) # your generic plot
incProgress(1/5, detail = paste("Done with the plot"))
p <- p + labs(...) # your axis labels
incProgress(1/5, detail = paste("Done with cosmetics"))
...
}
通过这种方法，您可以将构建情节的每个步骤分成更小的块，并且在它们之间更新进度条。
这里是你修改后的代码：
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
shiny::withProgress(
message = "Let's plot",
value = 0,
{
cool_data = filtered_data()
shiny::incProgress(
amount = 1/5,
message = "transformation done")
v$plot <- ggplot2::ggplot(
data = cool_data,
mapping = ggplot2::aes_string(
x = input$x_axis,
y = input$y_axis
)
)
shiny::incProgress(
amount = 1/5,
message = "generating plot done")
v$plot <- v$plot + ggplot2::geom_point()
shiny::incProgress(
amount = 1/5,
message = "adding points done")
v$plot <- v$plot + xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
shiny::incProgress(
amount = 1/5,
message = "prettifying plot done")
}
)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
这些包中的大多数不需要预先计算旋转器到 运行 所需的时间。
这里有一个 shinycssloaders 的例子。
library(shiny)
library(DT)
library(ggplot2)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("Shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
mainPanel(
shinycssloaders::withSpinner(plotOutput("plot")),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2){
data <- log2(data+1)
}
if(input$sqrt){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)