I am trying to use tabs in an Rmarkdown document together with plots. But I can't seem to get the plot in the second tab to display. See the attached sample code for an example. If I remove {.tabset}, then everything would display fine.
I think if i can force a refresh within the shinyApp when switching tabs, that probably would do the trick, but I can't figure out how to do that.
---
title: "Test"
output:
html_document:
toc: true
theme: united
runtime: shiny
---
# Main Page {.tabset}
## Page 1
```{r, echo=FALSE}
require(plotly)
require(dplyr)
shinyApp(
ui = fluidPage(
titlePanel("Page 1"),
mainPanel(fluidRow(plotlyOutput("plot"))
)),
server = function(input, output) {
output$plot = renderPlotly({
data.frame(x=seq(1,10)) %>% mutate(y=2*x) %>% plot_ly(x=x, y=y, mode="markers+lines")
})
},
options=list(height=500)
)
```
## Page 2
```{r, echo=FALSE}
shinyApp(
ui = fluidPage(
titlePanel("Page 2"),
mainPanel(fluidRow(plotlyOutput("plot"))
)),
server = function(input, output) {
output$plot = renderPlotly({
data.frame(x=seq(1,5)) %>% mutate(y=3*x-2) %>% plot_ly(x=x, y=y, mode="markers+lines")
})
},
options=list(height=500)
)
```
Related
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
I am trying to adapt the RMarkdown file with *.rmd extension into Shiny application. My file has elements of Shiny but works with flexdashboard. Below you can see the code.
---
title: "Test"
author: " "
output:
flexdashboard::flex_dashboard:
orientation: columns
social: menu
source_code: embed
runtime: shiny
editor_options:
markdown:
wrap: 72
---
# Module 1
```{r global, include=FALSE}
library(biclust)
data(BicatYeast)
set.seed(1)
res <- biclust(BicatYeast, method=BCPlaid(), verbose=FALSE)
```
## Inputs {.sidebar}
```{r}
selectInput("clusterNum", label = h3("Cluster number"),
choices = list("1" = 1, "2" = 2),
selected = 1)
```
## Row {.tabset}
### Parallel Coordinates
```{r}
num <- reactive(as.integer(input$clusterNum))
renderPlot(
parallelCoordinates(BicatYeast, res, number=num()))
```
### Data for Selected Cluster
```{r}
renderTable(
BicatYeast[which(res#RowxNumber[, num()]), which(res#NumberxCol[num(), ])]
)
```
The shiny app usually has two main parts first is ui and second is server, so can anybody help how to solve this problem and run this file as a Shiny app.
library(shiny)
library(biclust)
ui <- fluidPage(
selectInput("clusterNum",
label = h3("Cluster number"),
choices = list("1" = 1, "2" = 2),
selected = 1
),
plotOutput("plot"),
tableOutput("table")
)
server <- function(input, output, session) {
set.seed(1)
data(BicatYeast)
res <- biclust(BicatYeast, method = BCPlaid(), verbose = FALSE)
num <- reactive(as.integer(input$clusterNum))
output$plot <-
renderPlot(
parallelCoordinates(BicatYeast, res, number = num())
)
output$table <-
renderTable(
BicatYeast[which(res#RowxNumber[, num()]), which(res#NumberxCol[num(), ])]
)
}
shinyApp(ui, server)
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
I am trying to combine flexdashboard with Shiny state bookmarking. When used alone (example from the docs) Shiny app works fine, but when put in flexdasboard, url is not updated:
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
shinyApp(
ui=function(req) {
fluidPage(
textInput("txt", "Text"),
checkboxInput("chk", "Checkbox")
)
},
server=function(input, output, session) {
observe({
# Trigger this observer every time an input changes
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
},
enableBookmarking = "url"
)
```
Is this even possible? Compared to standalone execution:
shinyApp(
ui=function(req) {
fluidPage(
textInput("txt", "Text"),
checkboxInput("chk", "Checkbox")
)
},
server=function(input, output, session) {
observe({
# Trigger this observer every time an input changes
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
},
enableBookmarking = "url"
)
it looks like onBookmarked (and similar events like onBookmark, onRestore and onRestored) are never triggered.
Bookmarking isn't supported in Shiny apps embedded in R Markdown documents.
See discussion here: https://github.com/rstudio/shiny/pull/1209#issuecomment-227207713
Sounds like it's technically possible, but tricky to do. For example, what happens if there are multiple apps embedded in the document? Also, apps are embedded as iframes, so there would have to be some wiring up to be done to allow these apps to access/modify their parent window's URL.
However, bookmarking does work with embedded Shiny components (rather than full applications).
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
enableBookmarking("url")
```
```{r, include=FALSE}
observe({
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
output$content <- renderUI({
tagList(
textInput("txt", "Text"),
checkboxInput("chk", "Checkbox")
)
})
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
fluidPage(
uiOutput("content"),
selectInput("sel", label = "Select", choices = c(10, 20, 30), selected = 10)
)
```
You can also use Prerendered Shiny Documents, although bookmarking would not work 100% the same since the UI is pre-rendered. Any static UI would have to be manually restored with bookmarking callbacks, but dynamic UI would be restored just fine.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny_prerendered
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
enableBookmarking("url")
```
```{r, context="server"}
observe({
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
# Static inputs are pre-rendered, and must be manually restored
onRestored(function(state) {
updateSelectInput(session, "sel", selected = state$input$sel)
})
# Dynamic inputs will be restored with no extra effort
output$content <- renderUI({
tagList(
textInput("txt", "Text"),
checkboxInput("chk", "Checkbox")
)
})
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
fluidPage(
uiOutput("content"),
selectInput("sel", label = "Select", choices = c(10, 20, 30), selected = 10)
)
```
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")
})
```