如果输入之前已写入 RDS 文件,是否可以在 Shiny 应用程序中本地恢复会话?

2024-02-12

我正在开发一个在本地使用的闪亮应用程序。我正在尝试开发一个系统,使用户能够恢复以前的会话。

为此,我从这个入口获取了代码:Shiny 应用程序的保存状态稍后恢复 https://stackoverflow.com/questions/32922190/saving-state-of-shiny-app-to-be-restored-later,它确实有效,但是我希望能够在不同的会话中恢复输入,因此我在代码中添加了一个 fileInput (恢复会话)和一个 downloadButton (保存会话),但不幸的是我无法使其工作。

我的代码如下:

library(shiny)  

ui <- fluidPage(
  textInput("control_label",
            "This controls some of the labels:",
            "LABEL TEXT"),
  numericInput("inNumber", "Number input:", min = 1, max = 20, value = 5, step = 0.5),
  radioButtons("inRadio", "Radio buttons:",
               c("label 1" = "option1",
                 "label 2" = "option2",
                 "label 3" = "option3")),
  fileInput("load_inputs", "Restore Session", multiple = FALSE),
  downloadButton("save_inputs", 'Save Session')
)

server <-  function(input, output,session) { 

  # SAVE SESSION
  output$save_inputs <- downloadHandler(
    filename = function() {
      paste("session", ".RDS", sep = "")
    },
    content = function(file) {
      saveRDS( reactiveValuesToList(input), file)
    })

  # LOAD SESSION
  load_sesion <- reactive({
    req(input$load_inputs)
    load_session <- readRDS( input$load_inputs$datapath )
  })

  observeEvent(input$load_inputs,{       
    if(is.null(input$load_inputs)) {return(NULL)}

    savedInputs <- load_sesion()
    inputIDs      <- names(savedInputs) 
    inputvalues   <- unlist(savedInputs) 

    for (i in 1:length(inputvalues)) { 
      session$sendInputMessage(inputIDs[i], list(value=inputvalues[[i]]) )
    }
  })}

shinyApp(ui, server)

使用此代码,我可以保存会话的输入,并且可以在下一个会话中读取它们,但是我无法将存储在 RDS 上的这些值用作另一个会话中的输入。

多谢,

Rachael


正如我在上面的评论中所建议的,以下应用程序使用闪亮的内置功能来创建书签,而不是使用自定义函数来保存输入的当前状态。

单击下载按钮后,书签将存储在服务器端,重命名并复制到 downloadHandler。

如果用户上传书签文件,则会根据文件名创建所需的路径,并且用户将被重定向到较早的会话。 (另请参阅注释掉的替代方案,它要求用户主动切换会话)。

当然,您可以实现一个模式来让用户输入会话的名称,以避免使用相当神秘的书签哈希作为文件名。

Edit:实现了一个模式,让用户提供自定义会话名称(仅限字母数字字符)

library(shiny)
library(shinyjs)
library(utils)
library(tools)
library(stringi)

ui <- function(request) {
    fluidPage(
        useShinyjs(),
        textInput("control_label", "This controls some of the labels:", "LABEL TEXT"),
        numericInput("inNumber", "Number input:", min = 1, max = 20, value = 5, step = 0.5 ),
        radioButtons("inRadio", "Radio buttons:", c("label 1" = "option1", "label 2" = "option2", "label 3" = "option3")),
        fileInput("restore_bookmark", "Restore Session", multiple = FALSE, accept = ".rds"),
        actionButton("save_inputs", 'Save Session', icon = icon("download"))
    )
}

