In dtsonipmph/esquisse: Explore and Visualize Your Data Interactively

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = FALSE
)

library(shiny)
library(esquisse)

Use esquisse as a Shiny module

{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 ...

Other exported modules

Some modules used in {esquisse} are exported, so you can use them in your Shiny applications.

Filter data

Module to interactively filter a data.frame and retrieve the code :

?`module-filterDF`

run_module("filterDF")

Choose data

Module to interactively choose a data.frame in Global environment or to import an external file :

?`module-chooseData`

run_module("chooseData")

With an external file, import will be performed by package {rio} :

run_module("chooseData2")

Coerce variable

Coerce a variable from a class to another :

?`module-coerce`

run_module("coerce")

Input widgets

The drag-and-drop widget along with the button to select a geom are exported.

dragulaInput

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)

dropInput

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)

colorPicker

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)

palettePicker

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)