#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.