server <-  function(input, output, session) {
    latestBookmarkURL <- reactiveVal()
    
    onBookmarked(
        fun = function(url) {
            latestBookmarkURL(parseQueryString(url))
        }
    )
    
    onRestored(function(state) {
        showNotification(paste("Restored session:", basename(state$dir)), duration = 10, type = "message")
    })
    
    observeEvent(input$save_inputs, {
        showModal(modalDialog(
            title = "Session Name",
            textInput("session_name", "Please enter a session name (optional):"),
            footer = tagList(
                modalButton("Cancel"),
                downloadButton("download_inputs", "OK")
            )
        ))
    }, ignoreInit = TRUE)
    
    # SAVE SESSION
    output$download_inputs <- downloadHandler(
        filename = function() {
            removeModal()
            session$doBookmark()
            if (input$session_name != "") {
                
                tmp_session_name <- sub("\\.rds$", "", input$session_name)
                
                # "Error: Invalid state id" when using special characters - removing them:
                tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
                # TODO: check if a valid filename is provided (e.g. via library(shinyvalidate)) for better user feedback
                
                tmp_session_name <- paste0(tmp_session_name, ".rds")
                
            } else {
                paste(req(latestBookmarkURL()), "rds", sep = ".")
            }
        },
        content = function(file) {
            file.copy(from = file.path(
                ".",
                "shiny_bookmarks",
                req(latestBookmarkURL()),
                "input.rds"
            ),
            to = file)
        }
    )
    
    # LOAD SESSION
    observeEvent(input$restore_bookmark, {
        
        sessionName <- file_path_sans_ext(input$restore_bookmark$name)
        targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
        
        if (!dir.exists(dirname(targetPath))) {
            dir.create(dirname(targetPath), recursive = TRUE)
        }
        
        file.copy(
            from = input$restore_bookmark$datapath,
            to = targetPath,
            overwrite = TRUE
        )
        
        restoreURL <- paste0(session$clientData$url_protocol, "//", session$clientData$url_hostname, ":", session$clientData$url_port, session$clientData$url_pathname, "?_state_id_=", sessionName)
        
        # redirect user to restoreURL
        runjs(sprintf("window.location = '%s';", restoreURL))
        
        # showModal instead of redirecting the user
        # showModal(modalDialog(
        #     title = "Restore Session",
        #     "The session data was uploaded to the server. Please visit:",
        #     tags$a(restoreURL),
        #     "to restore the session"
        # ))
    })
    
}

