R/variable_browser.R

In tomas-adam/ggt:

#' @import miniUI
#' @import tidyverse
#' @import shiny
#' @export
ggt_variable_browser <- function(df) {
  ui <-
    miniPage(
      gadgetTitleBar("Variable browser"),
      miniContentPanel(
        fluidRow(
          column(
            width = 4,
            uiOutput("variable_to_plot"),
            actionButton(inputId = "line_number_first", "|<<"),
            actionButton(inputId = "line_number_left", "<"),
            actionButton(inputId = "line_number_right", ">"),
            actionButton(inputId = "line_number_last", ">>|"),
            dateRangeInput(inputId = "date_range", label = "Select date range", start = min(df$date), end = max(df$date), startview = "month"),
            textOutput("txt_selected_variable")
          ),
          column(
            width = 8,
            plotOutput(outputId = "plot_out", height = 460)
          )
        )
      )
    )

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

    variable_names <- reactive({
      return(colnames(df)[-1])
    })

    output$variable_to_plot <- renderUI({
      selectInput(
        "txt_variable_to_plot",
        label = "Variable to plot",
        choices = variable_names(),
        selected = variable_names()[1]
      )
    })

    output$txt_selected_variable <- renderText({
      input$txt_variable_to_plot
    })

    output$plot_out <- renderPlot({
      req(input$txt_variable_to_plot)

      variable_name <- input$txt_variable_to_plot

      df %>%
        select(date, variable_name) %>%
        filter(date >= input$date_range[1],
               date <= input$date_range[2]) %>%
        gather(variable, value, -date) %>%
        ggplot(aes(x = date, y = value)) +
        geom_line() +
        ggtitle(variable_name) +
        scale_x_date(date_breaks = "1 year", date_labels = "%y") +
        xlab("") +
        ylab("")
    })

    observeEvent(input$line_number_first, {
      updateSelectInput(
        session,
        "txt_variable_to_plot",
        label = "Variable to plot",
        choices = variable_names(),
        selected = variable_names()[1]
      )
    })

    observeEvent(input$line_number_right, {
      cv <- match(input$txt_variable_to_plot, variable_names())

      if (cv < length(variable_names())) {
        cv <- cv + 1
      }

      updateSelectInput(
        session,
        "txt_variable_to_plot",
        label = "Variable to plot",
        choices = variable_names(),
        selected = variable_names()[cv]
      )
    })

    observeEvent(input$line_number_left, {
      cv <- match(input$txt_variable_to_plot, variable_names())

      if (cv > 1) {
        cv <- cv - 1
      }

      updateSelectInput(
        session,
        "txt_variable_to_plot",
        label = "Variable to plot",
        choices = variable_names(),
        selected = variable_names()[cv]
      )
    })

    observeEvent(input$line_number_last, {
      updateSelectInput(
        session,
        "txt_variable_to_plot",
        label = "Variable to plot",
        choices = variable_names(),
        selected = tail(variable_names(), 1)
      )
    })

    observeEvent(input$done, {
      stopApp(NULL)
    })
  }

  runGadget(ui, server, viewer = dialogViewer("Scatter plot", width = 1200, height = 1200))
}