我有这个应用程序，它有 selectinput() 和两个选项 Manual 和 Tiempo Real。
Options Manual：当您选择Manual时，您将选择Fecha Inicio和Fecha Fin，您可以做出两个选择：Lanzar Consulta或Cancelar Consulta。第一个将构建一个包含两列 fecha 和 valor 的数据框，当您想要取消第一个按钮时（例如，您的日期有误），将使用第二个按钮。
Options Tiempo Real：当您选择它时，您有一个materialSwitch（），当您单击第一个按钮（Lanzar Consulta）时，它每五秒刷新一次查询，而Cancelar Consulta按钮将用于停止实时并停用选项刷新materialSwithch()。
而且，我希望当将选项手册更改为 tiempo real 或反之亦然时， tablaResult 的结果是干净的。
所以，我想实现这个条件，但闪亮的应用程序的代码没有得到它。我必须更改选择并实施取消按钮。
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(lubridate)
ui <- fluidPage(
useShinyjs(),
sidebarPanel(
selectInput("fecha", "Fecha", choices = c("Manual", "Tiempo Real")),
conditionalPanel("input.fecha == 'Manual'",
airDatepickerInput("ini_manual", label = "Fecha Inicio", value = Sys.time() - 3 * (60 * 60),
addon = 'none', timepicker = TRUE, firstDay = 1,
width = "200px", autoClose = TRUE, timepickerOpts = timepickerOptions(timeFormat = "hh:ii")),
airDatepickerInput("fin_manual", label = "Fecha Fin", value = Sys.time(),
addon = 'none', timepicker = TRUE, firstDay = 1,
width = "200px", autoClose = TRUE, maxDate = NULL, timepickerOpts = timepickerOptions(timeFormat = "hh:ii"))
),
conditionalPanel("input.fecha == 'Tiempo Real'",
materialSwitch(inputId = "refresh", label = "Tiempo Real", value = TRUE, status = "success")
),
actionButton("btnConsulta", "Lanzar Consulta"),
actionButton("btnCancelarConsulta", "Cancelar Consulta")
),
mainPanel(
tableOutput("tablaResultado")
)
)
server <- function(input, output, session) {
# Reactive variable to store the last update time in real time
last_refresh_time <- reactiveVal(NULL)
# Reactive event for query button and real time
consulta_evento <- eventReactive(input$btnConsulta,
{
if (input$fecha == "Manual") {
# Get fecha_ini and fecha_fin
fecha_ini <- input$ini_manual
fecha_fin <- input$fin_manual
# Make data frame
resultado <- data.frame(
fecha = as.character(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")),
Valor = rnorm(length(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")))
)
resultado
} else {
last_refresh_time(Sys.time())
# Realizar la lógica de la consulta para tiempo real aquí
consulta_tiempo_real <- data.frame(
fecha = as.character(seq.POSIXt(from = Sys.time(), by = "hour", length.out = 5)),
Valor = rnorm(5)
)
consulta_tiempo_real
}
}
)
# Update real time with JS
observe({
if (input$fecha == "Tiempo Real" && input$refresh == TRUE) {
shinyjs::runjs(
'consultaInterval = setInterval(function() { Shiny.setInputValue("btnConsulta", Math.random(), {priority: "event"}); }, 5000);'
)
}
else if (input$fecha == "Tiempo Real" && input$refresh == FALSE){
shinyjs::runjs('clearInterval(consultaInterval);')
output$tablaResultado <- renderTable({
data.frame(NULL)
})
}
else{
consulta_evento()
}
})
output$tablaResultado <- renderTable({
req(input$btnConsulta)
consulta_evento()
})
}
shinyApp(ui, server)
我希望获得有关如何处理此问题的指导。
我不完全理解您的问题和您的应用程序，因此我的答案很可能不完整和/或不是您期望的答案。在这种情况下，请发表评论告诉我我做错了什么，我会更新我的答案。
首先，有几点评论。这是行不通的：
shinyjs::runjs(
'consultaInterval = setInterval(function() { Shiny.setInputValue("btnConsulta", Math.random(), {priority: "event"}); }, 5000);'
)
}
......
shinyjs::runjs('clearInterval(consultaInterval);')
因为两个不同
shinyjs::runjs此外，
btnConsultainput$btnConsultaShiny.setInputValue("btnConsulta"在观察结束时，您有：
else{
consulta_evento()
}
但是
consulta_evento()consulta_eventoconsulta_evento(data.frame(NULL))现在，这是我的解决方案。将下面的 JavaScript 代码保存在应用程序中 www 子文件夹中的文件 refresh.js 中：
$(document).ready(function() {
let intervalId;
let $switch = $("#refresh");
let $select = $("#fecha");
let $cancel = $("#btnCancelarConsulta");
function refresh() {
intervalId = setInterval(function() {
Shiny.setInputValue("observe", true, {priority: "event"});
}, 5000);
}
function stopRefresh() {
if(intervalId) {
clearInterval(intervalId);
intervalId = null;
Shiny.setInputValue("clear", true, {priority: "event"});
$switch.prop("checked", false);
}
}
if($select.val === "Tiempo Real") {
if($switch.prop("checked")) {
refresh();
} else {
stopRefresh();
}
} else {
stopRefresh();
}
$cancel.on("click", function() {
stopRefresh();
});
$switch.on("change", function() {
if($select.val() === "Tiempo Real") {
if($switch.prop("checked")) {
refresh();
} else {
stopRefresh();
}
}
});
$select.on("change", function() {
if($select.val() === "Manual") {
stopRefresh();
}
});
});
这是闪亮的应用程序：
library(shiny)
library(shinyWidgets)
library(lubridate)
ui <- fluidPage(
tags$head(tags$script(src = "refresh.js")),
sidebarPanel(
selectInput("fecha", "Fecha", choices = c("Manual", "Tiempo Real")),
conditionalPanel(
"input.fecha == 'Manual'",
airDatepickerInput("ini_manual", label = "Fecha Inicio", value = Sys.time() - 3 * (60 * 60),
addon = 'none', timepicker = TRUE, firstDay = 1,
width = "200px", autoClose = TRUE, timepickerOpts = timepickerOptions(timeFormat = "hh:ii")),
airDatepickerInput("fin_manual", label = "Fecha Fin", value = Sys.time(),
addon = 'none', timepicker = TRUE, firstDay = 1,
width = "200px", autoClose = TRUE, maxDate = NULL, timepickerOpts = timepickerOptions(timeFormat = "hh:ii"))
),
conditionalPanel(
"input.fecha == 'Tiempo Real'",
materialSwitch(
inputId = "refresh", label = "Tiempo Real", value = TRUE, status = "success"
)
),
actionButton("btnConsulta", "Lanzar Consulta"),
actionButton("btnCancelarConsulta", "Cancelar Consulta")
),
mainPanel(
tableOutput("tablaResultado")
)
)
server <- function(input, output, session) {
# Reactive variable to store the last update time in real time
last_refresh_time <- reactiveVal(NULL)
consulta_evento <- reactiveVal(data.frame(NULL))
# Reactive event for query button and real time
observeEvent(
list(input$btnConsulta, input$observe),
{
if(input$fecha == "Manual") {
# Get fecha_ini and fecha_fin
fecha_ini <- input$ini_manual
fecha_fin <- input$fin_manual
# Make data frame
resultado <- data.frame(
fecha = as.character(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")),
Valor = rnorm(length(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")))
)
consulta_evento(resultado)
} else {
last_refresh_time(Sys.time())
# Realizar la lógica de la consulta para tiempo real aquí
consulta_tiempo_real <- data.frame(
fecha = as.character(seq.POSIXt(from = Sys.time(), by = "hour", length.out = 5)),
Valor = rnorm(5)
)
consulta_evento(consulta_tiempo_real)
}
}
)
observeEvent(input$clear, {
consulta_evento(data.frame(NULL))
})
output$tablaResultado <- renderTable({
consulta_evento()
})
}
shinyApp(ui, server)