我尝试将其简化为一个最小的示例，但我认为我必须或多或少地提供完整的代码来显示问题。
基本上，我希望一个闪亮的应用程序充当用户友好的 GUI，通过 processx 包启动/停止（多个）系统进程（主要是 BASH 脚本，用于科学工作流程）。所以我做了一个闪亮的模块，可以启动/停止并显示一个进程日志（只是从 stderr+stdout 输出）。脚本/命令运行是在调用模块时决定的，而不是在模块本身中。然后重要的是，可以根据脚本运行将其他选项传递给不同的进程，例如选择输入/输出文件夹、数据库文件、设置等。
问题在于，每次单击 actionButton 时，任何附加输入的值都不会更新，因此再次单击开始按钮（触发 eventReactive）只会再次启动该过程而无需新的选项/设置。
我已在此处附加完整代码并在我的 shinyapps.io 帐户上发布了一个示例应用程序，可在此处获得：https ://kasperskytte.shinyapps.io/processxmodule/
library(shiny)
#shiny module to start asynchronous processes using processx package
#shiny must be version 1.4.0.9003 or later to use shiny modules, install from github
installGitHub <- function(...) {
if(!require("remotes")) {
install.packages("remotes")
}
remotes::install_github(...)
}
if(any(grepl("^shiny$", installed.packages()[,1]))) {
if(packageVersion("shiny") < "1.4.0.9003") {
installGitHub("rstudio/shiny")
}
} else
installGitHub("rstudio/shiny")
require("shiny")
require("processx")
processxUI <- function(id) {
shiny::tagList(
uiOutput(NS(id, "startStopBtn")),
p(),
uiOutput(NS(id, "processStatus")),
h4("Process log"),
verbatimTextOutput(NS(id, "processLog")),
downloadButton(NS(id, "downloadLogfile"), label = "Export log file")
)
}
processxServer <- function(id, ...) {
moduleServer(id, function(input, output, session) {
#reactive to store processx R6 class object
process <- reactiveVal()
#reactive to store logfile created on start
logfile <- reactiveVal(tempfile())
#start/stop button
output$startStopBtn <- renderUI({
if(isFALSE(processAlive())) {
actionButton(
inputId = NS(id, "startStopProcess"),
label = "Start process"
)
} else if(isTRUE(processAlive())) {
actionButton(
inputId = NS(id, "startStopProcess"),
label = "Kill process"
)
}
})
#start a new process and logfile when actionbutton is pressed
observeEvent(input$startStopProcess, {
#start process if not already running, otherwise kill
startProcess <- function(...) {
#generate new log file for each new process
logfile(tempfile())
#start process piping stderr+stdout to logfile
process(
processx::process$new(
...,
stderr = "2>&1",
stdout = logfile(),
supervise = TRUE
)
)
}
if(is.null(process()$is_alive))
startProcess(...)
else if(!is.null(process()$is_alive))
if(isTRUE(process()$is_alive()))
process()$kill_tree()
else if(isFALSE(process()$is_alive()))
startProcess(...)
})
#read process status every 500 ms (alive or not)
#(only for updating status message below, otherwise use
# process()$is_alive() to avoid refresh interval delay)
processAlive <- reactivePoll(
intervalMillis = 500,
session = session,
checkFunc = function() {
if(!is.null(process()$is_alive))
process()$is_alive()
else
FALSE
},
valueFunc = function() {
if(!is.null(process()$is_alive))
process()$is_alive()
else
FALSE
}
)
#print status message of process and exit status if finished
output$processStatus <- renderUI({
if(isTRUE(processAlive())) {
p("Process is running...")
} else if(isFALSE(processAlive()) && !is.null(process()$get_exit_status)) {
if(process()$get_exit_status() == 0)
p("Process has finished succesfully")
else if(process()$get_exit_status() == -9)
p("Process was killed")
else if(!process()$get_exit_status() %in% c(0, -9))
p(paste0("Process has errored (exit status: ", process()$get_exit_status(), ")"))
}
})
#read logfile every 500 ms
readLogfile <- reactivePoll(
intervalMillis = 500,
session = session,
checkFunc = function() {
if(file.exists(logfile()))
file.info(logfile())[["mtime"]][1]
else
return('No process has run yet')
},
valueFunc = function() {
if(file.exists(logfile()))
readLines(logfile())
else
return('No process has run yet')
}
)
#print process logfile
output$processLog <- renderText({
readLogfile()
},
sep = "\n")
#export process logfile
output$downloadLogfile <- downloadHandler(
filename = function() {
#append module id and date to logfile filename
paste0("logfile_", id, "_", format(Sys.time(), format = "%y%m%d_%H%M%S"), ".txt")
},
content = function(file) {
file.copy(from = logfile(), to = file)
},
contentType = "text/plain"
)
})
}
ui <- navbarPage(
title = "test",
tabPanel(
title = "Test",
column(
width = 4,
wellPanel(
sliderInput(
NS("process1", "delay"),
"Sleep delay",
min = 1,
max = 5,
step = 1,
value = 2)
)
),
column(
width = 8,
fluidRow(
processxUI("process1")
)
)
)
)
server <- function(input, output, session) {
processxServer(
"process1",
command = "echo",
args = as.character(reactive({input[[NS("process1", "delay")]]})())
)
}
shinyApp(ui = ui, server = server)