Explore and Visualize Your Data Interactively

Description

A 'shiny' gadget to create 'ggplot2' figures interactively with drag-and-drop to map your variables to different aesthetics. You can quickly visualize your data accordingly to their type, export in various formats, and retrieve the code to reproduce the plot.

Author(s)

Fanny Meyer & Victor Perrier (@dreamRs_fr)

See Also

Useful links:

• https://dreamrs.github.io/esquisse/

• https://github.com/dreamRs/esquisse

• Report bugs at https://github.com/dreamRs/esquisse/issues

Examples

## Not run: 

esquisser()

# launch esquisse with specific data:
esquisser(mtcars)


## End(Not run)

Bootstrap Theme for Esquisse

Description

Bootstrap Theme for Esquisse

Usage

bs_theme_esquisse()

Value

A bslib::bs_theme().

Build aesthetics to use in a plot

Description

Build aesthetics to use in a plot

Usage

build_aes(data, ..., .list = NULL, geom = NULL)

Arguments

Value

An expression

Examples

# Classic
build_aes(iris, x = "Sepal.Width")
build_aes(iris, x = "Sepal.Width", y = "Sepal.Width")

# Explicit geom : no change
build_aes(iris, x = "Species", geom = "bar")

# Little trick if data is count data
df <- data.frame(
  LET = c("A", "B"),
  VAL = c(4, 7)
)
build_aes(df, x = "LET", y = "VAL", geom = "bar")

# e.g. :
library(ggplot2)
ggplot(df) +
  build_aes(df, x = "LET", y = "VAL", geom = "bar") +
  geom_bar(stat = "summary", fun = "mean")

Drag And Drop Input Widget

Description

Drag And Drop Input Widget

Usage

dragulaInput(
  inputId,
  label = NULL,
  sourceLabel,
  targetsLabels,
  targetsIds = NULL,
  choices = NULL,
  choiceNames = NULL,
  choiceValues = NULL,
  selected = NULL,
  status = "primary",
  replace = FALSE,
  copySource = TRUE,
  badge = TRUE,
  ncolSource = "auto",
  ncolGrid = NULL,
  nrowGrid = NULL,
  dragulaOpts = list(),
  boxStyle = NULL,
  targetsHeight = NULL,
  width = NULL,
  height = "100px"
)

Arguments

Value

a UI definition

Note

The output server-side is a list with two slots: source and targets.

See Also

updateDragulaInput() to update choices server-side.

Examples

library(shiny)
library(esquisse)

ui <- fluidPage(
  tags$h2("Demo dragulaInput"),
  tags$br(),
  fluidRow(
    column(
      width = 6,
      
      dragulaInput(
        inputId = "dad1",
        label = "Default:",
        sourceLabel = "Source",
        targetsLabels = c("Target 1", "Target 2"),
        choices = month.abb,
        width = "100%"
      ),
      verbatimTextOutput(outputId = "result1"),
      
      tags$br(),
      
      dragulaInput(
        inputId = "dad3",
        label = "On same row:",
        sourceLabel = "Source",
        targetsLabels = c("Target 1", "Target 2"),
        choices = month.abb,
        width = "100%",
        ncolSource = 1,
        ncolGrid = 3
      ),
      verbatimTextOutput(outputId = "result3")
    ),
    
    column(
      width = 6,
      dragulaInput(
        inputId = "dad2",
        label = "Two rows:",
        sourceLabel = "Source",
        targetsLabels = c("x", "y", "color", "fill", "size", "facet"),
        choices = names(mtcars),
        width = "100%",
        ncolGrid = 3
      ),
      verbatimTextOutput(outputId = "result2"),
      
      tags$br(),
      
      dragulaInput(
        inputId = "dad4",
        label = "Two rows not filled:",
        sourceLabel = "Source",
        targetsLabels = c("x", "y", "color", "fill", "size"),
        choices = names(mtcars),
        width = "100%",
        ncolGrid = 3
      ),
      verbatimTextOutput(outputId = "result4")
    )
  )
)


server <- function(input, output, session) {
  
  output$result1 <- renderPrint(str(input$dad1))
  
  output$result2 <- renderPrint(str(input$dad2))
  
  output$result3 <- renderPrint(str(input$dad3))
  
  output$result4 <- renderPrint(str(input$dad4))
  
}

if (interactive())
  shinyApp(ui = ui, server = server)

