shinyApp not rendering Rmarkdown file as RStudio - r

I'm struggling to understand why shinyApp does not render a Rmarkdown file as done by RStudio, even when Rmarkdown is explicitly defined in app.R.
The Rmd file below has been written in RStudio, and when the "Run document" button is clicked an HTML document is generated with a friendly web of the application, the sidebar, pages, and plots. However, if this is hosted together with an app.R file in shiny-server, some errors are returned and the file rendered lacks of the structure of the original document (eg. sidebar, pages, etc..). This can be generated also by running Rscript --vanilla app.R and going to localhost:port.
Here are the files I'm using:
example.Rmd
---
title: "Example file"
runtime: shiny
theme: simplex
vertical_layout: fill
output:
flexdashboard::flex_dashboard:
orientation: rows
---
```{r setup, include=FALSE}
library(shiny)
library(tidyverse)
library(plotly)
```
Sidebar {.sidebar}
======================================================================
**Options**
```{r opt_general, echo = FALSE}
selectInput("opt_cyl",
label = "Select cyl",
choices = mtcars %>% .$cyl %>% unique %>% sort,
multiple = TRUE,
selected = "4")
sliderInput("opt_qsec", label = "Qsec", min = mtcars$qsec %>% min, max = mtcars$qsec %>% max, value = mtcars$qsec %>% max, step = 0.01)
```
**More options**
```{r opt_dist, echo = FALSE}
checkboxInput("opt_log", label = "Log scale (qsec)", value = FALSE)
```
Explore
======================================================================
```{r global, echo=FALSE}
mtcars$cyl <- as.character(mtcars$cyl)
```
```{r reactive_global, echo=FALSE}
rcars <- reactive({
C <- dplyr::filter(mtcars, cyl==input$opt_cyl, qsec <= input$opt_qsec)
return(C)
})
```
Row
------------------------
### One nice plot
```{r plot1a, echo = FALSE}
uiOutput("r1a")
output$r1a <- renderUI({
plotlyOutput("p1a")
})
output$p1a <- renderPlotly({
P <- mtcars %>% ggplot() + geom_point(aes(x=cyl, y=qsec))
ggplotly(P)
})
```
### Another nice plot
```{r plot1b, echo = FALSE}
uiOutput("r1b")
output$r1b <- renderUI({
plotlyOutput("p1b")
})
output$p1b <- renderPlotly({
P <- rcars() %>% ggplot() + geom_point(aes(x=cyl, y=qsec))
ggplotly(P)
})
```
Row
------------------------
### Second row plot
```{r plot2, echo = FALSE}
uiOutput("r2")
output$r2 <- renderUI({
plotlyOutput("p2")
})
output$p2 <- renderPlotly({
C <- rcars()
if (input$opt_log) C$qsec <- log(C$qsec)
P <- C %>% ggplot() + geom_point(aes(x=mpg, y=qsec))
ggplotly(P)
})
```
About
======================================================================
Some nice README
The corresponding app.R file is:
library(shiny)
library(knitr)
ui <- shinyUI(
fluidPage(
uiOutput('markdown')
)
)
server <-function (input, output) {
output$markdown <- renderUI({
HTML(markdown::markdownToHTML(knit('example.Rmd', quiet = TRUE)))
})
}
shinyApp(ui, server)
The error returned in the log file is:
Listening on http://127.0.0.1:44229
Warning: Error in : Result must have length 32, not 0
125:
Warning: Error in : Result must have length 32, not 0
100:
Does someone can give me a pointer on why this is happening? Thank you

You can try to mimic the function rmarkdown::run by changing the app.R as below.
library(shiny)
file <- 'example.Rmd'
dir <- dirname(file)
ui <- rmarkdown:::rmarkdown_shiny_ui(dir, file)
render_args <- list()
render_args$envir <- parent.frame()
server <- rmarkdown:::rmarkdown_shiny_server(dir, file, 'UTF-8', T, render_args)
shinyApp(ui, server)

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

Flexdashboard into Shiny

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)

Can't generate R-Markdown report within ShinyApp

I've created ShinyApp where everything works fine. I'd like to add downloadHandler to generate Markdown report that contains the chosen plot. Firstly, I upload a file into ShinyApp. Nextly, I select variables to be plotted using checkBoxInput. Next step is using dropdown list to select between Lattice/ggplot2 plot and finally I'd like to click download it and get it.
Unfortunately, every time I do try to download it I receive a blank Markdown page. It doesn't really matter what format of report will be generated. I'd like to get an appropiate logic for this task. I tried both solutions I found in a network:
output$downloadReport <- downloadHandler(
filename = function() {
paste('my-report', sep = '.', switch(
input$format, PDF = 'pdf', HTML = 'html', Word = 'docx')
)
},
content = function(file) {
src <- normalizePath('report.Rmd')
owd <- setwd(getwd())
on.exit(setwd(owd))
file.copy(src, 'report.Rmd', overwrite = TRUE)
out <- render('report.Rmd', switch(
input$format,
PDF = pdf_document(), HTML = html_document(), Word = word_document()
))
file.rename(out, file)
})
and
output$report <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- file.path(getwd(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(graph = input$graph, colsel = input$colsel)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
So respectively I created report.rmd templates for my app to fullfill it. I tried to put a lot of things inside but none of these works. Do I miss the logic for the template?
---
title: "Untitled"
author: "user"
date: "date"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r plot, echo=TRUE}
plotdata <- reactive({
d <- dataIn()[, c(req(input$colsel))]
d <- melt(d, id.vars="Numer")
})
plot1 <- reactive({
dotplot(value~Numer, data=plotdata(), auto.key = list(space="right", title="Types"), groups=variable)
})
plot2 <- reactive({
ggplot(plotdata(), aes(x=Numer, y=value, color=variable)) +
geom_point()
})
graphInput <- reactive({
switch(input$graph,
"Lattice" = plot1(),
"ggplot2" = plot2())
})
renderPlot({
graphInput()
})
})
```
Alright, I got it finally! Firstly, we need to run shinyApp using function "Run External". Secondly we don't need that mess I made in the template. Simple:
---
title: "Untitled"
author: "user"
date: "date"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
library(ggplot2)
library(lattice)
library(markdown)
```
```{r plot}
plot1()
plot2()
graphInput()
```
Where plot1(), plot2() and graphinput() represent my:
plot1 <- reactive({
dotplot(value~Numer,data=plotdata(), auto.key = list(space="right", title="WWW"), groups=variable)
})
plot2 <- reactive({
ggplot(plotdata(), aes(x=Numer, y=value, color=variable)) +
geom_point()
})
graphInput <- reactive({
switch(input$graph,
"Lattice" = plot1(),
"ggplot2" = plot2()
)
})

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

Resources