Embed Iframe Inside Shiny App

embed iframe inside shiny app

library(shiny)

members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))

ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, selectInput("Member", label=h5("Choose a option"),choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))

server <- function(input, output) {
observe({
query <- members[which(members$nr==input$Member),2]
test <<- paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src=test, height=600, width=535)
print(my_test)
my_test
})
}

shinyApp(ui, server)

R Sample Image 14

Iframe not working correctly in my Shiny App

I think you need the dashBoardBody inside the dashboardPage.

As far as I can see your current code isn't doing that.

library(shiny)
library(shinydashboard)


ui <-
dashboardPage(
skin = "black",
dashboardHeader(title = "CPV Dashboard ", titleWidth = 450),
dashboardSidebar(sidebarMenu(
menuItem(
"Tab 1",
tabName = "tab 1",
icon = icon("medicine"),
menuItem("Cell Culture",
menuItem("Control Chart"))
)
)),

dashboardBody(mainPanel(fluidRow(htmlOutput("frame"))
),

))

server = function(input, output, session) {
observe({
test <<- paste0("https://google.com") #sample url
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src = test,
height = 800,
width = 800)
print(my_test)
my_test
})
}
shinyApp(ui, server)

Embed weather iframe into Shiny Dashboard

Update with inserted dashboard

I transfered url from server to ui:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
)
)
),

dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
fluidRow(
tags$iframe(
seamless = "seamless",
src = "https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston",
height = 800, width = 1400
)
)
)
)
)
)

server <- function(input, output) {}
shinyApp(ui, server)

R Sample Image 15

Shiny Iframe not showing any website

So the problem you are facing is that the site you were referencing to had the X-Frame-Options set to sameorigin. This means that iframes are basically blocked by the https://www.google.co.in server.

You can see a corresponding error message in the javascript console which can be acessed with Ctrl+shift+K in google chrome. For other browsers see here.

Certain workarounds and morde discussion about the X-Frame-Options issue can be found in this question.

How can you pass a url to an iframe via textInput() in r shiny?

You can do like this:

library(shiny)
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
textInput("url", label = "Enter url"),
actionButton("go", "Go")
),
mainPanel(
htmlOutput("frame")
)
))

server <- function(input, output) {
output$frame <- renderUI({
validate(need(input$go, message=FALSE))
tags$iframe(src=isolate(input$url), height=600, width=535)
})
}

shinyApp(ui, server)

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

The following script creates two shiny apps:
The child_app is running in a seperate background R process (depending on how you deploy your app this might not be needed), which can be controlled (filtered) via query strings.

The parent_app displays the child_app in an iframe and changes the query string (iframe's src) depending on the user accessing the app (permission level):

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")

Please note the Species column:

result


Edit: Here is a clean multi-file approach avoiding nested render-functions (This needs to be adapted when used with shiny-server - please see my comments):

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")

Embed R Variable in Shiny HTML

Since the card comes from your custom HTML, not standard card components from Shiny or other Shiny extension packages. We can use shinyjs package to send the variable to UI and run some simple Javascript to update the value.

library(shiny)
library(bslib)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(
theme = bs_theme(bootswatch = "flatly"),
title = 'Methods',
tabPanel('One'),
),
mainPanel(
h1('Hello World'),
HTML(
'
<div class="card text-center">
<div class="card-header">
Featured
</div>
<div class="card-body">
<h5 class="card-title">Special title treatment</h5>
<p id="mycard" class="card-text">I want to put an R variable here</p>
<a href="#" class="btn btn-primary">Go somewhere</a>
</div>
<div class="card-footer text-muted">
2 days ago
</div>
</div>
'
)
)
)

library(shiny)
library(bslib)
server <- function(input, output) {
observe({
myVariable <- 2^2
runjs(paste0('$("#mycard").text("', myVariable, '")'))
})
}

shinyApp(ui, server)
  1. I added an ID for the card mycard so I can easily selected with JS.
  2. For easy to reproduce, I changed your foo.html to a HTML() tag, which is the same, you can continue to use your foo.html, but remember to add id="mycard" to the card.
  3. So here you didn't give us under what condition the update is triggered, so I directly computed the value from server and send to UI update at start. Change according to your real case.

Sample Image



Related Topics



Leave a reply



Submit