Shiny 模块的附加输入仅更新一次
Additional inputs for Shiny module only get updated once
我试着将其归结为一个最小的示例，但我认为我必须提供或多或少的完整代码来说明问题。
基本上我想要一个闪亮的应用程序通过 processx 包充当 start/stop（多个）系统进程（主要是 BASH 脚本，用于科学工作流程）的用户友好 GUI。所以我制作了一个闪亮的模块，可以 start/stop 并显示进程日志（只是从 stderr+stdout 输出）。 script/command 运行 是在调用模块时决定的，而不是在模块本身。然后重要的是，可以根据脚本 运行 将其他选项传递给不同的进程，例如选择 input/output 文件夹、数据库文件、设置等
问题是每次单击 actionButton 时不会更新任何其他输入的值，因此再次单击开始按钮（触发 eventReactive）只会启动在没有新 options/setting.
的情况下再次处理
我已在此处附上完整代码并在我的 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)
错误是您没有将反应传递给您的模块。在行
processxServer(
"process1",
command = "echo",
args = as.character(reactive({input[[NS("process1", "delay")]]})())
)
您在将 reactive 传递给模块之前对其进行评估，因此模块仅在启动时获得默认值。我对其进行了更改，以便将未计算的 reactive 传递给模块，并且仅在您创建 startProcess 函数时对其进行计算。但是，这会使 ... 的灵活性降低，因为现在 startProcess 假设已传递参数 args。
library(shiny)
library("processx")
#shiny module to start asynchronous processes using processx package
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
# make argument list
dots <- list(...)
dots$args <- as.character(dots$args())
arg_list <- c(dots, stderr = "2>&1", stdout = logfile(), supervise = TRUE)
process(
do.call(processx::process$new, arg_list)
)
}
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 = reactive({input[[NS("process1", "delay")]]})
)
}
shinyApp(ui = ui, server = server)
此外，您对 delay 滑块的定义有点超出闪亮模块的概念。 NS 被认为是在模块 ui 中调用的，因此明确区分了哪些元素属于哪个名称空间的定义（但它显然也适用于您的方法）。
我试着将其归结为一个最小的示例，但我认为我必须提供或多或少的完整代码来说明问题。
基本上我想要一个闪亮的应用程序通过 processx 包充当 start/stop（多个）系统进程（主要是 BASH 脚本，用于科学工作流程）的用户友好 GUI。所以我制作了一个闪亮的模块，可以 start/stop 并显示进程日志（只是从 stderr+stdout 输出）。 script/command 运行 是在调用模块时决定的，而不是在模块本身。然后重要的是，可以根据脚本 运行 将其他选项传递给不同的进程，例如选择 input/output 文件夹、数据库文件、设置等
问题是每次单击 actionButton 时不会更新任何其他输入的值，因此再次单击开始按钮（触发 eventReactive）只会启动在没有新 options/setting.
的情况下再次处理我已在此处附上完整代码并在我的 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)
错误是您没有将反应传递给您的模块。在行
processxServer(
"process1",
command = "echo",
args = as.character(reactive({input[[NS("process1", "delay")]]})())
)
您在将 reactive 传递给模块之前对其进行评估，因此模块仅在启动时获得默认值。我对其进行了更改，以便将未计算的 reactive 传递给模块，并且仅在您创建 startProcess 函数时对其进行计算。但是，这会使 ... 的灵活性降低，因为现在 startProcess 假设已传递参数 args。
library(shiny)
library("processx")
#shiny module to start asynchronous processes using processx package
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
# make argument list
dots <- list(...)
dots$args <- as.character(dots$args())
arg_list <- c(dots, stderr = "2>&1", stdout = logfile(), supervise = TRUE)
process(
do.call(processx::process$new, arg_list)
)
}
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 = reactive({input[[NS("process1", "delay")]]})
)
}
shinyApp(ui = ui, server = server)
此外，您对 delay 滑块的定义有点超出闪亮模块的概念。 NS 被认为是在模块 ui 中调用的，因此明确区分了哪些元素属于哪个名称空间的定义（但它显然也适用于您的方法）。