R/datexp_explore.R

In NicolasJBM/datexp: Interface to facilitate data exploration

#' Interface to explore variables distributions and relationships.
#' @param x  Tibble. Table containing the variables to explore.
#' @importFrom miniUI miniPage
#' @importFrom miniUI gadgetTitleBar
#' @importFrom miniUI miniTabstripPanel
#' @importFrom miniUI miniTabPanel
#' @importFrom miniUI miniContentPanel
#' @importFrom shiny fillCol
#' @importFrom shiny fillRow
#' @importFrom shiny icon
#' @importFrom shiny fileInput
#' @importFrom shiny textInput
#' @importFrom shiny dateInput
#' @importFrom shiny numericInput
#' @importFrom shiny textAreaInput
#' @importFrom shiny selectInput
#' @importFrom shiny checkboxInput
#' @importFrom shiny downloadButton
#' @importFrom shiny downloadHandler
#' @importFrom shiny stopApp
#' @importFrom shiny runGadget
#' @importFrom shiny conditionalPanel
#' @importFrom shiny tags
#' @importFrom shiny dataTableOutput
#' @importFrom shiny htmlOutput
#' @importFrom shiny uiOutput
#' @importFrom shiny plotOutput
#' @importFrom shiny actionButton
#' @importFrom shiny renderDataTable
#' @importFrom shiny renderUI
#' @importFrom shiny renderPlot
#' @importFrom shiny renderText
#' @importFrom shiny reactive
#' @importFrom shiny reactiveValues
#' @importFrom shiny observe
#' @importFrom shiny observeEvent
#' @importFrom shiny withProgress
#' @importFrom shiny incProgress
#' @importFrom shiny h3
#' @importFrom shiny isolate
#' @importFrom shiny reactiveValuesToList
#' @importFrom shiny tableOutput
#' @importFrom shiny renderTable
#' @importFrom shiny HTML
#' @importFrom dplyr select
#' @importFrom dplyr filter
#' @importFrom dplyr group_by
#' @importFrom dplyr summarize_all
#' @importFrom dplyr mutate
#' @importFrom dplyr %>%
#' @importFrom dplyr case_when
#' @importFrom dplyr arrange
#' @importFrom dplyr bind_rows
#' @importFrom dplyr everything
#' @importFrom purrr map
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 geom_density
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 xlab
#' @importFrom ggplot2 theme_light
#' @importFrom ggplot2 geom_bar
#' @importFrom ggplot2 geom_text
#' @importFrom corrgram corrgram
#' @importFrom corrgram panel.conf
#' @importFrom corrgram panel.pie
#' @importFrom purrr map_lgl
#' @importFrom stats na.omit
#' @importFrom stats heatmap
#' @export


