I prepared very simple rmarkdown document with shiny widget. I want to add table of content but although I use toc: yes it doesn't work at all, why?
---
title: "Test document"
author: "XXX"
date: "XXX"
output:
html_document:
toc: yes
runtime: shiny
---
```{r, echo = FALSE}
h2('R package')
br()
h3('Ggplot2')
br()
h4('Mtcars')
library(ggplot2)
data(mtcars)
selectInput('name', 'Choose a cylinder:',
choices = sort(unique(mtcars$cyl)),
selected = sort(unique(mtcars$cyl))[1])
data <- reactive(subset(mtcars,cyl == input$name))
number <- reactive(which(sort(unique(mtcars$cyl)) == input$name))
renderPlot(ggplot(data(),aes(qsec, mpg))+
geom_point(size = 6))
```
Your headers need to be outside the code chunk for the table of content to catch them.
You should then use the appropriate numbers of # instead of the html style to visualize the headers size.
Note also that the toc depth default to three, so in your case mtcars won't appear in the toc, unless you adjust the toc_depth to 4.
This should do what you want :
---
title: "Test document"
author: "XXX"
date: "XXX"
output:
html_document:
toc: TRUE
toc_depth: 4
runtime: shiny
---
## R package
### ggplot2
#### mtcars
```{r, echo = FALSE}
library(ggplot2)
data(mtcars)
selectInput('name', 'Choose a cylinder:',
choices = sort(unique(mtcars$cyl)),
selected = sort(unique(mtcars$cyl))[1])
data <- reactive(subset(mtcars,cyl == input$name))
number <- reactive(which(sort(unique(mtcars$cyl)) == input$name))
renderPlot(ggplot(data(),aes(qsec, mpg))+
geom_point(size = 6))
```
Side note : even if it's working it's more common to use toc: TRUE rather than toc: yes
Related
I would like to make an interactive rmarkdown using runtime:shiny in the yaml header.
I load my single-cell Rnaseq data into a sparse matrix and make it reactive using the reactive function. But there is a problem because the data seems to be not reactive.
Below is the code I used:
---
title: ""
author: ""
output:
html_document:
toc: true
runtime: shiny
---
```{r init}
library(shiny)
library(Seurat)
library(Matrix)
library(dplyr)
library(ggplot2)
library(here)
selectInput('Sample',
label = 'Old or Young',
choices = c("old","young"))
matrix_dir <- reactive({here(paste0(input$Sample,"/filtered_feature_bc_matrix/"))})
mat <- reactive({Read10X(data.dir = matrix_dir())})
renderPrint(dim(mat()))
```
When I run these commands, only the selection input is displayed. The renderPrint function no responds.
How to make it reactive?
Thank you in advance for any help
You would need to specify an output element to host that print, for example:
---
title: ""
author: ""
output:
html_document:
toc: true
runtime: shiny
---
```{r init}
library(shiny)
selectInput('Sample',
label = 'Old or Young',
choices = c("old","young"))
```
```{r print, echo=FALSE}
verbatimTextOutput("myprint")
output$myprint <- renderPrint(input$Sample)
```
As the minimal reproducible example below shows, plot 2 appears too late.
How can I fix this?
It seems, the message screws everthing up. Most likely related: this and this.
---
title: "Run all test-cases"
author: "STCH"
date: "`r Sys.Date()`"
output:
html_document:
keep_md: yes
number_sections: yes
toc: yes
toc_depth: 2
code_folding: hide
pdf_document:
number_sections: yes
toc: yes
toc_depth: '2'
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, fig.width = 10)
testfun <- function() {
message("in testfun")
Sys.sleep(10)
plot(3, main = "testfun 3")
return(0)
}
```
# All test cases `decreasing.benefits = TRUE`
```{r}
for (i in 1){#c(1:7)) {
cat("====================================================================\n")
plot(1, main = "1")
print("After plot 1, before plot 2")
plot(2, main = "2")
print("After plot 2, before plot 3 (Wrong!!??, appears BEFORE plot 2)")
r <- testfun()
}
```
From the docs ?message:
message(..., domain = NULL, appendLF = TRUE)
so it seems you can only control the domain (which has to with translation) and the line ending.
I'm trying to incorporate an Rmd I have been using into a flexdashboard. I'm curious if it is possible to isolate an uploaded file and use it as-is rather than writing a bunch of reactive functions. If this is my template, is it possible to get a static object named df that the child document can go ahead and run with?
---
title: "help"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
---
```{r}
fileInput("data", "select data")
df <- isolate(input$data)
```
```{r, child="some_code.Rmd"}
```
My real example does something completely different but let's say some_code.Rmd looks like this:
---
title: "some code"
output: html_document
---
```{r packages, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE)
library(tidyverse)
```
The data looks like this:
```{r}
as_tibble(df)
```
The numeric data can be summarized with the following means
```{r}
df |>
summarise(across(where(is.numeric), mean)) |>
gather()
```
This ended up working:
knitr::knit() + markdown::markdownToHTML() + HTML() ---> renderUI()
---
title: "help"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
---
Sidebar {.sidebar}
==============================================
```{r file-input}
fileInput("data", "select data")
```
Row
==============================================
```{r knit-child}
observeEvent(input$data, {
df <- isolate(read.csv(input$data$datapath))
new_env <- list2env(list(df = df))
output$res <- renderUI({
knitr::knit("some_code.Rmd", quiet = TRUE, envir = new_env) |>
markdown::markdownToHTML() |>
HTML()
})
})
uiOutput("res")
```
I have a parent-child Rmarkdown file and I am trying to embed a Shiny UI-server structured DT table in the child rmd file. But the DT item won't render in child(but if put in parent, it will). When inspecting the HTML output, error message in dom saying:
shinyapp.js:342 Uncaught Duplicate binding for ID table_diamond
favicon.ico:1 Failed to load resource: the server responded with a status of
404 (Not Found)
Below is the sampled code I have:
Parent.Rmd:
---
title: "Hello Prerendered Shiny"
output:
html_document:
fig_caption: yes
keep_md: no
number_sections: no
theme: cerulean
toc: yes
toc_depth: 5
toc_float:
collapsed: true
runtime: shiny_prerendered
---
```{r setup, results=FALSE, eval=TRUE, echo=FALSE, message=FALSE, warning=FALSE}
library(DT)
library(tidyverse)
library(knitr)
library(c3)
```
## Content Listed by diamond color
```{r echo=FALSE, eval=TRUE, include=FALSE, warning=FALSE}
color <- levels(diamonds$color)
out <- NULL
for (c in color){
colorNum <- 0
for (ct in 1: length(levels(diamonds[diamonds$color== c, ]$cut ))) {
this_cut <- levels(diamonds[diamonds$color==c, ]$cut)[ct]
env = new.env()
out <- c(out, knit_child('sample_child.Rmd', envir = env))
colorNum <- colorNum +1
}
}
```
`r paste(out, collapse='\n')`
Child Rmd:
---
output: html_document
runtime: shiny_prerendered
---
```{r eval='TRUE', echo=FALSE, results='asis'}
if(colorNum ==0) cat('\n##',c,'\n'); #cat('\n');
```
### `r this_cut`
#### Price range on fixed color and cut
```{r eval=TRUE, echo=FALSE, fig.retina=1, dpi = 72,results='asis', warning=FALSE}
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
plot(x = data$clarity, y = data$price, ylab = 'Price', xlab = 'clarity')
```
#### Detail Table
```{r, echo=FALSE}
DT::dataTableOutput("table_diamond")
submitButton("Save")
```
```{r, context="server"}
output$table_diamond <- DT::renderDataTable({
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
datatable(data)
})
```
Any insights?
Figured out why:
Just as dom error said “shinyapp.js:342 Uncaught Duplicate binding for ID table_diamond”，the loop is creating output dataTable using the same output ID "table_diamond".
To make this output Id dynamic, in UI:
table_id <- paste0('table_', c, this_cut)
dataTableOuput(outputId = table_id)
in Server, use double square brackets [[ ]] instead of $:
output[[table_id]] <- DT::renderDataTable({
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
datatable(data)
})
Thanks to R Shiny dynamic tab number and input generation
The following code has satisfying results locally But when uploaded on shinyapps.io does not work.
---
title: "shiny slidy app"
author: "IMI"
date: "11/29/2018"
output:
slidy_presentation:
self_contained: yes
runtime: shiny
---
```{r data, echo=FALSE, message=FALSE, warning=FALSE, paged.print=FALSE}
library(shiny)
data<- data.frame(Year= 1990:1999)
```
## First
```{r slideselect, echo=T, message=FALSE, warning=FALSE, paged.print=FALSE}
sliderInput("year", "Year",
min = min(data$Year), max = max(data$Year),
value = c(min(data$Year),max(data$Year)))
```
```{r print, echo=T}
year<-reactive(input$year)
output$rendtext<-renderText( year()[1]:year()[2])
textOutput("rendtext")
```
shinyapps.io:
local:
Any suggestion?
I just tried your code and it worked well:
I made the following steps in Rstudio:
1) Create a new Rmd file
---
title: "shiny slidy app"
author: "IMI"
date: "11/29/2018"
output:
html_document:
df_print: paged
slidy_presentation:
self_contained: yes
runtime: shiny
---
```{r data, echo=FALSE, message=FALSE, warning=FALSE, paged.print=FALSE}
library(shiny)
data<- data.frame(Year= 1990:1999)
```
## First
```{r slideselect, echo=T, message=FALSE, warning=FALSE, paged.print=FALSE}
sliderInput("year", "Year",
min = min(data$Year), max = max(data$Year),
value = c(min(data$Year),max(data$Year)))
```
```{r print, echo=T}
year<-reactive(input$year)
output$rendtext<-renderText( year()[1]:year()[2])
textOutput("rendtext")
```
2) Publish it on shinyapp.io via the dedicated button
Also I tried with a basic shiny deployment (looked at the shiny guidelines) and with this it's ok as well: it runs both local and on shinyapp.io.
# Global variables can go here
library(shiny)
data <- data.frame(Year= 1990:1999)
# Define the UI
ui <- bootstrapPage(
# Input: Simple integer interval ----
sliderInput("year", "Year", min = min(data$Year), max = max(data$Year), value = c(min(data$Year),max(data$Year))),
# Output: Text output summarizing the values ----
textOutput("rendtext")
)
# Define the server code
server <- function(input, output) {
# Reactive expression for the input values ---
year <- reactive(input$year)
# Show the values ----
output$rendtext<-renderText( year()[1]:year()[2])
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)