From 9e0d29c9781fa719104104dbb08c21418a8567f4 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 14 Aug 2026 15:10:42 +0000 Subject: [PATCH 01/20] initial push --- ratio-analysis/ratio-analysis.qmd | 597 ++++++++++++ ratio-analysis/ratio-analysis.sql | 67 ++ ratio-analysis/renv/activate.R | 1438 +++++++++++++++++++++++++++++ 3 files changed, 2102 insertions(+) create mode 100644 ratio-analysis/ratio-analysis.qmd create mode 100644 ratio-analysis/ratio-analysis.sql create mode 100644 ratio-analysis/renv/activate.R diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd new file mode 100644 index 0000000..61acf50 --- /dev/null +++ b/ratio-analysis/ratio-analysis.qmd @@ -0,0 +1,597 @@ +--- +title: "Ratio Analysis for `r paste0(tools::toTitleCase(gsub('-', ' ', sub('^[0-9]+-', '', sub('\\.xlsx$', '', basename(params$input_file))))), ', ', basename(dirname(params$input_file)))`" +subtitle: "Prepared `r format(Sys.Date(), '%B %d, %Y')`" +format: + pdf: + documentclass: article + geometry: margin=1in + fontsize: 11pt + fig-pos: H + tbl-pos: H + include-in-header: + text: | + \usepackage{colortbl} + \usepackage{xcolor} + \usepackage{booktabs} + \usepackage{longtable} + \usepackage{float} + \usepackage{caption} + \captionsetup[table]{position=top} + \setlength{\aboverulesep}{0pt} + \setlength{\belowrulesep}{0pt} +params: + input_file: "" +execute: + echo: false + warning: false + message: false +--- + +```{r setup} +library(DBI) +library(noctua) +library(openxlsx) +library(dplyr) +library(tidyr) +library(ggplot2) +library(ggspatial) +library(sf) +library(scales) +library(ccao) +library(assessr) +library(readr) +library(knitr) +library(glue) +library(rosm) +library(grid) + +set_default_cachedir("rosm.cache") + +input_file <- params$input_file +file_base <- sub("\\.xlsx$", "", basename(input_file)) +town_code <- substr(file_base, 1, 2) +year_val <- basename(dirname(input_file)) + +town_name <- ccao::town_dict |> + filter(township_code == town_code) |> + pull(township_name) |> + first() + +cap_tbl1 <- glue( + "Town-Level IAAO Statistics — {town_name} Township, {year_val}.", + " Green shading meets IAAO standard; orange shading does not." +) +cap_tbl2 <- glue( + "Ratio Curve by Sale Price Decile — {town_name} Township, {year_val}" +) +cap_tbl3 <- glue( + "Neighborhood-Level Median Ratios — {town_name} Township, {year_val}.", + " Warm colors (red–yellow) indicate under-assessment;", + " green (0.95–1.05) indicates near-standard;", + " cool colors (blue) indicate over-assessment." +) +cap_fig1 <- glue( + "IAAO Metrics: Model vs. Desk Review — {town_name} Township, {year_val}.", + " Green shaded band shows the IAAO acceptable range for each metric." +) +cap_fig2 <- glue( + "Sale Price Ratio Curve — {town_name} Township, {year_val}.", + " Each labeled point is the median ratio within that sale price decile.", + " Dotted lines show the IAAO acceptable range (0.9–1.1)." +) +cap_fig3 <- glue( + "Neighborhood Median Assessment Ratios — {town_name} Township, {year_val}.", + " Green (0.95–1.05) meets the ±5% threshold;", + " warm colors indicate under-assessment;", + " cool colors indicate over-assessment.", + " The right panel shows the change that desk review made." +) + +# --------------------------------------------------------------------------- +# Read desk review inputs +# --------------------------------------------------------------------------- +dr_wb <- loadWorkbook(input_file) +dr_vals <- read.xlsx(dr_wb, sheet = 1) |> + tibble(.name_repair = "unique") |> + select(pin = PIN, desk_review_value = Desk.Review.Value) + +# --------------------------------------------------------------------------- +# Athena: pull model values and the residential PIN universe +# --------------------------------------------------------------------------- +noctua_options(unload = TRUE) +conn <- dbConnect(noctua::athena(), rstudio_conn_tab = FALSE) + +dr_towns <- town_code + +model_vals <- dbGetQuery( + conn = conn, + glue_sql( + read_file("ratio-analysis.sql"), + .con = conn + ) +) + +dbDisconnect(conn) + +# --------------------------------------------------------------------------- +# Join and compute ratios / price deciles +# --------------------------------------------------------------------------- +all_parcels <- dr_vals |> + inner_join(select(model_vals, pin), by = "pin") |> + full_join(model_vals, by = "pin") |> + filter(township_name == town_name) |> + mutate( + sale_date = as.Date(sale_date), + sale_excluded = if_else(is.na(sale_price), NA, is.na(desk_review_value)), + price_decile = ntile( + if_else(sale_excluded %in% TRUE, NA_real_, sale_price), 10 + ), + model_sale_ratio = model_value / sale_price, + desk_review_sale_ratio = desk_review_value / sale_price + ) + +# --------------------------------------------------------------------------- +# Compute statistics +# --------------------------------------------------------------------------- +sales_df <- all_parcels |> + filter(!is.na(sale_price), !sale_excluded %in% TRUE) + +town_stats <- tibble( + model_ratio = median(sales_df$model_sale_ratio, na.rm = TRUE), + model_cod = assessr::cod(sales_df$model_sale_ratio), + model_prd = assessr::prd(sales_df$model_value, sales_df$sale_price), + model_prb = assessr::prb(sales_df$model_value, sales_df$sale_price), + model_mki = assessr::mki(sales_df$model_value, sales_df$sale_price), + desk_review_ratio = median(sales_df$desk_review_sale_ratio, na.rm = TRUE), + desk_review_cod = assessr::cod(sales_df$desk_review_sale_ratio), + desk_review_prd = assessr::prd( + sales_df$desk_review_value, sales_df$sale_price + ), + desk_review_prb = assessr::prb( + sales_df$desk_review_value, sales_df$sale_price + ), + desk_review_mki = assessr::mki( + sales_df$desk_review_value, sales_df$sale_price + ), + price_range = paste( + scales::dollar(min(sales_df$sale_price)), + scales::dollar(max(sales_df$sale_price)), + sep = "–" + ), + number_of_sales = nrow(sales_df) +) + +decile_stats <- sales_df |> + summarize( + model_ratio = median(model_sale_ratio, na.rm = TRUE), + model_cod = assessr::cod(model_sale_ratio), + desk_review_ratio = median(desk_review_sale_ratio, na.rm = TRUE), + desk_review_cod = assessr::cod(desk_review_sale_ratio), + price_range = paste( + scales::dollar(min(sale_price)), + scales::dollar(max(sale_price)), + sep = "–" + ), + number_of_sales = n(), + .by = price_decile + ) |> + arrange(price_decile) + +# --------------------------------------------------------------------------- +# Methods summary values +# --------------------------------------------------------------------------- +n_original_sales <- sum(!is.na(all_parcels$sale_price)) +n_final_sales <- nrow(sales_df) +n_excluded_sales <- n_original_sales - n_final_sales +n_total_pins <- nrow(all_parcels) +pct_with_sale <- round(n_final_sales / n_total_pins * 100, 1) + +sale_dates <- all_parcels$sale_date[!is.na(all_parcels$sale_date)] +min_sale_date <- format(min(sale_dates), "%B %d, %Y") +max_sale_date <- format(max(sale_dates), "%B %d, %Y") + +# --------------------------------------------------------------------------- +# IAAO helpers +# --------------------------------------------------------------------------- +iaao_check <- function(metric, value) { + switch(metric, + "Median Ratio" = value >= 0.90 & value <= 1.10, + "COD" = value <= 15.0, + "PRD" = value >= 0.98 & value <= 1.03, + "PRB" = value >= -0.05 & value <= 0.05, + "MKI" = value >= 0.90 & value <= 1.10, + NA + ) +} + +iaao_color_cell <- function(metric, value, digits = 4) { + v <- round(value, digits) + passes <- iaao_check(metric, value) + if (is.na(passes)) { + return(as.character(v)) + } + hex <- if (passes) "A8DDB5" else "FDBB84" + paste0("\\cellcolor[HTML]{", hex, "} ", v) +} + +ratio_to_hex <- function(ratio) { + case_when( + is.na(ratio) ~ "EEEEEE", + ratio < 0.80 ~ "D73027", + ratio < 0.90 ~ "FC8D59", + ratio < 0.95 ~ "FEE08B", + ratio <= 1.05 ~ "66BD63", + ratio <= 1.10 ~ "ABD9E9", + ratio <= 1.15 ~ "74ADD1", + TRUE ~ "4575B4" + ) +} + +color_ratio_cell <- function(ratio, digits = 3) { + v <- round(ratio, digits) + hex <- ratio_to_hex(ratio) + paste0("\\cellcolor[HTML]{", hex, "} ", v) +} + +ratio_fill_scale <- function(name = "Median\nRatio") { + scale_fill_gradientn( + colors = c( + "#D73027", "#FC8D59", "#FEE08B", + "#66BD63", "#66BD63", "#66BD63", + "#ABD9E9", "#74ADD1", "#4575B4" + ), + values = scales::rescale( + c(0.70, 0.80, 0.90, 0.9499, 0.95, 1.0499, 1.05, 1.15, 1.30) + ), + limits = c(0.70, 1.30), + oob = scales::squish, + na.value = "gray90", + breaks = c(0.80, 0.90, 0.95, 1.00, 1.05, 1.10, 1.20), + labels = c("0.80", "0.90", "0.95", "1.00", "1.05", "1.10", "1.20"), + name = name + ) +} +``` + +## Methods + +This analysis covers **`r town_name` Township** for the `r year_val` assessment cycle. CCAO Data's original sale sample included **`r format(n_original_sales, big.mark = ",")`** arm's-length sales occurring between `r min_sale_date` and `r max_sale_date`, with sale prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded at desk review, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales** used throughout this analysis. The township contains **`r format(n_total_pins, big.mark = ",")` residential parcels**; the final sale sample covers **`r pct_with_sale`%** of all residential parcels, indicating the degree to which these sales represent the full assessment universe. + +Two sets of assessments are compared: (1) **Model** values, produced by the model, and (2) **Desk Review** values, reflecting adjustment by CCAO staff. + +## Results + +```{r tbl-1} +#| tbl-cap: !expr 'cap_tbl1' + +ts <- town_stats + +iaao_table <- data.frame( + Metric = c("Median Ratio", "COD", "PRD", "PRB", "MKI", "N Sales"), + `IAAO Standard` = c( + "0.90 -- 1.10", + "$\\leq$ 15.0", + "0.98 -- 1.03", + "$\\pm$0.05", + "0.90 -- 1.10", + "---" + ), + Model = c( + iaao_color_cell("Median Ratio", ts$model_ratio, digits = 3), + iaao_color_cell("COD", ts$model_cod, digits = 1), + iaao_color_cell("PRD", ts$model_prd, digits = 4), + iaao_color_cell("PRB", ts$model_prb, digits = 4), + iaao_color_cell("MKI", ts$model_mki, digits = 4), + format(ts$number_of_sales, big.mark = ",") + ), + `Desk Review` = c( + iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), + iaao_color_cell("COD", ts$desk_review_cod, digits = 1), + iaao_color_cell("PRD", ts$desk_review_prd, digits = 4), + iaao_color_cell("PRB", ts$desk_review_prb, digits = 4), + iaao_color_cell("MKI", ts$desk_review_mki, digits = 4), + format(ts$number_of_sales, big.mark = ",") + ), + check.names = FALSE +) + +knitr::kable( + iaao_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + col.names = c("Metric", "IAAO Standard", "Model", "Desk Review"), + align = c("l", "c", "r", "r") +) +``` + +```{r nbhd-ratios-prep} +nbhd_ratios <- all_parcels |> + filter(!is.na(sale_price), !sale_excluded %in% TRUE) |> + mutate(neighborhood_number = gsub("-", "", neighborhood_number)) |> + summarize( + model_ratio = median(model_sale_ratio, na.rm = TRUE), + dr_ratio = median(desk_review_sale_ratio, na.rm = TRUE), + n_sales = n(), + .by = neighborhood_number + ) +``` + +```{r tbl-3} +#| tbl-cap: !expr 'cap_tbl3' + +all_nbhds <- all_parcels |> + distinct(neighborhood_number) |> + arrange(neighborhood_number) + +nbhd_table_data <- all_nbhds |> + left_join(nbhd_ratios, by = "neighborhood_number") |> + mutate( + `NBHD` = neighborhood_number, + `Model Ratio` = ifelse( + is.na(model_ratio), "---", color_ratio_cell(model_ratio, digits = 3) + ), + `DR Ratio` = ifelse( + is.na(dr_ratio), "---", color_ratio_cell(dr_ratio, digits = 3) + ), + `N Sales` = ifelse(is.na(n_sales), 0L, n_sales) + ) |> + select(`NBHD`, `Model Ratio`, `DR Ratio`, `N Sales`) + +knitr::kable( + nbhd_table_data, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + longtable = TRUE, + align = c("l", "r", "r", "r"), + col.names = c("NBHD", "Model Ratio", "DR Ratio", "N Sales") +) +``` + +```{r fig-1} +#| fig-cap: !expr 'cap_fig1' +#| fig-height: 7 +#| fig-width: 7 + +metric_order <- c("Median Ratio", "COD", "PRD", "PRB", "MKI") + +ts_wide <- tibble( + Metric = factor(metric_order, levels = metric_order), + Model = c( + ts$model_ratio, ts$model_cod, ts$model_prd, + ts$model_prb, ts$model_mki + ), + `Desk Review` = c( + ts$desk_review_ratio, ts$desk_review_cod, ts$desk_review_prd, + ts$desk_review_prb, ts$desk_review_mki + ) +) + +ts_long <- ts_wide |> + pivot_longer( + c(Model, `Desk Review`), + names_to = "Stage", values_to = "Value" + ) |> + mutate(Stage = factor(Stage, levels = c("Model", "Desk Review"))) + +iaao_bands <- tibble( + Metric = factor(metric_order, levels = metric_order), + xmin = c(0.90, 0, 0.98, -0.05, 0.90), + xmax = c(1.10, 15.0, 1.03, 0.05, 1.10) +) + +ggplot() + + geom_rect( + data = iaao_bands, + aes(xmin = xmin, xmax = xmax, ymin = 0.1, ymax = 1.9), + fill = "#A8DDB5", alpha = 0.45 + ) + + geom_segment( + data = ts_wide, + aes(x = Model, xend = `Desk Review`, y = 1, yend = 1), + color = "gray40", linewidth = 2, lineend = "round" + ) + + geom_point( + data = ts_long, + aes(x = Value, y = 1, color = Stage, shape = Stage), + size = 5 + ) + + geom_text( + data = ts_long, + aes(x = Value, y = 1, label = round(Value, 3), color = Stage), + vjust = -1.6, size = 3, fontface = "bold" + ) + + facet_wrap(~Metric, scales = "free_x", ncol = 1) + + scale_color_manual( + values = c("Model" = "#4575B4", "Desk Review" = "#D73027") + ) + + scale_shape_manual(values = c("Model" = 16, "Desk Review" = 17)) + + scale_y_continuous(limits = c(0, 2)) + + theme_minimal(base_size = 11) + + theme( + axis.text.y = element_blank(), + axis.ticks.y = element_blank(), + panel.grid.major.y = element_blank(), + panel.grid.minor.y = element_blank(), + strip.text = element_text(face = "bold", size = 11), + legend.position = "bottom" + ) + + labs(x = NULL, y = NULL, color = "Stage", shape = "Stage") +``` + +```{r fig-2} +#| fig-cap: !expr 'cap_fig2' +#| fig-height: 5 +#| fig-width: 7 + +decile_long <- decile_stats |> + select(price_decile, model_ratio, desk_review_ratio) |> + pivot_longer( + cols = c(model_ratio, desk_review_ratio), + names_to = "Stage", + values_to = "Sale Ratio" + ) |> + mutate( + Stage = case_when( + Stage == "model_ratio" ~ "Model", + Stage == "desk_review_ratio" ~ "Desk Review" + ), + Stage = factor(Stage, levels = c("Model", "Desk Review")) + ) + +axis_labels <- all_parcels |> + filter(!is.na(sale_price), !sale_excluded %in% TRUE, !is.na(price_decile)) |> + summarize( + min_price = min(sale_price), + max_price = max(sale_price), + .by = price_decile + ) |> + arrange(price_decile) |> + mutate(label = paste0( + price_decile, "\n", + scales::dollar(min_price, scale_cut = scales::cut_short_scale()), + "–\n", + scales::dollar(max_price, scale_cut = scales::cut_short_scale()) + )) |> + (\(df) setNames(df$label, df$price_decile))() + +y_min <- min(decile_long$`Sale Ratio`, 0.7, na.rm = TRUE) +y_max <- max(decile_long$`Sale Ratio`, 1.3, na.rm = TRUE) + +ggplot( + decile_long, + aes( + x = price_decile, + y = `Sale Ratio`, + group = Stage, + color = Stage, + label = round(`Sale Ratio`, 2) + ) +) + + geom_hline(yintercept = 1, color = "darkgreen", linewidth = 1) + + geom_hline( + yintercept = 0.9, linetype = "dotted", color = "black", linewidth = 0.8 + ) + + geom_hline( + yintercept = 1.1, linetype = "dotted", color = "black", linewidth = 0.8 + ) + + annotate("text", + x = 1, y = 1.11, + label = "IAAO Range (0.9–1.1)", hjust = 0, vjust = -0.4, size = 3.5 + ) + + geom_line(linewidth = 1) + + geom_label(show.legend = FALSE, size = 3) + + scale_color_manual( + values = c("Model" = "#4575B4", "Desk Review" = "#D73027") + ) + + scale_x_continuous(breaks = 1:10, labels = axis_labels) + + scale_y_continuous( + breaks = seq(floor(y_min * 10) / 10, ceiling(y_max * 10) / 10, by = 0.1) + ) + + coord_cartesian(ylim = c(y_min, y_max)) + + theme_minimal(base_size = 11) + + theme(axis.text.x = element_text(size = 7.5)) + + labs(x = "Sale Price Decile", y = "Median Sale Ratio", color = "Stage") +``` + +```{r tbl-2} +#| tbl-cap: !expr 'cap_tbl2' + +decile_display <- decile_stats |> + select( + Decile = price_decile, + `Price Range` = price_range, + `N Sales` = number_of_sales, + `Model Ratio` = model_ratio, + `DR Ratio` = desk_review_ratio + ) |> + mutate( + `Model Ratio` = round(`Model Ratio`, 3), + `DR Ratio` = round(`DR Ratio`, 3) + ) + +knitr::kable( + decile_display, + format = "latex", + booktabs = TRUE, + linesep = "", + align = c("c", "l", "r", "r", "r") +) +``` + +```{r fig-3-prep} +neighborhoods <- ccao::nbhd_shp |> + filter(township_name == town_name) |> + select(town_nbhd, geometry) + +map_data <- neighborhoods |> + left_join(nbhd_ratios, by = c("town_nbhd" = "neighborhood_number")) |> + mutate(diff = dr_ratio - model_ratio) + +map_theme <- theme_void(base_size = 9) + + theme( + legend.position = "right", + plot.title = element_text(face = "bold", size = 10) + ) + +map_model <- ggplot() + + annotation_map_tile(type = "cartolight", zoomin = 0) + + geom_sf( + data = map_data, aes(fill = model_ratio), alpha = 0.85, linewidth = 0.1 + ) + + ratio_fill_scale() + + map_theme + + labs(title = "Model") + +map_dr <- ggplot() + + annotation_map_tile(type = "cartolight", zoomin = 0) + + geom_sf( + data = map_data, aes(fill = dr_ratio), alpha = 0.85, linewidth = 0.1 + ) + + ratio_fill_scale() + + map_theme + + labs(title = "Desk Review") + +diff_limit <- max(abs(map_data$diff), na.rm = TRUE) +diff_limit <- ceiling(diff_limit * 10) / 10 + +map_diff <- ggplot() + + annotation_map_tile(type = "cartolight", zoomin = 0) + + geom_sf(data = map_data, aes(fill = diff), alpha = 0.85, linewidth = 0.1) + + scale_fill_gradient2( + low = "#D73027", + mid = "white", + high = "#4575B4", + midpoint = 0, + limits = c(-diff_limit, diff_limit), + oob = scales::squish, + na.value = "gray90", + name = "Model −\nDesk Review" + ) + + map_theme + + labs(title = "Model − Desk Review") +``` + +```{r fig-3} +#| fig-cap: !expr 'cap_fig3' +#| fig-height: 5.5 +#| fig-width: 8.5 + +grid.newpage() +print(map_model, vp = viewport( + x = 0, y = 0, width = 1 / 3, height = 1, + just = c("left", "bottom") +)) +print(map_dr, vp = viewport( + x = 1 / 3, y = 0, width = 1 / 3, height = 1, + just = c("left", "bottom") +)) +print(map_diff, vp = viewport( + x = 2 / 3, y = 0, width = 1 / 3, height = 1, + just = c("left", "bottom") +)) +``` + diff --git a/ratio-analysis/ratio-analysis.sql b/ratio-analysis/ratio-analysis.sql new file mode 100644 index 0000000..9476dea --- /dev/null +++ b/ratio-analysis/ratio-analysis.sql @@ -0,0 +1,67 @@ +-- Final model run IDs by township and year +WITH final_models AS ( + SELECT + final_model.run_id, + towns.township_code + FROM model.final_model + CROSS JOIN + UNNEST(final_model.township_code_coverage) AS towns (township_code) + -- Year will need to be adjusted so that desk review to model values join in + -- R script is 1 to 1. + WHERE final_model.year = CAST(YEAR(CURRENT_DATE) AS VARCHAR) + AND final_model.type = 'res' +), + +-- Use final model run IDs to grab the model values we need to compare Res Val's +-- desk review values against +model_vals AS ( + SELECT + assessment_pin.meta_pin AS pin, + assessment_pin.pred_pin_final_fmv_round AS model_value, + assessment_pin.sale_ratio_study_price AS sale_price, + assessment_pin.sale_ratio_study_date AS sale_date, + assessment_pin.sale_ratio_study_document_num AS sale_document_number + FROM model.assessment_pin + INNER JOIN final_models + ON assessment_pin.run_id = final_models.run_id + AND assessment_pin.township_code = final_models.township_code +), + +-- Res Val provides PINs that sometimes only appear in 2025 or 2026 in +-- default.vw_pin_universe. Make sure we grab one and only one row for every PIN +-- that appears in either year, regardless of whether they have a model value. +most_recent_pin AS ( + SELECT + uni.pin, + uni.township_name, + uni.nbhd_code AS neighborhood_number, + ROW_NUMBER() OVER ( + PARTITION BY + uni.pin + ORDER BY uni.year DESC + ) AS rank + FROM default.vw_pin_universe AS uni + -- Make sure we only grab parcels valued by the res avm, for the towns we're + -- processing. + INNER JOIN ccao.class_dict + ON uni.class = class_dict.class_code + AND class_dict.modeling_group IN ('SF', 'MF', 'BB') + WHERE uni.year IN ( + CAST(YEAR(CURRENT_DATE) - 1 AS VARCHAR), + CAST(YEAR(CURRENT_DATE) AS VARCHAR) + ) + AND uni.township_code IN ({dr_towns*}) -- noqa +) + +SELECT + vpu.pin, + vpu.township_name, + vpu.neighborhood_number, + model_vals.model_value, + model_vals.sale_price, + model_vals.sale_date, + model_vals.sale_document_number +FROM most_recent_pin AS vpu +LEFT JOIN model_vals + ON vpu.pin = model_vals.pin +WHERE vpu.rank = 1 diff --git a/ratio-analysis/renv/activate.R b/ratio-analysis/renv/activate.R new file mode 100644 index 0000000..abd9432 --- /dev/null +++ b/ratio-analysis/renv/activate.R @@ -0,0 +1,1438 @@ + +local({ + + # the requested version of renv + version <- "1.1.5" + attr(version, "md5") <- "770fcbc2c4616e8fbcb187cccd46a6b1" + attr(version, "sha") <- NULL + + # the project directory + project <- Sys.getenv("RENV_PROJECT") + if (!nzchar(project)) + project <- getwd() + + # use start-up diagnostics if enabled + diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE") + if (diagnostics) { + start <- Sys.time() + profile <- tempfile("renv-startup-", fileext = ".Rprof") + utils::Rprof(profile) + on.exit({ + utils::Rprof(NULL) + elapsed <- signif(difftime(Sys.time(), start, units = "auto"), digits = 2L) + writeLines(sprintf("- renv took %s to run the autoloader.", format(elapsed))) + writeLines(sprintf("- Profile: %s", profile)) + print(utils::summaryRprof(profile)) + }, add = TRUE) + } + + # figure out whether the autoloader is enabled + enabled <- local({ + + # first, check config option + override <- getOption("renv.config.autoloader.enabled") + if (!is.null(override)) + return(override) + + # if we're being run in a context where R_LIBS is already set, + # don't load -- presumably we're being run as a sub-process and + # the parent process has already set up library paths for us + rcmd <- Sys.getenv("R_CMD", unset = NA) + rlibs <- Sys.getenv("R_LIBS", unset = NA) + if (!is.na(rlibs) && !is.na(rcmd)) + return(FALSE) + + # next, check environment variables + # prefer using the configuration one in the future + envvars <- c( + "RENV_CONFIG_AUTOLOADER_ENABLED", + "RENV_AUTOLOADER_ENABLED", + "RENV_ACTIVATE_PROJECT" + ) + + for (envvar in envvars) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(tolower(envval) %in% c("true", "t", "1")) + } + + # enable by default + TRUE + + }) + + # bail if we're not enabled + if (!enabled) { + + # if we're not enabled, we might still need to manually load + # the user profile here + profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile") + if (file.exists(profile)) { + cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE") + if (tolower(cfg) %in% c("true", "t", "1")) + sys.source(profile, envir = globalenv()) + } + + return(FALSE) + + } + + # avoid recursion + if (identical(getOption("renv.autoloader.running"), TRUE)) { + warning("ignoring recursive attempt to run renv autoloader") + return(invisible(TRUE)) + } + + # signal that we're loading renv during R startup + options(renv.autoloader.running = TRUE) + on.exit(options(renv.autoloader.running = NULL), add = TRUE) + + # signal that we've consented to use renv + options(renv.consent = TRUE) + + # load the 'utils' package eagerly -- this ensures that renv shims, which + # mask 'utils' packages, will come first on the search path + library(utils, lib.loc = .Library) + + # unload renv if it's already been loaded + if ("renv" %in% loadedNamespaces()) + unloadNamespace("renv") + + # load bootstrap tools + ansify <- function(text) { + if (renv_ansify_enabled()) + renv_ansify_enhanced(text) + else + renv_ansify_default(text) + } + + renv_ansify_enabled <- function() { + + override <- Sys.getenv("RENV_ANSIFY_ENABLED", unset = NA) + if (!is.na(override)) + return(as.logical(override)) + + pane <- Sys.getenv("RSTUDIO_CHILD_PROCESS_PANE", unset = NA) + if (identical(pane, "build")) + return(FALSE) + + testthat <- Sys.getenv("TESTTHAT", unset = "false") + if (tolower(testthat) %in% "true") + return(FALSE) + + iderun <- Sys.getenv("R_CLI_HAS_HYPERLINK_IDE_RUN", unset = "false") + if (tolower(iderun) %in% "false") + return(FALSE) + + TRUE + + } + + renv_ansify_default <- function(text) { + text + } + + renv_ansify_enhanced <- function(text) { + + # R help links + pattern <- "`\\?(renv::(?:[^`])+)`" + replacement <- "`\033]8;;x-r-help:\\1\a?\\1\033]8;;\a`" + text <- gsub(pattern, replacement, text, perl = TRUE) + + # runnable code + pattern <- "`(renv::(?:[^`])+)`" + replacement <- "`\033]8;;x-r-run:\\1\a\\1\033]8;;\a`" + text <- gsub(pattern, replacement, text, perl = TRUE) + + # return ansified text + text + + } + + renv_ansify_init <- function() { + + envir <- renv_envir_self() + if (renv_ansify_enabled()) + assign("ansify", renv_ansify_enhanced, envir = envir) + else + assign("ansify", renv_ansify_default, envir = envir) + + } + + `%||%` <- function(x, y) { + if (is.null(x)) y else x + } + + catf <- function(fmt, ..., appendLF = TRUE) { + + quiet <- getOption("renv.bootstrap.quiet", default = FALSE) + if (quiet) + return(invisible()) + + # also check for config environment variables that should suppress messages + # https://github.com/rstudio/renv/issues/2214 + enabled <- Sys.getenv("RENV_CONFIG_STARTUP_QUIET", unset = NA) + if (!is.na(enabled) && tolower(enabled) %in% c("true", "1")) + return(invisible()) + + enabled <- Sys.getenv("RENV_CONFIG_SYNCHRONIZED_CHECK", unset = NA) + if (!is.na(enabled) && tolower(enabled) %in% c("false", "0")) + return(invisible()) + + msg <- sprintf(fmt, ...) + cat(msg, file = stdout(), sep = if (appendLF) "\n" else "") + + invisible(msg) + + } + + header <- function(label, + ..., + prefix = "#", + suffix = "-", + n = min(getOption("width"), 78)) + { + label <- sprintf(label, ...) + n <- max(n - nchar(label) - nchar(prefix) - 2L, 8L) + if (n <= 0) + return(paste(prefix, label)) + + tail <- paste(rep.int(suffix, n), collapse = "") + paste0(prefix, " ", label, " ", tail) + + } + + heredoc <- function(text, leave = 0) { + + # remove leading, trailing whitespace + trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text) + + # split into lines + lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]] + + # compute common indent + indent <- regexpr("[^[:space:]]", lines) + common <- min(setdiff(indent, -1L)) - leave + text <- paste(substring(lines, common), collapse = "\n") + + # substitute in ANSI links for executable renv code + ansify(text) + + } + + bootstrap <- function(version, library) { + + friendly <- renv_bootstrap_version_friendly(version) + section <- header(sprintf("Bootstrapping renv %s", friendly)) + catf(section) + + # ensure the target library path exists; required for file.copy(..., recursive = TRUE) + dir.create(library, showWarnings = FALSE, recursive = TRUE) + + # try to install renv from cache + md5 <- attr(version, "md5", exact = TRUE) + if (length(md5)) { + pkgpath <- renv_bootstrap_find(version) + if (length(pkgpath) && file.exists(pkgpath)) { + ok <- file.copy(pkgpath, library, recursive = TRUE) + if (isTRUE(ok)) + return(invisible()) + } + } + + # attempt to download renv + catf("- Downloading renv ... ", appendLF = FALSE) + withCallingHandlers( + tarball <- renv_bootstrap_download(version), + error = function(err) { + catf("FAILED") + stop("failed to download:\n", conditionMessage(err)) + } + ) + catf("OK") + on.exit(unlink(tarball), add = TRUE) + + # now attempt to install + catf("- Installing renv ... ", appendLF = FALSE) + withCallingHandlers( + status <- renv_bootstrap_install(version, tarball, library), + error = function(err) { + catf("FAILED") + stop("failed to install:\n", conditionMessage(err)) + } + ) + catf("OK") + + # add empty line to break up bootstrapping from normal output + catf("") + return(invisible()) + } + + renv_bootstrap_tests_running <- function() { + getOption("renv.tests.running", default = FALSE) + } + + renv_bootstrap_repos <- function() { + + # get CRAN repository + cran <- getOption("renv.repos.cran", "https://cloud.r-project.org") + + # check for repos override + repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) + if (!is.na(repos)) { + + # split on ';' if present + parts <- strsplit(repos, ";", fixed = TRUE)[[1L]] + + # split into named repositories if present + idx <- regexpr("=", parts, fixed = TRUE) + keys <- substring(parts, 1L, idx - 1L) + vals <- substring(parts, idx + 1L) + names(vals) <- keys + + # if we have a single unnamed repository, call it CRAN + if (length(vals) == 1L && identical(keys, "")) + names(vals) <- "CRAN" + + return(vals) + + } + + # check for lockfile repositories + repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) + if (!inherits(repos, "error") && length(repos)) + return(repos) + + # retrieve current repos + repos <- getOption("repos") + + # ensure @CRAN@ entries are resolved + repos[repos == "@CRAN@"] <- cran + + # add in renv.bootstrap.repos if set + default <- c(FALLBACK = "https://cloud.r-project.org") + extra <- getOption("renv.bootstrap.repos", default = default) + repos <- c(repos, extra) + + # remove duplicates that might've snuck in + dupes <- duplicated(repos) | duplicated(names(repos)) + repos[!dupes] + + } + + renv_bootstrap_repos_lockfile <- function() { + + lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") + if (!file.exists(lockpath)) + return(NULL) + + lockfile <- tryCatch(renv_json_read(lockpath), error = identity) + if (inherits(lockfile, "error")) { + warning(lockfile) + return(NULL) + } + + repos <- lockfile$R$Repositories + if (length(repos) == 0) + return(NULL) + + keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) + vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) + names(vals) <- keys + + return(vals) + + } + + renv_bootstrap_download <- function(version) { + + sha <- attr(version, "sha", exact = TRUE) + + methods <- if (!is.null(sha)) { + + # attempting to bootstrap a development version of renv + c( + function() renv_bootstrap_download_tarball(sha), + function() renv_bootstrap_download_github(sha) + ) + + } else { + + # attempting to bootstrap a release version of renv + c( + function() renv_bootstrap_download_tarball(version), + function() renv_bootstrap_download_cran_latest(version), + function() renv_bootstrap_download_cran_archive(version) + ) + + } + + for (method in methods) { + path <- tryCatch(method(), error = identity) + if (is.character(path) && file.exists(path)) + return(path) + } + + stop("All download methods failed") + + } + + renv_bootstrap_download_impl <- function(url, destfile) { + + mode <- "wb" + + # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715 + fixup <- + Sys.info()[["sysname"]] == "Windows" && + substring(url, 1L, 5L) == "file:" + + if (fixup) + mode <- "w+b" + + args <- list( + url = url, + destfile = destfile, + mode = mode, + quiet = TRUE + ) + + if ("headers" %in% names(formals(utils::download.file))) { + headers <- renv_bootstrap_download_custom_headers(url) + if (length(headers) && is.character(headers)) + args$headers <- headers + } + + do.call(utils::download.file, args) + + } + + renv_bootstrap_download_custom_headers <- function(url) { + + headers <- getOption("renv.download.headers") + if (is.null(headers)) + return(character()) + + if (!is.function(headers)) + stopf("'renv.download.headers' is not a function") + + headers <- headers(url) + if (length(headers) == 0L) + return(character()) + + if (is.list(headers)) + headers <- unlist(headers, recursive = FALSE, use.names = TRUE) + + ok <- + is.character(headers) && + is.character(names(headers)) && + all(nzchar(names(headers))) + + if (!ok) + stop("invocation of 'renv.download.headers' did not return a named character vector") + + headers + + } + + renv_bootstrap_download_cran_latest <- function(version) { + + spec <- renv_bootstrap_download_cran_latest_find(version) + type <- spec$type + repos <- spec$repos + + baseurl <- utils::contrib.url(repos = repos, type = type) + ext <- if (identical(type, "source")) + ".tar.gz" + else if (Sys.info()[["sysname"]] == "Windows") + ".zip" + else + ".tgz" + name <- sprintf("renv_%s%s", version, ext) + url <- paste(baseurl, name, sep = "/") + + destfile <- file.path(tempdir(), name) + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (inherits(status, "condition")) + return(FALSE) + + # report success and return + destfile + + } + + renv_bootstrap_download_cran_latest_find <- function(version) { + + # check whether binaries are supported on this system + binary <- + getOption("renv.bootstrap.binary", default = TRUE) && + !identical(.Platform$pkgType, "source") && + !identical(getOption("pkgType"), "source") && + Sys.info()[["sysname"]] %in% c("Darwin", "Windows") + + types <- c(if (binary) "binary", "source") + + # iterate over types + repositories + for (type in types) { + for (repos in renv_bootstrap_repos()) { + + # build arguments for utils::available.packages() call + args <- list(type = type, repos = repos) + + # add custom headers if available -- note that + # utils::available.packages() will pass this to download.file() + if ("headers" %in% names(formals(utils::download.file))) { + headers <- renv_bootstrap_download_custom_headers(repos) + if (length(headers) && is.character(headers)) + args$headers <- headers + } + + # retrieve package database + db <- tryCatch( + as.data.frame( + do.call(utils::available.packages, args), + stringsAsFactors = FALSE + ), + error = identity + ) + + if (inherits(db, "error")) + next + + # check for compatible entry + entry <- db[db$Package %in% "renv" & db$Version %in% version, ] + if (nrow(entry) == 0) + next + + # found it; return spec to caller + spec <- list(entry = entry, type = type, repos = repos) + return(spec) + + } + } + + # if we got here, we failed to find renv + fmt <- "renv %s is not available from your declared package repositories" + stop(sprintf(fmt, version)) + + } + + renv_bootstrap_download_cran_archive <- function(version) { + + name <- sprintf("renv_%s.tar.gz", version) + repos <- renv_bootstrap_repos() + urls <- file.path(repos, "src/contrib/Archive/renv", name) + destfile <- file.path(tempdir(), name) + + for (url in urls) { + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (identical(status, 0L)) + return(destfile) + + } + + return(FALSE) + + } + + renv_bootstrap_find <- function(version) { + + path <- renv_bootstrap_find_cache(version) + if (length(path) && file.exists(path)) { + catf("- Using renv %s from global package cache", version) + return(path) + } + + } + + renv_bootstrap_find_cache <- function(version) { + + md5 <- attr(version, "md5", exact = TRUE) + if (is.null(md5)) + return() + + # infer path to renv cache + cache <- Sys.getenv("RENV_PATHS_CACHE", unset = "") + if (!nzchar(cache)) { + root <- Sys.getenv("RENV_PATHS_ROOT", unset = NA) + if (!is.na(root)) + cache <- file.path(root, "cache") + } + + if (!nzchar(cache)) { + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) { + root <- tools$R_user_dir("renv", "cache") + cache <- file.path(root, "cache") + } + } + + # start completing path to cache + file.path( + cache, + renv_bootstrap_cache_version(), + renv_bootstrap_platform_prefix(), + "renv", + version, + md5, + "renv" + ) + + } + + renv_bootstrap_download_tarball <- function(version) { + + # if the user has provided the path to a tarball via + # an environment variable, then use it + tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA) + if (is.na(tarball)) + return() + + # allow directories + if (dir.exists(tarball)) { + name <- sprintf("renv_%s.tar.gz", version) + tarball <- file.path(tarball, name) + } + + # bail if it doesn't exist + if (!file.exists(tarball)) { + + # let the user know we weren't able to honour their request + fmt <- "- RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." + msg <- sprintf(fmt, tarball) + warning(msg) + + # bail + return() + + } + + catf("- Using local tarball '%s'.", tarball) + tarball + + } + + renv_bootstrap_github_token <- function() { + for (envvar in c("GITHUB_TOKEN", "GITHUB_PAT", "GH_TOKEN")) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(envval) + } + } + + renv_bootstrap_download_github <- function(version) { + + enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") + if (!identical(enabled, "TRUE")) + return(FALSE) + + # prepare download options + token <- renv_bootstrap_github_token() + if (is.null(token)) + token <- "" + + if (nzchar(Sys.which("curl")) && nzchar(token)) { + fmt <- "--location --fail --header \"Authorization: token %s\"" + extra <- sprintf(fmt, token) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "curl", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } else if (nzchar(Sys.which("wget")) && nzchar(token)) { + fmt <- "--header=\"Authorization: token %s\"" + extra <- sprintf(fmt, token) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "wget", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } + + url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version) + name <- sprintf("renv_%s.tar.gz", version) + destfile <- file.path(tempdir(), name) + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (!identical(status, 0L)) + return(FALSE) + + renv_bootstrap_download_augment(destfile) + + return(destfile) + + } + + # Add Sha to DESCRIPTION. This is stop gap until #890, after which we + # can use renv::install() to fully capture metadata. + renv_bootstrap_download_augment <- function(destfile) { + sha <- renv_bootstrap_git_extract_sha1_tar(destfile) + if (is.null(sha)) { + return() + } + + # Untar + tempdir <- tempfile("renv-github-") + on.exit(unlink(tempdir, recursive = TRUE), add = TRUE) + untar(destfile, exdir = tempdir) + pkgdir <- dir(tempdir, full.names = TRUE)[[1]] + + # Modify description + desc_path <- file.path(pkgdir, "DESCRIPTION") + desc_lines <- readLines(desc_path) + remotes_fields <- c( + "RemoteType: github", + "RemoteHost: api.github.com", + "RemoteRepo: renv", + "RemoteUsername: rstudio", + "RemotePkgRef: rstudio/renv", + paste("RemoteRef: ", sha), + paste("RemoteSha: ", sha) + ) + writeLines(c(desc_lines[desc_lines != ""], remotes_fields), con = desc_path) + + # Re-tar + local({ + old <- setwd(tempdir) + on.exit(setwd(old), add = TRUE) + + tar(destfile, compression = "gzip") + }) + invisible() + } + + # Extract the commit hash from a git archive. Git archives include the SHA1 + # hash as the comment field of the tarball pax extended header + # (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html) + # For GitHub archives this should be the first header after the default one + # (512 byte) header. + renv_bootstrap_git_extract_sha1_tar <- function(bundle) { + + # open the bundle for reading + # We use gzcon for everything because (from ?gzcon) + # > Reading from a connection which does not supply a 'gzip' magic + # > header is equivalent to reading from the original connection + conn <- gzcon(file(bundle, open = "rb", raw = TRUE)) + on.exit(close(conn)) + + # The default pax header is 512 bytes long and the first pax extended header + # with the comment should be 51 bytes long + # `52 comment=` (11 chars) + 40 byte SHA1 hash + len <- 0x200 + 0x33 + res <- rawToChar(readBin(conn, "raw", n = len)[0x201:len]) + + if (grepl("^52 comment=", res)) { + sub("52 comment=", "", res) + } else { + NULL + } + } + + renv_bootstrap_install <- function(version, tarball, library) { + + # attempt to install it into project library + dir.create(library, showWarnings = FALSE, recursive = TRUE) + output <- renv_bootstrap_install_impl(library, tarball) + + # check for successful install + status <- attr(output, "status") + if (is.null(status) || identical(status, 0L)) + return(status) + + # an error occurred; report it + header <- "installation of renv failed" + lines <- paste(rep.int("=", nchar(header)), collapse = "") + text <- paste(c(header, lines, output), collapse = "\n") + stop(text) + + } + + renv_bootstrap_install_impl <- function(library, tarball) { + + # invoke using system2 so we can capture and report output + bin <- R.home("bin") + exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" + R <- file.path(bin, exe) + + args <- c( + "--vanilla", "CMD", "INSTALL", "--no-multiarch", + "-l", shQuote(path.expand(library)), + shQuote(path.expand(tarball)) + ) + + system2(R, args, stdout = TRUE, stderr = TRUE) + + } + + renv_bootstrap_platform_prefix_default <- function() { + + # read version component + version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v") + + # expand placeholders + placeholders <- list( + list("%v", format(getRversion()[1, 1:2])), + list("%V", format(getRversion()[1, 1:3])) + ) + + for (placeholder in placeholders) + version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE) + + # include SVN revision for development versions of R + # (to avoid sharing platform-specific artefacts with released versions of R) + devel <- + identical(R.version[["status"]], "Under development (unstable)") || + identical(R.version[["nickname"]], "Unsuffered Consequences") + + if (devel) + version <- paste(version, R.version[["svn rev"]], sep = "-r") + + version + + } + + renv_bootstrap_platform_prefix <- function() { + + # construct version prefix + version <- renv_bootstrap_platform_prefix_default() + + # build list of path components + components <- c(version, R.version$platform) + + # include prefix if provided by user + prefix <- renv_bootstrap_platform_prefix_impl() + if (!is.na(prefix) && nzchar(prefix)) + components <- c(prefix, components) + + # build prefix + paste(components, collapse = "/") + + } + + renv_bootstrap_platform_prefix_impl <- function() { + + # if an explicit prefix has been supplied, use it + prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA) + if (!is.na(prefix)) + return(prefix) + + # if the user has requested an automatic prefix, generate it + auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (is.na(auto) && getRversion() >= "4.4.0") + auto <- "TRUE" + + if (auto %in% c("TRUE", "True", "true", "1")) + return(renv_bootstrap_platform_prefix_auto()) + + # empty string on failure + "" + + } + + renv_bootstrap_platform_prefix_auto <- function() { + + prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity) + if (inherits(prefix, "error") || prefix %in% "unknown") { + + msg <- paste( + "failed to infer current operating system", + "please file a bug report at https://github.com/rstudio/renv/issues", + sep = "; " + ) + + warning(msg) + + } + + prefix + + } + + renv_bootstrap_platform_os <- function() { + + sysinfo <- Sys.info() + sysname <- sysinfo[["sysname"]] + + # handle Windows + macOS up front + if (sysname == "Windows") + return("windows") + else if (sysname == "Darwin") + return("macos") + + # check for os-release files + for (file in c("/etc/os-release", "/usr/lib/os-release")) + if (file.exists(file)) + return(renv_bootstrap_platform_os_via_os_release(file, sysinfo)) + + # check for redhat-release files + if (file.exists("/etc/redhat-release")) + return(renv_bootstrap_platform_os_via_redhat_release()) + + "unknown" + + } + + renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) { + + # read /etc/os-release + release <- utils::read.table( + file = file, + sep = "=", + quote = c("\"", "'"), + col.names = c("Key", "Value"), + comment.char = "#", + stringsAsFactors = FALSE + ) + + vars <- as.list(release$Value) + names(vars) <- release$Key + + # get os name + os <- tolower(sysinfo[["sysname"]]) + + # read id + id <- "unknown" + for (field in c("ID", "ID_LIKE")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + id <- vars[[field]] + break + } + } + + # read version + version <- "unknown" + for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + version <- vars[[field]] + break + } + } + + # join together + paste(c(os, id, version), collapse = "-") + + } + + renv_bootstrap_platform_os_via_redhat_release <- function() { + + # read /etc/redhat-release + contents <- readLines("/etc/redhat-release", warn = FALSE) + + # infer id + id <- if (grepl("centos", contents, ignore.case = TRUE)) + "centos" + else if (grepl("redhat", contents, ignore.case = TRUE)) + "redhat" + else + "unknown" + + # try to find a version component (very hacky) + version <- "unknown" + + parts <- strsplit(contents, "[[:space:]]")[[1L]] + for (part in parts) { + + nv <- tryCatch(numeric_version(part), error = identity) + if (inherits(nv, "error")) + next + + version <- nv[1, 1] + break + + } + + paste(c("linux", id, version), collapse = "-") + + } + + renv_bootstrap_library_root_name <- function(project) { + + # use project name as-is if requested + asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE") + if (asis) + return(basename(project)) + + # otherwise, disambiguate based on project's path + id <- substring(renv_bootstrap_hash_text(project), 1L, 8L) + paste(basename(project), id, sep = "-") + + } + + renv_bootstrap_library_root <- function(project) { + + prefix <- renv_bootstrap_profile_prefix() + + path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) + if (!is.na(path)) + return(paste(c(path, prefix), collapse = "/")) + + path <- renv_bootstrap_library_root_impl(project) + if (!is.null(path)) { + name <- renv_bootstrap_library_root_name(project) + return(paste(c(path, prefix, name), collapse = "/")) + } + + renv_bootstrap_paths_renv("library", project = project) + + } + + renv_bootstrap_library_root_impl <- function(project) { + + root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) + if (!is.na(root)) + return(root) + + type <- renv_bootstrap_project_type(project) + if (identical(type, "package")) { + userdir <- renv_bootstrap_user_dir() + return(file.path(userdir, "library")) + } + + } + + renv_bootstrap_validate_version <- function(version, description = NULL) { + + # resolve description file + # + # avoid passing lib.loc to `packageDescription()` below, since R will + # use the loaded version of the package by default anyhow. note that + # this function should only be called after 'renv' is loaded + # https://github.com/rstudio/renv/issues/1625 + description <- description %||% packageDescription("renv") + + # check whether requested version 'version' matches loaded version of renv + sha <- attr(version, "sha", exact = TRUE) + valid <- if (!is.null(sha)) + renv_bootstrap_validate_version_dev(sha, description) + else + renv_bootstrap_validate_version_release(version, description) + + if (valid) + return(TRUE) + + # the loaded version of renv doesn't match the requested version; + # give the user instructions on how to proceed + dev <- identical(description[["RemoteType"]], "github") + remote <- if (dev) + paste("rstudio/renv", description[["RemoteSha"]], sep = "@") + else + paste("renv", description[["Version"]], sep = "@") + + # display both loaded version + sha if available + friendly <- renv_bootstrap_version_friendly( + version = description[["Version"]], + sha = if (dev) description[["RemoteSha"]] + ) + + fmt <- heredoc(" + renv %1$s was loaded from project library, but this project is configured to use renv %2$s. + - Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile. + - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library. + ") + catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote) + + FALSE + + } + + renv_bootstrap_validate_version_dev <- function(version, description) { + + expected <- description[["RemoteSha"]] + if (!is.character(expected)) + return(FALSE) + + pattern <- sprintf("^\\Q%s\\E", version) + grepl(pattern, expected, perl = TRUE) + + } + + renv_bootstrap_validate_version_release <- function(version, description) { + expected <- description[["Version"]] + is.character(expected) && identical(c(expected), c(version)) + } + + renv_bootstrap_hash_text <- function(text) { + + hashfile <- tempfile("renv-hash-") + on.exit(unlink(hashfile), add = TRUE) + + writeLines(text, con = hashfile) + tools::md5sum(hashfile) + + } + + renv_bootstrap_load <- function(project, libpath, version) { + + # try to load renv from the project library + if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) + return(FALSE) + + # warn if the version of renv loaded does not match + renv_bootstrap_validate_version(version) + + # execute renv load hooks, if any + hooks <- getHook("renv::autoload") + for (hook in hooks) + if (is.function(hook)) + tryCatch(hook(), error = warnify) + + # load the project + renv::load(project) + + TRUE + + } + + renv_bootstrap_profile_load <- function(project) { + + # if RENV_PROFILE is already set, just use that + profile <- Sys.getenv("RENV_PROFILE", unset = NA) + if (!is.na(profile) && nzchar(profile)) + return(profile) + + # check for a profile file (nothing to do if it doesn't exist) + path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project) + if (!file.exists(path)) + return(NULL) + + # read the profile, and set it if it exists + contents <- readLines(path, warn = FALSE) + if (length(contents) == 0L) + return(NULL) + + # set RENV_PROFILE + profile <- contents[[1L]] + if (!profile %in% c("", "default")) + Sys.setenv(RENV_PROFILE = profile) + + profile + + } + + renv_bootstrap_profile_prefix <- function() { + profile <- renv_bootstrap_profile_get() + if (!is.null(profile)) + return(file.path("profiles", profile, "renv")) + } + + renv_bootstrap_profile_get <- function() { + profile <- Sys.getenv("RENV_PROFILE", unset = "") + renv_bootstrap_profile_normalize(profile) + } + + renv_bootstrap_profile_set <- function(profile) { + profile <- renv_bootstrap_profile_normalize(profile) + if (is.null(profile)) + Sys.unsetenv("RENV_PROFILE") + else + Sys.setenv(RENV_PROFILE = profile) + } + + renv_bootstrap_profile_normalize <- function(profile) { + + if (is.null(profile) || profile %in% c("", "default")) + return(NULL) + + profile + + } + + renv_bootstrap_path_absolute <- function(path) { + + substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( + substr(path, 1L, 1L) %in% c(letters, LETTERS) && + substr(path, 2L, 3L) %in% c(":/", ":\\") + ) + + } + + renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { + renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") + root <- if (renv_bootstrap_path_absolute(renv)) NULL else project + prefix <- if (profile) renv_bootstrap_profile_prefix() + components <- c(root, renv, prefix, ...) + paste(components, collapse = "/") + } + + renv_bootstrap_project_type <- function(path) { + + descpath <- file.path(path, "DESCRIPTION") + if (!file.exists(descpath)) + return("unknown") + + desc <- tryCatch( + read.dcf(descpath, all = TRUE), + error = identity + ) + + if (inherits(desc, "error")) + return("unknown") + + type <- desc$Type + if (!is.null(type)) + return(tolower(type)) + + package <- desc$Package + if (!is.null(package)) + return("package") + + "unknown" + + } + + renv_bootstrap_user_dir <- function() { + dir <- renv_bootstrap_user_dir_impl() + path.expand(chartr("\\", "/", dir)) + } + + renv_bootstrap_user_dir_impl <- function() { + + # use local override if set + override <- getOption("renv.userdir.override") + if (!is.null(override)) + return(override) + + # use R_user_dir if available + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) + return(tools$R_user_dir("renv", "cache")) + + # try using our own backfill for older versions of R + envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") + for (envvar in envvars) { + root <- Sys.getenv(envvar, unset = NA) + if (!is.na(root)) + return(file.path(root, "R/renv")) + } + + # use platform-specific default fallbacks + if (Sys.info()[["sysname"]] == "Windows") + file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") + else if (Sys.info()[["sysname"]] == "Darwin") + "~/Library/Caches/org.R-project.R/R/renv" + else + "~/.cache/R/renv" + + } + + renv_bootstrap_version_friendly <- function(version, shafmt = NULL, sha = NULL) { + sha <- sha %||% attr(version, "sha", exact = TRUE) + parts <- c(version, sprintf(shafmt %||% " [sha: %s]", substring(sha, 1L, 7L))) + paste(parts, collapse = "") + } + + renv_bootstrap_exec <- function(project, libpath, version) { + if (!renv_bootstrap_load(project, libpath, version)) + renv_bootstrap_run(project, libpath, version) + } + + renv_bootstrap_run <- function(project, libpath, version) { + tryCatch( + renv_bootstrap_run_impl(project, libpath, version), + error = function(e) { + msg <- paste( + "failed to bootstrap renv: the project will not be loaded.", + paste("Reason:", conditionMessage(e)), + "Use `renv::activate()` to re-initialize the project.", + sep = "\n" + ) + warning(msg, call. = FALSE) + } + ) + } + + renv_bootstrap_run_impl <- function(project, libpath, version) { + + # perform bootstrap + bootstrap(version, libpath) + + # exit early if we're just testing bootstrap + if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) + return(TRUE) + + # try again to load + if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { + return(renv::load(project = project)) + } + + # failed to download or load renv; warn the user + msg <- c( + "Failed to find an renv installation: the project will not be loaded.", + "Use `renv::activate()` to re-initialize the project." + ) + + warning(paste(msg, collapse = "\n"), call. = FALSE) + + } + + renv_bootstrap_cache_version <- function() { + # NOTE: users should normally not override the cache version; + # this is provided just to make testing easier + Sys.getenv("RENV_CACHE_VERSION", unset = "v5") + } + + renv_bootstrap_cache_version_previous <- function() { + version <- renv_bootstrap_cache_version() + number <- as.integer(substring(version, 2L)) + paste("v", number - 1L, sep = "") + } + + renv_json_read <- function(file = NULL, text = NULL) { + + jlerr <- NULL + + # if jsonlite is loaded, use that instead + if ("jsonlite" %in% loadedNamespaces()) { + + json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity) + if (!inherits(json, "error")) + return(json) + + jlerr <- json + + } + + # otherwise, fall back to the default JSON reader + json <- tryCatch(renv_json_read_default(file, text), error = identity) + if (!inherits(json, "error")) + return(json) + + # report an error + if (!is.null(jlerr)) + stop(jlerr) + else + stop(json) + + } + + renv_json_read_jsonlite <- function(file = NULL, text = NULL) { + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") + jsonlite::fromJSON(txt = text, simplifyVector = FALSE) + } + + renv_json_read_patterns <- function() { + + list( + + # objects + list("{", "\t\n\tobject(\t\n\t", TRUE), + list("}", "\t\n\t)\t\n\t", TRUE), + + # arrays + list("[", "\t\n\tarray(\t\n\t", TRUE), + list("]", "\n\t\n)\n\t\n", TRUE), + + # maps + list(":", "\t\n\t=\t\n\t", TRUE), + + # newlines + list("\\u000a", "\n", FALSE) + + ) + + } + + renv_json_read_envir <- function() { + + envir <- new.env(parent = emptyenv()) + + envir[["+"]] <- `+` + envir[["-"]] <- `-` + + envir[["object"]] <- function(...) { + result <- list(...) + names(result) <- as.character(names(result)) + result + } + + envir[["array"]] <- list + + envir[["true"]] <- TRUE + envir[["false"]] <- FALSE + envir[["null"]] <- NULL + + envir + + } + + renv_json_read_remap <- function(object, patterns) { + + # repair names if necessary + if (!is.null(names(object))) { + + nms <- names(object) + for (pattern in patterns) + nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE) + names(object) <- nms + + } + + # repair strings if necessary + if (is.character(object)) { + for (pattern in patterns) + object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE) + } + + # recurse for other objects + if (is.recursive(object)) + for (i in seq_along(object)) + object[i] <- list(renv_json_read_remap(object[[i]], patterns)) + + # return remapped object + object + + } + + renv_json_read_default <- function(file = NULL, text = NULL) { + + # read json text + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") + + # convert into something the R parser will understand + patterns <- renv_json_read_patterns() + transformed <- text + for (pattern in patterns) + transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE) + + # parse it + rfile <- tempfile("renv-json-", fileext = ".R") + on.exit(unlink(rfile), add = TRUE) + writeLines(transformed, con = rfile) + json <- parse(rfile, keep.source = FALSE, srcfile = NULL)[[1L]] + + # evaluate in safe environment + result <- eval(json, envir = renv_json_read_envir()) + + # fix up strings if necessary -- do so only with reversible patterns + patterns <- Filter(function(pattern) pattern[[3L]], patterns) + renv_json_read_remap(result, patterns) + + } + + + # load the renv profile, if any + renv_bootstrap_profile_load(project) + + # construct path to library root + root <- renv_bootstrap_library_root(project) + + # construct library prefix for platform + prefix <- renv_bootstrap_platform_prefix() + + # construct full libpath + libpath <- file.path(root, prefix) + + # run bootstrap code + renv_bootstrap_exec(project, libpath, version) + + invisible() + +}) From 27c5429ce291b8f95bfbab6bdb3a3a37deaf573c Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Mon, 24 Aug 2026 17:19:01 +0000 Subject: [PATCH 02/20] post-Nicole updates --- ratio-analysis/.Rprofile | 1 + ratio-analysis/ratio-analysis.qmd | 398 +++++--- ratio-analysis/renv.lock | 1547 +++++++++++++++++++++++++++++ ratio-analysis/renv/.gitignore | 7 + ratio-analysis/renv/activate.R | 4 +- 5 files changed, 1833 insertions(+), 124 deletions(-) create mode 100644 ratio-analysis/.Rprofile create mode 100644 ratio-analysis/renv.lock create mode 100644 ratio-analysis/renv/.gitignore diff --git a/ratio-analysis/.Rprofile b/ratio-analysis/.Rprofile new file mode 100644 index 0000000..81b960f --- /dev/null +++ b/ratio-analysis/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 61acf50..699676c 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -6,19 +6,7 @@ format: documentclass: article geometry: margin=1in fontsize: 11pt - fig-pos: H - tbl-pos: H - include-in-header: - text: | - \usepackage{colortbl} - \usepackage{xcolor} - \usepackage{booktabs} - \usepackage{longtable} - \usepackage{float} - \usepackage{caption} - \captionsetup[table]{position=top} - \setlength{\aboverulesep}{0pt} - \setlength{\belowrulesep}{0pt} + include-in-header: preamble.tex params: input_file: "" execute: @@ -52,52 +40,22 @@ file_base <- sub("\\.xlsx$", "", basename(input_file)) town_code <- substr(file_base, 1, 2) year_val <- basename(dirname(input_file)) -town_name <- ccao::town_dict |> - filter(township_code == town_code) |> - pull(township_name) |> +town_name <- ccao::town_dict %>% + filter(township_code == town_code) %>% + pull(township_name) %>% first() -cap_tbl1 <- glue( - "Town-Level IAAO Statistics — {town_name} Township, {year_val}.", - " Green shading meets IAAO standard; orange shading does not." -) -cap_tbl2 <- glue( - "Ratio Curve by Sale Price Decile — {town_name} Township, {year_val}" -) -cap_tbl3 <- glue( - "Neighborhood-Level Median Ratios — {town_name} Township, {year_val}.", - " Warm colors (red–yellow) indicate under-assessment;", - " green (0.95–1.05) indicates near-standard;", - " cool colors (blue) indicate over-assessment." -) -cap_fig1 <- glue( - "IAAO Metrics: Model vs. Desk Review — {town_name} Township, {year_val}.", - " Green shaded band shows the IAAO acceptable range for each metric." -) -cap_fig2 <- glue( - "Sale Price Ratio Curve — {town_name} Township, {year_val}.", - " Each labeled point is the median ratio within that sale price decile.", - " Dotted lines show the IAAO acceptable range (0.9–1.1)." -) -cap_fig3 <- glue( - "Neighborhood Median Assessment Ratios — {town_name} Township, {year_val}.", - " Green (0.95–1.05) meets the ±5% threshold;", - " warm colors indicate under-assessment;", - " cool colors indicate over-assessment.", - " The right panel shows the change that desk review made." -) -# --------------------------------------------------------------------------- # Read desk review inputs -# --------------------------------------------------------------------------- + dr_wb <- loadWorkbook(input_file) -dr_vals <- read.xlsx(dr_wb, sheet = 1) |> - tibble(.name_repair = "unique") |> +dr_vals <- read.xlsx(dr_wb, sheet = 1) %>% + tibble(.name_repair = "unique") %>% select(pin = PIN, desk_review_value = Desk.Review.Value) -# --------------------------------------------------------------------------- + # Athena: pull model values and the residential PIN universe -# --------------------------------------------------------------------------- + noctua_options(unload = TRUE) conn <- dbConnect(noctua::athena(), rstudio_conn_tab = FALSE) @@ -113,13 +71,11 @@ model_vals <- dbGetQuery( dbDisconnect(conn) -# --------------------------------------------------------------------------- # Join and compute ratios / price deciles -# --------------------------------------------------------------------------- -all_parcels <- dr_vals |> - inner_join(select(model_vals, pin), by = "pin") |> - full_join(model_vals, by = "pin") |> - filter(township_name == town_name) |> +all_parcels <- dr_vals %>% + inner_join(select(model_vals, pin), by = "pin") %>% + full_join(model_vals, by = "pin") %>% + filter(township_name == town_name) %>% mutate( sale_date = as.Date(sale_date), sale_excluded = if_else(is.na(sale_price), NA, is.na(desk_review_value)), @@ -130,10 +86,8 @@ all_parcels <- dr_vals |> desk_review_sale_ratio = desk_review_value / sale_price ) -# --------------------------------------------------------------------------- # Compute statistics -# --------------------------------------------------------------------------- -sales_df <- all_parcels |> +sales_df <- all_parcels %>% filter(!is.na(sale_price), !sale_excluded %in% TRUE) town_stats <- tibble( @@ -161,7 +115,7 @@ town_stats <- tibble( number_of_sales = nrow(sales_df) ) -decile_stats <- sales_df |> +decile_stats <- sales_df %>% summarize( model_ratio = median(model_sale_ratio, na.rm = TRUE), model_cod = assessr::cod(model_sale_ratio), @@ -174,12 +128,10 @@ decile_stats <- sales_df |> ), number_of_sales = n(), .by = price_decile - ) |> + ) %>% arrange(price_decile) -# --------------------------------------------------------------------------- # Methods summary values -# --------------------------------------------------------------------------- n_original_sales <- sum(!is.na(all_parcels$sale_price)) n_final_sales <- nrow(sales_df) n_excluded_sales <- n_original_sales - n_final_sales @@ -190,13 +142,13 @@ sale_dates <- all_parcels$sale_date[!is.na(all_parcels$sale_date)] min_sale_date <- format(min(sale_dates), "%B %d, %Y") max_sale_date <- format(max(sale_dates), "%B %d, %Y") -# --------------------------------------------------------------------------- -# IAAO helpers -# --------------------------------------------------------------------------- + +# Calculate Stats + iaao_check <- function(metric, value) { switch(metric, "Median Ratio" = value >= 0.90 & value <= 1.10, - "COD" = value <= 15.0, + "COD" = value >= 5.0 & value <= 15.0, "PRD" = value >= 0.98 & value <= 1.03, "PRB" = value >= -0.05 & value <= 0.05, "MKI" = value >= 0.90 & value <= 1.10, @@ -217,13 +169,13 @@ iaao_color_cell <- function(metric, value, digits = 4) { ratio_to_hex <- function(ratio) { case_when( is.na(ratio) ~ "EEEEEE", - ratio < 0.80 ~ "D73027", - ratio < 0.90 ~ "FC8D59", - ratio < 0.95 ~ "FEE08B", + ratio < 0.80 ~ "4575B4", + ratio < 0.90 ~ "74ADD1", + ratio < 0.95 ~ "ABD9E9", ratio <= 1.05 ~ "66BD63", - ratio <= 1.10 ~ "ABD9E9", - ratio <= 1.15 ~ "74ADD1", - TRUE ~ "4575B4" + ratio <= 1.10 ~ "FEE08B", + ratio <= 1.15 ~ "FC8D59", + TRUE ~ "D73027" ) } @@ -236,9 +188,9 @@ color_ratio_cell <- function(ratio, digits = 3) { ratio_fill_scale <- function(name = "Median\nRatio") { scale_fill_gradientn( colors = c( - "#D73027", "#FC8D59", "#FEE08B", + "#4575B4", "#74ADD1", "#ABD9E9", "#66BD63", "#66BD63", "#66BD63", - "#ABD9E9", "#74ADD1", "#4575B4" + "#FEE08B", "#FC8D59", "#D73027" ), values = scales::rescale( c(0.70, 0.80, 0.90, 0.9499, 0.95, 1.0499, 1.05, 1.15, 1.30) @@ -255,14 +207,118 @@ ratio_fill_scale <- function(name = "Median\nRatio") { ## Methods -This analysis covers **`r town_name` Township** for the `r year_val` assessment cycle. CCAO Data's original sale sample included **`r format(n_original_sales, big.mark = ",")`** arm's-length sales occurring between `r min_sale_date` and `r max_sale_date`, with sale prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded at desk review, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales** used throughout this analysis. The township contains **`r format(n_total_pins, big.mark = ",")` residential parcels**; the final sale sample covers **`r pct_with_sale`%** of all residential parcels, indicating the degree to which these sales represent the full assessment universe. - -Two sets of assessments are compared: (1) **Model** values, produced by the model, and (2) **Desk Review** values, reflecting adjustment by CCAO staff. +This analysis covers **`r town_name` Township** for the `r year_val` +assessment cycle. CCAO Data's original sale sample included +**`r format(n_original_sales, big.mark = ",")`** arm's-length sales +occurring between `r min_sale_date` and `r max_sale_date`, with sale +prices ranging from `r town_stats$price_range`. Of these, +**`r format(n_excluded_sales, big.mark = ",")`** sales were excluded +at desk review, leaving a **final sample of +`r format(n_final_sales, big.mark = ",")` sales**. The township +contains **`r format(n_total_pins, big.mark = ",")` residential +parcels**. + +Two sets of values are compared: (1) **Model** values, which are the +output of the model, and (2) **Desk Review** values, which reflect +CCAO staff adjustments. ## Results +```{r cap-desc} +cap_desc <- glue( + "Descriptive Statistics.", + "\\newline Summary of model and desk review assessed values and sale prices", + " across all properties, properties with arm's-length sales used in the", + " ratio analysis, and properties without qualifying sales.", + " Note: Some sales are excluded as non-arm's-length transactions,", + " so 'Sales Used' and 'No Sales' do not sum to 'All Properties'." +) +``` + +```{r tbl-desc} +#| tbl-cap: !expr 'cap_desc' +#| tbl-pos: H + +no_sale <- all_parcels %>% filter(is.na(sale_price)) + +fmt_n <- function(x) format(x, big.mark = ",") +fmt_dol <- function(x) paste0("\\$", format(round(x), big.mark = ",")) +fmt_pct <- function(changed, total) { + paste0(round(changed / total * 100, 1), "\\%") +} + +n_changed <- function(df) { + sum(!is.na(df$model_value) & !is.na(df$desk_review_value) & + df$model_value != df$desk_review_value) # nolint: indentation_linter. +} + +desc_table <- tibble( + Statistic = c( + "N", + "N DR Changes", + "\\% DR Changes", + "Median Model AV", + "Mean Model AV", + "Median DR AV", + "Mean DR AV", + "Median Sale Price", + "Mean Sale Price" + ), + `Sales Used` = c( + fmt_n(nrow(sales_df)), + fmt_n(n_changed(sales_df)), + fmt_pct(n_changed(sales_df), nrow(sales_df)), + fmt_dol(median(sales_df$model_value, na.rm = TRUE)), + fmt_dol(mean(sales_df$model_value, na.rm = TRUE)), + fmt_dol(median(sales_df$desk_review_value, na.rm = TRUE)), + fmt_dol(mean(sales_df$desk_review_value, na.rm = TRUE)), + fmt_dol(median(sales_df$sale_price, na.rm = TRUE)), + fmt_dol(mean(sales_df$sale_price, na.rm = TRUE)) + ), + `All Properties` = c( + fmt_n(nrow(all_parcels)), + fmt_n(n_changed(all_parcels)), + fmt_pct(n_changed(all_parcels), nrow(all_parcels)), + fmt_dol(median(all_parcels$model_value, na.rm = TRUE)), + fmt_dol(mean(all_parcels$model_value, na.rm = TRUE)), + fmt_dol(median(all_parcels$desk_review_value, na.rm = TRUE)), + fmt_dol(mean(all_parcels$desk_review_value, na.rm = TRUE)), + "---", + "---" + ), + `No Sales` = c( + fmt_n(nrow(no_sale)), + "---", + "---", + fmt_dol(median(no_sale$model_value, na.rm = TRUE)), + fmt_dol(mean(no_sale$model_value, na.rm = TRUE)), + fmt_dol(median(no_sale$desk_review_value, na.rm = TRUE)), + fmt_dol(mean(no_sale$desk_review_value, na.rm = TRUE)), + "---", + "---" + ) +) + +knitr::kable( + desc_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r") +) +``` + +```{r cap-1} +cap_fig1 <- glue( + "Town-Level IAAO Statistics.", + "\\newline Green shading meets IAAO standard; orange shading does not." +) +``` + ```{r tbl-1} -#| tbl-cap: !expr 'cap_tbl1' +#| tbl-cap: !expr 'cap_fig1' +#| tbl-pos: H ts <- town_stats @@ -270,7 +326,7 @@ iaao_table <- data.frame( Metric = c("Median Ratio", "COD", "PRD", "PRB", "MKI", "N Sales"), `IAAO Standard` = c( "0.90 -- 1.10", - "$\\leq$ 15.0", + "5.0 -- 15.0", "0.98 -- 1.03", "$\\pm$0.05", "0.90 -- 1.10", @@ -307,9 +363,9 @@ knitr::kable( ``` ```{r nbhd-ratios-prep} -nbhd_ratios <- all_parcels |> - filter(!is.na(sale_price), !sale_excluded %in% TRUE) |> - mutate(neighborhood_number = gsub("-", "", neighborhood_number)) |> +nbhd_ratios <- all_parcels %>% + filter(!is.na(sale_price), !sale_excluded %in% TRUE) %>% + mutate(neighborhood_number = gsub("-", "", neighborhood_number)) %>% summarize( model_ratio = median(model_sale_ratio, na.rm = TRUE), dr_ratio = median(desk_review_sale_ratio, na.rm = TRUE), @@ -318,15 +374,26 @@ nbhd_ratios <- all_parcels |> ) ``` -```{r tbl-3} -#| tbl-cap: !expr 'cap_tbl3' +{{< pagebreak >}} + +```{r cap-2} +cap_fig2 <- glue( + "Neighborhood-Level Median Ratios.", + "\\newline Blue indicates under-assessment;", + " Green (0.95–1.05) indicates near-standard;", + " Red indicates over-assessment." +) +``` + +```{r tbl-2} +#| tbl-cap: !expr 'cap_fig2' -all_nbhds <- all_parcels |> - distinct(neighborhood_number) |> +all_nbhds <- all_parcels %>% + distinct(neighborhood_number) %>% arrange(neighborhood_number) -nbhd_table_data <- all_nbhds |> - left_join(nbhd_ratios, by = "neighborhood_number") |> +nbhd_table_data <- all_nbhds %>% + left_join(nbhd_ratios, by = "neighborhood_number") %>% mutate( `NBHD` = neighborhood_number, `Model Ratio` = ifelse( @@ -336,7 +403,7 @@ nbhd_table_data <- all_nbhds |> is.na(dr_ratio), "---", color_ratio_cell(dr_ratio, digits = 3) ), `N Sales` = ifelse(is.na(n_sales), 0L, n_sales) - ) |> + ) %>% select(`NBHD`, `Model Ratio`, `DR Ratio`, `N Sales`) knitr::kable( @@ -351,8 +418,17 @@ knitr::kable( ) ``` -```{r fig-1} -#| fig-cap: !expr 'cap_fig1' +```{r cap-3} +cap_fig3 <- glue( + "IAAO Metrics: Model vs. Desk Review.", + "\\newline Green shaded band shows the IAAO acceptable range for each metric." +) +``` + +```{r fig-3} +#| fig-cap: !expr 'cap_fig3' +#| fig-pos: H +#| fig-cap-location: top #| fig-height: 7 #| fig-width: 7 @@ -370,20 +446,59 @@ ts_wide <- tibble( ) ) -ts_long <- ts_wide |> +ts_long <- ts_wide %>% pivot_longer( c(Model, `Desk Review`), names_to = "Stage", values_to = "Value" - ) |> + ) %>% mutate(Stage = factor(Stage, levels = c("Model", "Desk Review"))) iaao_bands <- tibble( Metric = factor(metric_order, levels = metric_order), - xmin = c(0.90, 0, 0.98, -0.05, 0.90), + xmin = c(0.90, 5.0, 0.98, -0.05, 0.90), xmax = c(1.10, 15.0, 1.03, 0.05, 1.10) ) +iaao_meta <- tibble( + Metric = factor(metric_order, levels = metric_order), + mid = c(1.000, 10.0, 1.005, 0.00, 1.000), + half_span = c(0.100, 5.0, 0.025, 0.05, 0.100) +) + +sym_anchors <- ts_long %>% + left_join(iaao_meta, by = "Metric") %>% + mutate(dev = abs(Value - mid)) %>% + group_by(Metric, mid, half_span) %>% + summarize( + max_dev = max(dev, na.rm = TRUE), + out_of_range = any(dev > half_span, na.rm = TRUE), + .groups = "drop" + ) %>% + filter(out_of_range) %>% + mutate( + half_ax = pmax(half_span, max_dev) * 1.15, + x_lo = mid - half_ax, + x_hi = mid + half_ax + ) %>% + select(Metric, x_lo, x_hi) %>% + pivot_longer( + c(x_lo, x_hi), + names_to = "side", values_to = "x" + ) %>% + select(Metric, x) + +scale_anchors <- bind_rows( + sym_anchors, + tibble(Metric = factor("COD", levels = metric_order), x = 0) +) + ggplot() + + geom_point( + data = scale_anchors, + aes(x = x, y = 1), + size = 0, + alpha = 0 + ) + geom_rect( data = iaao_bands, aes(xmin = xmin, xmax = xmax, ymin = 0.1, ymax = 1.9), @@ -406,7 +521,7 @@ ggplot() + ) + facet_wrap(~Metric, scales = "free_x", ncol = 1) + scale_color_manual( - values = c("Model" = "#4575B4", "Desk Review" = "#D73027") + values = c("Model" = "#A569BD", "Desk Review" = "#2C2C2C") ) + scale_shape_manual(values = c("Model" = 16, "Desk Review" = 17)) + scale_y_continuous(limits = c(0, 2)) + @@ -422,18 +537,29 @@ ggplot() + labs(x = NULL, y = NULL, color = "Stage", shape = "Stage") ``` -```{r fig-2} -#| fig-cap: !expr 'cap_fig2' +```{r cap-4} +cap_fig4 <- glue( + "Sale Price Ratio Curve.", + "\\newline Each labeled point is the median ratio within that", + " sale price decile.", + " Dotted lines show the IAAO acceptable range (0.9–1.1)." +) +``` + +```{r fig-4} +#| fig-cap: !expr 'cap_fig4' +#| fig-pos: H +#| fig-cap-location: top #| fig-height: 5 #| fig-width: 7 -decile_long <- decile_stats |> - select(price_decile, model_ratio, desk_review_ratio) |> +decile_long <- decile_stats %>% + select(price_decile, model_ratio, desk_review_ratio) %>% pivot_longer( cols = c(model_ratio, desk_review_ratio), names_to = "Stage", values_to = "Sale Ratio" - ) |> + ) %>% mutate( Stage = case_when( Stage == "model_ratio" ~ "Model", @@ -442,20 +568,20 @@ decile_long <- decile_stats |> Stage = factor(Stage, levels = c("Model", "Desk Review")) ) -axis_labels <- all_parcels |> - filter(!is.na(sale_price), !sale_excluded %in% TRUE, !is.na(price_decile)) |> +axis_labels <- all_parcels %>% + filter(!is.na(sale_price), !sale_excluded %in% TRUE, !is.na(price_decile)) %>% summarize( min_price = min(sale_price), max_price = max(sale_price), .by = price_decile - ) |> - arrange(price_decile) |> + ) %>% + arrange(price_decile) %>% mutate(label = paste0( price_decile, "\n", scales::dollar(min_price, scale_cut = scales::cut_short_scale()), "–\n", scales::dollar(max_price, scale_cut = scales::cut_short_scale()) - )) |> + )) %>% (\(df) setNames(df$label, df$price_decile))() y_min <- min(decile_long$`Sale Ratio`, 0.7, na.rm = TRUE) @@ -471,6 +597,10 @@ ggplot( label = round(`Sale Ratio`, 2) ) ) + + annotate("rect", + xmin = -Inf, xmax = Inf, ymin = 0.9, ymax = 1.1, + fill = "#66BD63", alpha = 0.12 + ) + geom_hline(yintercept = 1, color = "darkgreen", linewidth = 1) + geom_hline( yintercept = 0.9, linetype = "dotted", color = "black", linewidth = 0.8 @@ -485,7 +615,7 @@ ggplot( geom_line(linewidth = 1) + geom_label(show.legend = FALSE, size = 3) + scale_color_manual( - values = c("Model" = "#4575B4", "Desk Review" = "#D73027") + values = c("Model" = "#A569BD", "Desk Review" = "#2C2C2C") ) + scale_x_continuous(breaks = 1:10, labels = axis_labels) + scale_y_continuous( @@ -497,17 +627,26 @@ ggplot( labs(x = "Sale Price Decile", y = "Median Sale Ratio", color = "Stage") ``` -```{r tbl-2} -#| tbl-cap: !expr 'cap_tbl2' +{{< pagebreak >}} + +```{r cap-5} +cap_fig5 <- glue( + "Ratio Curve by Sale Price Decile" +) +``` + +```{r tbl-5} +#| tbl-cap: !expr 'cap_fig5' +#| tbl-pos: H -decile_display <- decile_stats |> +decile_display <- decile_stats %>% select( Decile = price_decile, `Price Range` = price_range, `N Sales` = number_of_sales, `Model Ratio` = model_ratio, `DR Ratio` = desk_review_ratio - ) |> + ) %>% mutate( `Model Ratio` = round(`Model Ratio`, 3), `DR Ratio` = round(`DR Ratio`, 3) @@ -522,14 +661,14 @@ knitr::kable( ) ``` -```{r fig-3-prep} -neighborhoods <- ccao::nbhd_shp |> - filter(township_name == town_name) |> +```{r fig-6-prep} +neighborhoods <- ccao::nbhd_shp %>% + filter(township_name == town_name) %>% select(town_nbhd, geometry) -map_data <- neighborhoods |> - left_join(nbhd_ratios, by = c("town_nbhd" = "neighborhood_number")) |> - mutate(diff = dr_ratio - model_ratio) +map_data <- neighborhoods %>% + left_join(nbhd_ratios, by = c("town_nbhd" = "neighborhood_number")) %>% + mutate(diff = abs(model_ratio - 1) - abs(dr_ratio - 1)) map_theme <- theme_void(base_size = 9) + theme( @@ -569,16 +708,31 @@ map_diff <- ggplot() + limits = c(-diff_limit, diff_limit), oob = scales::squish, na.value = "gray90", - name = "Model −\nDesk Review" + name = "Improvement" ) + map_theme + - labs(title = "Model − Desk Review") + labs(title = "Desk Review Improvement") ``` -```{r fig-3} -#| fig-cap: !expr 'cap_fig3' +```{r cap-6} +cap_fig6 <- glue( + "Neighborhood Median Assessment Ratios.", + "\\newline Green (0.95–1.05) meets the ±5% threshold;", + " Blue indicates under-assessment;", + " Red indicates over-assessment.", + " The right panel shows desk review improvement:", + " Blue indicates an improved ratio (closer to 1)", + " and red indicates it moved further away." +) +``` + +```{r fig-6} +#| fig-cap: !expr 'cap_fig6' +#| fig-pos: H +#| fig-cap-location: top #| fig-height: 5.5 #| fig-width: 8.5 +#| results: 'hide' grid.newpage() print(map_model, vp = viewport( diff --git a/ratio-analysis/renv.lock b/ratio-analysis/renv.lock new file mode 100644 index 0000000..112ba76 --- /dev/null +++ b/ratio-analysis/renv.lock @@ -0,0 +1,1547 @@ +{ + "R": { + "Version": "4.6.1", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cloud.r-project.org" + } + ] + }, + "Packages": { + "DBI": { + "Package": "DBI", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "dbfa2adb83f8063640982459e153f650" + }, + "KernSmooth": { + "Package": "KernSmooth", + "Version": "2.23-26", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "2fb39782c07b5ad422b0448ae83f64c4" + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-65", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "methods", + "stats", + "utils" + ], + "Hash": "a41d0fc833ea756a1136b60a437efe26" + }, + "R6": { + "Package": "R6", + "Version": "2.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "d4335fe7207f1c01ab8c41762f5840d4" + }, + "RColorBrewer": { + "Package": "RColorBrewer", + "Version": "1.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "45f0398006e83a5b10b72a90663d8d8c" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "f481f89daa906a34eab8ef8658c8a89c" + }, + "S7": { + "Package": "S7", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "6a72e94a8c9be4ef719af3aa3628f2dc" + }, + "abind": { + "Package": "abind", + "Version": "1.4-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "2288423bb0f20a457800d7fc47f6aa54" + }, + "arrow": { + "Package": "arrow", + "Version": "25.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "assertthat", + "bit64", + "cpp11", + "glue", + "methods", + "purrr", + "rlang", + "stats", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "d8c220599be46a5d07f6837e715bfe13" + }, + "askpass": { + "Package": "askpass", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "sys" + ], + "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" + }, + "assertthat": { + "Package": "assertthat", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "50c838a310445e954bc13f26f26a6ecf" + }, + "assessr": { + "Package": "assessr", + "Version": "0.6.0", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "ccao-data", + "RemoteRepo": "assessr", + "RemoteRef": "master", + "RemoteSha": "f1b2cdaa4fd5bc9d1597b9fe9537dc48d34e4a80", + "Requirements": [ + "R", + "stats" + ], + "Hash": "e533ff8176cf00d0fec973ae645098a4" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5edb675b7baa6e9a0d86dd2c28de1676" + }, + "bit": { + "Package": "bit", + "Version": "4.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "ebe86ffd194564abdc895d87742d5a29" + }, + "bit64": { + "Package": "bit64", + "Version": "4.8.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bit", + "graphics", + "methods", + "stats", + "utils" + ], + "Hash": "71778c0b60bbf439ac64e6a8be695917" + }, + "bslib": { + "Package": "bslib", + "Version": "0.12.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "fastmap", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "lifecycle", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "b2d0b0a17142ed4858f252d88eb56223" + }, + "cachem": { + "Package": "cachem", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cd9a672193789068eb5a2aad65a0dedf" + }, + "ccao": { + "Package": "ccao", + "Version": "1.3.1", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "ccao-data", + "RemoteRepo": "ccao", + "RemoteRef": "master", + "RemoteSha": "419b67731a1aeb1fa1d2b47b0ed6c3391f5c653a", + "Requirements": [ + "R", + "arrow", + "assessr", + "dplyr", + "glue", + "magrittr", + "noctua", + "rlang", + "tidyr" + ], + "Hash": "f05c4f99a56189cac0a30f11cc05dbf3" + }, + "class": { + "Package": "class", + "Version": "7.3-23", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "stats", + "utils" + ], + "Hash": "d0cb9cc838c3b43560bd958fc4317fdc" + }, + "classInt": { + "Package": "classInt", + "Version": "0.4-11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "KernSmooth", + "R", + "class", + "e1071", + "grDevices", + "graphics", + "stats" + ], + "Hash": "f2af70314a63d7f025ae668f08bd933a" + }, + "cli": { + "Package": "cli", + "Version": "3.6.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "a73d822b669d443ff8de6928f9c49850" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "cc6e507cf89f11ffc44b32519e0198da" + }, + "commonmark": { + "Package": "commonmark", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "https://packagemanager.posit.co/cran/__linux__/jammy/2026-07-10", + "Hash": "8cba62334c1088d21689d353a7e87663" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.5.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "20ecb9105a3fb48a8390919abc3b7e90" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "859d96e65ef198fd43e82b9628d593ef" + }, + "curl": { + "Package": "curl", + "Version": "7.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "2e004ed19964915a8faf48a574439be9" + }, + "data.table": { + "Package": "data.table", + "Version": "1.18.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "da9ddede68a6f6e5d3098c0ab81b6e1f" + }, + "digest": { + "Package": "digest", + "Version": "0.6.39", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "d18028e978a88b2b16ef8d400cb49adf" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "d71f190466b9496cf8543c76641be5cf" + }, + "e1071": { + "Package": "e1071", + "Version": "1.7-17", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "class", + "grDevices", + "graphics", + "methods", + "proxy", + "stats", + "utils" + ], + "Hash": "9d516dde384526d4784166f888cd2c6c" + }, + "evaluate": { + "Package": "evaluate", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "94cf2c54237f6841cee68e3ba4ab5a14" + }, + "farver": { + "Package": "farver", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "680887028577f3fa2a81e410ed0d6e42" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "aa5e1cd11c2d15497494c5292d7ffcc8" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "bd1297f9b5b1fc1372d19e2c4cd82215" + }, + "fs": { + "Package": "fs", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "09278623bca442bc53b0940ffa2f6d87" + }, + "generics": { + "Package": "generics", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4b29bf698d0c7bdb9f1e4976e7ade41d" + }, + "ggplot2": { + "Package": "ggplot2", + "Version": "4.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "S7", + "cli", + "grDevices", + "grid", + "gtable", + "isoband", + "lifecycle", + "rlang", + "scales", + "stats", + "vctrs", + "withr" + ], + "Hash": "98520fe6b2745c466dca8e46aaa86242" + }, + "ggspatial": { + "Package": "ggspatial", + "Version": "1.1.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "abind", + "ggplot2", + "glue", + "grid", + "methods", + "rlang", + "rosm", + "scales", + "sf", + "tibble", + "tidyr" + ], + "Hash": "a065e21174bbce1866deff1e30d26ca5" + }, + "glue": { + "Package": "glue", + "Version": "1.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "f8122473e9a49e00d0642f78235ca5e3" + }, + "gtable": { + "Package": "gtable", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "grid", + "lifecycle", + "rlang", + "stats" + ], + "Hash": "de949855009e2d4d0e52a844e30617ae" + }, + "highr": { + "Package": "highr", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "2a2f862ade01a56dcbcd60944de11255" + }, + "hms": { + "Package": "hms", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "2799ac720626cec589478b191e48b88b" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "digest", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "102298e238c14eb830cc4b5edd23c3e8" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.17", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "4ff0297ad1cd631d57f0d30172972754" + }, + "httr2": { + "Package": "httr2", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "lifecycle", + "magrittr", + "openssl", + "rlang", + "vctrs", + "withr" + ], + "Hash": "f4d796ba71b073f7bc95da858caded00" + }, + "isoband": { + "Package": "isoband", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "cpp11", + "grid", + "rlang", + "utils" + ], + "Hash": "0f9a864bbd7ce0232ad05cb76249cc1a" + }, + "jpeg": { + "Package": "jpeg", + "Version": "0.1-11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c23ab23c370d1ce3a7a80d8c0bdfa105" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "b0776f526d36d8bd4a3344a88fe165c4" + }, + "knitr": { + "Package": "knitr", + "Version": "1.51", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "27682babb50f03b6eb7939ea69ec79ca" + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "graphics", + "stats" + ], + "Hash": "b64ec208ac5bc1852b285f665d6368b3" + }, + "later": { + "Package": "later", + "Version": "1.4.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "rlang" + ], + "Hash": "824c180e69b9be79ab96a985e233c470" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "rlang" + ], + "Hash": "36dbfe4fba6c064db50a671a90297c85" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "665e77ab6e5f37a7913226d40b324e37" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.13", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "0ec19f34c72fab674d8f2b4b1c6410e1" + }, + "noctua": { + "Package": "noctua", + "Version": "2.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "DBI", + "R", + "data.table", + "methods", + "paws", + "stats", + "utils", + "uuid" + ], + "Hash": "15471c0eaafcb7f2a4dabc983ea71112" + }, + "openssl": { + "Package": "openssl", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass" + ], + "Hash": "6994d1c3ea954f29de6aeca5da95c99d" + }, + "openxlsx": { + "Package": "openxlsx", + "Version": "4.2.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "grDevices", + "methods", + "stats", + "stringi", + "utils", + "zip" + ], + "Hash": "a1565bd9ee11620aeea591cc037b3aa1" + }, + "otel": { + "Package": "otel", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "https://packagemanager.posit.co/cran/__linux__/jammy/2026-07-10", + "Requirements": [ + "R" + ], + "Hash": "627d6993db1043703c0b084fa432f21f" + }, + "paws": { + "Package": "paws", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.analytics", + "paws.application.integration", + "paws.common", + "paws.compute", + "paws.cost.management", + "paws.customer.engagement", + "paws.database", + "paws.developer.tools", + "paws.end.user.computing", + "paws.machine.learning", + "paws.management", + "paws.networking", + "paws.security.identity", + "paws.storage" + ], + "Hash": "f840835e93f287e6bf79d95f536cdb2f" + }, + "paws.analytics": { + "Package": "paws.analytics", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "7d181b30d14ef34589ca20bbb7361fde" + }, + "paws.application.integration": { + "Package": "paws.application.integration", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "6cde06aeae9f2a6f193886a7756afa7f" + }, + "paws.common": { + "Package": "paws.common", + "Version": "0.8.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "base64enc", + "curl", + "digest", + "httr2", + "jsonlite", + "methods", + "stats", + "utils", + "xml2" + ], + "Hash": "39e4ac3a7ca67421d5f6b6f5ed2340b9" + }, + "paws.compute": { + "Package": "paws.compute", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "ae63fc9e22e25b5f7d69bf6a62c6a2bb" + }, + "paws.cost.management": { + "Package": "paws.cost.management", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "f239556e7261d7e6036d882ae6cf1c39" + }, + "paws.customer.engagement": { + "Package": "paws.customer.engagement", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "07280ba6a6878f004297a1e00ad7a26f" + }, + "paws.database": { + "Package": "paws.database", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "bdf105fa60f5705a47643ee8fd897500" + }, + "paws.developer.tools": { + "Package": "paws.developer.tools", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "ec39a93b14e132a19dd50ff439f821de" + }, + "paws.end.user.computing": { + "Package": "paws.end.user.computing", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "92a5c132a8a378e98028fdaf0cd71a27" + }, + "paws.machine.learning": { + "Package": "paws.machine.learning", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "9cb6408161e048927bbbdff3d8765d62" + }, + "paws.management": { + "Package": "paws.management", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "b114e36c4090bb299408958c785856a8" + }, + "paws.networking": { + "Package": "paws.networking", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "92bea219331b4cbfe790ac56dd92ec0a" + }, + "paws.security.identity": { + "Package": "paws.security.identity", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "0667aa70df94a5d303440420ca56c0f8" + }, + "paws.storage": { + "Package": "paws.storage", + "Version": "0.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "paws.common" + ], + "Hash": "7dc3b787d34451ee84b1e1d60f245fe4" + }, + "pillar": { + "Package": "pillar", + "Version": "1.11.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "1395e64f2689ffd503657778e810cee2" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "png": { + "Package": "png", + "Version": "0.1-9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "961c433971606243a724eb19b1075e60" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "6b01fc98b1e86c4f705ce9dcfd2f57c7" + }, + "progress": { + "Package": "progress", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "crayon", + "hms", + "prettyunits" + ], + "Hash": "f4625e061cb2865f111b47ff163a5ca6" + }, + "promises": { + "Package": "promises", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "fastmap", + "later", + "lifecycle", + "magrittr", + "otel", + "rlang" + ], + "Hash": "62cb899ed5fff70d4e918ec1b762bf7c" + }, + "proxy": { + "Package": "proxy", + "Version": "0.4-29", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b6c826e897b46b163c51a3b990113a21" + }, + "purrr": { + "Package": "purrr", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "0a35605539b085a4828ec55ad973fe60" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "f146a5bfc94db048309712535d4d0aee" + }, + "readr": { + "Package": "readr", + "Version": "2.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "clipr", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "methods", + "rlang", + "tibble", + "tzdb", + "utils", + "vroom", + "withr" + ], + "Hash": "4425ad9e28b8e3351184ca2739995b87" + }, + "renv": { + "Package": "renv", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "1bd9f58e1cfe27ce035933937c6f03de" + }, + "rlang": { + "Package": "rlang", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "8d05afdb0b0dd5ef01b306db289fe21f" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.31", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "f34039d57d861d2869cbf9be813ed08e" + }, + "rosm": { + "Package": "rosm", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "curl", + "glue", + "jpeg", + "png", + "progress", + "rlang", + "wk" + ], + "Hash": "14c0023fdb16dddf88fd43b321dd1948" + }, + "s2": { + "Package": "s2", + "Version": "1.1.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "wk" + ], + "Hash": "54b09824b3ac78eb4fa44f76c0616131" + }, + "sass": { + "Package": "sass", + "Version": "0.4.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "3fb78d066fb92299b1d13f6a7c9a90a8" + }, + "scales": { + "Package": "scales", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "RColorBrewer", + "cli", + "farver", + "glue", + "labeling", + "lifecycle", + "rlang", + "viridisLite" + ], + "Hash": "c5bba8f0d1df8c4b9538a40570798d9b" + }, + "sf": { + "Package": "sf", + "Version": "1.1-2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "DBI", + "R", + "Rcpp", + "classInt", + "grDevices", + "graphics", + "grid", + "methods", + "s2", + "stats", + "tools", + "units", + "utils" + ], + "Hash": "02483c8ee4115581472646cd5d5984d9" + }, + "shiny": { + "Package": "shiny", + "Version": "1.14.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "cli", + "commonmark", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "otel", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "e71fb3fcf73db153eccd8afed293984f" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7-2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "e716e13bfbfe8acb6182a05f4b367772" + }, + "stringi": { + "Package": "stringi", + "Version": "1.8.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "2b56088e23bdd58f89aebf43a0913457" + }, + "stringr": { + "Package": "stringr", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "d47392652eedc68bf916657347ff2526" + }, + "sys": { + "Package": "sys", + "Version": "3.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "de342ebfebdbf40477d0758d05426646" + }, + "tibble": { + "Package": "tibble", + "Version": "3.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "c55df870972551cac674b50cadb2d51f" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "a4fa2f5876396f04814cb9d8d9ab89e9" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.60", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "263651b52279eaa7835e44aa32f9b754" + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "09e3961e87b7bafa4a9340bbb34aeda8" + }, + "units": { + "Package": "units", + "Version": "1.0-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp" + ], + "Hash": "14743a941151a12449e8af67497c7b96" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "d526d558be176e9ceb68c3d1e83479b7" + }, + "uuid": { + "Package": "uuid", + "Version": "1.2-2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "528fc9e90d70a6a115e21164f37b2c64" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.7.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "2dcde2d30d3ad67bf1d3a37177457b87" + }, + "viridisLite": { + "Package": "viridisLite", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "9380d36888b72faf5ae6c22b44703867" + }, + "vroom": { + "Package": "vroom", + "Version": "1.7.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bit64", + "cli", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "methods", + "progress", + "rlang", + "stats", + "tibble", + "tidyselect", + "tzdb", + "vctrs", + "withr" + ], + "Hash": "1e9494eda38f3418f71474363293da2a" + }, + "withr": { + "Package": "withr", + "Version": "3.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics" + ], + "Hash": "d979712ec72df779bc2d30bcc5d0d541" + }, + "wk": { + "Package": "wk", + "Version": "0.9.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "10fb21ed42dbd4ed9162aaab818146e3" + }, + "xfun": { + "Package": "xfun", + "Version": "0.60", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "stats", + "tools" + ], + "Hash": "8304c2894061f6ae062996f09dd1528e" + }, + "xml2": { + "Package": "xml2", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "methods", + "rlang" + ], + "Hash": "568fe669c645b2007e4e8fcf5cde40e7" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "stats", + "utils" + ], + "Hash": "93b19c064862d315a828c7170d806453" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.12", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7cd77cb32abd9220d744307e9fc94ffb" + }, + "zip": { + "Package": "zip", + "Version": "3.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli" + ], + "Hash": "2c4eff2acdb28a05588a5fee7b35921c" + } + } +} diff --git a/ratio-analysis/renv/.gitignore b/ratio-analysis/renv/.gitignore new file mode 100644 index 0000000..0ec0cbb --- /dev/null +++ b/ratio-analysis/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/ratio-analysis/renv/activate.R b/ratio-analysis/renv/activate.R index abd9432..20ffd44 100644 --- a/ratio-analysis/renv/activate.R +++ b/ratio-analysis/renv/activate.R @@ -2,8 +2,8 @@ local({ # the requested version of renv - version <- "1.1.5" - attr(version, "md5") <- "770fcbc2c4616e8fbcb187cccd46a6b1" + version <- "1.2.3" + attr(version, "md5") <- "1bd9f58e1cfe27ce035933937c6f03de" attr(version, "sha") <- NULL # the project directory From bc0265f370d78854bdbdf9329c4e883d8ddd1267 Mon Sep 17 00:00:00 2001 From: Damonamajor <56321109+Damonamajor@users.noreply.github.com> Date: Mon, 24 Aug 2026 16:22:38 -0500 Subject: [PATCH 03/20] Update ratio-analysis/ratio-analysis.qmd Co-authored-by: Nicole Jardine <138712135+ccao-jardine@users.noreply.github.com> --- ratio-analysis/ratio-analysis.qmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 699676c..f16ccb2 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -213,7 +213,7 @@ assessment cycle. CCAO Data's original sale sample included occurring between `r min_sale_date` and `r max_sale_date`, with sale prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded -at desk review, leaving a **final sample of +as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. From e1b5ad08f57c29f9927f06ad1d4414ebb5ae31cf Mon Sep 17 00:00:00 2001 From: Damonamajor <56321109+Damonamajor@users.noreply.github.com> Date: Mon, 24 Aug 2026 16:23:59 -0500 Subject: [PATCH 04/20] Apply suggestions from code review Co-authored-by: Nicole Jardine <138712135+ccao-jardine@users.noreply.github.com> --- ratio-analysis/ratio-analysis.qmd | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index f16ccb2..898a86b 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -207,10 +207,11 @@ ratio_fill_scale <- function(name = "Median\nRatio") { ## Methods -This analysis covers **`r town_name` Township** for the `r year_val` -assessment cycle. CCAO Data's original sale sample included +This is a ratio analysis for **`r town_name` Township** for the `r year_val` +assessment cycle. The original sale sample included **`r format(n_original_sales, big.mark = ",")`** arm's-length sales -occurring between `r min_sale_date` and `r max_sale_date`, with sale +after outliers were excluded. These sales +occurred between `r min_sale_date` and `r max_sale_date`, with sale prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of @@ -218,9 +219,9 @@ as outliers by Valuations analysts, leaving a **final sample of contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. -Two sets of values are compared: (1) **Model** values, which are the -output of the model, and (2) **Desk Review** values, which reflect -CCAO staff adjustments. +This analysis compares ratio statistics from two stages: +(1) **Model** values, which are the output of the model, and +(2) **Desk Review** values, which reflect manual adjustments by staff. ## Results @@ -338,7 +339,6 @@ iaao_table <- data.frame( iaao_color_cell("PRD", ts$model_prd, digits = 4), iaao_color_cell("PRB", ts$model_prb, digits = 4), iaao_color_cell("MKI", ts$model_mki, digits = 4), - format(ts$number_of_sales, big.mark = ",") ), `Desk Review` = c( iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), @@ -380,7 +380,7 @@ nbhd_ratios <- all_parcels %>% cap_fig2 <- glue( "Neighborhood-Level Median Ratios.", "\\newline Blue indicates under-assessment;", - " Green (0.95–1.05) indicates near-standard;", + " Green (0.90–1.1) indicates within standard;", " Red indicates over-assessment." ) ``` From f99714c073be7f380e28d54d247f13054974efb3 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Tue, 25 Aug 2026 17:13:03 +0000 Subject: [PATCH 05/20] ordering updates --- ratio-analysis/ratio-analysis.qmd | 191 +++++++++++++++--------------- 1 file changed, 95 insertions(+), 96 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 898a86b..248e858 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -225,6 +225,58 @@ This analysis compares ratio statistics from two stages: ## Results +```{r cap-1} +cap_fig1 <- glue( + "Town-Level IAAO Statistics.", + "\\newline Green shading meets IAAO standard; orange shading does not." +) +``` + +```{r tbl-1} +#| tbl-cap: !expr 'cap_fig1' +#| tbl-pos: H + +ts <- town_stats + +iaao_table <- data.frame( + Metric = c("Median Ratio", "COD", "PRD", "PRB", "MKI", "N Sales"), + `IAAO Standard` = c( + "0.90 -- 1.10", + "5.0 -- 15.0", + "0.98 -- 1.03", + "$\\pm$0.05", + "0.90 -- 1.10", + "---" + ), + Model = c( + iaao_color_cell("Median Ratio", ts$model_ratio, digits = 3), + iaao_color_cell("COD", ts$model_cod, digits = 1), + iaao_color_cell("PRD", ts$model_prd, digits = 4), + iaao_color_cell("PRB", ts$model_prb, digits = 4), + iaao_color_cell("MKI", ts$model_mki, digits = 4), + ), + `Desk Review` = c( + iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), + iaao_color_cell("COD", ts$desk_review_cod, digits = 1), + iaao_color_cell("PRD", ts$desk_review_prd, digits = 4), + iaao_color_cell("PRB", ts$desk_review_prb, digits = 4), + iaao_color_cell("MKI", ts$desk_review_mki, digits = 4), + format(ts$number_of_sales, big.mark = ",") + ), + check.names = FALSE +) + +knitr::kable( + iaao_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + col.names = c("Metric", "IAAO Standard", "Model", "Desk Review"), + align = c("l", "c", "r", "r") +) +``` + ```{r cap-desc} cap_desc <- glue( "Descriptive Statistics.", @@ -310,58 +362,6 @@ knitr::kable( ) ``` -```{r cap-1} -cap_fig1 <- glue( - "Town-Level IAAO Statistics.", - "\\newline Green shading meets IAAO standard; orange shading does not." -) -``` - -```{r tbl-1} -#| tbl-cap: !expr 'cap_fig1' -#| tbl-pos: H - -ts <- town_stats - -iaao_table <- data.frame( - Metric = c("Median Ratio", "COD", "PRD", "PRB", "MKI", "N Sales"), - `IAAO Standard` = c( - "0.90 -- 1.10", - "5.0 -- 15.0", - "0.98 -- 1.03", - "$\\pm$0.05", - "0.90 -- 1.10", - "---" - ), - Model = c( - iaao_color_cell("Median Ratio", ts$model_ratio, digits = 3), - iaao_color_cell("COD", ts$model_cod, digits = 1), - iaao_color_cell("PRD", ts$model_prd, digits = 4), - iaao_color_cell("PRB", ts$model_prb, digits = 4), - iaao_color_cell("MKI", ts$model_mki, digits = 4), - ), - `Desk Review` = c( - iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), - iaao_color_cell("COD", ts$desk_review_cod, digits = 1), - iaao_color_cell("PRD", ts$desk_review_prd, digits = 4), - iaao_color_cell("PRB", ts$desk_review_prb, digits = 4), - iaao_color_cell("MKI", ts$desk_review_mki, digits = 4), - format(ts$number_of_sales, big.mark = ",") - ), - check.names = FALSE -) - -knitr::kable( - iaao_table, - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - col.names = c("Metric", "IAAO Standard", "Model", "Desk Review"), - align = c("l", "c", "r", "r") -) -``` - ```{r nbhd-ratios-prep} nbhd_ratios <- all_parcels %>% filter(!is.na(sale_price), !sale_excluded %in% TRUE) %>% @@ -374,50 +374,6 @@ nbhd_ratios <- all_parcels %>% ) ``` -{{< pagebreak >}} - -```{r cap-2} -cap_fig2 <- glue( - "Neighborhood-Level Median Ratios.", - "\\newline Blue indicates under-assessment;", - " Green (0.90–1.1) indicates within standard;", - " Red indicates over-assessment." -) -``` - -```{r tbl-2} -#| tbl-cap: !expr 'cap_fig2' - -all_nbhds <- all_parcels %>% - distinct(neighborhood_number) %>% - arrange(neighborhood_number) - -nbhd_table_data <- all_nbhds %>% - left_join(nbhd_ratios, by = "neighborhood_number") %>% - mutate( - `NBHD` = neighborhood_number, - `Model Ratio` = ifelse( - is.na(model_ratio), "---", color_ratio_cell(model_ratio, digits = 3) - ), - `DR Ratio` = ifelse( - is.na(dr_ratio), "---", color_ratio_cell(dr_ratio, digits = 3) - ), - `N Sales` = ifelse(is.na(n_sales), 0L, n_sales) - ) %>% - select(`NBHD`, `Model Ratio`, `DR Ratio`, `N Sales`) - -knitr::kable( - nbhd_table_data, - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - longtable = TRUE, - align = c("l", "r", "r", "r"), - col.names = c("NBHD", "Model Ratio", "DR Ratio", "N Sales") -) -``` - ```{r cap-3} cap_fig3 <- glue( "IAAO Metrics: Model vs. Desk Review.", @@ -749,3 +705,46 @@ print(map_diff, vp = viewport( )) ``` +{{< pagebreak >}} + +```{r cap-2} +cap_fig2 <- glue( + "Neighborhood-Level Median Ratios.", + "\\newline Blue indicates under-assessment;", + " Green (0.90–1.1) indicates within standard;", + " Red indicates over-assessment." +) +``` + +```{r tbl-2} +#| tbl-cap: !expr 'cap_fig2' + +all_nbhds <- all_parcels %>% + distinct(neighborhood_number) %>% + arrange(neighborhood_number) + +nbhd_table_data <- all_nbhds %>% + left_join(nbhd_ratios, by = "neighborhood_number") %>% + mutate( + `NBHD` = neighborhood_number, + `Model Ratio` = ifelse( + is.na(model_ratio), "---", color_ratio_cell(model_ratio, digits = 3) + ), + `DR Ratio` = ifelse( + is.na(dr_ratio), "---", color_ratio_cell(dr_ratio, digits = 3) + ), + `N Sales` = ifelse(is.na(n_sales), 0L, n_sales) + ) %>% + select(`NBHD`, `Model Ratio`, `DR Ratio`, `N Sales`) + +knitr::kable( + nbhd_table_data, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + longtable = TRUE, + align = c("l", "r", "r", "r"), + col.names = c("NBHD", "Model Ratio", "DR Ratio", "N Sales") +) +``` From 80943a55dc248a6763187e03635a346aef33c739 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Tue, 25 Aug 2026 17:39:16 +0000 Subject: [PATCH 06/20] sepearate tables --- ratio-analysis/ratio-analysis.qmd | 139 +++++++++++++++++------------- 1 file changed, 79 insertions(+), 60 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 248e858..d39f09a 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -277,21 +277,7 @@ knitr::kable( ) ``` -```{r cap-desc} -cap_desc <- glue( - "Descriptive Statistics.", - "\\newline Summary of model and desk review assessed values and sale prices", - " across all properties, properties with arm's-length sales used in the", - " ratio analysis, and properties without qualifying sales.", - " Note: Some sales are excluded as non-arm's-length transactions,", - " so 'Sales Used' and 'No Sales' do not sum to 'All Properties'." -) -``` - -```{r tbl-desc} -#| tbl-cap: !expr 'cap_desc' -#| tbl-pos: H - +```{r desc-helpers} no_sale <- all_parcels %>% filter(is.na(sale_price)) fmt_n <- function(x) format(x, big.mark = ",") @@ -299,66 +285,99 @@ fmt_dol <- function(x) paste0("\\$", format(round(x), big.mark = ",")) fmt_pct <- function(changed, total) { paste0(round(changed / total * 100, 1), "\\%") } - n_changed <- function(df) { sum(!is.na(df$model_value) & !is.na(df$desk_review_value) & df$model_value != df$desk_review_value) # nolint: indentation_linter. } +``` -desc_table <- tibble( - Statistic = c( - "N", - "N DR Changes", - "\\% DR Changes", - "Median Model AV", - "Mean Model AV", - "Median DR AV", - "Mean DR AV", - "Median Sale Price", - "Mean Sale Price" - ), - `Sales Used` = c( - fmt_n(nrow(sales_df)), - fmt_n(n_changed(sales_df)), - fmt_pct(n_changed(sales_df), nrow(sales_df)), +```{r cap-desc-av} +cap_desc_av <- glue( + "Assessed Values by Group.", + "\\newline Model and desk review assessed values for properties", + " with qualifying arm's-length sales (Sold), properties without", + " a recorded sale (Unsold), and all residential parcels (All)." +) +``` + +```{r tbl-desc-av} +#| tbl-cap: !expr 'cap_desc_av' +#| tbl-pos: H + +av_table <- tibble( + Group = c("Sold", "Unsold", "All"), + `Median Model AV` = c( fmt_dol(median(sales_df$model_value, na.rm = TRUE)), + fmt_dol(median(no_sale$model_value, na.rm = TRUE)), + fmt_dol(median(all_parcels$model_value, na.rm = TRUE)) + ), + `Mean Model AV` = c( fmt_dol(mean(sales_df$model_value, na.rm = TRUE)), + fmt_dol(mean(no_sale$model_value, na.rm = TRUE)), + fmt_dol(mean(all_parcels$model_value, na.rm = TRUE)) + ), + `Median DR AV` = c( fmt_dol(median(sales_df$desk_review_value, na.rm = TRUE)), + fmt_dol(median(no_sale$desk_review_value, na.rm = TRUE)), + fmt_dol(median(all_parcels$desk_review_value, na.rm = TRUE)) + ), + `Mean DR AV` = c( fmt_dol(mean(sales_df$desk_review_value, na.rm = TRUE)), - fmt_dol(median(sales_df$sale_price, na.rm = TRUE)), - fmt_dol(mean(sales_df$sale_price, na.rm = TRUE)) + fmt_dol(mean(no_sale$desk_review_value, na.rm = TRUE)), + fmt_dol(mean(all_parcels$desk_review_value, na.rm = TRUE)) + ) +) + +knitr::kable( + av_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r", "r") +) +``` + +```{r cap-desc-changes} +cap_desc_changes <- glue( + "Desk Review Changes by Group.", + "\\newline Number and share of properties whose assessed value was", + " changed by desk review. Sold and Unsold do not sum to All because", + " properties with non-arm's-length sales are counted in All but", + " neither in Sold nor Unsold." +) +``` + +```{r tbl-desc-changes} +#| tbl-cap: !expr 'cap_desc_changes' +#| tbl-pos: H + +changes_table <- tibble( + Group = c("Sold", "Unsold", "All"), + N = c( + fmt_n(nrow(sales_df)), + fmt_n(nrow(no_sale)), + fmt_n(nrow(all_parcels)) ), - `All Properties` = c( - fmt_n(nrow(all_parcels)), - fmt_n(n_changed(all_parcels)), - fmt_pct(n_changed(all_parcels), nrow(all_parcels)), - fmt_dol(median(all_parcels$model_value, na.rm = TRUE)), - fmt_dol(mean(all_parcels$model_value, na.rm = TRUE)), - fmt_dol(median(all_parcels$desk_review_value, na.rm = TRUE)), - fmt_dol(mean(all_parcels$desk_review_value, na.rm = TRUE)), - "---", - "---" + `N DR Changes` = c( + fmt_n(n_changed(sales_df)), + fmt_n(n_changed(no_sale)), + fmt_n(n_changed(all_parcels)) ), - `No Sales` = c( - fmt_n(nrow(no_sale)), - "---", - "---", - fmt_dol(median(no_sale$model_value, na.rm = TRUE)), - fmt_dol(mean(no_sale$model_value, na.rm = TRUE)), - fmt_dol(median(no_sale$desk_review_value, na.rm = TRUE)), - fmt_dol(mean(no_sale$desk_review_value, na.rm = TRUE)), - "---", - "---" + `\\% DR Changes` = c( + fmt_pct(n_changed(sales_df), nrow(sales_df)), + fmt_pct(n_changed(no_sale), nrow(no_sale)), + fmt_pct(n_changed(all_parcels), nrow(all_parcels)) ) ) knitr::kable( - desc_table, - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - align = c("l", "r", "r", "r") + changes_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r") ) ``` From b114b325e8666bd0416aab11f88beae845b14be3 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Tue, 25 Aug 2026 18:14:27 +0000 Subject: [PATCH 07/20] add total av --- ratio-analysis/preamble.tex | 7 +++++++ ratio-analysis/ratio-analysis.qmd | 13 ++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) create mode 100644 ratio-analysis/preamble.tex diff --git a/ratio-analysis/preamble.tex b/ratio-analysis/preamble.tex new file mode 100644 index 0000000..7ebbf4c --- /dev/null +++ b/ratio-analysis/preamble.tex @@ -0,0 +1,7 @@ +\usepackage{colortbl} +\usepackage{caption} +\captionsetup{position=top, labelfont=bf} +\setlength{\aboverulesep}{0pt} +\setlength{\belowrulesep}{0pt} +\renewcommand{\tablename}{Figure} +\makeatletter\let\c@table\c@figure\makeatother diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index d39f09a..bc3efdb 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -254,6 +254,7 @@ iaao_table <- data.frame( iaao_color_cell("PRD", ts$model_prd, digits = 4), iaao_color_cell("PRB", ts$model_prb, digits = 4), iaao_color_cell("MKI", ts$model_mki, digits = 4), + format(ts$number_of_sales, big.mark = ",") ), `Desk Review` = c( iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), @@ -289,6 +290,11 @@ n_changed <- function(df) { sum(!is.na(df$model_value) & !is.na(df$desk_review_value) & df$model_value != df$desk_review_value) # nolint: indentation_linter. } +total_shift <- function(df) { + changed <- !is.na(df$model_value) & !is.na(df$desk_review_value) & + df$model_value != df$desk_review_value # nolint: indentation_linter. + sum(df$desk_review_value[changed] - df$model_value[changed], na.rm = TRUE) +} ``` ```{r cap-desc-av} @@ -368,6 +374,11 @@ changes_table <- tibble( fmt_pct(n_changed(sales_df), nrow(sales_df)), fmt_pct(n_changed(no_sale), nrow(no_sale)), fmt_pct(n_changed(all_parcels), nrow(all_parcels)) + ), + `Total AV Shift` = c( + fmt_dol(total_shift(sales_df)), + fmt_dol(total_shift(no_sale)), + fmt_dol(total_shift(all_parcels)) ) ) @@ -377,7 +388,7 @@ knitr::kable( escape = FALSE, booktabs = FALSE, linesep = "", - align = c("l", "r", "r", "r") + align = c("l", "r", "r", "r", "r") ) ``` From 74407310f4d189cdc15db8aac3b2658d4d89490b Mon Sep 17 00:00:00 2001 From: Damonamajor <56321109+Damonamajor@users.noreply.github.com> Date: Thu, 27 Aug 2026 10:02:41 -0500 Subject: [PATCH 08/20] Update ratio-analysis/ratio-analysis.qmd Co-authored-by: Nicole Jardine <138712135+ccao-jardine@users.noreply.github.com> --- ratio-analysis/ratio-analysis.qmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index bc3efdb..49752cd 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -703,7 +703,7 @@ map_diff <- ggplot() + ```{r cap-6} cap_fig6 <- glue( "Neighborhood Median Assessment Ratios.", - "\\newline Green (0.95–1.05) meets the ±5% threshold;", + "\\newline Green (0.90–1.10) meets the ±10% threshold;", " Blue indicates under-assessment;", " Red indicates over-assessment.", " The right panel shows desk review improvement:", From c365d9639501d60e6bf5490846a456944a47a78c Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Thu, 27 Aug 2026 18:35:42 +0000 Subject: [PATCH 09/20] Nicole V2 edits --- ratio-analysis/ratio-analysis.qmd | 452 ++++++++++++++---------------- 1 file changed, 213 insertions(+), 239 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index bc3efdb..864110e 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -51,7 +51,7 @@ town_name <- ccao::town_dict %>% dr_wb <- loadWorkbook(input_file) dr_vals <- read.xlsx(dr_wb, sheet = 1) %>% tibble(.name_repair = "unique") %>% - select(pin = PIN, desk_review_value = Desk.Review.Value) + select(pin = PIN, desk_review_FMV = Desk.Review.Value) # Athena: pull model values and the residential PIN universe @@ -75,15 +75,16 @@ dbDisconnect(conn) all_parcels <- dr_vals %>% inner_join(select(model_vals, pin), by = "pin") %>% full_join(model_vals, by = "pin") %>% + rename(model_FMV = model_value) %>% filter(township_name == town_name) %>% mutate( sale_date = as.Date(sale_date), - sale_excluded = if_else(is.na(sale_price), NA, is.na(desk_review_value)), + sale_excluded = if_else(is.na(sale_price), NA, is.na(desk_review_FMV)), price_decile = ntile( if_else(sale_excluded %in% TRUE, NA_real_, sale_price), 10 ), - model_sale_ratio = model_value / sale_price, - desk_review_sale_ratio = desk_review_value / sale_price + model_sale_ratio = model_FMV / sale_price, + desk_review_sale_ratio = desk_review_FMV / sale_price ) # Compute statistics @@ -93,19 +94,19 @@ sales_df <- all_parcels %>% town_stats <- tibble( model_ratio = median(sales_df$model_sale_ratio, na.rm = TRUE), model_cod = assessr::cod(sales_df$model_sale_ratio), - model_prd = assessr::prd(sales_df$model_value, sales_df$sale_price), - model_prb = assessr::prb(sales_df$model_value, sales_df$sale_price), - model_mki = assessr::mki(sales_df$model_value, sales_df$sale_price), + model_prd = assessr::prd(sales_df$model_FMV, sales_df$sale_price), + model_prb = assessr::prb(sales_df$model_FMV, sales_df$sale_price), + model_mki = assessr::mki(sales_df$model_FMV, sales_df$sale_price), desk_review_ratio = median(sales_df$desk_review_sale_ratio, na.rm = TRUE), desk_review_cod = assessr::cod(sales_df$desk_review_sale_ratio), desk_review_prd = assessr::prd( - sales_df$desk_review_value, sales_df$sale_price + sales_df$desk_review_FMV, sales_df$sale_price ), desk_review_prb = assessr::prb( - sales_df$desk_review_value, sales_df$sale_price + sales_df$desk_review_FMV, sales_df$sale_price ), desk_review_mki = assessr::mki( - sales_df$desk_review_value, sales_df$sale_price + sales_df$desk_review_FMV, sales_df$sale_price ), price_range = paste( scales::dollar(min(sales_df$sale_price)), @@ -143,39 +144,62 @@ min_sale_date <- format(min(sale_dates), "%B %d, %Y") max_sale_date <- format(max(sale_dates), "%B %d, %Y") -# Calculate Stats +# Metric definitions: name, digits, IAAO lo/hi bounds, band mid and half-span +metric_meta <- tibble( + name = c("Median Ratio", "COD", "PRD", "PRB", "MKI"), + digits = c(3, 1, 4, 4, 4), + lo = c(0.90, 5.0, 0.98, -0.05, 0.90), + hi = c(1.10, 15.0, 1.03, 0.05, 1.10), + mid = c(1.000, 10.0, 1.005, 0.00, 1.000), + half_span = c(0.100, 5.0, 0.025, 0.05, 0.100), + standard_label = c( + "0.90 -- 1.10", "5.0 -- 15.0", "0.98 -- 1.03", "$\\pm$0.05", "0.90 -- 1.10" + ) +) + +# Color palette +pal <- list( + pass = "A8DDB5", + fail = "FDBB84", + model = "#A569BD", + desk_review = "#2C2C2C", + ratio_na = "EEEEEE", + ratio_colors = c("4575B4", "74ADD1", "66BD63", "FC8D59", "D73027"), + ratio_values = c(0.70, 0.8999, 0.9001, 1.0999, 1.1001, 1.30), + ratio_limits = c(0.70, 1.30), + ratio_breaks = c(0.80, 0.90, 1.00, 1.10, 1.20), + iaao_band = "#A8DDB5" +) iaao_check <- function(metric, value) { - switch(metric, - "Median Ratio" = value >= 0.90 & value <= 1.10, - "COD" = value >= 5.0 & value <= 15.0, - "PRD" = value >= 0.98 & value <= 1.03, - "PRB" = value >= -0.05 & value <= 0.05, - "MKI" = value >= 0.90 & value <= 1.10, - NA - ) + m <- metric_meta[metric_meta$name == metric, ] + if (nrow(m) == 0) { + return(NA) + } + value >= m$lo & value <= m$hi } -iaao_color_cell <- function(metric, value, digits = 4) { +iaao_color_cell <- function(metric, value) { + m <- metric_meta[metric_meta$name == metric, ] + digits <- if (nrow(m) > 0) m$digits else 4 v <- round(value, digits) passes <- iaao_check(metric, value) if (is.na(passes)) { return(as.character(v)) } - hex <- if (passes) "A8DDB5" else "FDBB84" + hex <- if (passes) pal$pass else pal$fail paste0("\\cellcolor[HTML]{", hex, "} ", v) } ratio_to_hex <- function(ratio) { + rc <- pal$ratio_colors case_when( - is.na(ratio) ~ "EEEEEE", - ratio < 0.80 ~ "4575B4", - ratio < 0.90 ~ "74ADD1", - ratio < 0.95 ~ "ABD9E9", - ratio <= 1.05 ~ "66BD63", - ratio <= 1.10 ~ "FEE08B", - ratio <= 1.15 ~ "FC8D59", - TRUE ~ "D73027" + is.na(ratio) ~ pal$ratio_na, + ratio < 0.80 ~ rc[1], + ratio < 0.90 ~ rc[2], + ratio <= 1.10 ~ rc[3], + ratio <= 1.20 ~ rc[4], + TRUE ~ rc[5] ) } @@ -186,21 +210,16 @@ color_ratio_cell <- function(ratio, digits = 3) { } ratio_fill_scale <- function(name = "Median\nRatio") { + rc <- paste0("#", pal$ratio_colors) scale_fill_gradientn( - colors = c( - "#4575B4", "#74ADD1", "#ABD9E9", - "#66BD63", "#66BD63", "#66BD63", - "#FEE08B", "#FC8D59", "#D73027" - ), - values = scales::rescale( - c(0.70, 0.80, 0.90, 0.9499, 0.95, 1.0499, 1.05, 1.15, 1.30) - ), - limits = c(0.70, 1.30), - oob = scales::squish, - na.value = "gray90", - breaks = c(0.80, 0.90, 0.95, 1.00, 1.05, 1.10, 1.20), - labels = c("0.80", "0.90", "0.95", "1.00", "1.05", "1.10", "1.20"), - name = name + colors = c(rc[1], rc[2], rc[3], rc[3], rc[4], rc[5]), + values = scales::rescale(pal$ratio_values), + limits = pal$ratio_limits, + oob = scales::squish, + na.value = paste0("#", pal$ratio_na), + breaks = pal$ratio_breaks, + labels = sprintf("%.2f", pal$ratio_breaks), + name = name ) } ``` @@ -239,29 +258,22 @@ cap_fig1 <- glue( ts <- town_stats iaao_table <- data.frame( - Metric = c("Median Ratio", "COD", "PRD", "PRB", "MKI", "N Sales"), - `IAAO Standard` = c( - "0.90 -- 1.10", - "5.0 -- 15.0", - "0.98 -- 1.03", - "$\\pm$0.05", - "0.90 -- 1.10", - "---" - ), + Metric = c(metric_meta$name, "N Sales"), + `IAAO Standard` = c(metric_meta$standard_label, "---"), Model = c( - iaao_color_cell("Median Ratio", ts$model_ratio, digits = 3), - iaao_color_cell("COD", ts$model_cod, digits = 1), - iaao_color_cell("PRD", ts$model_prd, digits = 4), - iaao_color_cell("PRB", ts$model_prb, digits = 4), - iaao_color_cell("MKI", ts$model_mki, digits = 4), + iaao_color_cell("Median Ratio", ts$model_ratio), + iaao_color_cell("COD", ts$model_cod), + iaao_color_cell("PRD", ts$model_prd), + iaao_color_cell("PRB", ts$model_prb), + iaao_color_cell("MKI", ts$model_mki), format(ts$number_of_sales, big.mark = ",") ), `Desk Review` = c( - iaao_color_cell("Median Ratio", ts$desk_review_ratio, digits = 3), - iaao_color_cell("COD", ts$desk_review_cod, digits = 1), - iaao_color_cell("PRD", ts$desk_review_prd, digits = 4), - iaao_color_cell("PRB", ts$desk_review_prb, digits = 4), - iaao_color_cell("MKI", ts$desk_review_mki, digits = 4), + iaao_color_cell("Median Ratio", ts$desk_review_ratio), + iaao_color_cell("COD", ts$desk_review_cod), + iaao_color_cell("PRD", ts$desk_review_prd), + iaao_color_cell("PRB", ts$desk_review_prb), + iaao_color_cell("MKI", ts$desk_review_mki), format(ts$number_of_sales, big.mark = ",") ), check.names = FALSE @@ -278,132 +290,6 @@ knitr::kable( ) ``` -```{r desc-helpers} -no_sale <- all_parcels %>% filter(is.na(sale_price)) - -fmt_n <- function(x) format(x, big.mark = ",") -fmt_dol <- function(x) paste0("\\$", format(round(x), big.mark = ",")) -fmt_pct <- function(changed, total) { - paste0(round(changed / total * 100, 1), "\\%") -} -n_changed <- function(df) { - sum(!is.na(df$model_value) & !is.na(df$desk_review_value) & - df$model_value != df$desk_review_value) # nolint: indentation_linter. -} -total_shift <- function(df) { - changed <- !is.na(df$model_value) & !is.na(df$desk_review_value) & - df$model_value != df$desk_review_value # nolint: indentation_linter. - sum(df$desk_review_value[changed] - df$model_value[changed], na.rm = TRUE) -} -``` - -```{r cap-desc-av} -cap_desc_av <- glue( - "Assessed Values by Group.", - "\\newline Model and desk review assessed values for properties", - " with qualifying arm's-length sales (Sold), properties without", - " a recorded sale (Unsold), and all residential parcels (All)." -) -``` - -```{r tbl-desc-av} -#| tbl-cap: !expr 'cap_desc_av' -#| tbl-pos: H - -av_table <- tibble( - Group = c("Sold", "Unsold", "All"), - `Median Model AV` = c( - fmt_dol(median(sales_df$model_value, na.rm = TRUE)), - fmt_dol(median(no_sale$model_value, na.rm = TRUE)), - fmt_dol(median(all_parcels$model_value, na.rm = TRUE)) - ), - `Mean Model AV` = c( - fmt_dol(mean(sales_df$model_value, na.rm = TRUE)), - fmt_dol(mean(no_sale$model_value, na.rm = TRUE)), - fmt_dol(mean(all_parcels$model_value, na.rm = TRUE)) - ), - `Median DR AV` = c( - fmt_dol(median(sales_df$desk_review_value, na.rm = TRUE)), - fmt_dol(median(no_sale$desk_review_value, na.rm = TRUE)), - fmt_dol(median(all_parcels$desk_review_value, na.rm = TRUE)) - ), - `Mean DR AV` = c( - fmt_dol(mean(sales_df$desk_review_value, na.rm = TRUE)), - fmt_dol(mean(no_sale$desk_review_value, na.rm = TRUE)), - fmt_dol(mean(all_parcels$desk_review_value, na.rm = TRUE)) - ) -) - -knitr::kable( - av_table, - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - align = c("l", "r", "r", "r", "r") -) -``` - -```{r cap-desc-changes} -cap_desc_changes <- glue( - "Desk Review Changes by Group.", - "\\newline Number and share of properties whose assessed value was", - " changed by desk review. Sold and Unsold do not sum to All because", - " properties with non-arm's-length sales are counted in All but", - " neither in Sold nor Unsold." -) -``` - -```{r tbl-desc-changes} -#| tbl-cap: !expr 'cap_desc_changes' -#| tbl-pos: H - -changes_table <- tibble( - Group = c("Sold", "Unsold", "All"), - N = c( - fmt_n(nrow(sales_df)), - fmt_n(nrow(no_sale)), - fmt_n(nrow(all_parcels)) - ), - `N DR Changes` = c( - fmt_n(n_changed(sales_df)), - fmt_n(n_changed(no_sale)), - fmt_n(n_changed(all_parcels)) - ), - `\\% DR Changes` = c( - fmt_pct(n_changed(sales_df), nrow(sales_df)), - fmt_pct(n_changed(no_sale), nrow(no_sale)), - fmt_pct(n_changed(all_parcels), nrow(all_parcels)) - ), - `Total AV Shift` = c( - fmt_dol(total_shift(sales_df)), - fmt_dol(total_shift(no_sale)), - fmt_dol(total_shift(all_parcels)) - ) -) - -knitr::kable( - changes_table, - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - align = c("l", "r", "r", "r", "r") -) -``` - -```{r nbhd-ratios-prep} -nbhd_ratios <- all_parcels %>% - filter(!is.na(sale_price), !sale_excluded %in% TRUE) %>% - mutate(neighborhood_number = gsub("-", "", neighborhood_number)) %>% - summarize( - model_ratio = median(model_sale_ratio, na.rm = TRUE), - dr_ratio = median(desk_review_sale_ratio, na.rm = TRUE), - n_sales = n(), - .by = neighborhood_number - ) -``` - ```{r cap-3} cap_fig3 <- glue( "IAAO Metrics: Model vs. Desk Review.", @@ -415,10 +301,10 @@ cap_fig3 <- glue( #| fig-cap: !expr 'cap_fig3' #| fig-pos: H #| fig-cap-location: top -#| fig-height: 7 -#| fig-width: 7 +#| fig-height: 5 +#| fig-width: 6.5 -metric_order <- c("Median Ratio", "COD", "PRD", "PRB", "MKI") +metric_order <- metric_meta$name ts_wide <- tibble( Metric = factor(metric_order, levels = metric_order), @@ -437,19 +323,17 @@ ts_long <- ts_wide %>% c(Model, `Desk Review`), names_to = "Stage", values_to = "Value" ) %>% - mutate(Stage = factor(Stage, levels = c("Model", "Desk Review"))) + mutate(Stage = factor(Stage, levels = c("Model", "Desk Review"))) %>% + left_join(select(metric_meta, Metric = name, digits), by = "Metric") %>% + mutate(label = round(Value, pmin(digits, 2))) -iaao_bands <- tibble( - Metric = factor(metric_order, levels = metric_order), - xmin = c(0.90, 5.0, 0.98, -0.05, 0.90), - xmax = c(1.10, 15.0, 1.03, 0.05, 1.10) -) +iaao_bands <- metric_meta %>% + mutate(Metric = factor(name, levels = metric_order)) %>% + select(Metric, xmin = lo, xmax = hi) -iaao_meta <- tibble( - Metric = factor(metric_order, levels = metric_order), - mid = c(1.000, 10.0, 1.005, 0.00, 1.000), - half_span = c(0.100, 5.0, 0.025, 0.05, 0.100) -) +iaao_meta <- metric_meta %>% + mutate(Metric = factor(name, levels = metric_order)) %>% + select(Metric, mid, half_span) sym_anchors <- ts_long %>% left_join(iaao_meta, by = "Metric") %>% @@ -488,7 +372,7 @@ ggplot() + geom_rect( data = iaao_bands, aes(xmin = xmin, xmax = xmax, ymin = 0.1, ymax = 1.9), - fill = "#A8DDB5", alpha = 0.45 + fill = pal$iaao_band, alpha = 0.45 ) + geom_segment( data = ts_wide, @@ -502,15 +386,16 @@ ggplot() + ) + geom_text( data = ts_long, - aes(x = Value, y = 1, label = round(Value, 3), color = Stage), + aes(x = Value, y = 1, label = label, color = Stage), vjust = -1.6, size = 3, fontface = "bold" ) + facet_wrap(~Metric, scales = "free_x", ncol = 1) + scale_color_manual( - values = c("Model" = "#A569BD", "Desk Review" = "#2C2C2C") + values = c("Model" = pal$model, "Desk Review" = pal$desk_review) ) + scale_shape_manual(values = c("Model" = 16, "Desk Review" = 17)) + scale_y_continuous(limits = c(0, 2)) + + coord_cartesian(clip = "off") + theme_minimal(base_size = 11) + theme( axis.text.y = element_blank(), @@ -523,6 +408,122 @@ ggplot() + labs(x = NULL, y = NULL, color = "Stage", shape = "Stage") ``` +```{r desc-helpers} +no_sale <- all_parcels %>% filter(is.na(sale_price)) + +fmt_n <- function(x) format(x, big.mark = ",") +fmt_dol <- function(x) paste0("\\$", format(round(x), big.mark = ",")) +fmt_pct <- function(changed, total) { + paste0(round(changed / total * 100, 1), "\\%") +} +n_changed <- function(df) { + sum(!is.na(df$model_FMV) & !is.na(df$desk_review_FMV) & + df$model_FMV != df$desk_review_FMV) # nolint: indentation_linter. +} +``` + +```{r cap-desc-av} +cap_desc_av <- glue( + "Fair Market Values by Group.", + "\\newline Model and desk review fair market values for properties", + " with qualifying arm's-length sales (Sold), properties without", + " a recorded sale (Unsold), and all residential parcels (All)." +) +``` + +```{r tbl-desc-av} +#| tbl-cap: !expr 'cap_desc_av' +#| tbl-pos: H + +av_table <- tibble( + Group = c("Sold", "Unsold", "All"), + `Median Model FMV` = c( + fmt_dol(median(sales_df$model_FMV, na.rm = TRUE)), + fmt_dol(median(no_sale$model_FMV, na.rm = TRUE)), + fmt_dol(median(all_parcels$model_FMV, na.rm = TRUE)) + ), + `Median DR FMV` = c( + fmt_dol(median(sales_df$desk_review_FMV, na.rm = TRUE)), + fmt_dol(median(no_sale$desk_review_FMV, na.rm = TRUE)), + fmt_dol(median(all_parcels$desk_review_FMV, na.rm = TRUE)) + ), + `Mean Model FMV` = c( + fmt_dol(mean(sales_df$model_FMV, na.rm = TRUE)), + fmt_dol(mean(no_sale$model_FMV, na.rm = TRUE)), + fmt_dol(mean(all_parcels$model_FMV, na.rm = TRUE)) + ), + `Mean DR FMV` = c( + fmt_dol(mean(sales_df$desk_review_FMV, na.rm = TRUE)), + fmt_dol(mean(no_sale$desk_review_FMV, na.rm = TRUE)), + fmt_dol(mean(all_parcels$desk_review_FMV, na.rm = TRUE)) + ) +) + +knitr::kable( + av_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r", "r") +) +``` + +```{r cap-desc-changes} +cap_desc_changes <- glue( + "Desk Review Changes by Group.", + "\\newline Number and share of properties whose assessed value was", + " changed by desk review. Sold and Unsold do not sum to All because", + " properties with non-arm's-length sales are counted in All but", + " neither in Sold nor Unsold." +) +``` + +```{r tbl-desc-changes} +#| tbl-cap: !expr 'cap_desc_changes' +#| tbl-pos: H + +changes_table <- tibble( + Group = c("Sold", "Unsold", "All"), + N = c( + fmt_n(nrow(sales_df)), + fmt_n(nrow(no_sale)), + fmt_n(nrow(all_parcels)) + ), + `N DR Changes` = c( + fmt_n(n_changed(sales_df)), + fmt_n(n_changed(no_sale)), + fmt_n(n_changed(all_parcels)) + ), + `\\% DR Changes` = c( + fmt_pct(n_changed(sales_df), nrow(sales_df)), + fmt_pct(n_changed(no_sale), nrow(no_sale)), + fmt_pct(n_changed(all_parcels), nrow(all_parcels)) + ) +) + +knitr::kable( + changes_table, + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r") +) +``` + +```{r nbhd-ratios-prep} +nbhd_ratios <- all_parcels %>% + filter(!is.na(sale_price), !sale_excluded %in% TRUE) %>% + mutate(neighborhood_number = gsub("-", "", neighborhood_number)) %>% + summarize( + model_ratio = median(model_sale_ratio, na.rm = TRUE), + dr_ratio = median(desk_review_sale_ratio, na.rm = TRUE), + n_sales = n(), + .by = neighborhood_number + ) +``` + ```{r cap-4} cap_fig4 <- glue( "Sale Price Ratio Curve.", @@ -585,7 +586,7 @@ ggplot( ) + annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0.9, ymax = 1.1, - fill = "#66BD63", alpha = 0.12 + fill = pal$iaao_band, alpha = 0.12 ) + geom_hline(yintercept = 1, color = "darkgreen", linewidth = 1) + geom_hline( @@ -601,7 +602,7 @@ ggplot( geom_line(linewidth = 1) + geom_label(show.legend = FALSE, size = 3) + scale_color_manual( - values = c("Model" = "#A569BD", "Desk Review" = "#2C2C2C") + values = c("Model" = pal$model, "Desk Review" = pal$desk_review) ) + scale_x_continuous(breaks = 1:10, labels = axis_labels) + scale_y_continuous( @@ -653,8 +654,7 @@ neighborhoods <- ccao::nbhd_shp %>% select(town_nbhd, geometry) map_data <- neighborhoods %>% - left_join(nbhd_ratios, by = c("town_nbhd" = "neighborhood_number")) %>% - mutate(diff = abs(model_ratio - 1) - abs(dr_ratio - 1)) + left_join(nbhd_ratios, by = c("town_nbhd" = "neighborhood_number")) map_theme <- theme_void(base_size = 9) + theme( @@ -679,36 +679,14 @@ map_dr <- ggplot() + ratio_fill_scale() + map_theme + labs(title = "Desk Review") - -diff_limit <- max(abs(map_data$diff), na.rm = TRUE) -diff_limit <- ceiling(diff_limit * 10) / 10 - -map_diff <- ggplot() + - annotation_map_tile(type = "cartolight", zoomin = 0) + - geom_sf(data = map_data, aes(fill = diff), alpha = 0.85, linewidth = 0.1) + - scale_fill_gradient2( - low = "#D73027", - mid = "white", - high = "#4575B4", - midpoint = 0, - limits = c(-diff_limit, diff_limit), - oob = scales::squish, - na.value = "gray90", - name = "Improvement" - ) + - map_theme + - labs(title = "Desk Review Improvement") ``` ```{r cap-6} cap_fig6 <- glue( "Neighborhood Median Assessment Ratios.", - "\\newline Green (0.95–1.05) meets the ±5% threshold;", + "\\newline Green (0.90–1.10) meets the IAAO standard;", " Blue indicates under-assessment;", - " Red indicates over-assessment.", - " The right panel shows desk review improvement:", - " Blue indicates an improved ratio (closer to 1)", - " and red indicates it moved further away." + " Red indicates over-assessment." ) ``` @@ -722,15 +700,11 @@ cap_fig6 <- glue( grid.newpage() print(map_model, vp = viewport( - x = 0, y = 0, width = 1 / 3, height = 1, + x = 0, y = 0, width = 1 / 2, height = 1, just = c("left", "bottom") )) print(map_dr, vp = viewport( - x = 1 / 3, y = 0, width = 1 / 3, height = 1, - just = c("left", "bottom") -)) -print(map_diff, vp = viewport( - x = 2 / 3, y = 0, width = 1 / 3, height = 1, + x = 1 / 2, y = 0, width = 1 / 2, height = 1, just = c("left", "bottom") )) ``` From aa668090389e046bef6f10d9e0debae2a56786b6 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Thu, 27 Aug 2026 18:44:21 +0000 Subject: [PATCH 10/20] switch more to mv --- ratio-analysis/ratio-analysis.qmd | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 864110e..212b1cd 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -422,8 +422,8 @@ n_changed <- function(df) { } ``` -```{r cap-desc-av} -cap_desc_av <- glue( +```{r cap-desc-mv} +cap_desc_mv <- glue( "Fair Market Values by Group.", "\\newline Model and desk review fair market values for properties", " with qualifying arm's-length sales (Sold), properties without", @@ -431,11 +431,11 @@ cap_desc_av <- glue( ) ``` -```{r tbl-desc-av} -#| tbl-cap: !expr 'cap_desc_av' +```{r tbl-desc-mv} +#| tbl-cap: !expr 'cap_desc_mv' #| tbl-pos: H -av_table <- tibble( +mv_table <- tibble( Group = c("Sold", "Unsold", "All"), `Median Model FMV` = c( fmt_dol(median(sales_df$model_FMV, na.rm = TRUE)), @@ -460,7 +460,7 @@ av_table <- tibble( ) knitr::kable( - av_table, + mv_table, format = "latex", escape = FALSE, booktabs = FALSE, From 219205283d695fb1c23b272a528dc722edcd44b5 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 15:11:38 +0000 Subject: [PATCH 11/20] remove nsales --- ratio-analysis/ratio-analysis.qmd | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 212b1cd..f4037a5 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -53,7 +53,6 @@ dr_vals <- read.xlsx(dr_wb, sheet = 1) %>% tibble(.name_repair = "unique") %>% select(pin = PIN, desk_review_FMV = Desk.Review.Value) - # Athena: pull model values and the residential PIN universe noctua_options(unload = TRUE) @@ -235,8 +234,7 @@ prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township -contains **`r format(n_total_pins, big.mark = ",")` residential -parcels**. +contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. This universe includes Single and Multifamily parcels (up to 6 units) and excludes condo units. This analysis compares ratio statistics from two stages: (1) **Model** values, which are the output of the model, and @@ -258,23 +256,21 @@ cap_fig1 <- glue( ts <- town_stats iaao_table <- data.frame( - Metric = c(metric_meta$name, "N Sales"), - `IAAO Standard` = c(metric_meta$standard_label, "---"), + Metric = metric_meta$name, + `IAAO Standard` = metric_meta$standard_label, Model = c( iaao_color_cell("Median Ratio", ts$model_ratio), iaao_color_cell("COD", ts$model_cod), iaao_color_cell("PRD", ts$model_prd), iaao_color_cell("PRB", ts$model_prb), - iaao_color_cell("MKI", ts$model_mki), - format(ts$number_of_sales, big.mark = ",") + iaao_color_cell("MKI", ts$model_mki) ), `Desk Review` = c( iaao_color_cell("Median Ratio", ts$desk_review_ratio), iaao_color_cell("COD", ts$desk_review_cod), iaao_color_cell("PRD", ts$desk_review_prd), iaao_color_cell("PRB", ts$desk_review_prb), - iaao_color_cell("MKI", ts$desk_review_mki), - format(ts$number_of_sales, big.mark = ",") + iaao_color_cell("MKI", ts$desk_review_mki) ), check.names = FALSE ) From 1cd8574935d2935cdf60caa53ee24cb3f8573d3b Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 15:23:16 +0000 Subject: [PATCH 12/20] improve text --- ratio-analysis/ratio-analysis.qmd | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index f4037a5..341d93f 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -226,9 +226,8 @@ ratio_fill_scale <- function(name = "Median\nRatio") { ## Methods This is a ratio analysis for **`r town_name` Township** for the `r year_val` -assessment cycle. The original sale sample included -**`r format(n_original_sales, big.mark = ",")`** arm's-length sales -after outliers were excluded. These sales +assessment cycle. The original sale sample included the most recent sales of +**`r format(n_original_sales, big.mark = ",")`** parcels. These sales occurred between `r min_sale_date` and `r max_sale_date`, with sale prices ranging from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded From 9115841763e846cfc82aac97eca5cf3130d4a41d Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 15:38:01 +0000 Subject: [PATCH 13/20] updated text --- ratio-analysis/ratio-analysis.qmd | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 341d93f..dc057ba 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -226,10 +226,8 @@ ratio_fill_scale <- function(name = "Median\nRatio") { ## Methods This is a ratio analysis for **`r town_name` Township** for the `r year_val` -assessment cycle. The original sale sample included the most recent sales of -**`r format(n_original_sales, big.mark = ",")`** parcels. These sales -occurred between `r min_sale_date` and `r max_sale_date`, with sale -prices ranging from `r town_stats$price_range`. Of these, +assessment cycle. It includes the +**`r format(n_original_sales, big.mark = ",")`** most recent sales for each single-card parcel in the past assessment year (between `r min_sale_date` and `r max_sale_date`). Outliers flagged by the data department are removed. Prices range from `r town_stats$price_range`. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township From e97de6f6f180e95c8fdb549193ca093bab930a8c Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 15:38:38 +0000 Subject: [PATCH 14/20] improve text --- ratio-analysis/ratio-analysis.qmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index dc057ba..91f02df 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -227,11 +227,11 @@ ratio_fill_scale <- function(name = "Median\nRatio") { This is a ratio analysis for **`r town_name` Township** for the `r year_val` assessment cycle. It includes the -**`r format(n_original_sales, big.mark = ",")`** most recent sales for each single-card parcel in the past assessment year (between `r min_sale_date` and `r max_sale_date`). Outliers flagged by the data department are removed. Prices range from `r town_stats$price_range`. Of these, +**`r format(n_original_sales, big.mark = ",")`** most recent sales for each single-card parcel in the past assessment year (between `r min_sale_date` and `r max_sale_date`). Outliers flagged by the data department are removed. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township -contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. This universe includes Single and Multifamily parcels (up to 6 units) and excludes condo units. +contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. This universe includes Single and Multifamily parcels (up to 6 units) and excludes condo units. Prices range from `r town_stats$price_range`. This analysis compares ratio statistics from two stages: (1) **Model** values, which are the output of the model, and From bc6eec105b60e8e3f7160cc3da89d3fb84abc753 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 15:39:52 +0000 Subject: [PATCH 15/20] Add text comment --- ratio-analysis/ratio-analysis.sql | 1 + 1 file changed, 1 insertion(+) diff --git a/ratio-analysis/ratio-analysis.sql b/ratio-analysis/ratio-analysis.sql index 9476dea..d68a7a7 100644 --- a/ratio-analysis/ratio-analysis.sql +++ b/ratio-analysis/ratio-analysis.sql @@ -18,6 +18,7 @@ model_vals AS ( SELECT assessment_pin.meta_pin AS pin, assessment_pin.pred_pin_final_fmv_round AS model_value, + -- Outlier sale prices are already removed in pipeline assessment_pin.sale_ratio_study_price AS sale_price, assessment_pin.sale_ratio_study_date AS sale_date, assessment_pin.sale_ratio_study_document_num AS sale_document_number From 65dc3949058c088ad7c455d82ab1c88802032df9 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 16:04:25 +0000 Subject: [PATCH 16/20] small text change --- ratio-analysis/ratio-analysis.qmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 91f02df..6b95a62 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -227,7 +227,7 @@ ratio_fill_scale <- function(name = "Median\nRatio") { This is a ratio analysis for **`r town_name` Township** for the `r year_val` assessment cycle. It includes the -**`r format(n_original_sales, big.mark = ",")`** most recent sales for each single-card parcel in the past assessment year (between `r min_sale_date` and `r max_sale_date`). Outliers flagged by the data department are removed. Of these, +**`r format(n_original_sales, big.mark = ",")`** most recent sale for each single-card parcel in the past assessment year (between `r min_sale_date` and `r max_sale_date`). Outliers flagged by the data department are removed. Of these, **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township @@ -467,7 +467,7 @@ cap_desc_changes <- glue( "Desk Review Changes by Group.", "\\newline Number and share of properties whose assessed value was", " changed by desk review. Sold and Unsold do not sum to All because", - " properties with non-arm's-length sales are counted in All but", + " properties removed by desk review as outliers are counted in All but", " neither in Sold nor Unsold." ) ``` From 044843626890ca85e7891865311f6f49212d3a45 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 16:18:24 +0000 Subject: [PATCH 17/20] move all text --- ratio-analysis/ratio-analysis.qmd | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 6b95a62..d25c1b9 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -420,7 +420,10 @@ cap_desc_mv <- glue( "Fair Market Values by Group.", "\\newline Model and desk review fair market values for properties", " with qualifying arm's-length sales (Sold), properties without", - " a recorded sale (Unsold), and all residential parcels (All)." + " a recorded sale (Unsold), and all residential parcels (All).", + " Sold and Unsold do not sum to All because properties removed", + " by desk review as outliers are counted in All but neither in", + " Sold nor Unsold." ) ``` @@ -466,9 +469,7 @@ knitr::kable( cap_desc_changes <- glue( "Desk Review Changes by Group.", "\\newline Number and share of properties whose assessed value was", - " changed by desk review. Sold and Unsold do not sum to All because", - " properties removed by desk review as outliers are counted in All but", - " neither in Sold nor Unsold." + " changed by desk review." ) ``` From 56fad5bcd9e80dd0122b89ce0c52c8bf4d13ed18 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 18:06:10 +0000 Subject: [PATCH 18/20] renaming of headers and cleanup --- ratio-analysis/preamble.tex | 8 +- ratio-analysis/ratio-analysis.qmd | 280 +++++++++++++----------------- 2 files changed, 131 insertions(+), 157 deletions(-) diff --git a/ratio-analysis/preamble.tex b/ratio-analysis/preamble.tex index 7ebbf4c..6b89533 100644 --- a/ratio-analysis/preamble.tex +++ b/ratio-analysis/preamble.tex @@ -1,7 +1,11 @@ \usepackage{colortbl} +\usepackage{titling} +\setlength{\droptitle}{-6em} +\posttitle{\par\end{center}\vspace{-0.5em}} +\postdate{\par\end{center}\vspace{-3em}} \usepackage{caption} -\captionsetup{position=top, labelfont=bf} +\captionsetup{position=top, labelfont=bf, justification=raggedright, singlelinecheck=false} +\captionsetup[table]{name=Figure, position=top, labelfont=bf, justification=raggedright, singlelinecheck=false} \setlength{\aboverulesep}{0pt} \setlength{\belowrulesep}{0pt} -\renewcommand{\tablename}{Figure} \makeatletter\let\c@table\c@figure\makeatother diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index d25c1b9..226a562 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -90,7 +90,7 @@ all_parcels <- dr_vals %>% sales_df <- all_parcels %>% filter(!is.na(sale_price), !sale_excluded %in% TRUE) -town_stats <- tibble( +ts <- tibble( model_ratio = median(sales_df$model_sale_ratio, na.rm = TRUE), model_cod = assessr::cod(sales_df$model_sale_ratio), model_prd = assessr::prd(sales_df$model_FMV, sales_df$sale_price), @@ -221,9 +221,52 @@ ratio_fill_scale <- function(name = "Median\nRatio") { name = name ) } -``` -## Methods +caps <- list( + fig1 = glue( + "Town-Level IAAO Statistics.", + "\\newline Green shading meets IAAO standard; orange shading does not." + ), + fig2 = glue( + "IAAO Metrics: Model vs. Desk Review.", + "\\newline Green shaded band shows the IAAO acceptable range", + " for each metric." + ), + fig3 = glue( + "Fair Market Values by Group.", + "\\newline Model and desk review fair market values for properties", + " with qualifying arm's-length sales (Sold), properties without", + " a recorded sale (Unsold), and all residential parcels (All).", + " Sold and Unsold do not sum to All because properties removed", + " by desk review as outliers are counted in All but neither in", + " Sold nor Unsold." + ), + fig4 = glue( + "Desk Review Changes by Group.", + "\\newline Number and share of properties whose value was", + " changed by desk review." + ), + fig5 = glue( + "Sale Price Ratio Curve.", + "\\newline Each labeled point is the median ratio within that", + " sale price decile.", + " Dotted lines show the IAAO acceptable range (0.9–1.1)." + ), + fig6 = glue("Ratio Curve by Sale Price Decile"), + fig7 = glue( + "Neighborhood Median Assessment Ratios.", + "\\newline Green (0.90–1.10) meets the IAAO standard;", + " Blue indicates under-assessment;", + " Red indicates over-assessment." + ), + fig8 = glue( + "Neighborhood-Level Median Ratios.", + "\\newline Blue indicates under-assessment;", + " Green (0.90–1.1) indicates within standard;", + " Red indicates over-assessment." + ) +) +``` This is a ratio analysis for **`r town_name` Township** for the `r year_val` assessment cycle. It includes the @@ -231,42 +274,35 @@ assessment cycle. It includes the **`r format(n_excluded_sales, big.mark = ",")`** sales were excluded as outliers by Valuations analysts, leaving a **final sample of `r format(n_final_sales, big.mark = ",")` sales**. The township -contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. This universe includes Single and Multifamily parcels (up to 6 units) and excludes condo units. Prices range from `r town_stats$price_range`. +contains **`r format(n_total_pins, big.mark = ",")` residential parcels**. This universe includes Single and Multifamily parcels (up to 6 units) and excludes condo units. Prices range from `r ts$price_range`. This analysis compares ratio statistics from two stages: (1) **Model** values, which are the output of the model, and (2) **Desk Review** values, which reflect manual adjustments by staff. -## Results - -```{r cap-1} -cap_fig1 <- glue( - "Town-Level IAAO Statistics.", - "\\newline Green shading meets IAAO standard; orange shading does not." -) -``` - ```{r tbl-1} -#| tbl-cap: !expr 'cap_fig1' +#| tbl-cap: !expr 'caps$fig1' #| tbl-pos: H -ts <- town_stats +display_order <- c("Median Ratio", "PRB", "PRD", "COD", "MKI") iaao_table <- data.frame( - Metric = metric_meta$name, - `IAAO Standard` = metric_meta$standard_label, + Metric = display_order, + `IAAO Standard` = metric_meta$standard_label[ + match(display_order, metric_meta$name) + ], Model = c( iaao_color_cell("Median Ratio", ts$model_ratio), - iaao_color_cell("COD", ts$model_cod), - iaao_color_cell("PRD", ts$model_prd), iaao_color_cell("PRB", ts$model_prb), + iaao_color_cell("PRD", ts$model_prd), + iaao_color_cell("COD", ts$model_cod), iaao_color_cell("MKI", ts$model_mki) ), `Desk Review` = c( iaao_color_cell("Median Ratio", ts$desk_review_ratio), - iaao_color_cell("COD", ts$desk_review_cod), - iaao_color_cell("PRD", ts$desk_review_prd), iaao_color_cell("PRB", ts$desk_review_prb), + iaao_color_cell("PRD", ts$desk_review_prd), + iaao_color_cell("COD", ts$desk_review_cod), iaao_color_cell("MKI", ts$desk_review_mki) ), check.names = FALSE @@ -283,31 +319,22 @@ knitr::kable( ) ``` -```{r cap-3} -cap_fig3 <- glue( - "IAAO Metrics: Model vs. Desk Review.", - "\\newline Green shaded band shows the IAAO acceptable range for each metric." -) -``` - -```{r fig-3} -#| fig-cap: !expr 'cap_fig3' +```{r fig-2} +#| fig-cap: !expr 'caps$fig2' #| fig-pos: H #| fig-cap-location: top -#| fig-height: 5 +#| fig-height: 3.5 #| fig-width: 6.5 -metric_order <- metric_meta$name - ts_wide <- tibble( - Metric = factor(metric_order, levels = metric_order), + Metric = factor(display_order, levels = display_order), Model = c( - ts$model_ratio, ts$model_cod, ts$model_prd, - ts$model_prb, ts$model_mki + ts$model_ratio, ts$model_prb, ts$model_prd, + ts$model_cod, ts$model_mki ), `Desk Review` = c( - ts$desk_review_ratio, ts$desk_review_cod, ts$desk_review_prd, - ts$desk_review_prb, ts$desk_review_mki + ts$desk_review_ratio, ts$desk_review_prb, ts$desk_review_prd, + ts$desk_review_cod, ts$desk_review_mki ) ) @@ -316,17 +343,15 @@ ts_long <- ts_wide %>% c(Model, `Desk Review`), names_to = "Stage", values_to = "Value" ) %>% - mutate(Stage = factor(Stage, levels = c("Model", "Desk Review"))) %>% - left_join(select(metric_meta, Metric = name, digits), by = "Metric") %>% - mutate(label = round(Value, pmin(digits, 2))) + mutate( + Stage = factor(Stage, levels = c("Model", "Desk Review")), + digits = metric_meta$digits[match(Metric, metric_meta$name)], + label = round(Value, pmin(digits, 2)) + ) -iaao_bands <- metric_meta %>% - mutate(Metric = factor(name, levels = metric_order)) %>% - select(Metric, xmin = lo, xmax = hi) +iaao_bands <- select(metric_meta, Metric = name, xmin = lo, xmax = hi) -iaao_meta <- metric_meta %>% - mutate(Metric = factor(name, levels = metric_order)) %>% - select(Metric, mid, half_span) +iaao_meta <- select(metric_meta, Metric = name, mid, half_span) sym_anchors <- ts_long %>% left_join(iaao_meta, by = "Metric") %>% @@ -352,10 +377,11 @@ sym_anchors <- ts_long %>% scale_anchors <- bind_rows( sym_anchors, - tibble(Metric = factor("COD", levels = metric_order), x = 0) + tibble(Metric = "COD", x = 0) ) ggplot() + + geom_blank(data = ts_long, aes(x = Value, y = 1)) + geom_point( data = scale_anchors, aes(x = x, y = 1), @@ -382,7 +408,7 @@ ggplot() + aes(x = Value, y = 1, label = label, color = Stage), vjust = -1.6, size = 3, fontface = "bold" ) + - facet_wrap(~Metric, scales = "free_x", ncol = 1) + + facet_wrap(~Metric, scales = "free_x", ncol = 1, strip.position = "left") + scale_color_manual( values = c("Model" = pal$model, "Desk Review" = pal$desk_review) ) + @@ -391,12 +417,16 @@ ggplot() + coord_cartesian(clip = "off") + theme_minimal(base_size = 11) + theme( - axis.text.y = element_blank(), - axis.ticks.y = element_blank(), + axis.text.y = element_blank(), + axis.ticks.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), - strip.text = element_text(face = "bold", size = 11), - legend.position = "bottom" + strip.text.y.left = element_text( + face = "bold", size = 11, angle = 0, hjust = 1 + ), + strip.placement = "outside", + legend.position = "bottom", + plot.margin = margin(t = 20, r = 5, b = 5, l = 5, unit = "pt") ) + labs(x = NULL, y = NULL, color = "Stage", shape = "Stage") ``` @@ -415,43 +445,27 @@ n_changed <- function(df) { } ``` -```{r cap-desc-mv} -cap_desc_mv <- glue( - "Fair Market Values by Group.", - "\\newline Model and desk review fair market values for properties", - " with qualifying arm's-length sales (Sold), properties without", - " a recorded sale (Unsold), and all residential parcels (All).", - " Sold and Unsold do not sum to All because properties removed", - " by desk review as outliers are counted in All but neither in", - " Sold nor Unsold." -) -``` +{{< pagebreak >}} -```{r tbl-desc-mv} -#| tbl-cap: !expr 'cap_desc_mv' +```{r tbl-3} +#| tbl-cap: !expr 'caps$fig3' #| tbl-pos: H +groups <- list(Sold = sales_df, Unsold = no_sale, All = all_parcels) + mv_table <- tibble( - Group = c("Sold", "Unsold", "All"), - `Median Model FMV` = c( - fmt_dol(median(sales_df$model_FMV, na.rm = TRUE)), - fmt_dol(median(no_sale$model_FMV, na.rm = TRUE)), - fmt_dol(median(all_parcels$model_FMV, na.rm = TRUE)) + Group = names(groups), + `Median Model FMV` = sapply( + groups, \(d) fmt_dol(median(d$model_FMV, na.rm = TRUE)) ), - `Median DR FMV` = c( - fmt_dol(median(sales_df$desk_review_FMV, na.rm = TRUE)), - fmt_dol(median(no_sale$desk_review_FMV, na.rm = TRUE)), - fmt_dol(median(all_parcels$desk_review_FMV, na.rm = TRUE)) + `Median DR FMV` = sapply( + groups, \(d) fmt_dol(median(d$desk_review_FMV, na.rm = TRUE)) ), - `Mean Model FMV` = c( - fmt_dol(mean(sales_df$model_FMV, na.rm = TRUE)), - fmt_dol(mean(no_sale$model_FMV, na.rm = TRUE)), - fmt_dol(mean(all_parcels$model_FMV, na.rm = TRUE)) + `Mean Model FMV` = sapply( + groups, \(d) fmt_dol(mean(d$model_FMV, na.rm = TRUE)) ), - `Mean DR FMV` = c( - fmt_dol(mean(sales_df$desk_review_FMV, na.rm = TRUE)), - fmt_dol(mean(no_sale$desk_review_FMV, na.rm = TRUE)), - fmt_dol(mean(all_parcels$desk_review_FMV, na.rm = TRUE)) + `Mean DR FMV` = sapply( + groups, \(d) fmt_dol(mean(d$desk_review_FMV, na.rm = TRUE)) ) ) @@ -465,16 +479,8 @@ knitr::kable( ) ``` -```{r cap-desc-changes} -cap_desc_changes <- glue( - "Desk Review Changes by Group.", - "\\newline Number and share of properties whose assessed value was", - " changed by desk review." -) -``` - -```{r tbl-desc-changes} -#| tbl-cap: !expr 'cap_desc_changes' +```{r tbl-4} +#| tbl-cap: !expr 'caps$fig4' #| tbl-pos: H changes_table <- tibble( @@ -518,20 +524,13 @@ nbhd_ratios <- all_parcels %>% ) ``` -```{r cap-4} -cap_fig4 <- glue( - "Sale Price Ratio Curve.", - "\\newline Each labeled point is the median ratio within that", - " sale price decile.", - " Dotted lines show the IAAO acceptable range (0.9–1.1)." -) -``` +{{< pagebreak >}} -```{r fig-4} -#| fig-cap: !expr 'cap_fig4' +```{r fig-5} +#| fig-cap: !expr 'caps$fig5' #| fig-pos: H #| fig-cap-location: top -#| fig-height: 5 +#| fig-height: 3.5 #| fig-width: 7 decile_long <- decile_stats %>% @@ -608,17 +607,10 @@ ggplot( labs(x = "Sale Price Decile", y = "Median Sale Ratio", color = "Stage") ``` -{{< pagebreak >}} - -```{r cap-5} -cap_fig5 <- glue( - "Ratio Curve by Sale Price Decile" -) -``` - -```{r tbl-5} -#| tbl-cap: !expr 'cap_fig5' +```{r tbl-6} +#| tbl-cap: !expr 'caps$fig6' #| tbl-pos: H +#| tbl-cap-location: top decile_display <- decile_stats %>% select( @@ -642,7 +634,7 @@ knitr::kable( ) ``` -```{r fig-6-prep} +```{r fig-7-prep} neighborhoods <- ccao::nbhd_shp %>% filter(township_name == town_name) %>% select(town_nbhd, geometry) @@ -656,39 +648,26 @@ map_theme <- theme_void(base_size = 9) + plot.title = element_text(face = "bold", size = 10) ) -map_model <- ggplot() + - annotation_map_tile(type = "cartolight", zoomin = 0) + - geom_sf( - data = map_data, aes(fill = model_ratio), alpha = 0.85, linewidth = 0.1 - ) + - ratio_fill_scale() + - map_theme + - labs(title = "Model") - -map_dr <- ggplot() + - annotation_map_tile(type = "cartolight", zoomin = 0) + - geom_sf( - data = map_data, aes(fill = dr_ratio), alpha = 0.85, linewidth = 0.1 - ) + - ratio_fill_scale() + - map_theme + - labs(title = "Desk Review") -``` +make_map <- function(col, title) { + ggplot() + + annotation_map_tile(type = "cartolight", zoomin = 0) + + geom_sf( + data = map_data, aes(fill = .data[[col]]), alpha = 0.85, linewidth = 0.1 + ) + + ratio_fill_scale() + + map_theme + + labs(title = title) +} -```{r cap-6} -cap_fig6 <- glue( - "Neighborhood Median Assessment Ratios.", - "\\newline Green (0.90–1.10) meets the IAAO standard;", - " Blue indicates under-assessment;", - " Red indicates over-assessment." -) +map_model <- make_map("model_ratio", "Model") +map_dr <- make_map("dr_ratio", "Desk Review") ``` -```{r fig-6} -#| fig-cap: !expr 'cap_fig6' +```{r fig-7} +#| fig-cap: !expr 'caps$fig7' #| fig-pos: H #| fig-cap-location: top -#| fig-height: 5.5 +#| fig-height: 4.5 #| fig-width: 8.5 #| results: 'hide' @@ -703,19 +682,10 @@ print(map_dr, vp = viewport( )) ``` -{{< pagebreak >}} - -```{r cap-2} -cap_fig2 <- glue( - "Neighborhood-Level Median Ratios.", - "\\newline Blue indicates under-assessment;", - " Green (0.90–1.1) indicates within standard;", - " Red indicates over-assessment." -) -``` -```{r tbl-2} -#| tbl-cap: !expr 'cap_fig2' +```{r tbl-8} +#| tbl-cap: !expr 'caps$fig8' +#| tbl-cap-location: top all_nbhds <- all_parcels %>% distinct(neighborhood_number) %>% From fbc64a40ce85768d871514bbb36b8474341e3052 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 18:51:55 +0000 Subject: [PATCH 19/20] Fit onto one page --- ratio-analysis/ratio-analysis.qmd | 38 +++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 226a562..45f117e 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -285,6 +285,7 @@ This analysis compares ratio statistics from two stages: #| tbl-pos: H display_order <- c("Median Ratio", "PRB", "PRD", "COD", "MKI") +met_fac <- function(x) factor(x, levels = display_order) iaao_table <- data.frame( Metric = display_order, @@ -327,7 +328,7 @@ knitr::kable( #| fig-width: 6.5 ts_wide <- tibble( - Metric = factor(display_order, levels = display_order), + Metric = met_fac(display_order), Model = c( ts$model_ratio, ts$model_prb, ts$model_prd, ts$model_cod, ts$model_mki @@ -349,9 +350,11 @@ ts_long <- ts_wide %>% label = round(Value, pmin(digits, 2)) ) -iaao_bands <- select(metric_meta, Metric = name, xmin = lo, xmax = hi) +iaao_bands <- select(metric_meta, Metric = name, xmin = lo, xmax = hi) %>% + mutate(Metric = met_fac(Metric)) -iaao_meta <- select(metric_meta, Metric = name, mid, half_span) +iaao_meta <- select(metric_meta, Metric = name, mid, half_span) %>% + mutate(Metric = met_fac(Metric)) sym_anchors <- ts_long %>% left_join(iaao_meta, by = "Metric") %>% @@ -378,7 +381,8 @@ sym_anchors <- ts_long %>% scale_anchors <- bind_rows( sym_anchors, tibble(Metric = "COD", x = 0) -) +) %>% + mutate(Metric = met_fac(Metric)) ggplot() + geom_blank(data = ts_long, aes(x = Value, y = 1)) + @@ -667,7 +671,7 @@ map_dr <- make_map("dr_ratio", "Desk Review") #| fig-cap: !expr 'caps$fig7' #| fig-pos: H #| fig-cap-location: top -#| fig-height: 4.5 +#| fig-height: 3.5 #| fig-width: 8.5 #| results: 'hide' @@ -686,6 +690,7 @@ print(map_dr, vp = viewport( ```{r tbl-8} #| tbl-cap: !expr 'caps$fig8' #| tbl-cap-location: top +#| tbl-pos: H all_nbhds <- all_parcels %>% distinct(neighborhood_number) %>% @@ -701,18 +706,31 @@ nbhd_table_data <- all_nbhds %>% `DR Ratio` = ifelse( is.na(dr_ratio), "---", color_ratio_cell(dr_ratio, digits = 3) ), - `N Sales` = ifelse(is.na(n_sales), 0L, n_sales) + `N Sales` = as.character(ifelse(is.na(n_sales), 0L, n_sales)) ) %>% select(`NBHD`, `Model Ratio`, `DR Ratio`, `N Sales`) +n <- nrow(nbhd_table_data) +half <- ceiling(n / 2) +pad <- half - (n - half) + +right_half <- bind_rows( + nbhd_table_data[(half + 1):n, ], + if (pad > 0) { + tibble( + NBHD = rep("", pad), `Model Ratio` = rep("", pad), + `DR Ratio` = rep("", pad), `N Sales` = rep("", pad) + ) + } +) + knitr::kable( - nbhd_table_data, + cbind(nbhd_table_data[1:half, ], right_half), format = "latex", escape = FALSE, booktabs = FALSE, linesep = "", - longtable = TRUE, - align = c("l", "r", "r", "r"), - col.names = c("NBHD", "Model Ratio", "DR Ratio", "N Sales") + align = c("l", "r", "r", "r", "l", "r", "r", "r"), + col.names = rep(c("NBHD", "Model Ratio", "DR Ratio", "N Sales"), 2) ) ``` From 688f4f6b7fe028a5e98d3d4a6a5bff76f6bca591 Mon Sep 17 00:00:00 2001 From: Damonamajor Date: Fri, 28 Aug 2026 18:54:36 +0000 Subject: [PATCH 20/20] add spacer --- ratio-analysis/ratio-analysis.qmd | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/ratio-analysis/ratio-analysis.qmd b/ratio-analysis/ratio-analysis.qmd index 45f117e..dec007b 100644 --- a/ratio-analysis/ratio-analysis.qmd +++ b/ratio-analysis/ratio-analysis.qmd @@ -724,13 +724,18 @@ right_half <- bind_rows( } ) +spacer <- tibble(` ` = rep("", half)) + knitr::kable( - cbind(nbhd_table_data[1:half, ], right_half), - format = "latex", - escape = FALSE, - booktabs = FALSE, - linesep = "", - align = c("l", "r", "r", "r", "l", "r", "r", "r"), - col.names = rep(c("NBHD", "Model Ratio", "DR Ratio", "N Sales"), 2) + cbind(nbhd_table_data[1:half, ], spacer, right_half), + format = "latex", + escape = FALSE, + booktabs = FALSE, + linesep = "", + align = c("l", "r", "r", "r", "l", "l", "r", "r", "r"), + col.names = c( + "NBHD", "Model Ratio", "DR Ratio", "N Sales", "", + "NBHD", "Model Ratio", "DR Ratio", "N Sales" + ) ) ```