datexp_explore <- function(x) {

  # Increase the size of the memory allocated to the documents
  options(shiny.maxRequestSize = 30 * 1024 ^ 2)

  # Interface
  ui <- miniPage(
    gadgetTitleBar("Check variables shape and relationships"),

    miniTabstripPanel(
      miniTabPanel(
        "Distribution",
        icon = icon("bar-chart"),

        miniContentPanel(
          fillCol(
            flex = c(1, 1, 1, 12),

            uiOutput("optDensity"),

            tags$hr(),

            fillRow(
              
              actionButton(
                "applyTransform",
                "transform",
                icon = icon("edit")
              ),

              actionButton(
                "unTransform",
                "untransform",
                icon = icon("reply")
              ),
              
              actionButton(
                "plotDensity",
                "plot",
                icon = icon("bar-chart")
              )
            ),

            plotOutput(
              "density",
              height = "100%",
              width = "100%"
            )
          )
        )
      ),

      miniTabPanel(
        "Relationship",
        icon = icon("arrows"),

        miniContentPanel(
          fillCol(
            flex = c(1, 1, 1, 12),

            uiOutput("OptBivariate"),

            tags$hr(),

            actionButton(
              "plotBivariate",
              "plot",
              icon = icon("arrows")
            ),

            plotOutput(
              "bivariate",
              height = "100%",
              width = "100%"
            )
          )
        )
      ),

      miniTabPanel(
        "Correlations",
        icon = icon("th"),

        miniContentPanel(
          fillCol(
            flex = c(1, 1, 1, 12),

            fillRow(
              flex = c(1,1),
              selectInput(
                "typeVarCorrel",
                "Select the type of variable to plot",
                choices = c("numeric", "categorical"),
                selected = "numeric"
              ),
              conditionalPanel(
                condition = "input.typeVarCorrel == 'numeric'",
                selectInput(
                  "method",
                  "Select the type of relationship to display",
                  choices = c("pearson", "spearman", "conditional"),
                  selected = "pearson"
                )
              )
            ),

            tags$hr(),

            actionButton(
              "plotCorrel",
              "plot",
              icon = icon("th")
            ),

            plotOutput(
              "correlation",
              height = "100%",
              width = "100%"
            )
          )
        )
      )
    )
  )



  # Server
  server <- function(input, output, session) {
    
    # Selection of variables
    output$optDensity <- renderUI({
      choices <- names(x)

      selection <- choices[1]

      ui <- fillRow(
        selectInput(
          "selectDensity",
          "Select a variable",
          choices = choices,
          selected = selection,
          multiple = FALSE
        ),

        textInput(
          "formula",
          "Write a transformation (x being the variable)",
          value = "x"
        )
      )

      ui
    })


    # Initialize the base and apply/undo transformations
    data <- reactiveValues()

    data$base <- as.data.frame(x)

    observeEvent(input$applyTransform, {

      x <- data$base[, input$selectDensity]

      if (is.numeric(x)) {
        data$base[, input$selectDensity] <- eval(parse(text = input$formula))
      } else {
        x <- as.factor(x)
        data$base[, input$selectDensity] <- factor(x, levels = levels(x)[eval(parse(text = input$formula))])
      }
    })


    observeEvent(input$unTransform, {
      data$base[, input$selectDensity] <- x[, input$selectDensity]
    })


    # Plot density
    output$density <- renderPlot({
      
      input$plotDensity

      isolate({
        
        validate(
          need(input$selectDensity, "Please choose a variable")
        )
        
        if (!is.null(data$base)) {
          x <- data$base[, input$selectDensity]
        } else {
          x <- x[, input$selectDensity]
        }

        if (is.numeric(x)) {
          plot <- na.omit(data.frame(x = eval(parse(text = input$formula)))) %>%
            ggplot(aes(x)) +
            geom_density() +
            xlab(input$selectDensity) +
            theme_light()
        } else {
          plot <- na.omit(data.frame(x = x)) %>%
            ggplot(aes(x)) +
            geom_bar() +
            xlab(input$selectDensity) +
            theme_light()
        }
      })
      
      plot
    })


    # Plot bivariate relationship
    output$OptBivariate <- renderUI({
      choices <- names(data$base)

      ui <- fillRow(
        selectInput(
          "var1",
          "Select a x variable",
          choices = choices,
          selected = choices[1],
          multiple = FALSE
        ),

        selectInput(
          "var2",
          "Select a y variable",
          choices = choices,
          selected = choices[1],
          multiple = FALSE
        ),

        selectInput(
          "var3",
          "Select a z variable",
          choices = c("all", choices),
          selected = "all",
          multiple = FALSE
        )
      )

      ui
    })


    output$bivariate <- renderPlot({
      
      input$plotBivariate

      isolate({
        
        validate(
          need(input$var1, "Please choose a x variable"),
          need(input$var2, "Please choose a y variable"),
          need(input$var3, "Please choose a z variable")
        )
        
        if (is.numeric(data$base[, input$var1]) & is.numeric(data$base[, input$var2])) {
          plot <- datexp_scatter(
            x = data$base,
            var1 = input$var1,
            var2 = input$var2,
            var3 = input$var3
          )
        } else if (!is.numeric(data$base[, input$var1]) & is.numeric(data$base[, input$var2])) {
          plot <- datexp_violin(
            x = data$base,
            var1 = input$var1,
            var2 = input$var2,
            var3 = input$var3
          )
        } else if (is.numeric(data$base[, input$var1]) & !is.numeric(data$base[, input$var2])) {
          plot <- datexp_violin(
            x = data$base,
            var1 = input$var2,
            var2 = input$var1,
            var3 = input$var3
          )
        } else if (!is.numeric(data$base[, input$var1]) & !is.numeric(data$base[, input$var2])) {
          plot <- datexp_crosscat(
            x = data$base,
            var1 = input$var1,
            var2 = input$var2
          )
        } else {
          plot <- ggplot() + geom_text(aes(x = 0, y = 0, label = "Sorry, this cannot be plotted.\nRevise your selection"))
        }
      })
      
      plot
    })


    output$correlation <- renderPlot({
      
      input$plotCorrel

      isolate({
        
        validate(
          need(input$typeVarCorrel, "Please choose a type of variable"),
          need(input$method, "Please choose a method")
        )
        
        if (input$typeVarCorrel == "numeric") {
          x <- data$base[, map_lgl(data$base, is.numeric)]
          association <- datexp_assonum(x, method = input$method)
        } else {
          x <- data$base[, map_lgl(data$base, is.numeric) == FALSE]
          association <- datexp_assocat(x)
        }
        if (input$typeVarCorrel != "numeric" | input$method != "conditional"){
          plot <- corrgram(
            as.matrix(association),
            type = "cor",
            order = "HC",
            upper.panel = panel.conf,
            lower.panel = panel.pie
          )
        } else {
          plot <- heatmap(as.matrix(association))
        }
        
      })
      
      plot
    })


    # Prepare the output
    observeEvent(input$done, {
      stopApp()
    })
  }

  runGadget(ui, server)
}