---
title: "Shiny usage"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{shiny-usage}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval = FALSE
)
```
```{r setup}
library(shiny)
library(esquisse)
```
## Use esquisse as a Shiny module
{esquisse} is built with Shiny modules (see this [article](https://shiny.rstudio.com/articles/modules.html) for reference), so you can use {esquisse} directly into a Shiny application :
```{r esquisse-module}
library(esquisse)
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Use esquisse as a Shiny module"),
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "data",
label = "Select data to use:",
choices = c("mpg", "diamonds", "economics")
)
),
mainPanel(
tabsetPanel(
tabPanel(
title = "esquisse",
esquisse_ui(
id = "esquisse",
header = FALSE # dont display gadget title
)
),
tabPanel(
title = "output",
tags$b("Code:"),
verbatimTextOutput("code"),
tags$b("Filters:"),
verbatimTextOutput("filters"),
tags$b("Data:"),
verbatimTextOutput("data")
)
)
)
)
)
server <- function(input, output, session) {
data_r <- reactiveValues(data = iris, name = "iris")
observe({
data_r$data <- get(input$data)
data_r$name <- input$data
})
results <- esquisse_server(
id = "esquisse",
data_rv = data_r
)
output$code <- renderPrint({
results$code_plot
})
output$filters <- renderPrint({
results$code_filters
})
output$data <- renderPrint({
str(results$data)
})
}
shinyApp(ui, server)
```
Result looks like :
![](figures/shiny-esquisse.png)
The output of the module is a `reactiveValues` with 3 slots :
* **code_plot** : code to generate plot.
* **code_filters** : a list of length two with code to reproduce filters.
* **data** : `data.frame` used in plot (with filters applied).
## Module for saving a ggplot object
This module allow to save a `ggplot` object in various format and to resize it before:
![](figures/save-ggplot.png)
You can call the module from server to display it in a modal window (it's also possible to display it directly in your UI):
```{r save-ggplot}
function(input, output, session) {
observeEvent(input$save, { # actionButton to trigger modal
save_ggplot_modal("ID", "Save plot") # launch modal
})
save_ggplot_server("ID", rv) # rv is a reactiValues with a slot 'plot'
}
```
See `?"save-ggplot-module"` for complete example.
## Module to render a plot and add export options
Add a menu to directly export plot, you can also launch module above for more controls (height, width, filename) by clicking "More options":
![](figures/render-ggplot.png)
```{r render-ggplot}
library(shiny)
library(ggplot2)
library(esquisse)
ui <- fluidPage(
tags$h2("ggplot output"),
selectInput("var", "Variable:", names(economics)[-1]),
ggplot_output("MYID", width = "600px")
)
server <- function(input, output, session) {
render_ggplot("MYID", {
ggplot(economics) +
geom_line(aes(date, !!sym(input$var))) +
theme_minimal() +
labs(
title = "A cool chart made with ggplot2",
subtitle = "that you can export in various format"
)
})
}
if (interactive())
shinyApp(ui, server)
```
## Input widgets
The drag-and-drop widget along with the button to select a geom and the color/palette picker are exported:
### dragulaInput
```{r dragula-input}
ui <- fluidPage(
tags$h2("Demo dragulaInput"),
tags$br(),
dragulaInput(
inputId = "dad",
sourceLabel = "Source",
targetsLabels = c("Target 1", "Target 2"),
choices = names(iris),
width = "400px"
),
verbatimTextOutput(outputId = "result")
)
server <- function(input, output, session) {
output$result <- renderPrint(str(input$dad))
}
shinyApp(ui = ui, server = server)
```
![](figures/input-dragula.png)
### dropInput
The widget used to select a geom in `esquisser` addin. You can use images or icons for example:
```{r drop-input}
ui <- fluidPage(
tags$h2("Drop Input"),
dropInput(
inputId = "mydrop",
choicesNames = tagList(
list(icon("home"), style = "width: 100px;"),
list(icon("flash"), style = "width: 100px;"),
list(icon("cogs"), style = "width: 100px;"),
list(icon("fire"), style = "width: 100px;"),
list(icon("users"), style = "width: 100px;"),
list(icon("info"), style = "width: 100px;")
),
choicesValues = c("home", "flash", "cogs",
"fire", "users", "info"),
dropWidth = "220px"
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$mydrop
})
}
shinyApp(ui, server)
```
![](figures/input-drop.png)
### colorPicker
A select menu to choose one or several colors:
```{r color-picker}
ui <- fluidPage(
tags$h2("Color Picker"),
colorPicker(
inputId = "col",
label = "Choose a color:",
choices = scales::brewer_pal(palette = "Dark2")(8),
textColor = "white"
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$col
})
}
shinyApp(ui, server)
```
![](figures/input-color.png)
### palettePicker
A select menu to choose a color palette:
```{r palette-picker}
library(scales)
ui <- fluidPage(
tags$h2("Palette Picker"),
palettePicker(
inputId = "pal",
label = "Choose a palette",
choices = list(
"Viridis" = list(
"viridis" = viridis_pal(option = "viridis")(10),
"magma" = viridis_pal(option = "magma")(10),
"inferno" = viridis_pal(option = "inferno")(10),
"plasma" = viridis_pal(option = "plasma")(10),
"cividis" = viridis_pal(option = "cividis")(10)
),
"Brewer" = list(
"Blues" = brewer_pal(palette = "Blues")(8),
"Reds" = brewer_pal(palette = "Reds")(8),
"Paired" = brewer_pal(palette = "Paired")(8),
"Set1" = brewer_pal(palette = "Set1")(8)
)
),
textColor = c(
rep("white", 5), rep("black", 4)
)
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$pal
})
}
shinyApp(ui, server)
```
![](figures/input-palette.png)