Dropdown Input

Description

A dropdown menu for selecting a value.

Usage

dropInput(
  inputId,
  choicesNames,
  choicesValues,
  selected = NULL,
  dropUp = FALSE,
  dropWidth = NULL,
  dropMaxHeight = NULL,
  dropPreScrollable = FALSE,
  btnClass = "btn-link",
  width = NULL
)

Arguments

See Also

updateDropInput

Examples

if (interactive()) {

  library(shiny)
  library(esquisse)

  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)

}

Deprecated functions

Description

Deprecated functions

Usage

esquisseContainer(...)

Arguments

Note

The following functions are deprecated and will be removed in next release:

• esquisseContainer : replaced by esquisse_container

esquisse exported operators and S3 methods

Description

esquisse exported operators and S3 methods

Esquisse module

Description

Use esquisse as a module in a Shiny application.

Usage

esquisse_ui(
  id,
  header = esquisse_header(),
  container = esquisse_container(),
  controls = c("options", "labs", "axes", "geoms", "theme", "filters", "code"),
  insert_code = FALSE,
  play_pause = TRUE,
  layout_sidebar = FALSE,
  downloads = downloads_labels(),
  n_geoms = 8
)

esquisse_server(
  id,
  data_rv = NULL,
  name = "data",
  default_aes = c("fill", "color", "size", "group", "facet"),
  import_from = c("env", "file", "copypaste", "googlesheets", "url"),
  n_geoms = 8,
  drop_ids = TRUE,
  notify_warnings = NULL
)

esquisse_container(width = "100%", height = "700px", fixed = FALSE)

esquisse_header(
  import_data = TRUE,
  show_data = TRUE,
  update_variable = TRUE,
  create_column = TRUE,
  cut_variable = TRUE,
  update_factor = TRUE,
  settings = TRUE,
  close = TRUE,
  .before = NULL,
  .after = NULL
)

Arguments

Value

A reactiveValues with 4 slots :

• ggobj: the ggplot object

• 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).

Examples

### Part of a Shiny app ###

library(shiny)
library(esquisse)

