{esquisse} is built with Shiny modules (see this article for reference), so you can use {esquisse} directly into a Shiny application :
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 :
The output of the module is a reactiveValues
with 3
slots :
data.frame
used in plot (with
filters applied).This module allow to save a ggplot
object in various
format and to resize it before:
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):
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.
Add a menu to directly export plot, you can also launch module above for more controls (height, width, filename) by clicking “More options”:
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)
The drag-and-drop widget along with the button to select a geom and the color/palette picker are exported:
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)
The widget used to select a geom in esquisser
addin. You
can use images or icons for example:
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)
A select menu to choose one or several colors:
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)
A select menu to choose a color palette:
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)