Jor*_*ong 2 r shiny shinydashboard shinyjs
很抱歉再次问这个问题,但我真的需要解决这个问题(即将达到我在shinyapps.io 上的最大数据限制)。这是我上一个问题的链接 上一个堆栈问题
这是我的演示应用程序的链接。演示应用程序托管在 ShinyApps.io您会注意到该应用程序不会超时。例如,这是我今天这个应用程序的日志。
我已经尝试了上一个问题中向我推荐的所有内容以及timeOut在shinymanager::secure_server()函数中包含参数。
问题似乎在于,shinyapps.io 在 UI 上设置了一个不活动计时器。一旦 UI 处于非活动状态,它就会启动进程超时R。然而,在我们的例子中,UI 在身份验证之前不会启动。这意味着我们的服务器继续运行。
像设置超时 ( setTimeout()) 这样的东西将是一个很好的选择。例如,如果用户在 5 分钟内未进行身份验证,则超时。我最初尝试了 while 循环,但结果并没有按计划进行。
我正在寻找一种在没有活动的情况下使服务器超时的方法。这是我的代码的一个玩具示例。最后,这是 github 上的shinymanager包的链接。闪亮经理
乌鲁木齐
ui <- dashboardPage(
#My UI page and functions
)
shinymanager::secure_app(ui)
Run Code Online (Sandbox Code Playgroud)
服务器R
function(input, output, session){
auth = secure_server(check_credentials = check_credentials(df)) #df is my client database
observeEvent(auth$user,{
#server functions. This only gets run once the user authenticates
}
}
Run Code Online (Sandbox Code Playgroud)
如果未输入凭据,此应用程序将在 120 秒后超时
library(shiny)
library(shinymanager)
inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer; // catches mouse clicks
window.onscroll = resetTimer; // catches scrolling
window.onkeypress = resetTimer; //catches keyboard actions
function logout() {
window.close(); //close the window
}
function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 120000); // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"
# data.frame with credentials info
credentials <- data.frame(
user = c("1", "fanny", "victor", "benoit"),
password = c("1", "azerty", "12345", "azerty"),
# comment = c("alsace", "auvergne", "bretagne"), %>%
stringsAsFactors = FALSE
)
ui <- secure_app(head_auth = tags$script(inactivity),
fluidPage(
# classic app
headerPanel('Iris k-means clustering'),
sidebarPanel(
selectInput('xcol', 'X Variable', names(iris)),
selectInput('ycol', 'Y Variable', names(iris),
selected=names(iris)[[2]]),
numericInput('clusters', 'Cluster count', 3,
min = 1, max = 9)
),
mainPanel(
plotOutput('plot1'),
verbatimTextOutput("res_auth")
)
))
server <- function(input, output, session) {
result_auth <- secure_server(check_credentials =
check_credentials(credentials))
output$res_auth <- renderPrint({
reactiveValuesToList(result_auth)
})
# classic app
selectedData <- reactive({
iris[, c(input$xcol, input$ycol)]
})
clusters <- reactive({
kmeans(selectedData(), input$clusters)
})
output$plot1 <- renderPlot({
palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
"#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
par(mar = c(5.1, 4.1, 0, 1))
plot(selectedData(),
col = clusters()$cluster,
pch = 20, cex = 3)
points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
})
}
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)