ui <- fluidPage(

  theme = bs_theme_esquisse(),

  tags$h1("Use esquisse as a Shiny module"),

  radioButtons(
    inputId = "data",
    label = "Data to use:",
    choices = c("iris", "mtcars"),
    inline = TRUE
  ),
  checkboxGroupInput(
    inputId = "aes",
    label = "Aesthetics to use:",
    choices = c(
      "fill", "color", "size", "shape",
      "weight", "group", "facet", "facet_row", "facet_col"
    ),
    selected = c("fill", "color", "size", "facet"),
    inline = TRUE
  ),
  esquisse_ui(
    id = "esquisse",
    header = FALSE, # dont display gadget title
    container = esquisse_container(height = "700px")
  ),
  tags$b("Output of the module:"),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {

  data_rv <- reactiveValues(data = iris, name = "iris")

  observeEvent(input$data, {
    if (input$data == "iris") {
      data_rv$data <- iris
      data_rv$name <- "iris"
    } else {
      data_rv$data <- mtcars
      data_rv$name <- "mtcars"
    }
  })

  esquisse_out <- esquisse_server(
    id = "esquisse",
    data_rv = data_rv,
    default_aes = reactive(input$aes)
  )

  output$out <- renderPrint({
    str(reactiveValuesToList(esquisse_out), max.level = 1)
  })
}

if (interactive())
  shinyApp(ui, server)


### Whole Shiny app ###

library(shiny)
library(esquisse)


# Load some datasets in app environment
my_data <- data.frame(
  var1 = rnorm(100),
  var2 = sample(letters[1:5], 100, TRUE)
)


ui <- fluidPage(
  theme = bs_theme_esquisse(),
  esquisse_ui(
    id = "esquisse",
    header = esquisse_header(
      close = FALSE, # hide the close button
      .after = actionButton( # custom button
        inputId = "open_modal",
        label = NULL,
        icon = icon("plus")
      )
    ),
    container = esquisse_container(fixed = TRUE),
    play_pause = FALSE,
    controls = c("settings", "labs", "axes", "geoms", "theme", "filters", "code", "export"),
    layout_sidebar = TRUE
  )
)

server <- function(input, output, session) {

  esquisse_server(id = "esquisse")


  observeEvent(input$open_modal, {
    showModal(modalDialog("Some content"))
  })
}

if (interactive())
  shinyApp(ui, server)



## You can also use a vector of margins for the fixed argument,
# useful if you have a navbar for example

library(shiny)
library(esquisse)
library(datamods)

ui <- navbarPage(
  title = "My navbar app",
  theme = bs_theme_esquisse(),
  tabPanel(
    title = "esquisse",
    esquisse_ui(
      id = "esquisse", 
      header = FALSE,
      container = esquisse_container(
        fixed = c(55, 0, 0, 0)
      )
    )
  )
)

server <- function(input, output, session) {
  
  # lauch import data modal
  import_modal(
    id = "import-data",
    from = c("env", "file", "copypaste"),
    title = "Import data"
  )
  data_imported_r <- datamods::import_server("import-data")

  data_rv <- reactiveValues(data = data.frame())
  observeEvent(data_imported_r$data(), {
    data_rv$data <- data_imported_r$data()
    data_rv$name <- data_imported_r$name()
  })
  
  esquisse_server(id = "esquisse", data_rv = data_rv)
  
}

if (interactive())
  shinyApp(ui, server)

An add-in to easily create plots with ggplot2

Description

Select data to be used and map variables to aesthetics to produce a chart, customize common elements and get code to reproduce the chart.

Usage

esquisser(
  data = NULL,
  controls = c("options", "labs", "axes", "geoms", "theme", "filters", "code"),
  viewer = getOption(x = "esquisse.viewer", default = "dialog")
)

Arguments

Value

NULL. You can view code used to produce the chart, copy it or insert it in current script.

Examples

if (interactive()) {
# Launch with :
esquisser(iris)
# If in RStudio it will be launched by default in dialog window
# If not, it will be launched in browser

# Launch esquisse in browser :
esquisser(iris, viewer = "browser")

# You can set this option in .Rprofile :
options("esquisse.viewer" = "viewer")
# or
options("esquisse.viewer" = "browser")

# esquisse use shiny::runApp
# see ?shiny::runApp to see options
# available, example to use custom port:

options("shiny.port" = 8080)
esquisser(iris, viewer = "browser")

}

Potential geometries according to the data

Description

From the data and variable used in aesthetics, decide which geometry can be used and which one is used by default.

Usage

potential_geoms(data, mapping, auto = FALSE)

potential_geoms_ref()

Arguments

Value

A character vector

Examples

library(ggplot2)

# One continuous variable
potential_geoms(
  data = iris,
  mapping = aes(x = Sepal.Length)
)

# Automatic pick a geom
potential_geoms(
  data = iris,
  mapping = aes(x = Sepal.Length),
  auto = TRUE
)

# One discrete variable
potential_geoms(
  data = iris,
  mapping = aes(x = Species)
)

# Two continuous variables
potential_geoms(
  data = iris,
  mapping = aes(x = Sepal.Length, y = Sepal.Width)
)
# Reference used by esquisse to select available geoms
# and decide which one to use by default
potential_geoms_ref()

Generate code to create a ggplot2

Description

Generate code to create a ggplot2

Usage

ggcall(
  data = NULL,
  mapping = NULL,
  geom = NULL,
  geom_args = list(),
  scales = NULL,
  scales_args = list(),
  coord = NULL,
  coord_args = list(),
  labs = list(),
  theme = NULL,
  theme_args = list(),
  facet = NULL,
  facet_row = NULL,
  facet_col = NULL,
  facet_args = list(),
  xlim = NULL,
  ylim = NULL
)

Arguments

Value

a call that can be evaluated with eval.

Examples

# Default:
ggcall()

# With data and aes
ggcall("mtcars", list(x = "mpg", y = "wt"))

# Evaluate the call
library(ggplot2)
eval(ggcall("mtcars", list(x = "mpg", y = "wt")))


# With a geom:
ggcall(
  data = "mtcars",
  mapping = list(x = "mpg", y = "wt"),
  geom = "point"
)

# With options
ggcall(
  data = "mtcars",
  mapping = list(x = "hp", y = "cyl", fill = "color"),
  geom = "bar",
  coord = "flip",
  labs = list(title = "My title"),
  theme = "minimal",
  facet = c("gear", "carb"),
  theme_args = list(legend.position = "bottom")
)

# Theme
ggcall(
  "mtcars", list(x = "mpg", y = "wt"),
  theme = "theme_minimal",
  theme_args = list(
    panel.ontop = TRUE,
    legend.title = rlang::expr(element_text(face = "bold"))
  )
)

# Theme from other package than ggplot2
ggcall(
  "mtcars", list(x = "mpg", y = "wt"),
  theme = "ggthemes::theme_economist"
)


# One scale
ggcall(
  data = "mtcars",
  mapping = list(x = "mpg", y = "wt", color = "qsec"),
  geom = "point",
  scales = "color_distiller",
  scales_args = list(palette = "Blues")
)

# Two scales
ggcall(
  data = "mtcars",
  mapping = list(x = "mpg", y = "wt", color = "qsec", size = "qsec"),
  geom = "point",
  scales = c("color_distiller", "size_continuous"),
  scales_args = list(
    color_distiller = list(palette = "Greens"),
    size_continuous = list(range = c(1, 20))
  )
)


# Coordinates
ggcall(
  data = "mtcars",
  mapping = list(x = "mpg", y = "wt"),
  geom = "point",
  coord = "fixed"
)
ggcall(
  data = "mtcars",
  mapping = list(x = "mpg", y = "wt"),
  geom = "point",
  coord = "fixed",
  coord_args = list(ratio = 5)
)

Render ggplot module

Description

Display a plot on the client and allow to download it.

Usage

ggplot_output(
  id,
  width = "100%",
  height = "400px",
  downloads = downloads_labels(),
  ...
)

downloads_labels(
  label = ph("download-simple"),
  png = tagList(ph("image"), "PNG"),
  pdf = tagList(ph("file-pdf"), "PDF"),
  svg = tagList(ph("browsers"), "SVG"),
  jpeg = tagList(ph("image"), "JPEG"),
  pptx = tagList(ph("projector-screen"), "PPTX"),
  more = tagList(ph("gear"), i18n("More options"))
)

render_ggplot(
  id,
  expr,
  ...,
  env = parent.frame(),
  quoted = FALSE,
  filename = "export-ggplot",
  resizable = FALSE,
  use_plotly = reactive(FALSE),
  width = reactive(NULL),
  height = reactive(NULL)
)

Arguments

Value

Server-side, a reactiveValues with the plot.

Examples

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)

