From 72170f9f65758396f71fd6bbf71cbbdb127849e1 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Fri, 1 Mar 2019 17:21:57 -0600 Subject: [PATCH] clean-up implementation of 146 --- 146-ames-explorer/app.R | 77 +++++++------- 146-ames-explorer/helpers/data_functions.R | 14 --- 146-ames-explorer/helpers/plot_functions.R | 62 +++++------ 146-ames-explorer/modules/data_modules.R | 23 ++--- 146-ames-explorer/modules/plot_modules.R | 113 ++++++--------------- 5 files changed, 106 insertions(+), 183 deletions(-) delete mode 100755 146-ames-explorer/helpers/data_functions.R diff --git a/146-ames-explorer/app.R b/146-ames-explorer/app.R index d57aaa62..4540ad93 100755 --- a/146-ames-explorer/app.R +++ b/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 diff --git a/146-ames-explorer/helpers/data_functions.R b/146-ames-explorer/helpers/data_functions.R deleted file mode 100755 index 05ac1431..00000000 --- a/146-ames-explorer/helpers/data_functions.R +++ /dev/null @@ -1,14 +0,0 @@ -highlight_prep <- function(data, highlight_rows) { - # assumes data set has a "selected_" column - res_filtered <- data %>% - filter(selected_) %>% - mutate(label_ind = row_number() %in% highlight_rows) - - res_unfiltered <- data %>% - filter(!selected_) %>% - mutate(label_ind = FALSE) - - res <- bind_rows(res_filtered, res_unfiltered) - - return(res) -} diff --git a/146-ames-explorer/helpers/plot_functions.R b/146-ames-explorer/helpers/plot_functions.R index 0e5705bd..72792992 100755 --- a/146-ames-explorer/helpers/plot_functions.R +++ b/146-ames-explorer/helpers/plot_functions.R @@ -1,26 +1,10 @@ -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 @@ -28,19 +12,18 @@ is_brushed <- function(dataset, brush_colname = "selected_") { #' @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) + @@ -48,13 +31,30 @@ scatter_sales <- function(dataset, 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) + } } diff --git a/146-ames-explorer/modules/data_modules.R b/146-ames-explorer/modules/data_modules.R index fb1ff49c..f72bee45 100755 --- a/146-ames-explorer/modules/data_modules.R +++ b/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') } diff --git a/146-ames-explorer/modules/plot_modules.R b/146-ames-explorer/modules/plot_modules.R index 152130a9..663b60ae 100755 --- a/146-ames-explorer/modules/plot_modules.R +++ b/146-ames-explorer/modules/plot_modules.R @@ -8,7 +8,7 @@ #' @examples scatterplot_mod_ui <- function(id) { ns <- NS(id) - + tagList( fluidRow( column( @@ -38,16 +38,14 @@ scatterplot_mod_ui <- function(id) { #' Scatterplot module server-side processing #' #' This module produces a scatterplot with the sales price against a variable selected by the user. -#' +#' #' @param input,output,session standard \code{shiny} boilerplate. #' @param dataset data frame (non-reactive) with variables necessary for scatterplot. #' @param plot1_vars reactive list of plot 1 x variable, y variable, and grouping variable. #' @param plot2_vars reactive list of plot 2 x variable, y variable, and grouping variable. #' @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}. -#' +#' #' @return list with following components: #' \describe{ #' \item{plot_data}{reactive data frame containing only the \code{xvar} and \code{yvar} variables}. @@ -56,86 +54,37 @@ scatterplot_mod_ui <- function(id) { #' @export #' #' @examples -scatterplot_mod_server <- function(input, - output, - session, - dataset, - plot1vars, - plot2vars, - highlight_ind = FALSE, - highlight_rows = NULL) { - - # reactive data frame with new column indicating if rows were - # selected in brush - processed <- reactive({ - res <- brushedPoints(dataset(), input$brush, allRows = TRUE) - return(res) - }) - - - plot1_obj <- reactive({ - p <- scatter_sales(dataset(), - xvar = plot1vars$xvar(), - yvar = plot1vars$yvar(), - facetvar = plot1vars$facetvar(), - highlight_ind = highlight_ind(), - highlight_rows = highlight_rows()) - - # was: if (highlight_ind()) - if (highlight_ind()) { - validate( - need( - any(dataset()$selected_), "Brush at least one point on a plot" - ) - ) - df <- dataset() %>% - filter(selected_) %>% - slice(highlight_rows()) - - p <- p + - geom_label_repel(data = df, aes(label = Sale_Price)) - } - - return(p) - }) - - plot2_obj <- reactive({ - p <- scatter_sales(dataset(), - xvar = plot2vars$xvar(), - yvar = plot2vars$yvar(), - facetvar = plot2vars$facetvar(), - highlight_ind = highlight_ind(), - highlight_rows = highlight_rows()) - - if (highlight_ind()) { - validate( - need( - any(dataset()$selected_), "Brush at least one point on a plot" - ) - ) - df <- dataset() %>% - filter(selected_) %>% - slice(highlight_rows()) - - p <- p + - geom_label_repel(data = df, aes(label =Sale_Price)) - } - - return(p) +scatterplot_mod_server <- function(input, + output, + session, + dataset, + plot1vars, + plot2vars, + label = reactive(FALSE)) { + + dat <- reactive({ + brushedPoints(dataset, input$brush, allRows = TRUE) }) - + output$plot1 <- renderPlot({ - plot1_obj() + scatter_sales( + dat(), + xvar = plot1vars$xvar(), + yvar = plot1vars$yvar(), + facetvar = plot1vars$facetvar(), + label = label() + ) }) - + output$plot2 <- renderPlot({ - plot2_obj() - }) - - return( - list( - processed = processed, - brush = reactive({ input$brush }) + scatter_sales( + dat(), + xvar = plot2vars$xvar(), + yvar = plot2vars$yvar(), + facetvar = plot2vars$facetvar(), + label = label() ) - ) + }) + + dat }