Clean-up ames app

146-ames-explorer/app.R

@@ -20,59 +20,52 @@ source("modules/data_modules.R")
 # user interface
 ui <- fluidPage(
 
-   titlePanel("Ames Housing Data Explorer"),
+  titlePanel("Ames Housing Data Explorer"),
 
-   fluidRow(
-     column(
-       width = 3,
-       wellPanel(
-         varselect_mod_ui("plot1_vars")
-       )
-     ),
-     column(
-       width = 6,
-       scatterplot_mod_ui("plots")
-     ),
-     column(
-       width = 3,
-       wellPanel(
-         varselect_mod_ui("plot2_vars")
-       )
-     )
-   ),
+  fluidRow(
+    column(
+      width = 3,
+      wellPanel(
+        varselect_mod_ui("plot1_vars")
+      )
+    ),
+    column(
+      width = 6,
+      scatterplot_mod_ui("plots")
+    ),
+    column(
+      width = 3,
+      wellPanel(
+        varselect_mod_ui("plot2_vars")
+      )
+    )
+  ),
 
-   fluidRow(
-     column(
-       width = 12,
-       checkboxInput("highlight_ind", "Highlight records selected?", value = FALSE),
-       dataviewer_mod_ui("dataviewer")
-     )
-   )
+  fluidRow(
+    column(
+      width = 12,
+      checkboxInput("label", "Label brushed points?", value = FALSE),
+      dataviewer_mod_ui("dataviewer")
+    )
+  )
 )
 
 # server logic
 server <- function(input, output, session) {
 
-  plotdf <- reactive({
-    brushedPoints(ames, res$brush(), allRows = TRUE)
-  })
-
-
-  # execute plot variable selection modules
   plot1vars <- callModule(varselect_mod_server, "plot1_vars")
   plot2vars <- callModule(varselect_mod_server, "plot2_vars")
 
-  # execute scatterplot module
-  res <- callModule(scatterplot_mod_server,
-                    "plots",
-                    dataset = plotdf,
-                    plot1vars = plot1vars,
-                    plot2vars = plot2vars,
-                    highlight_ind = reactive({ input$highlight_ind }),
-                    highlight_rows = dt_highlight)
+  dat <- callModule(
+    scatterplot_mod_server,
+    "plots",
+    dataset = ames,
+    plot1vars = plot1vars,
+    plot2vars = plot2vars,
+    label = reactive({ input$label })
+  )
 
-  # execute dataviewer module
-  dt_highlight <- callModule(dataviewer_mod_server, "dataviewer", dataset = res$processed)
+  callModule(dataviewer_mod_server, "dataviewer", dat)
 }
 
 # Run the application

146-ames-explorer/helpers/plot_functions.R

@@ -1,60 +1,60 @@
-plot_labeller <- function(l, varname) {
-  if (varname == "Sale_Price") {
-    res <- dollar(l)
-  } else {
-    res <- comma(l)
-  }
-  return(res)
-}
-
-is_brushed <- function(dataset, brush_colname = "selected_") {
-  brush_colname %in% names(dataset)
-}
-
 #' Produce scatterplot with sales data and a single continuous variable
 #'
 #' @param data data frame with variables necessary for scatterplot.
 #' @param xvar variable (string format) to be used on x-axis.
 #' @param yvar variable (string format) to be used on y-axis.
 #' @param facetvar optional variable (string format) to use for facetted version of plot.
-#' @param highlight_ind boolean indicating whether to perform annotation of data points
-#'   on the plot. Default is \code{FALSE}.
-#' @param highlight_rows optional vector of row ids corresponding to which data point(s)
-#'   to highlight in the scatterplot. Default value is \code{NULL}.
+#' @param label whether or not to label brushed points.
 #'
 #' @return {\code{ggplot2} object for the scatterplot.
 #' @export
 #'
 #' @examples
 #' plot_obj <- scatter_sales(data = ames, xvar = "Lot_Frontage")
 #' plot_obj
