Embed an external shiny app in another vanilla shiny app - r

I want to embed an external shiny app in another vanilla shiny app and run this app including the nested / embedded app on my local machine.
In RMarkdown this is well documented and can be easily done by using shinyAppDir() in an R chunk within a flexdashboard.
My question is: How can this be done in a pure vanilla shiny context (without relying on RMarkdown and flexdashboard)? I gave it a first try with putting shinyAppDir in a renderUI statement, but that is not working (which makes sense, since the app is not only made of UI, but also contains server logic).
Here is a working example of an embedded shiny app in a flexdashboard:
This is a simple shiny app I want to embed:
library(shiny)
library(dplyr)
shinyApp(ui = fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
textInput("min_e", "min eruptions", min(faithful$eruptions)),
textInput("max_e", "max eruptions", max(faithful$eruptions)),
actionButton(inputId = "OK", label = "OK")
),
mainPanel( plotOutput("distPlot1")
)
)
),
server = function(input, output) {
nbins = reactive({input$OK
isolate(input$bins)})
faithful_filtered = reactive({input$OK
faithful %>% filter(eruptions >= isolate(input$min_e),
eruptions <= isolate(input$max_e))
})
output$distPlot1 <- renderPlot({
x <- faithful_filtered()[, 2] # Old Faithful Geyser data
bins <- seq(min(x), max(x), length.out = nbins() + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
)
And it can be embedded in a flexdashboard like this (if you run this code make sure to first save the app above (as app.R) and enter the correct file path in shinyAppDir()).
---
title: "embedded shiny"
output:
flexdashboard::flex_dashboard:
orientation: column
runtime: shiny
---
```{r, include=FALSE, message=FALSE, context="setup"}
library(flexdashboard)
library(shiny)
```
Input {.sidebar data-width=300}
-------------------------------------
```{r, echo=FALSE, context="render"}
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
actionButton(inputId = "OK", label = "OK")
```
```{r, context="server"}
```
Row
-----------------------------------------------------------------------
### Some plot here
```{r, context="server"}
```
```{r, echo=FALSE}
```
### Another plot here
```{r, context="server"}
```
```{r, echo=FALSE}
```
### Embeded app here
```{r, echo=FALSE}
shinyAppDir(
file.path("file_path_goes_here"), # enter valid file path here
options=list(
width="100%", height=700
)
)
```

Related

Use of conditionalPanel with flexdashboard and runtime shiny to conditionally switch output type based upon column presence

I am trying to conditionally swith shiny output render types in a flexdashboard tab using conditionalPanel as outlined in the Shiny documentation here, by using a reactive output object and making sure it is returned to the browser by using outputOptions(output, [myOutputName], suspendWhenHidden = FALSE). This approach has been suggested in several SO anwsers (e.g. here and here) for full-fledged Shiny apps but I could not find an example for their use in a Shiny document (R markdown). Essentially, I want to test if a selected data set has a certain column (i.e. the column is not null), and make the UI conditionally render the plot based upon the presence of this column. In the toy data below, the list has a known number of items, and it is known which ones have the missing column. When running the document locally, the desired behavior is there (i.e. the set will switch based upon the selection and the conditionalPanel appears to show what I would like it to show), but still the inspector shows the errors that I listed below. Publishing on rstudio connect leads to the interface just not being rendered (because of the same errors, I presume). Are these errors (Error evaluating expression: ouput.evalseplen == true and Uncaught ReferenceError: ouput is not defined) in the inspector a known shiny bug? Or is something deeper going on?
---
title: "fdb_reprex"
author: "FMKerchof"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
inlcudes:
navbar:
- { title: "More info", href: "https://github.com/FMKerckhof", align: right }
fontsize: 9pt
editor_options:
chunk_output_type: console
---
```{r setup, include=FALSE}
# Set knitr options ----
knitr::opts_chunk$set(echo = TRUE)
# load packages ----
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
# toy dataset ----
inputlist <- list(fulliris=iris,
irisnoseplen=iris[,-1],
irisnopetlen=iris[,c(1,2,4,5)])
```
Inputs {.sidebar}
=======================================================================
```{r datasetsel, echo = FALSE}
renderUI(inputPanel(
selectInput("datasetsel", label = "Choose your dataset:",
choices = unique(names(inputlist)),
selected = unique(names(inputlist))[2])
))
selected_data <- reactive({
inputlist[[input$datasetsel]]
}) |> bindEvent(input$datasetsel)
```
Sepals {data-icon="fa-leaf"}
=====================================
Row {.tabset}
-------------------------------------
### Sepal widths
```{r sepwidthplotly, echo=FALSE}
output$p1 <- renderPlotly({
req(selected_data())
p1 <- selected_data() |>
ggplot(aes(y=Sepal.Width,fill=Species,x=Species)) + geom_boxplot() + theme_bw()
ggplotly(p1)
})
plotlyOutput("p1", width = "auto", height = "auto")
```
### Sepal lengths
```{r seplenplotly, echo=FALSE}
output$p2 <- renderPlotly({
if(!is.null(selected_data()$Sepal.Length)){
p2 <- selected_data() |>
ggplot(aes(y=Sepal.Length,fill=Species,x=Species)) + geom_boxplot() + theme_bw()
ggplotly(p2)
}
})
output$noseplentext <- renderText({
if(is.null(selected_data()$Sepal.Length)){
"No Sepal Lengths in the selected dataset"
}
})
output$evalseplen <- reactive({
return(is.null(selected_data()$Sepal.Length))
})
outputOptions(output, "evalseplen", suspendWhenHidden = FALSE)
conditionalPanel(condition = "ouput.evalseplen == true",
textOutput("noseplentext"))
conditionalPanel(condition = "ouput.evalseplen == false",
plotlyOutput("p2",width="auto",height="auto"))
```
From the inspector it becomes clear that the output is not defined, but I explicitly asked for it to be returned by setting suspendWhenHidden to FALSE
My session information: R 4.1.2, shiny 1.7.1, flexdashboard 0.5.2, plotly 4.10.0, ggplot2 2.3.3.5
edit Thanks to the answer below, I realize I made a typo in the conditional statement (ouput in lieu of output), which was also very clear from the error messages.
I think I found a solution, now I do not use the select input to show/hide the conditional panels.
---
title: "fdb_reprex"
author: "FMKerchof"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
inlcudes:
navbar:
- { title: "More info", href: "https://github.com/FMKerckhof", align: right }
fontsize: 9pt
editor_options:
chunk_output_type: console
---
```{r setup, include=FALSE}
# Set knitr options ----
knitr::opts_chunk$set(echo = TRUE)
# load packages ----
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(shinyjs)
# toy dataset ----
inputlist <- list(
fulliris=iris,
irisnoseplen=iris[,-1],
irisnopetlen=iris[,c(1,2,4,5)]
)
```
Inputs {.sidebar}
=======================================================================
```{r datasetsel, echo = FALSE}
renderUI(
inputPanel(
selectInput(
"datasetsel", label = "Choose your dataset:",
choices = unique(names(inputlist)),
selected = unique(names(inputlist))[2]),
)
)
selected_data <- reactive({
inputlist[[input$datasetsel]]
}) |>
bindEvent(input$datasetsel)
```
Sepals {data-icon="fa-leaf"}
=====================================
Row {.tabset}
-------------------------------------
### Sepal widths
```{r sepwidthplotly, echo=FALSE}
output$p1 <- renderPlotly({
req(selected_data())
p1 <- selected_data() |>
ggplot(aes(y=Sepal.Width,fill=Species,x=Species)) +
geom_boxplot() +
theme_bw()
ggplotly(p1)
})
plotlyOutput("p1", width = "auto", height = "auto")
```
### Sepal lengths
```{r seplenplotly, echo=FALSE}
output$p2 <- renderPlotly({
p2 <- selected_data() |>
ggplot(aes(y = Sepal.Length, fill = Species, x = Species)) +
geom_boxplot() +
theme_bw()
ggplotly(p2)
})
output$evalseplen = reactive({
is.null(selected_data()$Sepal.Length)
})
output$noseplentext <- renderText({
"No Sepal Lengths in the selected dataset"
})
outputOptions(output, "evalseplen", suspendWhenHidden = FALSE)
conditionalPanel(
condition = "output.evalseplen",
textOutput("noseplentext")
)
conditionalPanel(
condition = "!output.evalseplen",
plotlyOutput("p2",width="auto",height="auto")
)
```
When you select irisnopetlen or fulliris
When you select irisnoseplen

Embed a website in shiny app using flexdashboard: not working, not reactive

I am trying to make a shinyapp using flexdashboard. The app takes as input a string of text, and then it outputs a website using that input text. I have an example of the app working in standard shiny. My problem is "translating" it to an app using flexdashboard.
Here is my app in standard shiny:
library(shiny)
ui <- fluidPage(titlePanel("Testing"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(9, selectInput("Color", label=h5("Choose a color"),choices=c('red', 'blue'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))
server <- function(input, output) {
observe({
query <- input$Color
test <<- paste0("https://en.wikipedia.org/wiki/",query)
})
output$frame <- renderUI({
input$Color
my_test <- tags$iframe(src=test, height=600, width=535, frameborder = "no")
print(my_test)
my_test
})
}
shinyApp(ui, server)
Here is my attempt trying to get it to work using flexdashboards. I am having problem trying to get the input as a reactive expression to make my output dynamic. I am trying 2 different ways to get the output, but none work.
---
title: "Testing Colors"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(knitr)
lookup <- structure(c("r", "b"), .Names = c("Red", "Blue"))
Column {.sidebar}
-----------------------------------------------------------------------
```{r}
selectInput('Color', label = 'Select a color', choices = lookup, selected = "r")
Column {data-width=600}
-----------------------------------------------------------------------
### Color Web Page
```{r}
observeEvent(input$Color,{
output$url <-renderUI(a(href=paste0("https://en.wikipedia.org/wiki/", input$Color)))
})
Column {data-width=400}
-----------------------------------------------------------------------
### Another webpage
```{r}
selectedColor<- reactive({
color <- input$Color
})
webpage <- renderUI({
include_url(paste0("https://www.wikipedia.org/",selectedColor))
})
webpage
I would certainly appreciate any comments or ideas.
Thanks!
This code gave me a flexdashboard back with the selectInput, I think the alignment of spaces made for errors
---
title: "Testing Colors"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(knitr)
lookup <- structure(c("r", "b"), .Names = c("Red", "Blue"))
```
```{r,}
selectInput('Color', label = 'Select a color', choices = lookup, selected = "r")
```
Column {data-width=600}
-----------------------------------------------------------------------
### Color Web Page
```{r}
observeEvent(input$Color,{
output$url <-renderUI(a(href=paste0("https://en.wikipedia.org/wiki/", input$Color)))
})
```
Column {data-width=400}
-----------------------------------------------------------------------
### Another webpage
```{r}
selectedColor<- reactive({
color <- input$Color
})
webpage <- renderUI({
include_url(paste0("https://www.wikipedia.org/",selectedColor))
})
webpage

read_chunk not working with shiny widget in rmarkdown

I am trying to use function read_chunk along with a shiny widget in Rmarkdown report. The output is an HTML document and runtime: shiny.
When I run the chunks individually it works perfectly fine. But when I use
read_chunk() in my script and then run_chunk t run only one chunk of the source chunk, it throws an error. What I feel is there is a way to interact shiny widget and read chunks. Please help how do I do this.
Error:
Warning: Error in parse: :2:0: unexpected end of input 1:
read_chunk(paste0(params$code_path,"chunk_name.R")
the chunk that I am using is saved at '/loaction/chunk_v1.R'
## #knitr iris_sub
#######################################################################################################################################
#######################################################################################################################################
iris_subset <- subset(iris, Species=='setosa')
#
---
params:
code_chunk: '/location/'
title: "Untitled"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## R Markdown
```{r iris_sub}
read_chunk(paste0(params$code_chunk,"chunk_v1.R"))
```
```{r iris_plot, echo=FALSE}
sample_his <- function(dataset_name){
library(shiny)
shinyApp(
ui=fluidPage(
titlePanel("Iris Dataset"),
sidebarLayout(
sidebarPanel(
radioButtons("p", "Select column of iris dataset:",
list("Sepal.Length"='a', "Sepal.Width"='b', "Petal.Length"='c', "Petal.Width"='d')),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
),
server = function(input, output, session) {
output$distPlot <- renderPlot({
if(input$p=='a'){
i<-1
}
if(input$p=='b'){
i<-2
}
if(input$p=='c'){
i<-3
}
if(input$p=='d'){
i<-4
}
x <- dataset_name[, i]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
)}
```
## Including Plots
```{r pressure, echo=FALSE}
sample_his(iris)
```

Flex dashboard: Input and Outputs in different tabs

I´m a newby with flex-dashboards...
How can I separate in two different tabs the input information and output results? here is a simple example, I am trying to render only the barplot in the second tab "Output"
---
title: "Dashboard"
output:
flexdashboard::flex_dashboard:
runtime: shiny
---
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(WorldPhones)
```
Inputs
=======================================================================
```{r, include=FALSE}
# Shiny module definition (would typically be defined in a separate R script)
# UI function
worldPhonesUI <- function(id) {
ns <- NS(id)
fillCol(height = 600, flex = c(2, 1),
inputPanel(
selectInput(ns("region"), "Region1:", choices = colnames(WorldPhones))
)
)
}
# Server function
worldPhones <- function(input, output, session) {
output$phonePlot <- renderPlot({
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
})
}
```
```{r, eval=TRUE}
# Include the module
worldPhonesUI("phones")
callModule(worldPhones, "phones")
```
Results
=======================================================================
```{r}
worldPhonesUI <- function(id) {
ns <- NS(id)
fillCol(height = 600, flex = c(NA, 1),
plotOutput(ns("phonePlot"), height = "80%")
)
}
```
you forget everything about ui and server functions and put directly objects in chucks like this:
---
title: "Dashboard"
output:
flexdashboard::flex_dashboard:
runtime: shiny
---
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(WorldPhones)
```
Inputs
=======================================================================
```{r}
selectInput("region", "Region1:", choices = colnames(WorldPhones))
```
Results
=======================================================================
```{r}
renderPlot({
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
})
```

exact same shiny code can insert image in shiny but in shiny flexdashboard the image failed to show up

I run the exact same code in both shiny and shiny flexdashboard. The image can be inserted using shiny but failed for shiny flexdashboard. The image is stored in www folder and put in the same directory with the code file.
Does anyone know what the reason behind this would be?
shiny code:
setwd("C:/Users/Desktop/Shiny dashboard")
b=read.csv("table_clusterupdate.csv")
shinyApp(
ui = fluidPage(
img(src="cluster.png", height = 500, width = 900),
fluidPage(DT::dataTableOutput('tbl'))
),
server = function(input, output) {output$tbl = DT::renderDataTable(
b, options = list(lengthChange = FALSE)
)
})
Shiny flexdashboard code:
---
title: "R"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
setwd("C:/Users/Desktop/Shiny dashboard")
b=read.csv("table_clusterupdate.csv")
```
Multidimensional OP cluster
===========================================
```{r}
shinyApp(
ui = fluidPage(
img(src="cluster.png", height = 500, width = 900),
fluidPage(DT::dataTableOutput('tbl'))
),
server = function(input, output) {output$tbl = DT::renderDataTable(
b, options = list(lengthChange = FALSE)
)
})
```

Resources