R/mapdata.R

In dpowerstp/mctroubledprops: Processes and Visualizes Montgomery County Troubled Properties Data

#' Filter troubled properties and create labels
#'
#' Optionally filters Montgomery County troubled properties dataset to a rating, and creates labels for circle-marker layers generated by markers_severity() or markers_severity_num()
#'
#' @param filter Rating to which data is being filtered; options include "Troubled", "Compliant", "At-Risk", or "Tbd." Default NULL, for no filter
#' @param mctroubledprops Montgomery County troubled properties data, read and processed by read_fix_mc
#'
#' @return A list of 1) the filtered dataset 2) the text supplied to the label argument of a leaflet map 3) the text supplied to the popup argument of a leaflet map
#' @export
#'
#' @examples
filter_labels <- function(mctroubledprops, filter = NULL){
  df <- mctroubledprops

  if (!is.null(filter)){
    df <- df %>%
      dplyr::filter(rating == filter)
  }

  labtext <- leafletwrappers::label_output(df, "Property name: {communityname}<p></p>
Address: {fulladdress}<p></p>
Rating: {str_to_title(rating)}<p></p>
                      Total units: {unitcount}")

  poptext <- leafletwrappers::label_output(df, "Property name: {communityname}<p></p>
Address: {fulladdress}<p></p>
Rating: {str_to_title(rating)}<p></p>
Severity Index: {severityindex}<p></p>
                      Total units: {unitcount}<p></p>
                        Average violations per unit: {averageviolationsperunit}<p></p>
                        Units inspected: {unitsinspected}<p></p>
                        Units without violations: {noviolationsobserved}<p></p>
                        Percent of units with mold: {units_with_mold}<p></p>
                        Percent of units with infestation: {infestedunitspercentage}<p></p>
                        Frequency of inspections: {inspectionfrequency}")

  list("df" = df, "labtext" = labtext, "poptext" = poptext)

}


#' Generate colors for TP ratings
#'
#' Function to generate a leaflet palette function for coloring rating variable in leaflet maps
#'
#' @return Color palette function
#' @export
#'
#' @examples
color_rating <- function(){
  leaflet::colorFactor(c("#85ffb1", "#ffcc00", "#fa8484", "#fff0f0"), c("Compliant", "At-Risk", "Troubled", "Tbd"), ordered = T)
}


#' Add Circle Markers of Building Rating
#'
#' Adds circlemarkers of Montgomery County Troubled property building ratings to leaflet map
#'
#' @param basemap Basemap adding layer to
#' @param filter Filter to apply to mctroubledprops dataframe analyzing data/adding circle markers; default NULL
#' @param sizeadjust Whether to scale the size of the circle markers to the number of units in the property; default F
#' @param mctroubledprops Dataframe of Montgomery County troubled properties
#'
#' @return Leaflet map with Circle-markers added
#' @export
#'
#' @examples
markers_severity <- function(basemap, mctroubledprops, filter = NULL, sizeadjust = F){

  color_rating <- mctroubledproperties::color_rating()

  # browser()
  listoutput <- mctroubledproperties::filter_labels(mctroubledprops = mctroubledprops, filter = filter)

  if (is.null(filter)){
    filter <- "All properties"
  }

  grp <- filter

  if (!sizeadjust){

    bm <-   basemap %>%
      leaflet::addCircleMarkers(radius = 5,
                       group = grp,
                       stroke = T,
                       color = "Black",
                       weight = 0.5,
                       opacity = 0.5,
                       fillColor = ~ color_rating(rating),
                       fillOpacity = 0.8,
                       popup = listoutput[[3]],
                       popupOptions = leaflet::popupOptions(maxHeight = 200, maxWidth = 250, textsize= "10px"),
                       label = listoutput[[2]],
                       fill = T,
                       labelOptions = leaflet::labelOptions(opacity = 0.8, textsize = "10px"),
                       options = leaflet::markerOptions(riseOnHover = T),
                       data = listoutput[[1]])
  }

  if (sizeadjust){

    grp <- paste0(grp, ": sized to units")

    bm <-   basemap %>%
      leaflet::addCircleMarkers(radius = ~ sqrt(as.numeric(unitcount)),
                       group = grp,
                       stroke = T,
                       color = "Black",
                       weight = 0.5,
                       opacity = 0.5,
                       fillColor = ~ color_rating(rating),
                       fillOpacity = 0.8,
                       popup = listoutput[[3]],
                       popupOptions = leaflet::popupOptions(maxHeight = 200, maxWidth = 250, textsize= "10px"),
                       label = listoutput[[2]],
                       fill = T,
                       labelOptions = leaflet::labelOptions(opacity = 0.8, textsize = "10px"),
                       options = leaflet::markerOptions(riseOnHover = T),
                       data = listoutput[[1]])
  }


  if (!exists("overlaygrps")){
    overlaygrps <<- grp
  }
  else if (exists("overlaygrps")){
    overlaygrps <<- c(overlaygrps, grp)
  }

  bm %>%
    leaflet::addLegend(position = "topleft",
              pal = color_rating,
              values = ~ listoutput[[1]][["rating"]],
              title = filter,
              data = listoutput[[1]],
              group = grp)

}



#' Add Circle Markers by Severity
#'
#' Adds circlemarkers of Montgomery County Troubled property buildings colored by severity to leaflet map
#'
#' @param basemap Basemap adding layer to
#' @param filter Filter to apply to mctroubledprops dataframe analyzing data/adding circle markers; default NULL
#' @param sizeadjust Whether to scale the size of the circle markers to the number of units in the property; default F
#' @param mctroubledprops Dataframe of Montgomery County troubled properties
#'
#' @return Leaflet map with Circle-markers added, colored by severity
#' @export
#'
#' @examples
markers_severity_num <- function(basemap, mctroubledprops, filter = NULL, sizeadjust = F){
  # browser()

  listoutput <- mctroubledproperties::filter_labels(mctroubledprops = mctroubledprops, filter = filter)

  if (is.null(filter)){
    filter <- "All properties"
  }

  # browser()
  pal_severity <- leaflet::colorBin(palette = "YlOrRd",domain = sf::st_drop_geometry(listoutput[[1]])[["severityindex"]], bins = seq(0, 5, 1))

  grp <- as.character(filter)

  if (!sizeadjust){
    bm <- basemap %>%
      leaflet::addCircleMarkers(radius = 5,
                       group = grp,
                       stroke = T,
                       color = "Black",
                       weight = 0.5,
                       opacity = 0.5,
                       fillColor = ~ pal_severity(severityindex),
                       fillOpacity = 0.8,
                       popup = listoutput[[3]],
                       popupOptions = leaflet::popupOptions(maxHeight = 200, maxWidth = 250, textsize= "10px"),
                       label = listoutput[[2]],
                       fill = T,
                       labelOptions = leaflet::labelOptions(opacity = 0.8, textsize = "10px"),
                       options = leaflet::markerOptions(riseOnHover = T),
                       data = listoutput[[1]])
  }

  if (sizeadjust){

    grp <- paste0(grp, ": sized to units")

    bm <- basemap %>%
      leaflet::addCircleMarkers(radius = ~ sqrt(as.numeric(unitcount)),
                       group = grp,
                       stroke = T,
                       color = "Black",
                       weight = 0.5,
                       opacity = 0.5,
                       fillColor = ~ pal_severity(severityindex),
                       fillOpacity = 0.8,
                       popup = listoutput[[3]],
                       popupOptions = leaflet::popupOptions(maxHeight = 200, maxWidth = 250, textsize= "10px"),
                       label = listoutput[[2]],
                       fill = T,
                       labelOptions = leaflet::labelOptions(opacity = 0.8, textsize = "10px"),
                       options = leaflet::markerOptions(riseOnHover = T),
                       data = listoutput[[1]])
  }


  if (!exists("overlaygrps")){
    overlaygrps <<- grp
  }
  else if (exists("overlaygrps")){
    overlaygrps <<- c(overlaygrps, grp)
  }

  bm %>%
    # clusterOptions = markerClusterOptions()) %>%
    leaflet::addLegend(position = "topleft",
              pal = pal_severity,
              values = ~ listoutput[[1]][["severityindex"]],
              title = paste0(as.character(filter), " severity index"),
              data = listoutput[[1]],
              group = grp)

}