In laderast/burro: Shiny App Package for setting up a data exploration session ("burro"w into the data)

library(flexdashboard)
library(ggplot2)
library(burro)
library(dplyr)
library(plotly)

#skimr::fix_windows_histograms()

if(!exists("dataset")){
  data(diamonds)
  dataset <- diamonds
#  stop("You need to input a dataset")
}

options(DT.options = list(scrollY="100vh"))

#dataset <- diamonds

my_data_table <- burro::check_data(dataset)

numericVars <- attr(my_data_table, "numericVars")
categoricalVars <- attr(my_data_table, "categoricalVars")
outcome_var <- attr(my_data_table, "outcome_var")
cat_no_outcome <- attr(my_data_table, "cat_no_outcome")

 dataOut <- reactive({
      my_data_table 
    })

#use rmarkdown::run() to run app
#https://somtom.github.io/post/using-dynamically-rendered-r-markdown-childs-for-reports/
#https://www.andrewheiss.com/blog/2020/01/01/flexdashboard-dynamic-data/

Data Overview

Row {.tabset .tabset-fade}

Visual Summary

plotOutput("visdat")

output$visdat <- renderCachedPlot({

      visdat::vis_dat(data.frame(dataOut()), palette = "cb_safe") +
        theme(axis.text.x = element_text(size = 15, angle = 45))
    },

    cacheKeyExpr= {dataOut()}
    )

Tabular Summary

#not interactive - using knitr.print defaults to make it look better
skimr::skim(my_data_table)

Data Dictionary

fillCol(
DT::DTOutput("data_dict")
)
output$data_dict <- DT::renderDT({
     #print(data_dictionary)

     if(is.null(data_dictionary)){
          return(NULL)
     }

      DT::datatable(data_dictionary, options=list(pageLength=50))
    })

Categorical Data

Row {.tabset .tabset-fade}

Single Variable

fillCol(flex = c(NA, 1),
selectInput(inputId = "singleVar",
  "Select Categorical Variable",
  choices = categoricalVars,
  selected =categoricalVars[1]),
plotOutput("singleTab"))

output$singleTab <- renderPlot({

      if(is.null(categoricalVars)){
        return(NULL)
      }

      #dataOut()[,c(input$singleVar)] %>%
      dataOut() %>%
        #data.frame() %>%
        mutate(gr = 1) %>%
        ggplot(aes_string(x=input$singleVar, fill=input$singleVar)) +
        geom_bar(aes(y = ..count..), color="black") +
        viridis::scale_fill_viridis(discrete=TRUE, option="magma") +
        geom_text(aes(group=gr, label = scales::percent(..prop..),
                      y= ..count..), stat= "count", vjust=-0.5) +
        theme(axis.text.x=element_text(angle=90), legend.position = "none")
    })

Outcome View

fillCol(flex = c(NA,1),
  inputPanel(
    selectInput(inputId = "condTab", "Select Variable",
            choices=cat_no_outcome, selected=cat_no_outcome[1]),

    selectInput(inputId = "outcomeTab", "Select Outcome Variable",
            choices=outcome_var, selected=outcome_var[2])),

    plotlyOutput("proportionBarplot")
)

    proportionTable <- reactive({

      out <- dataOut()[,c(input$condTab, input$outcomeTab), with=FALSE]
      out
    })

    output$proportionTab <- renderPrint({
      tab <- table(proportionTable(), useNA="ifany")
      return(tab[,"Yes"]/(tab[,"No"] + tab[,"Yes"]))

    })


    output$proportionBarplot <- renderPlotly({

      #need to figure out how to calculate cumulative sum?
      #https://stackoverflow.com/questions/43520318/how-to-use-percentage-as-label-in-stacked-bar-plot

      out_plot <- burro:::percent_plot(proportion_table = proportionTable(),
                   outcome_var = input$outcomeTab,
                   condition_var = input$condTab) +
        theme(legend.position = "None")

      ggplotly(out_plot, tooltip = c("x", "fill", "y"))

    })

Tabular