Utility to export ggplot objects to PowerPoint

Description

You can use the RStudio addin to interactively select ggplot objects, or directly pass their names to the function.

Usage

ggplot_to_ppt(gg = NULL)

Arguments

Value

Path to the temporary PowerPoint file.

Examples

# Shiny gadget
if (interactive()) {

ggplot_to_ppt()



# Or with an object's name
library(ggplot2)
p <- ggplot(iris) +
  geom_point(aes(Sepal.Length, Sepal.Width))

ggplot_to_ppt("p")

}

Picker input to select color(s) or palette

Description

Select menu to view and choose a color or a palette of colors.

Usage

colorPicker(
  inputId,
  label,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE,
  multiple = FALSE,
  pickerOpts = list(),
  width = NULL
)

updateColorPicker(
  session = getDefaultReactiveDomain(),
  inputId,
  choices,
  textColor = "#000",
  plainColor = FALSE,
  multiple = FALSE
)

palettePicker(
  inputId,
  label,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE,
  pickerOpts = list(),
  width = NULL
)

updatePalettePicker(
  session = getDefaultReactiveDomain(),
  inputId,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE
)

Arguments

Value

A select control that can be added to a UI definition.

Examples

# colorPicker -------------------------------------------------------------

library(shiny)
library(esquisse)
library(scales)


ui <- fluidPage(
  tags$h2("colorPicker examples"),
  fluidRow(
    column(
      width = 3,
      colorPicker(
        inputId = "col1",
        label = "With a vector of colors:",
        choices = brewer_pal(palette = "Dark2")(8)
      ),
      verbatimTextOutput("res1"),
      colorPicker(
        inputId = "col5",
        label = "Update colors:",
        choices = brewer_pal(palette = "Blues", direction = -1)(8),
        textColor = "#FFF"
      ),
      verbatimTextOutput("res5"),
      radioButtons(
        "update", "Colors", c("Blues", "Greens", "Reds"),
        inline = TRUE
      )
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col2",
        label = "Change text color:",
        choices = brewer_pal(palette = "Blues")(8), 
        textColor = c("black", "black", "black", "white",
                      "white", "white", "white", "white")
      ),
      verbatimTextOutput("res2")
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col3",
        label = "With a list of vector of colors:",
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8),
          "Greens" = brewer_pal(palette = "Greens")(8)
        )
      ),
      verbatimTextOutput("res3")
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col4",
        label = "Plain color & multiple choices:",
        choices = brewer_pal(palette = "Paired")(8), 
        plainColor = TRUE, 
        multiple = TRUE, 
        pickerOpts = list(`selected-text-format`= "count > 3")
      ),
      verbatimTextOutput("res4")
    )
  )
)

