如何以编程方式过滤通过 iframe 显示的第二个闪亮应用程序的内容

Question

我的应用程序服务器文件如下所示：

packages <- c("shiny", "shinydashboard", "RColorBrewer", "DT", "readxl", "plotly", "shinyanimate", "tidyverse", "shinycssloaders", "gridExtra", "shinyjs", "shinymanager")

lapply(packages, library, character.only = TRUE)

credentials <- data.frame(
  user = c("A", "B", "C"),
  password = c("Admin", "User1", "User2"),
  admin = c(TRUE, FALSE, FALSE),
  permission = c("advanced", "basic", "basic"),
  job = c("CEO", "CTO", "DRH"),
  stringsAsFactors = FALSE)


server <- function(input, output, session) {
  
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  
  # Create reactive values including all credentials
  creds_reactive <- reactive({
    reactiveValuesToList(res_auth)
  })
  
  observeEvent(creds_reactive()$job, {

  data <- subset(data, 
                   grepl(creds_reactive()$job,
                          ignore.case = TRUE,
                          Job))

  
output$ev <- renderUI ({
  data <- subset(data, 
                  grepl(creds_reactive()$job,
                        ignore.case = TRUE,
                        Job))
  tags$iframe(
    seamless = "seamless",
    src = "link to the second application",
    style = "overflow:hiden; overflow-x : hidden; overflow-y : hidden; height:90%; width : 125%; position : absolute; top : 50px; padding : 0;",
    height = "200%", width = "100%",#"100%", #2000, #transform = scale(10),
    #"transform-origin" = "top right",
    frameBorder = "0"
  )})
  })
}

我想在 iframe 中对我的第二个应用程序应用过滤器。

例如，如果 A 连接，我的第二个应用程序中的数据将仅显示 CEO 的行，如果 B 连接，我的第二个应用程序中的数据将仅显示 CTO 的行.....

我的问题是是否可以将此过滤器应用于外部应用程序？

提前感谢您的回答和抽出时间:)。

Answer 1

以下脚本创建了两个闪亮的应用程序： child_app 在单独的后台 R 进程中运行（根据您部署应用程序的方式，这可能不需要），可以通过查询字符串控制（过滤）。

parent_app 在 iframe 中显示 child_app 并根据访问的用户更改查询字符串（iframe 的 src）应用程序（权限级别）：

library(shiny)
library(shinymanager)
library(callr)
library(datasets)
library(DT)

# create child_app --------------------------------------------------------
# which will be shown in an iframe of the parent_app and can be controlled by passing query strings
ui <- fluidPage(
  DT::DTOutput("filteredTable")
)

server <- function(input, output, session) {
  permission <- reactive({shiny::getQueryString(session)$permission})
  
  # req: if child_app is accessed without providing a permission query string nothing is shown
  # "virginica" is default (unknown permission level - query string other than "advanced" / "basic")
  # http://127.0.0.1:3838/?permission=unknown
  output$filteredTable <- DT::renderDT({
    permissionFilter <- switch(req(permission()),
                               "advanced" = "setosa",
                               "basic" = "versicolor",
                               "virginica")
    if(!is.null(permissionFilter) && permissionFilter %in% unique(iris$Species)){
      datasets::iris[datasets::iris$Species == permissionFilter,]
    } else {
      datasets::iris
    }
  })
}

child_app <- shinyApp(ui, server)

# run child_app in a background R process - not needed when e.g. hosted on shinyapps.io
child_app_process <- callr::r_bg(
  func = function(app) {
    shiny::runApp(
      appDir = app,
      port = 3838L,
      launch.browser = FALSE,
      host = "127.0.0.1" # child_app is accessible only locally (or via the iframe)
    )
  },
  args = list(child_app),
  supervise = TRUE
)
# child_app_process$is_alive()

# create parent app -------------------------------------------------------
credentials <- data.frame(
  user = c("admin", "user1", "user2"),
  password = c("admin", "user1", "user2"),
  admin = c(TRUE, FALSE, FALSE),
  permission = c("advanced", "basic", "basic"),
  job = c("CEO", "CTO", "DRH"),
  stringsAsFactors = FALSE)

ui <- fluidPage(
  fluidRow(tags$h2("My secure application"),
  verbatimTextOutput("auth_output"),
  uiOutput("child_app_iframe"))
)

ui <- secure_app(ui)

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })
  
  output$child_app_iframe <- renderUI({
    tags$iframe(
      src = sprintf("http://127.0.0.1:3838/?permission=%s", res_auth$permission),
      style = "border: none;
               overflow: hidden;
               height: 65vh;
               width : 100%;
               position: relative;
               top:15px;
               padding:0;"
      # position: absolute;
    )
    })
}

parent_app <- shinyApp(ui, server, onStart = function() {
  cat("Doing application setup\n")
  onStop(function() {
    cat("Doing application cleanup\n")
    child_app_process$kill() # kill child_app if parent_app is exited - not needed when hosted separately
  })
})

# run parent_app
runApp(appDir = parent_app,
       port = 3939L,
       launch.browser = TRUE,
       host = "0.0.0.0")

请注意Species列：

编辑： 这是避免嵌套 render-functions 的干净 multi-file 方法（与 shiny-server 一起使用时需要进行调整 - 请看我的评论）：

child_app.R:

library(shiny)
library(shinymanager)
library(datasets)
library(DT)

ui <- fluidPage(
  DT::DTOutput("filteredTable")
  )

server <- function(input, output, session) {
  permission <- reactive({shiny::getQueryString(session)$permission})
  
  table_data <- reactive({
    permissionFilter <- switch(req(permission()),
                               "advanced" = "setosa",
                               "basic" = "versicolor",
                               "virginica")
    if(!is.null(permissionFilter) && permissionFilter %in% unique(iris$Species)){
      datasets::iris[datasets::iris$Species == permissionFilter,]
    } else {
      NULL # don't show something without permission
    }
  })
  
  output$filteredTable <- DT::renderDT({
    table_data()
  })
    
}

child_app <- shinyApp(ui, server)

# run parent_app (local deployment)
runApp(
  appDir = child_app,
  port = 3838L,
  launch.browser = FALSE,
  host = "127.0.0.1" # child_app is accessible only locally (or via the iframe)
)

parent_app.R:

library(shiny)
library(shinymanager)
library(datasets)
library(DT)

credentials <- data.frame(
  user = c("admin", "user1", "user2"),
  password = c("admin", "user1", "user2"),
  permission = c("advanced", "basic", "basic"),
  stringsAsFactors = FALSE)

ui <- fluidPage(
  fluidRow(tags$h2("My secure application"),
           verbatimTextOutput("auth_output"),
           uiOutput("child_app_iframe"))
)

ui <- secure_app(ui)

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })
  
  output$child_app_iframe <- renderUI({
    tags$iframe(
      # src = sprintf("child_app_link/child_app/?permission=%s", res_auth$permission), # shiny-server
      src = sprintf("http://127.0.0.1:3838/?permission=%s", res_auth$permission), # local deployment
      style = "border: none;
               overflow: hidden;
               height: 500px;
               width : 95%;
               # position: relative;
               # top:15px;
               # padding:0;
      "
    )
  })
}

parent_app <- shinyApp(ui, server)

# run parent_app (local deployment)
runApp(appDir = parent_app,
       port = 3939L,
       launch.browser = TRUE,
       host = "0.0.0.0")

如何以编程方式过滤通过 iframe 显示的第二个闪亮应用程序的内容

How to programmatically filter contents of a second shiny app displayed via iframe

r

shiny

shiny-server

shinyapps

shinymanager