R代码中的Shinyapp在作为网站部署时与在本地运行时运行不同

我有一个闪亮的应用程序，工作得很好，当我从r本地运行它。然而，代码不运行相同后，我已经部署它作为一个网站。

发布的网站不会忽略重复按键，就像我在本地运行闪亮的应用程序时一样。
此外，它保存所有以前的会话。如果我打开网站启动定时器，然后关闭网站，它保存了上一个会话。我希望datatableOutput重置。erikor为我解决了这个问题

下面是我希望应用程序运行的方式，以及当我在Rstudio本地运行它时它是如何运行的:

[<img src="https://i.imgur.com/tPMPHaN.gif" title="Click to enlarge.">]

下面是我使用shinyapp.io部署应用程序后的运行情况

[<img src="https://i.imgur.com/UjmHbsm.gif" title="Click to enlarge.">]

------Background------

这个闪亮的应用程序是我实验室进行实验的计时器。它在按键被按下的持续时间内启动一个计数计时器。按下第一个键后，开始显示"从第一次预试开始的时间间隔:"秒表，这只是一种方式来跟踪已经过去的时间，因为实验第一次开始。

当按下该键时，将重置"Time elapsed: "秒表记录每次试验持续的时间。当键被释放时，它保存了在DT::dataTableOutput("TailFlickTrials")中持有键的时间，并重置了"时间失效"。秒表，这样我们就可以跟踪每次实验之间的时间流逝。

然后在实验结束时我们可以点击"下载数据"按钮，将数据保存为本地的csv文件。

我想把这个应用程序做一个网站，这样我实验室里不习惯使用R的人也可以使用这个。

然而，当我发布这个应用程序作为一个网站，它的功能不一样。它记录重复按键。当我按住一个键时它每毫秒重置一次计时器。我用if (!e.repeat)解决了这个问题。该函数在代码的上下文中是:

tags$script(HTML('document.addEventListener("keypress", function(e) {
if (!e.repeat) {
Shiny.setInputValue("start", e.key == 32, {priority: "event"});
}
}
)

此外，它保存了我关闭选项卡并重新打开网站后以前运行的会话。我希望DT::dataTableOutput("TailFlickTrials")重置每一个新的会话。

必要的库:

# install.packages("shinythemes")
# install.packages("shiny")
# install.packages("DT")
# install.packages("lubridate")
# install.packages("keys")
# install.packages("vtable")
# install.packages('rsconnect')
library(shinythemes)
library(shiny)
library(DT)
library(lubridate)
library(keys)
library(vtable)

代码，很抱歉它很长，我不相信我可以用更少的代码制作一个可重复的问题:

my_options <- options(digits.secs = 3) # setting the digits for the timer to round up to
ui <- fluidPage(
title = NULL,
lang = NULL,
hr(),
tags$script(HTML('document.addEventListener("keypress", function(e) {
if (!e.repeat) {
Shiny.setInputValue("t_exp_timer", e.key == 13, {priority: "event"});
}
}
);
')),
tags$script(HTML('document.addEventListener("keypress", function(e) {
if (!e.repeat) {
Shiny.setInputValue("start", e.key == 32, {priority: "event"});
}
}
);
')),
tags$script(HTML('document.addEventListener("keyup", function(e) {
Shiny.setInputValue("lapsing_timer", e.key == 32, {priority: "event"});
}
);
')),
tags$script(HTML('document.addEventListener("keyup", function(e) {
if (!e.repeat) {
Shiny.setInputValue("reset", e.key == 32, {priority: "event"});
}
}
);
')),
tags$script(HTML('document.addEventListener("keydown", function(e) {
Shiny.setInputValue("stop", e.key == 83, {priority: "event"});
b                            }
);
')),
titlePanel("Tail Flick Latency StopWatch"),
sidebarPanel(
textOutput('stopwatch')
),
sidebarPanel(
textOutput('exp_stopwatch')
),

tags$hr(),
mainPanel(
DT::dataTableOutput("TailFlickTrials")
),
downloadButton('download',"Download the data")
)

