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)