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)
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)
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:
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)
- I added an ID for the card
mycard
so I can easily selected with JS. - 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 addid="mycard"
to the card. - 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.
Related Topics
Horizontal/Vertical Line in Plotly
Add Correct Century to Dates With Year Provided as "Year Without Century", %Y
How to Set Multiple Legends/Scales For the Same Aesthetic in Ggplot2
Test If Characters Are in a String
R Shiny Passing Reactive to Selectinput Choices
How to Divide Each Row of a Matrix by Elements of a Vector in R
How to Create an R Function Programmatically
How to Use Reference Variables by Character String in a Formula
Dplyr: Nonstandard Column Names (White Space, Punctuation, Starts With Numbers)
Displaying Text Below the Plot Generated by Ggplot2
Subset a Dataframe Between 2 Dates