#create data frame with 0 rows and 5 columns. this is an empty data frame that will fill with values as they are generate by user
v <- reactiveValues()
v$df <- data.frame(Start_Time = numeric(), 
End_Time = numeric(), 
TimeLapsed = numeric(), 
stringsAsFactors = FALSE)
server <- function(input, output, session) {

exp_timer <- reactiveVal(0)
exp_timer_active <- reactiveVal(FALSE)
timer <- reactiveVal(0)
active <- reactiveVal(FALSE)
tmp_Start_Time <- numeric(0)
tmp_End_Time <- numeric(0)
observe({
invalidateLater(100, session)
isolate({
if(active())
{
timer(round(timer()+0.1,3))
}
})
})

observe({
invalidateLater(100, session)
isolate({
if(exp_timer_active())
{
exp_timer(round(exp_timer()+0.1,2))
}
})
})

# observeEvent for the keydown event
observeEvent(input$start,{
timer(0)
start_timing <- as.numeric(Sys.time())
will_it_work <- as.numeric(Sys.time())
# on keydown event erase values of tmp_End_Time and tmp_Time_Lapsed previous saved
tmp_End_Time <- numeric(0)
# on keydown add one to tmp_Trial
# on keydown, input new values for tmp_Trial, tmp_Trial_Date, and tmp_Start_Time        
tmp_Start_Time <- Sys.time()
# append tmp_Trial, tmp_Trial_date, tmp_Start_time to df
# this method allows for the new row to have NA values for the End_Time and TimeLapsed columns. the code below will append those values to the row. 
new_row <- head(v$df[NA,], 1)
new_row[c('Start_Time')] <- list(Start_Time = tmp_Start_Time)
v$df <- rbind(v$df, new_row)
})

# observeEvent for the keyup event
observeEvent(input$reset,{
timer(0)
start_timing <- as.numeric(Sys.time())
will_it_work <- as.numeric(Sys.time())
# on keyup event erase values of tmp_Trial_Date, and tmp_Start_Time, previously saved
tmp_Start_Time <- numeric(0)
new_row <- head(v$df[NA,], 1)
# on keyup, input new values for tmp_End_Time and tmp_Time_Lapsed
tmp_End_Time <- Sys.time()
tmp_TimeLapsed <- round(as.numeric(difftime(tmp_End_Time, v$df[nrow(v$df), 1], units ="secs")),3)
# on keyup, combine tmp_End_Time and tmp_TimeLapsed into new vector called tmp
# append tmp_End_Time and tmp_Time_Lapsed to df's last row by called nrow() in the row and the last two columns. 
v$df[nrow(v$df), 2] <- tmp_End_Time
v$df[nrow(v$df), 3] <- tmp_TimeLapsed
})
observeEvent(input$lapsing_timer, {active(TRUE)})
output$stopwatch <- renderText({
paste("Time Lapsed: ", seconds_to_period(timer()))
})

observeEvent(input$t_exp_timer, exp_timer_active(TRUE))
output$exp_stopwatch <- renderText({
paste("Time Lapse Since first Pre-Test Trial: ", seconds_to_period(exp_timer()))
})

output$TailFlickTrials <- DT::renderDataTable({ 
v$df
})
output$download <-       
downloadHandler(
filename = function () {
paste("MyData.csv")
},
content = function(file) {
write.csv(v$df, file)
}
)
}
# Run the application 
options(shiny.maxRequestSize=30*1024^2)
options(rsconnect.max.bundle.files = 500000000)
shinyApp(ui = ui, server = server)

我希望部署的网站运行相同的闪亮的应用程序，当我在本地运行它。我希望我的代码和我的问题都是清楚的。

如果我需要提供额外的信息，请告诉我。谢谢!

您之前的运行持久化的原因是您的v变量是全局的，因此将在各个会话之间共享。将v <- reactivevalvalues()和它后面的行放入服务器函数中，然后每个会话将获得自己的数据帧来存储内容。所以不是:

v <- reactiveValues()
v$df <- data.frame(Start_Time = numeric(), 
End_Time = numeric(), 
TimeLapsed = numeric(), 
stringsAsFactors = FALSE)
server <- function(input, output, session) {
...
}

应该是

server <- function(input, output, session) {
v <- reactiveValues()
v$df <- data.frame(Start_Time = numeric(), 
End_Time = numeric(), 
TimeLapsed = numeric(), 
stringsAsFactors = FALSE)
...
}

(不幸的是，我无法重现e.repeat问题，因为当我部署到shinyapps.io时，这会像预期的那样工作)

相关内容

最新更新

热门标签：