server <- function(input, output, session) {
  
  output$res1 <- renderPrint(input$col1)
  output$res2 <- renderPrint(input$col2)
  output$res3 <- renderPrint(input$col3)
  output$res4 <- renderPrint(input$col4)
  output$res5 <- renderPrint(input$col5)
  
  observeEvent(input$update, {
    updateColorPicker(
      inputId = "col5",
      choices = brewer_pal(palette = input$update, direction = -1)(8),
      textColor = "#FFF"
    )
  })
  
}

if (interactive()) {
  shinyApp(ui, server)
}

# palettePicker -----------------------------------------------------------

library(shiny)
library(esquisse)
library(scales)

ui <- fluidPage(
  tags$h2("pickerColor examples"),
  
  fluidRow(
    column(
      width = 4,
      palettePicker(
        inputId = "pal1", 
        label = "Select a palette:", 
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      ),
      verbatimTextOutput("res1"),
      palettePicker(
        inputId = "pal4", 
        label = "Update palette:", 
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      ),
      verbatimTextOutput("res4"),
      radioButtons(
        "update", "Palettes:", c("default", "viridis", "brewer"),
        inline = TRUE
      )
    ),
    column(
      width = 4,
      palettePicker(
        inputId = "pal2", 
        label = "With a list of 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("res2")
    ),
    column(
      width = 4,
      palettePicker(
        inputId = "pal3", 
        label = "With plain colors:", 
        choices = list(
          "BrBG" = brewer_pal(palette = "BrBG")(8), 
          "PiYG" = brewer_pal(palette = "PiYG")(8), 
          "PRGn" = brewer_pal(palette = "PRGn")(8), 
          "PuOr" = brewer_pal(palette = "PuOr")(8), 
          "RdBu" = brewer_pal(palette = "RdBu")(8), 
          "RdGy" = brewer_pal(palette = "RdGy")(8), 
          "RdYlBu" = brewer_pal(palette = "RdYlBu")(8), 
          "RdYlGn" = brewer_pal(palette = "RdYlGn")(8), 
          "Spectral" = brewer_pal(palette = "Spectral")(8)
        ), 
        plainColor = TRUE, 
        textColor = "white"
      ),
      verbatimTextOutput("res3")
    )
  )
)

server <- function(input, output, session) {
  
  output$res1 <- renderPrint(input$pal1)
  output$res2 <- renderPrint(input$pal2)
  output$res3 <- renderPrint(input$pal3)
  output$res4 <- renderPrint(input$pal4)
  
  observeEvent(input$update, {
    if (input$update == "default") {
      updatePalettePicker(
        inputId = "pal4",
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      )
    } else if (input$update == "viridis") {
      updatePalettePicker(
        inputId = "pal4",
        choices = 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)
        ),
        textColor = "#FFF"
      )
    } else if (input$update == "brewer") {
      updatePalettePicker(
        inputId = "pal4",
        choices = 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)
        )
      )
    }
  })
}

if (interactive()) {
  shinyApp(ui, server)
}

Match list of arguments to arguments of geometry

Description

Match list of arguments to arguments of geometry

Usage

match_geom_args(
  geom,
  args,
  add_aes = TRUE,
  mapping = list(),
  add_mapping = FALSE,
  exclude_args = NULL,
  envir = "ggplot2"
)

Arguments

Value

a list().

Examples

# List of parameters
params <- list(
  bins = 30,
  scale = "width",
  adjust = 2,
  position = "stack",
  size = 1.6,
  fill = "#112246"
)

# Search arguments according to geom
match_geom_args(geom = "histogram", args = params)
match_geom_args(geom = "violin", args = params)
match_geom_args(geom = "bar", args = params, add_aes = FALSE)
match_geom_args(geom = "point", args = params)
match_geom_args(geom = "point", args = params, add_aes = FALSE)

