{esquisse} is built with Shiny modules (see this article for reference), so you can use {esquisse} directly into a Shiny application :
ui <- fluidPage(
titlePanel("Use esquisse as a Shiny module"),
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "data",
label = "Data to use:",
choices = c("iris", "mtcars"),
inline = TRUE
)
),
mainPanel(
tabsetPanel(
tabPanel(
title = "esquisse",
esquisserUI(
id = "esquisse",
header = FALSE, # dont display gadget title
choose_data = FALSE # dont display button to change data
)
),
tabPanel(
title = "output",
verbatimTextOutput("module_out")
)
)
)
)
)
server <- function(input, output, session) {
data_r <- reactiveValues(data = iris, name = "iris")
observeEvent(input$data, {
if (input$data == "iris") {
data_r$data <- iris
data_r$name <- "iris"
} else {
data_r$data <- mtcars
data_r$name <- "mtcars"
}
})
result <- callModule(
module = esquisserServer,
id = "esquisse",
data = data_r
)
output$module_out <- renderPrint({
str(reactiveValuesToList(result))
})
}
shinyApp(ui, server)
Result looks like :
The output of the module is a reactiveValues
with 3 slots :
List of 3
$ code_plot : chr "ggplot(iris) + aes(x = Sepal.Length) + geom_histogram(bins = 30L, fill = \"#0c4c8a\") + theme_minimal()"
$ code_filters:List of 2
..$ dplyr: language iris %>% filter(Petal.Length >= 1.45 & Petal.Length <= 6.9)
..$ expr : language Petal.Length >= 1.45 & Petal.Length <= 6.9
$ data :'data.frame': 126 obs. of 5 variables:
..$ Sepal.Length: num [1:126] 4.6 5.4 5 4.9 5.4 4.8 5.7 5.7 5.1 5.4 ...
..$ Sepal.Width : num [1:126] 3.1 3.9 3.4 3.1 3.7 3.4 4.4 3.8 3.8 3.4 ...
..$ Petal.Length: num [1:126] 1.5 1.7 1.5 1.5 1.5 1.6 1.5 1.7 1.5 1.7 ...
..$ Petal.Width : num [1:126] 0.2 0.4 0.2 0.1 0.2 0.2 0.4 0.3 0.3 0.2 ...
..$ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
Some modules used in {esquisse} are exported, so you can use them in your Shiny applications.
Module to interactively filter a data.frame
and retrieve the code :
Module to interactively choose a data.frame
in Global environment or to import an external file :
With an external file, import will be performed by package {rio} :
The drag-and-drop widget along with the button to select a geom 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)