shinyApp(ui, server, enableBookmarking = "server")
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如果输入之前已写入 RDS 文件,是否可以在 Shiny 应用程序中本地恢复会话? 的相关文章

  • par(mfrow=c(1,2)) 不显示并排密度图[重复]

    这个问题在这里已经有答案了 par mfrow c 1 2 plot 1 12 log y plot 1 2 xaxs i 然而 当我尝试做并排密度图时 图会单独输出 load the stud recs dataset library U
  • 如何在R中计算文本中的句子数?

    我使用 R 将文本读入readChar 功能 我的目的是测试文本句子中字母 a 出现次数与字母 b 出现次数一样多的假设 我最近发现了 stringr 包 它帮助我对文本做很多有用的事情 例如计算字符数以及整个文本中每个字母出现的总数 现在
  • 如何对同一列上的数据帧列表中的所有数据帧进行排序?

    我有一个数据框列表dataframes list 举个例子 我把dput dataframes list 在底部 我想对列列表中的所有数据框进行排序enrichment 我可以对一个数据框进行排序 first dataframe lt da
  • 如何在R中删除重复项

    我有一个非常大的数据集 如下所示 df lt data frame school c a a a b b c c c year c 3 3 1 4 2 4 3 1 GPA c 4 4 4 3 3 3 2 2 school year GPA
  • 如何在for循环中引用变量?

    我正在循环访问不同的 data tables 和 data table 中的变量 但我在引用内部变量时遇到问题for loop dt1 lt data table a1 c 1 2 3 a2 c 4 5 2 dt2 lt data tabl
  • R中的一元加/减是什么?

    来自 R 的详细信息部分Syntax http stat ethz ch R manual R patched library base html Syntax html帮助页面 定义了以下一元和二元运算符 他们被列出 在优先级组中 从最高
  • 我无法下载 R 中的 reshape2 包 [关闭]

    Closed 这个问题是无法重现或由拼写错误引起 help closed questions 目前不接受答案 我在尝试安装 R 包时收到此响应 gt installed packages reshape2 Package LibPath V
  • 使用 purrr 迭代替换数据帧列中的字符串

    我想用purrr使用以下命令在数据框列上迭代运行多个字符串替换gsub 功能 这是示例数据框 df lt data frame Year 2019 Text c rep a aa 5 rep a bb 3 rep a cc 2 gt df
  • 多功能测试仪替代 system.time

    我已经看到 我认为是这样 使用了类似于 system time 的函数 它可以同时评估多个函数的时间并输出一个输出 我不记得它是什么 并且用我正在使用的术语进行互联网搜索并没有得到我想要的响应 有人知道我正在谈论的功能的名称 位置吗 你想要
  • 如何使用 usmap 标记数字而不是名称?

    我知道 usmap 有一个选项label in plot usmap 我想标记一些数字 而不是状态名称 我想 usmap 中应该有与州质心坐标相关的数据 但我不知道如何找到它 如果我能得到 坐标然后我可以用它来标记数字geom text 这
  • 将绘图调用拆分为多个块

    我正在编写一个图的解释 其中我基本上将在第一个块中创建图 然后描述该输出 并在第二个块中添加一个轴 然而 似乎每个块都会强制一个新的绘图环境 因此当我们尝试使用以下命令运行块时会出现错误axis独自的 观察 output html docu
  • 为什么 dplyr filter() 不能在函数内工作(即使用变量作为列名)?

    使用 dplyr 函数对数据进行过滤 分组和变异的函数 基本管道序列在函数之外工作得很好 这就是我使用真实列名称的地方 将其放入一个函数中 其中列名称是一个变量 并且某些函数可以工作 但有些函数则不能 尤其是 dplyr filter 例如
  • 在 R 中创建虚拟变量,排除某些情况为 NA

    我的数据看起来像这样 V1 V2 A 0 B 1 C 2 D 3 E 4 F 5 G 9 我想创建一个虚拟变量R where 0 1 1 2 3 4 and NA 0 5 9 应该很简单 有人可以帮忙吗 我们可以转换V2 into a fa
  • Purrr::map_df() 删除 NULL 行

    使用时purrr map df 我偶尔会传递一个数据框列表 其中一些项目是NULL 当我做 map df 返回行数少于原始列表的数据框 我想发生的事情是这样的map df calls dplyr bind rows 它忽略了NULL价值观
  • 将每列的值乘以 R 中另一个 data.frame 中的权重

    我有两个data frames df and weights 代码如下 df看起来像这样 id a b d EE f 1 this 0 23421153 0 02324956 0 5457353 0 73068586 0 5642554 2
  • r 中训练和测试数据的最小最大缩放/归一化

    我正在创建一个函数 它将训练集和测试集作为其参数 最小 最大缩放 标准化并返回训练集并使用这些same最小值和最小 最大范围的值 标准化并返回测试集 到目前为止 这是我想出的功能 min max scaling lt function tr
  • 将数据框中重叠的范围合并到唯一的组中

    我有一个 n 行 3 的数据框 df lt data frame start c 178 400 983 1932 33653 end c 5025 5025 5535 6918 38197 group c 1 1 2 2 3 df sta
  • 基于时间窗口的不规则时间序列的优化滚动函数

    有没有办法使用 rollapply 来自zoo包或类似的东西 优化功能 rollmean rollmedian等 使用基于时间的窗口计算滚动函数 而不是基于大量观察的函数 我想要的很简单 对于不规则时间序列中的每个元素 我想计算一个具有 N
  • 将阴影区域添加到五分位数之间的直方图中

    All 我有一个包含 2 个直方图的图表 其中我还绘制了代表第 20 40 60 和 80 个百分位数的线条 下面的代码使用虚拟数据重现了类似的图表 data lt rbind data frame x rnorm 1000 0 1 g o
  • 更改闪亮 R 中的默认浏览器

    我在 RStudio 中使用 01 hello 虽然在 IE 中默认打开程序时它不会显示直方图 但即使在 Chrome 中 滑块也不起作用 我无法滑动条形图并看到直方图中的变化 如何更改 R 中的默认浏览器 以便闪亮启动 Chrome 而不

随机推荐