Safely render a ggplot in Shiny application

Description

Safely render a ggplot in Shiny application

Usage

safe_ggplot(
  expr,
  data = NULL,
  show_notification = c("always", "once", "never"),
  session = shiny::getDefaultReactiveDomain()
)

Arguments

Value

Output of ggplot_build.

Examples

if (interactive()) {
  library(shiny)
  library(ggplot2)

  ui <- fluidPage(
    fluidRow(
      column(
        width = 3,
        selectInput(
          inputId = "var",
          label = "Var:",
          choices = c("Sepal.Width", "Do.Not.Exist")
        )
      ),
      column(
        width = 9,
        plotOutput(outputId = "plot")
      )
    )
  )

  server <- function(input, output, session) {

    output$plot <- renderPlot({
      p <- ggplot(iris) +
        geom_point(aes_string("Sepal.Length", input$var))
      safe_ggplot(p)
    })

  }

  shinyApp(ui, server)
}

Save ggplot module

Description

Save a ggplot object in various format and resize it before saving.

Usage

save_ggplot_ui(
  id,
  output_format = c("png", "pdf", "svg", "jpeg", "bmp", "eps", "tiff")
)

save_ggplot_modal(
  id,
  title = NULL,
  output_format = c("png", "pdf", "svg", "jpeg", "bmp", "eps", "tiff")
)

save_ggplot_server(id, plot_rv)

Arguments

Value

No value. Use in UI & server in shiny application.

Examples

library(shiny)
library(ggplot2)
library(esquisse)


ui <- fluidPage(
  tags$h2("Save a ggplot"),
  selectInput("var", "Variable:", names(economics)[-1]),
  plotOutput("plot", width = "600px"),
  actionButton("save", "Save this plot")
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(plot = NULL)
  
  output$plot <- renderPlot({
    rv$plot <- ggplot(economics) + 
      geom_line(aes(date, !!sym(input$var))) + 
      theme_minimal()
    rv$plot
  })
  
  observeEvent(input$save, {
    save_ggplot_modal("ID", "Save plot")
  })
  save_ggplot_server("ID", rv)
}

if (interactive())
  shinyApp(ui, server)

Save multiple ggplot module

Description

Save multiple ggplot objects in various format and retrieve code.

Usage

save_multi_ggplot_ui(
  id,
  output_format = c("png", "pdf", "svg", "jpeg", "pptx")
)

save_multi_ggplot_server(
  id,
  plot_list_r = reactive(NULL),
  filename = "code-ggplot",
  placeholder = "No plots to display",
  code_pre = "library(ggplot2)"
)

Arguments

Value

No value. Use in UI & server in shiny application.

Examples

library(shiny)
library(ggplot2)
library(esquisse)
library(bslib)

ui <- page_fluid(
  theme = bs_theme_esquisse(),
  save_multi_ggplot_ui("mod")
)

server <- function(...) {

  p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
  p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
  p3 <- ggplot(mtcars) + geom_smooth(aes(disp, qsec))
  p4 <- ggplot(mtcars) + geom_bar(aes(carb))
  p5 <- ggplot(presidential) +
    geom_segment(aes(y = name, x = start, xend = end)) +
    geom_point(aes(y = name, x = start)) +
    geom_point(aes(y = name, x = end))

  save_multi_ggplot_server(
    id = "mod",
    plot_list_r = reactive(list(
      list(
        ggobj = p1,
        code = "ggplot(mtcars) + geom_point(aes(mpg, disp))",
        label = "Plot 1"
      ),
      list(
        ggobj = p2,
        code = "ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))",
        label = "Plot 2"
      ),
      list(
        ggobj = p3,
        code = "ggplot(mtcars) + geom_smooth(aes(disp, qsec))",
        label = "Plot 3"
      ),
      list(
        ggobj = p4,
        code = "ggplot(mtcars) + geom_bar(aes(carb))",
        label = "Plot 4"
      ),
      list(
        ggobj = p5,
        code = "ggplot(presidential) +
  geom_segment(aes(y = name, x = start, xend = end)) +
  geom_point(aes(y = name, x = start)) +
  geom_point(aes(y = name, x = end))",
        label = "Plot 5"
      )
    ))
  )
}

if (interactive())
  shinyApp(ui, server)

Update Dragula Input

Description

Update dragulaInput() widget server-side.

Usage

