Question

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

   observeEvent(input$run1, {
   prog <- Progress$new(session)
   prog$set(message = "Analysis in progress",
         detail = "This may take a while...",
         value = NULL)

  fut1 = future({
  system(paste("Command1" , input$file ">", "out1.txt"))

  system(paste("Command2" , out1.txt ">", "out2.txt"))
  head_rows <- read.delim("out2.txt")
    return(head_rows)
    }) %...>%
     out1_rows() %>%
  finally( ~ prog$close())
NULL
})


 observeEvent(req(out1_rows()), {
 output$out_table <-
  DT::renderDataTable(DT::datatable(
    out1_rows(),
    )
  ))

observeEvent(input$cancel, {
    async_pid <- fut1$job$pid  ##this is empty
    #async_pid <- Sys.getpid()  ##this return PID for main process and kills "/opt/shiny-server/R/SockJSAdapter.R"  but not for subprocesses inside future()
    system(paste("kill -15", async_pid))
  })
}

在这里，我需要终止在future（）中运行命令的进程。我以上述方式尝试获取运行future（）进程的PID，并在触发input$cancel时将其杀死。但是，fut1$job$pid不返回任何PID值，因此终止操作不成功。

此链接from future vignettes显示了如何为future（）作业获取PID。但是，在我的情况下，我无法在future（）中使用Sys.getpid()，因为由于该进程已经从我的系统命令中返回了一些输出，因此我不确定如何存储PID值。

此页面future GIT显示了语法fut1$job$pid的另一种外部终止方法。但这无法获取PID。

尝试不同的方法或对语法不了解后，我无法弄清楚。有人可以暗示这样做的方法。

Answer 1

能否请您提供完整的可复制示例？

您可能想看看图书馆（future.callr）：

使用plan(callr)可以获取pid并终止进程，如下所示：

library(future)
library(promises)
library(future.callr)

plan(callr)

myFuture <- future({
  Sys.sleep(5)
  return(runif(1))
})

myFuture$process$get_pid()
myFuture$process$is_alive()

# myFuture$process$kill()
# myFuture$process$is_alive()

then(myFuture, onFulfilled = function(value){
print(value)
}, onRejected = NULL)

编辑-根据您的代码改编：

library(shiny)
library(DT)
library(future)
library(promises)
library(future.callr)
library(shinyjs)
library(V8)

plan(callr)

ui <- fluidPage(
  useShinyjs(),
  titlePanel("Trigger & kill future"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId="run1", label="run future"),
      actionButton(inputId="cancel", label="kill future")
    ),
    mainPanel(
      dataTableOutput('out_table')
    )
  )
)

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

  disable("cancel") 
  out1 <- reactiveValues(rows=NULL)

  observeEvent(input$run1, {

    disable("run1")
    enable("cancel")
    out1$rows <- NULL

    prog <- Progress$new(session)
    prog$set(message = "Analysis in progress",
             detail = "This may take a while...",
             value = NULL)

    fut1 <<- future({
      # system(paste("Command1" , input$file, ">", "out1.txt"))
      # system(paste("Command2" , out1.txt, ">", "out2.txt"))
      # head_rows <- read.delim("out2.txt")
      head_rows <- data.frame(replicate(5, sample(runif(20, 0, 1), 20, rep=TRUE)))
      Sys.sleep(5)
      return(head_rows)
    })

    print(paste("Running async process with PID:", fut1$process$get_pid()))

    then(fut1, onFulfilled = function(value){
      out1$rows <<- value
    }, onRejected = function(error){NULL})

    finally(fut1, function(){
      prog$close()
      disable("cancel")
      enable("run1")
    })

    return(NULL)
  }, ignoreInit = TRUE)


  observeEvent(req(out1$rows), {
    output$out_table <- DT::renderDataTable(DT::datatable(out1$rows))
  })

  observeEvent(input$cancel, {
    async_pid <- fut1$process$get_pid()
    print(paste("Killing PID:", async_pid))
    # system(paste("kill -9", async_pid)) # Linux - kill
    # system(paste("taskkill /f /pid", async_pid)) # Windows - kill
    fut1$process$kill() # library(future.callr) - kill
    out1$rows <- NULL
    disable("cancel")
    enable("run1")
  }, ignoreInit = TRUE)

}

shinyApp(ui = ui, server = server)

偶尔会发生错误：

Unhandled promise error: callr failed, could not start R, exited with non-zero status, has crashed or was killed 
Warning: Error in : callr failed, could not start R, exited with non-zero status, has crashed or was killed 
  95: <Anonymous>

也许@HenrikB的statement告诉我们我们正在遇到什么：

但是，要使其正常工作，您可能还需要您将来的表达式/将来的代码中断感知使用 withCallingHandlers（）等。如果发生以下情况，我也将不知道您连续发出太多中断信号-可能是您管理中断工作人员的主要R循环，这将导致 R工人终止。这将导致缺少R工作者，而您已经遇到了您一开始提到的问题。

here中也提到了该错误，但目前仍在将来。在调用者上下文中，我不知道如何解决该问题。

第二次修改： 现在，我从Henrik Bengtsson得到了更多feedback。他再次提到核心的未来API当前不支持终止期货。因此，最终，无论我们使用哪种后端，都可能会遇到问题。

忽略此信息，我将再看看library(ipc) vignette，其中提供了两个有关杀死长期运行的进程的示例。但是我已经指出了这个here-可能导致了这个question。

最后，对于您的情况，所有这些可能都没有用，因为您正在使用system()调用，这些调用创建了自己的子流程（并相应地具有自己的pid）。因此，为什么不在系统命令中使用wait = FALSE（就像我在评论here中提到的那样）来获取异步行为并使用myCommand & echo $!之类的方法捕获它们的pid（请参见{ {3}}）。这样，您就不需要任何期货。

Answer 2

可以这样插入cat()来找到PID：


future({
   
   cat('future process PID \n', Sys.getpid(), '\')

   <expensive operation>

})

PID号将在运行应用程序时出现在控制台中。这就是我发现在我自己的情况下，将来的内部和外部的PID完全相同的方式。

为R Shiny中的异步期货获取子流程的PID

2 个答案: