inst/doc/shiny-usage.R

In esquisse: Explore and Visualize Your Data Interactively

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

## ----setup--------------------------------------------------------------------
# library(shiny)
# library(esquisse)

## ----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)

## ----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'
# 
# }

## ----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)

## ----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)

## ----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)

## ----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)

## ----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)