updateDragulaInput(
  session,
  inputId,
  choices = NULL,
  choiceNames = NULL,
  choiceValues = NULL,
  selected = NULL,
  selectedNames = NULL,
  selectedValues = NULL,
  badge = TRUE,
  status = "primary"
)

Arguments

Examples

if (interactive()) {

library("shiny")
library("esquisse")

ui <- fluidPage(
  tags$h2("Update dragulaInput"),
  radioButtons(
    inputId = "update",
    label = "Dataset",
    choices = c("iris", "mtcars")
  ),
  tags$br(),
  dragulaInput(
    inputId = "myDad",
    sourceLabel = "Variables",
    targetsLabels = c("X", "Y", "fill", "color", "size"),
    choices = names(iris),
    replace = TRUE, width = "400px", status = "success"
  ),
  verbatimTextOutput(outputId = "result")
)

server <- function(input, output, session) {

  output$result <- renderPrint(str(input$myDad))

  observeEvent(input$update, {
    if (input$update == "iris") {
      updateDragulaInput(
        session = session,
        inputId = "myDad",
        choices = names(iris),
        status = "success"
      )
    } else {
      updateDragulaInput(
        session = session,
        inputId = "myDad",
        choices = names(mtcars)
      )
    }
  }, ignoreInit = TRUE)

}

shinyApp(ui, server)

}

Change the value of a drop input on the client

Description

Change the value of a drop input on the client

Usage

updateDropInput(session, inputId, selected = NULL, disabled = NULL)

Arguments

See Also

dropInput

Examples

if (interactive()) {

  library(shiny)
  library(esquisse)

  myChoices <- 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;")
  )


  ui <- fluidPage(
    tags$h2("Update Drop Input"),
    fluidRow(
      column(
        width = 6,
        dropInput(
          inputId = "mydrop",
          choicesNames = myChoices,
          choicesValues = c("home", "flash", "cogs", "fire", "users", "info"),
          dropWidth = "220px"
        ),
        verbatimTextOutput(outputId = "res")
      ),
      column(
        width = 6,
        actionButton("home", "Select home"),
        actionButton("flash", "Select flash"),
        actionButton("cogs", "Select cogs"),
        actionButton("fire", "Select fire"),
        actionButton("users", "Select users"),
        actionButton("info", "Select info"),
        checkboxGroupInput(
          inputId = "disabled",
          label = "Choices to disable",
          choices = c("home", "flash", "cogs", "fire", "users", "info")
        ),
        actionButton("disable", "Disable")
      )
    )
  )

  server <- function(input, output, session) {

    output$res <- renderPrint({
      input$mydrop
    })

    observeEvent(input$home, {
      updateDropInput(session, "mydrop", "home")
    })
    observeEvent(input$flash, {
      updateDropInput(session, "mydrop", "flash")
    })
    observeEvent(input$cogs, {
      updateDropInput(session, "mydrop", "cogs")
    })
    observeEvent(input$fire, {
      updateDropInput(session, "mydrop", "fire")
    })
    observeEvent(input$users, {
      updateDropInput(session, "mydrop", "users")
    })
    observeEvent(input$info, {
      updateDropInput(session, "mydrop", "info")
    })

    observeEvent(input$disable, {
      if (!is.null(input$disabled)) {
        updateDropInput(session, "mydrop", disabled = input$disabled)
      } else {
        updateDropInput(session, "mydrop", disabled = character(0))
      }
    })
  }

  shinyApp(ui, server)

}

Automatically select appropriate color scale

Description

Automatically select appropriate color scale

Usage

which_pal_scale(
  mapping,
  palette = "ggplot2",
  data = NULL,
  fill_type = c("continuous", "discrete"),
  color_type = c("continuous", "discrete"),
  reverse = FALSE
)

Arguments

Value

a list

Examples

library(ggplot2)

# Automatic guess according to data
which_pal_scale(
  mapping = aes(fill = Sepal.Length),
  palette = "ggplot2",
  data = iris
)
which_pal_scale(
  mapping = aes(fill = Species),
  palette = "ggplot2",
  data = iris
)


# Explicitly specify type
which_pal_scale(
  mapping = aes(color = variable),
  palette = "Blues",
  color_type = "discrete"
)


# Both scales
which_pal_scale(
  mapping = aes(color = var1, fill = var2),
  palette = "Blues",
  color_type = "discrete",
  fill_type = "continuous"
)