r - 在while循环中使用R闪亮服务器控制循环执行

Question

我正在尝试创建一个简单的应用程序，它将循环执行以下操作： 0. 等待开始按钮 1. 系统调用以创建屏幕截图并将其保存到磁盘 2. 将屏幕截图从磁盘渲染到闪亮的输出 3.打印状态“filename - ok” 4. Sys.sleep 例如 5 秒 5. 检查停止按钮是否未激活 - 转到 1。

代码中的这个想法：

ui <- fluidPage(
    titlePanel("My App"),
    sidebarLayout(
        sidebarPanel(
            radioButtons("control", h3("Start/Stop switch"),
                         choices = list("Start" = TRUE, 
                                        "Stop" = FALSE
                         ),selected = TRUE),
            actionButton("go", label = "Go!")
        ),
        mainPanel(
            textOutput("status"),
            imageOutput("image")
        )
    )
)
server <- function(input, output) {
    actionflag <- eventReactive(input$go,{input$control})
    while (actionflag()==TRUE) {
        fname<-gsub("[[:punct:] ]", "", Sys.time())
        system(paste0("screencapture -t jpg -x ~/Documents/Screens/", fname,".jpg"))
        output$status <- renderText({paste(fname,"screen captured")})
        output$image <- renderImage({
            list(src = paste0("~/Documents/Screens/",fname,".jpg"),
                 alt = "Image",
                 width = 400,
                 height = 300)
        }, deleteFile = FALSE)
        Sys.sleep(5)
    }
}

但它不是这样工作的。正式地我得到这个错误： .getReactiveEnvironment()$currentContext() 中的错误：没有活动的反应上下文不允许操作。（你试图做一些只能从反应式表达式或观察者内部完成的事情。）

此外，即使没有控制按钮（while(1==1){execute code}），我也无法在闪亮的服务器中使用 while 循环来不断更改输出。我猜这个'while'实现是完全错误的，所以任何建议都值得赞赏

标签： rshiny

Answer 1

这是一个带有 2 个按钮（开始和停止）的闪亮应用程序。当按下“开始”时，每 5 秒截取一次屏幕截图并在 UI 中呈现。“循环”通过观察我们可以在此示例中的服务器中创建的名为“rv$loop”的反应值来发生。'go' 按钮总是使 'rv$loop' 为 1，'stop' 按钮总是使 'rv$loop' -100。如果 'rv$loop' > 0，则代码将通过在重新触发开始的观察者的末尾始终将 1 添加到 'rv$loop' 来执行并连续运行。

此外，shinyjs包功能“延迟”允许在执行一行代码之前进行时间延迟，而不会使整个 R 会话进入睡眠状态，从而允许将新的屏幕截图加载到浏览器中。要使用 shinyjs，需要在 UI 代码中的某处删除“useShinyJs()”行。

通常闪亮的应用程序只能访问其应用程序目录中包含的某些文件夹，它知道要查看并且默认情况下与应用程序一起启动，例如静态图像/徽标/等的“www”文件夹。要将文件夹添加为资源文件夹，您需要使用“ addResourePath ”使“~/Documents/Screens”在应用程序启动时可用。

此示例应用程序只有在您的机器上有一个“~/Documents/Screens”目录时才能工作。如果需要，取消注释前几行以创建此目录。

library(shiny)
library(shinyjs)

#make sure this directory exists
#uncomment and run if there is no 'Screens' folder in your 'Documents'
# if(!file.exists("~/Documents/Screens")){
#   dir.create("~/Documents/Screens")
# }

ui <- fluidPage(
  useShinyjs(), #make sure to drop this useShinyJs line somewhere in UI
  actionButton("go", label = "Go!"),
  actionButton("stop", label = "Stop!"),
  textOutput('status'),
  uiOutput("image")
)

server <- function(input, output, session) {

  #allow shiny app to access files in this non-shiny app directory folder
  addResourcePath("screen", "~/Documents/Screens")

  #this reactive value rv$loop will serve as our loop starter/stopper
  rv <- reactiveValues(loop = 0)

  #if input go is clicked the loop is started 
  #because the observe event only continues if rv$loop is > 0
  observeEvent(input$go,{
    rv$loop <- 1
  })

  #if input stop is clicked loop is stopped
  #because this makes rv$loop -100, which is < 0 
  #so observe event is not triggered again for the screenshot loop

  observeEvent(input$stop,{
    rv$loop <- -100
  })

  #observe changes in the rv$loop variable
  #only do anything if the rv$loop value is greater than 0
  #if it is triggered the last line adds 1 to rv$loop
  #which re-validates the observeEvent to trigger it again
  #it only stops if input$stop is pushed to make rv$loop -100
   observeEvent(rv$loop, {
     if(rv$loop > 0){
     #add the name of file to a reactive value to access inside/outside of this observe event
     rv$name <- gsub("[[:punct:] ]", "", Sys.time())
     system(paste0("screencapture -t jpg -x ~/Documents/Screens/", rv$name,".jpg"))
     #use shinyjs function 'delay' to wait to add 1
     #or Sys.sleep put everything to sleep and the app 
     #would not load the imaged because it was asleep an
     #did not have enough time. 
     shinyjs::delay(5000, rv$loop <- rv$loop + 1)
     }
   })

output$status <- renderText({paste(rv$name,"screen captured")})
output$image <- renderUI({
  img(src = paste0('screen/', rv$name, '.jpg'))
})

}

shinyApp(ui, server)

PS - 我从来不知道你可以这样截图，我觉得它很整洁。