-scatter_sales <- function(dataset, 
-                          xvar, 
-                          yvar, 
-                          facetvar = NULL, 
-                          highlight_ind = FALSE, 
-                          highlight_rows = NULL,
+scatter_sales <- function(dataset,
+                          xvar,
+                          yvar,
+                          facetvar = NULL,
+                          label = FALSE,
                           point_colors = c("black", "#66D65C")) {
-  
+
   x <- rlang::sym(xvar)
   y <- rlang::sym(yvar)
-  
-  p <- ggplot(dataset, aes(x = !!x, y = !!y)) 
-  
+
+  p <- ggplot(dataset, aes(x = !!x, y = !!y))
+
   p <- p +
     geom_point(aes(color = selected_)) +
     scale_color_manual(values = point_colors, guide = FALSE) +
     scale_x_continuous(labels = function(l) plot_labeller(l, varname = xvar)) +
     scale_y_continuous(labels = function(l) plot_labeller(l, varname = yvar)) +
     theme(axis.title = element_text(size = rel(1.2)),
           axis.text = element_text(size = rel(1.1)))
-  
+
   if (!is.null(facetvar)) {
     fvar <- rlang::sym(facetvar)
-    
+
     p <- p +
       facet_wrap(fvar)
   }
-
-  return(p)
+
+  if (label && any(dataset$selected_)) {
+    p <- p + geom_label_repel(
+      data = filter(dataset, selected_),
+      aes(label = Sale_Price)
+    )
+  }
+
+  p
+}
+
+
+
+plot_labeller <- function(l, varname) {
+  if (varname == "Sale_Price") {
+    dollar(l)
+  } else {
+    comma(l)
+  }
 }

146-ames-explorer/modules/data_modules.R

@@ -5,7 +5,7 @@
 #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements
 varselect_mod_ui <- function(id) {
   ns <- NS(id)
-  
+
   # define choices for X and Y variable selection
   var_choices <- list(
     `Sale price` = "Sale_Price",
@@ -20,7 +20,7 @@ varselect_mod_ui <- function(id) {
     `Above grade living area square feet` = "Gr_Liv_Area",
     `Garage area square feet` = "Garage_Area"
   )
-  
+
   # assemble UI elements
   tagList(
     selectInput(
@@ -68,11 +68,11 @@ varselect_mod_server <- function(input, output, session) {
     list(
       xvar = reactive({ input$xvar }),
       yvar = reactive({ input$yvar }),
-      facetvar = reactive({ 
+      facetvar = reactive({
         if (input$groupvar == "") {
           return(NULL)
         } else {
-          return(input$groupvar) 
+          return(input$groupvar)
         }
       })
     )
@@ -98,20 +98,15 @@ dataviewer_mod_ui <- function(id) {
 #' @param dataset data frame (reactive) used in scatterplots as produced by
 #'   the \code{brushedPoints} function in the scatterplot module
 #'
-#' @return reactive vector of row IDs corresponding to the current view in the 
+#' @return reactive vector of row IDs corresponding to the current view in the
 #'   datatable widget.
 dataviewer_mod_server <- function(input, output, session, dataset) {
-  
-  cols_select <- c("Year_Built", "Year_Sold", "Sale_Price", "Sale_Condition", "Lot_Frontage", "House_Style", 
+
+  cols_select <- c("Year_Built", "Year_Sold", "Sale_Price", "Sale_Condition", "Lot_Frontage", "House_Style",
                    "Lot_Shape", "Overall_Cond", "Overall_Qual")
-  
+
   output$table <- renderDT({
     filter(dataset(), selected_) %>%
       select(one_of(cols_select))
-  },
-  filter = 'top',
-  selection = "none")
-
-  # return highlight indicator and vector of row IDs selected by datatable filters
-  reactive({ input$table_rows_all })
+  }, filter = 'top', selection = 'none')
 }