fillCol(flex = c(NA,2,1), 
        inputPanel(
          selectInput(inputId = "crossTab1", "Select Crosstab Variable (x)",
            choices=categoricalVars, selected=categoricalVars[1]),
          selectInput(inputId = "crossTab2", "Select Crosstab Variable (y)",
           choices=categoricalVars, selected=categoricalVars[2])),
        plotly::plotlyOutput("cross_size"),
        verbatimTextOutput("crossTab")
)

output$crossTab <- renderPrint({

      out <- dataOut()[,c(input$crossTab1, input$crossTab2), with=FALSE]
      tab <- table(out, useNA = "ifany")
      tab
    })

output$cross_size <- plotly::renderPlotly({
      outplot <- dataOut() %>%
        data.frame() %>%
        ggplot(aes_string(y=input$crossTab1, x=input$crossTab2)) +
        geom_count() +
        theme(axis.text.x=element_text(angle=90))

      plotly::ggplotly(outplot, tooltip = "n")
    })

Missing Data Explorer

fillCol(flex=c(NA,1), 
        selectInput(inputId = "missingVar", 
                    "Select Variable to Examine",
                    choices=categoricalVars, selected = categoricalVars[1]),
        plotOutput("missingTab")
        )

output$missingTab <- renderPlot({

      var <- sym(input$missingVar)

      dataOut() %>%
        data.frame() %>%
        naniar::gg_miss_fct(fct = !!var) +
        theme(axis.text = element_text(size = 15))

    })

Continuous Data

Row {.tabset .tabset-fade}

Histogram Explorer

fillCol(flex=c(NA,1), inputPanel(
  selectInput(inputId = "numericVarHist", "Select Numeric Variable",
              choices = numericVars, selected=numericVars[1]),
   sliderInput("bins", "Number of bins:", min = 1, max = 50,value = 30)
                                 ),
   plotOutput("histPlot")
        )

output$histPlot <- renderPlot({

      outPlot <- ggplot(dataOut(), aes_string(x=input$numericVarHist)) +
        geom_histogram(bins=input$bins) + theme(text=element_text(size=20),
                                                axis.text.x = element_text(angle=90))
      outPlot
    })

Boxplot Explorer

fillCol(flex=c(NA,1),  
        inputPanel(
  selectInput(inputId = "numericVarBox", "Select Numeric Variable",
              choices = numericVars, selected=numericVars[1]),
  selectInput(inputId = "catVarBox", "Select Category to Condition on",
              choices = categoricalVars, selected=categoricalVars[1])),   
  plotOutput("boxPlot"))

output$boxPlot <- renderPlot({
      outPlot <- ggplot(dataOut(), aes_string(x=input$catVarBox,
                                              y=input$numericVarBox,
                                              fill=input$catVarBox)) +
        geom_boxplot() + theme(text=element_text(size=20), axis.text.x =
                                 element_text(angle=90)) +
        theme(legend.position = "none")
      outPlot
    })

Correlation Explorer

fillCol( flex=c(NA,1),
  inputPanel(
    selectInput("x_var", "Select Y Variable",
                choices=numericVars, selected = numericVars[1]),
    selectInput("y_var", "Select Y Variable", choices=numericVars, 
                selected = numericVars[2])
                                ),
  plotOutput("corr_plot")
  )


output$corr_plot <- renderPlot({

      mini_frame <- dataOut() %>% 
        data.frame() %>% 
        select(!!sym(input$x_var), !!sym(input$y_var)) %>%
        tidyr::drop_na()
      xcol <- mini_frame %>% pull(!!sym(input$x_var))
      ycol <- mini_frame %>% pull(!!sym(input$y_var))

      corval <- signif(cor(xcol, ycol), digits = 3)

      ggplot(dataOut(), aes_string(x=input$x_var, y=input$y_var)) +
        naniar::geom_miss_point() + stat_smooth(method=lm, se=FALSE) +
        #viridis::scale_color_viridis(discrete = TRUE, option="magma") +
        ggtitle(paste(input$x_var, "vs.", input$y_var, "correlation =", corval))
    })

laderast/burro documentation built on July 19, 2020, 10:51 p.m.