From 0e7e858f489529cdbbeab38f6c14c600c7cfd796 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 19:06:23 +0000 Subject: [PATCH 1/8] Update R source code to match assesspy 2.0 interface --- R/ci.R | 43 +++++++----- R/data.R | 23 ++++++- R/formulas.R | 87 ++++++++++++------------ R/outliers.R | 25 ++++--- R/sales_chasing.R | 103 ++++++++++++++--------------- tests/testthat/test-ci.R | 68 +++++++++---------- tests/testthat/test-formulas.R | 98 +++++++++++++-------------- tests/testthat/test-sale_chasing.R | 2 +- 8 files changed, 235 insertions(+), 214 deletions(-) diff --git a/R/ci.R b/R/ci.R index f6c6edb..090de5f 100644 --- a/R/ci.R +++ b/R/ci.R @@ -4,7 +4,11 @@ #' for a given numeric input and a chosen function. #' #' @param FUN Function to bootstrap. Must return a single value. -#' @param nboot Default 100. Number of iterations to use to estimate +#' @param estimate A character vector of estimated values. Must be the same +#' length as \code{sale_price}. +#' @param sale_price A character vector of sale prices. Must be the same +#' length as \code{estimate}. +#' @param nboot Default 1000. Number of iterations to use to estimate #' the output statistic confidence interval. #' @param alpha Default 0.05. Numeric value indicating the confidence #' interval to return. 0.05 will return the 95\% confidence interval. @@ -30,19 +34,23 @@ #' na.rm = FALSE #' ) #' @export -boot_ci <- function(FUN = NULL, nboot = 100, alpha = 0.05, na.rm = FALSE, ...) { # nolint +boot_ci <- function(FUN = NULL, estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { + + # Input checking and error handling + check_inputs(estimate, sale_price) # Check that the input function returns a numeric vector - est <- FUN(...) + est <- FUN(estimate, sale_price) stopifnot( length(est) == 1, is.numeric(est), - is.logical(na.rm) + is.logical(na.rm), + nboot > 0 ) # Create an index of missing values, where TRUE when missing. # If na.rm is FALSE and index contains TRUE, return NA - missing_idx <- index_na(...) + missing_idx <- index_na(estimate, sale_price) if (any(missing_idx) && !na.rm) { return(NA_real_) } @@ -62,7 +70,7 @@ boot_ci <- function(FUN = NULL, nboot = 100, alpha = 0.05, na.rm = FALSE, ...) { # For each of the input vectors to FUN, subset by first removing any # index positions that have a missing value, then take a random sample of # each vector using the sample index - sampled <- lapply(list(...), function(x) x[!missing_idx][idx]) + sampled <- lapply(list(estimate, sale_price), function(x) x[!missing_idx][idx]) # For each bootstrap sample, apply the function and output an estimate for # that sample @@ -85,16 +93,17 @@ boot_ci <- function(FUN = NULL, nboot = 100, alpha = 0.05, na.rm = FALSE, ...) { #' @examples #' #' # Calculate COD confidence interval -#' cod_ci(ratios_sample$ratio) +#' cod_ci(ratios_sample$assessed, ratios_sample$sale_price) #' @export -cod_ci <- function(ratio, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint +cod_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint cod_ci <- boot_ci( cod, + estimate = estimate, + sale_price = sale_price, nboot = nboot, alpha = alpha, na.rm = na.rm, - ratio = ratio ) return(cod_ci) @@ -110,15 +119,15 @@ cod_ci <- function(ratio, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint #' # Calculate PRD confidence interval #' prd_ci(ratios_sample$assessed, ratios_sample$sale_price) #' @export -prd_ci <- function(assessed, sale_price, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint +prd_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint prd_ci <- boot_ci( prd, + estimate = estimate, + sale_price = sale_price, nboot = nboot, alpha = alpha, na.rm = na.rm, - assessed = assessed, - sale_price = sale_price ) return(prd_ci) @@ -134,23 +143,23 @@ prd_ci <- function(assessed, sale_price, nboot = 100, alpha = 0.05, na.rm = FALS #' # Calculate PRD confidence interval #' prb_ci(ratios_sample$assessed, ratios_sample$sale_price) #' @export -prb_ci <- function(assessed, sale_price, alpha = 0.05, na.rm = FALSE) { # nolint +prb_ci <- function(estimate, sale_price, alpha = 0.05, na.rm = FALSE) { # nolint # Input checking and error handling - check_inputs(assessed, sale_price) + check_inputs(estimate, sale_price) # Remove NAs from input vectors. Otherwise, return NA if the input vectors # contain any NA values - idx <- index_na(assessed, sale_price) + idx <- index_na(estimate, sale_price) if (na.rm) { - assessed <- assessed[!idx] + estimate <- estimate[!idx] sale_price <- sale_price[!idx] } else if (any(idx) && !na.rm) { return(NA_real_) } # Calculate PRB model - prb_model <- calc_prb(assessed, sale_price) + prb_model <- calc_prb(estimate, sale_price) # Extract PRB CI from model prb_ci <- stats::confint(prb_model, level = (1 - alpha))[2, ] diff --git a/R/data.R b/R/data.R index 550efdd..8f2824f 100644 --- a/R/data.R +++ b/R/data.R @@ -3,13 +3,30 @@ #' This sample was take from Evanston and New Trier in 2019. Ratios are #' calculated using assessor certified (post-appeal) fair market values. #' -#' @format A data frame with 979 observation and 4 variables: +#' @format A data frame with 979 observation and 3 variables: #' \describe{ -#' \item{assessed}{The fair market assessed value predicted by CCAO assessment +#' \item{estimate}{The fair market assessed value predicted by CCAO assessment #' models, including any successful appeals} #' \item{sale_price}{The recorded sale price of this property} -#' \item{ratio}{Sales ratio representing fair market value / sale price} #' \item{town}{Township name the property is in} #' } #' "ratios_sample" + +#' Sample of sales and estimated market values provided by Quintos in the +#' following MKI papers: +#' +#' @references +#' Quintos, C. (2020). A Gini measure for vertical equity in property +#' assessments. +#' +#' Quintos, C. (2021). A Gini decomposition of the sources of inequality in +#' property assessments. +#' +#' @format A data frame with 30 observation and 2 variables: +#' \describe{ +#' \item{estimate}{Assessed fair market value} +#' \item{sale_price}{Recorded sale price of this property} +#' } +#' +"quintos_sample" diff --git a/R/formulas.R b/R/formulas.R index 3df4495..50a8954 100644 --- a/R/formulas.R +++ b/R/formulas.R @@ -20,9 +20,10 @@ #' \href{https://www.iaao.org/media/standards/Standard_on_Ratio_Studies.pdf}{IAAO Standard on Ratio Studies} #' Appendix B.1. #' -#' @param ratio A numeric vector of ratios centered around 1, where the -#' numerator of the ratio is the estimated fair market value and the -#' denominator is the actual sale price. +#' @param estimate A numeric vector of assessed values. Must be the same +#' length as \code{sale_price}. +#' @param sale_price A numeric vector of sale prices. Must be the same length +#' as \code{estimate}. #' @param na.rm Default FALSE. A boolean value indicating whether or not to #' remove NA values. If missing values are present but not removed the #' function will output NA. @@ -32,13 +33,15 @@ #' #' @examples #' # Calculate COD -#' cod(ratios_sample$ratio) +#' cod(ratios_sample$estimate, ratios_sample$sale_price) #' @family formulas #' @export -cod <- function(ratio, na.rm = FALSE) { +cod <- function(estimate, sale_price, na.rm = FALSE) { # nolint end - check_inputs(ratio) + check_inputs(estimate, sale_price) + ratio <- estimate / sale_price + if (na.rm) ratio <- stats::na.omit(ratio) # Calculate median ratio @@ -71,10 +74,10 @@ cod <- function(ratio, na.rm = FALSE) { #' as it is extremely sensitive to large outliers. PRD is being deprecated in #' favor of PRB, which is less sensitive to outliers and easier to interpret. #' -#' @param assessed A numeric vector of assessed values. Must be the same +#' @param estimate A numeric vector of assessed values. Must be the same #' length as \code{sale_price}. #' @param sale_price A numeric vector of sale prices. Must be the same length -#' as \code{assessed}. +#' as \code{estimate}. #' #' @inheritParams cod #' @describeIn prd Returns a numeric vector containing the PRD of the @@ -83,23 +86,23 @@ cod <- function(ratio, na.rm = FALSE) { #' #' @examples #' # Calculate PRD -#' prd(ratios_sample$assessed, ratios_sample$sale_price) +#' prd(ratios_sample$estimate, ratios_sample$sale_price) #' @family formulas #' @export -prd <- function(assessed, sale_price, na.rm = FALSE) { +prd <- function(estimate, sale_price, na.rm = FALSE) { # nolint end - check_inputs(assessed, sale_price) - idx <- index_na(assessed, sale_price) + check_inputs(estimate, sale_price) + idx <- index_na(estimate, sale_price) if (na.rm) { - assessed <- assessed[!idx] + estimate <- estimate[!idx] sale_price <- sale_price[!idx] } else if (any(idx) && !na.rm) { return(NA_real_) } # Calculate ratio of assessed values to sale price - ratio <- assessed / sale_price + ratio <- estimate / sale_price # Calculate PRD prd <- mean(ratio) / stats::weighted.mean(ratio, sale_price) @@ -112,11 +115,11 @@ prd <- function(assessed, sale_price, na.rm = FALSE) { ##### PRB ##### # Calculate PRB and return model object -calc_prb <- function(assessed, sale_price) { - ratio <- assessed / sale_price +calc_prb <- function(estimate, sale_price) { + ratio <- estimate / sale_price med_ratio <- stats::median(ratio) lhs <- (ratio - med_ratio) / med_ratio - rhs <- log(((assessed / med_ratio) + sale_price) * 0.5) / log(2) + rhs <- log(((estimate / med_ratio) + sale_price) * 0.5) / log(2) prb_model <- stats::lm(formula = lhs ~ rhs) return(prb_model) @@ -146,24 +149,24 @@ calc_prb <- function(assessed, sale_price) { #' #' @examples #' # Calculate PRB -#' prb(ratios_sample$assessed, ratios_sample$sale_price) +#' prb(ratios_sample$estimate, ratios_sample$sale_price) #' @family formulas #' @export -prb <- function(assessed, sale_price, na.rm = FALSE) { +prb <- function(estimate, sale_price, na.rm = FALSE) { # nolint end - check_inputs(assessed, sale_price) + check_inputs(estimate, sale_price) - idx <- index_na(assessed, sale_price) + idx <- index_na(estimate, sale_price) if (na.rm) { - assessed <- assessed[!idx] + estimate <- estimate[!idx] sale_price <- sale_price[!idx] } else if (any(idx) && !na.rm) { return(NA_real_) } # Calculate PRB - prb_model <- calc_prb(assessed, sale_price) + prb_model <- calc_prb(estimate, sale_price) # Extract PRB from model prb <- unname(stats::coef(prb_model)[2]) @@ -176,22 +179,22 @@ prb <- function(assessed, sale_price, na.rm = FALSE) { ##### MKI_KI ##### # Calculate the Gini cofficients needed for KI and MKI -calc_gini <- function(assessed, sale_price) { - df <- data.frame(av = assessed, sp = sale_price) +calc_gini <- function(estimate, sale_price) { + df <- data.frame(av = estimate, sp = sale_price) df <- df[order(df$sp), ] assessed_price <- df$av sale_price <- df$sp n <- length(assessed_price) av_sum <- sum(assessed_price * seq_len(n)) - g_assessed <- 2 * av_sum / sum(assessed_price) - (n + 1L) - gini_assessed <- g_assessed / n + g_estimate <- 2 * av_sum / sum(assessed_price) - (n + 1L) + gini_estimate <- g_estimate / n sale_sum <- sum(sale_price * seq_len(n)) g_sale <- 2 * sale_sum / sum(sale_price) - (n + 1L) gini_sale <- g_sale / n - result <- list(gini_assessed = gini_assessed, gini_sale = gini_sale) + result <- list(gini_estimate = gini_estimate, gini_sale = gini_sale) return(result) } @@ -240,25 +243,25 @@ calc_gini <- function(assessed, sale_price) { #' @examples #' #' # Calculate KI -#' ki(ratios_sample$assessed, ratios_sample$sale_price) +#' ki(ratios_sample$estimate, ratios_sample$sale_price) #' @family formulas #' @export #' @md -ki <- function(assessed, sale_price, na.rm = FALSE) { +ki <- function(estimate, sale_price, na.rm = FALSE) { # nolint end - check_inputs(assessed, sale_price) + check_inputs(estimate, sale_price) - idx <- index_na(assessed, sale_price) + idx <- index_na(estimate, sale_price) if (na.rm) { - assessed <- assessed[!idx] + estimate <- estimate[!idx] sale_price <- sale_price[!idx] } else if (any(idx) && !na.rm) { return(NA_real_) } - g <- calc_gini(assessed, sale_price) - ki <- g$gini_assessed - g$gini_sale + g <- calc_gini(estimate, sale_price) + ki <- g$gini_estimate - g$gini_sale return(ki) } @@ -270,21 +273,21 @@ ki <- function(assessed, sale_price, na.rm = FALSE) { #' #' @examples #' # Calculate MKI -#' mki(ratios_sample$assessed, ratios_sample$sale_price) +#' mki(ratios_sample$estimate, ratios_sample$sale_price) #' @export -mki <- function(assessed, sale_price, na.rm = FALSE) { - check_inputs(assessed, sale_price) +mki <- function(estimate, sale_price, na.rm = FALSE) { + check_inputs(estimate, sale_price) - idx <- index_na(assessed, sale_price) + idx <- index_na(estimate, sale_price) if (na.rm) { - assessed <- assessed[!idx] + estimate <- estimate[!idx] sale_price <- sale_price[!idx] } else if (any(idx) && !na.rm) { return(NA_real_) } - g <- calc_gini(assessed, sale_price) - mki <- g$gini_assessed / g$gini_sale + g <- calc_gini(estimate, sale_price) + mki <- g$gini_estimate / g$gini_sale return(mki) } diff --git a/R/outliers.R b/R/outliers.R index 1abaec3..c2c8439 100644 --- a/R/outliers.R +++ b/R/outliers.R @@ -7,22 +7,24 @@ #' outliers. As such, it is often necessary to remove outliers before #' performing a sales ratio study. #' -#' Standard method is to remove outliers that are 3 * IQR. Warnings are thrown +#' The IAAO standard method is to remove outliers that are 3 * IQR. Warnings are thrown #' when sample size is extremely small or when the IQR is extremely narrow. See #' \href{https://www.iaao.org/media/standards/Standard_on_Ratio_Studies.pdf}{IAAO Standard on Ratio Studies} #' Appendix B. Outlier Trimming Guidelines for more information. #' -#' @param x A numeric vector. Must be longer than 2 and not contain -#' \code{Inf} or \code{NaN}. -#' @param method Default "iqr". String indicating outlier detection method. +#' @param x A numeric vector, typically sales ratios. Must be longer than 2 and +#' cannot contain \code{Inf} or \code{NaN}. +#' @param method Default \code{iqr.} String indicating outlier detection method. #' Options are \code{iqr} or \code{quantile}. -#' @param ... Named arguments passed on to methods. +#' @param probs Upper and lower percentiles denoting outlier boundaries for +#' the \code{quantile} method. +#' @param mult Multiplier for IQR to determine outlier boundaries. Default 3. #' #' @return A logical vector this same length as \code{x} indicating whether or #' not each value of \code{x} is an outlier. #' #' @export -is_outlier <- function(x, method = "iqr", ...) { +is_outlier <- function(x, method = "iqr", probs = c(0.05, 0.95), mult = 3) { # nolint end # Check that inputs are well-formed numeric vector @@ -35,9 +37,10 @@ is_outlier <- function(x, method = "iqr", ...) { all(is.finite(x) | is.na(x)) # All values are finite OR are NA }) - out <- switch(method, - "quantile" = quantile_outlier(x, na.rm = TRUE, ...), - "iqr" = iqr_outlier(x, na.rm = TRUE, ...) + out <- ifelse( + method == "quantile", + quantile_outlier(x, probs = probs), + iqr_outlier(x, mult = mult) ) # Warn about removing data from small samples, as it can severely distort @@ -55,7 +58,7 @@ is_outlier <- function(x, method = "iqr", ...) { #' @describeIn is_outlier Quantile method for identifying outliers. #' @param probs Upper and lower percentiles denoting outlier boundaries. -quantile_outlier <- function(x, probs = c(0.05, 0.95), ...) { # nolint +quantile_outlier <- function(x, probs = c(0.05, 0.95)) { # Determine valid range of the data range <- stats::quantile(x, probs = probs, na.rm = TRUE) @@ -69,7 +72,7 @@ quantile_outlier <- function(x, probs = c(0.05, 0.95), ...) { # nolint #' @describeIn is_outlier IQR method for identifying outliers. #' @param mult Multiplier for IQR to determine outlier boundaries. -iqr_outlier <- function(x, mult = 3, ...) { # nolint +iqr_outlier <- function(x, mult = 3) { # Check that inputs are well-formed numeric vector stopifnot(is.numeric(mult), sign(mult) == 1) diff --git a/R/sales_chasing.R b/R/sales_chasing.R index f06ef25..a61da44 100644 --- a/R/sales_chasing.R +++ b/R/sales_chasing.R @@ -2,12 +2,18 @@ #' Detect sales chasing in a vector of sales ratios #' #' @description Sales chasing is when a property is selectively reappraised to -#' shift its assessed value toward its actual sale price. Sales chasing is +#' shift its assessed value toward its recent sale price. Sales chasing is #' difficult to detect. This function is NOT a statistical test and does #' not provide the probability of the given result. Rather, it combines two -#' novel methods to roughly estimate if sales chasing has occurred. +#' heuristic methods to roughly estimate if sales chasing has occurred. #' -#' The first method (dist) uses the technique outlined in the +#' The first method (cdf) detects discontinuities in the cumulative +#' distribution function (CDF) of the input vector. Ratios that are not sales +#' chased should have a fairly smooth CDF. Discontinuous jumps in the CDF, +#' particularly around 1, may indicate sales chasing. This can usually be seen +#' visually as a "flat spot" on the CDF. +#' +#' The second method (dist) uses the technique outlined in the #' \href{https://www.iaao.org/media/standards/Standard_on_Ratio_Studies.pdf}{IAAO Standard on Ratio Studies} #' Appendix E, Section 4. It compares the percentage of real data within +-2% #' of the mean ratio to the percentage of data within the same bounds given a @@ -15,23 +21,24 @@ #' The intuition here is that ratios that are sales chased may be more #' "bunched up" in the center of the distribution. #' -#' The second method (cdf) detects discontinuities in the cumulative -#' distribution function (CDF) of the input vector. Ratios that are not sales -#' chased should have a fairly smooth CDF. Discontinuous jumps in the CDF, -#' particularly around 1, may indicate sales chasing. This can usually be seen -#' visually as a "flat spot" on the CDF. -#' -#' @param ratio A numeric vector of ratios centered around 1, where the -#' numerator of the ratio is the estimated fair market value and the -#' denominator is the actual sale price. -#' @param method Default "both". String indicating sales chasing detection +#' @param x A numeric vector. Must be longer than 2 and cannot contain +#' \code{inf} or \code{NA} values. +#' @param method Default \code{both}. String indicating sales chasing detection #' method. Options are \code{cdf}, \code{dist}, or \code{both}. #' @param na.rm Default FALSE. A boolean value indicating whether or not to #' remove NA values. If missing values are present but not removed the #' function will output NA for those values. -#' @param ... Named arguments passed on to methods. +#' @param bounds Default \code{(0.98, 1.02)}. Lower and upper bounds of the +#' range of ratios to consider when detecting sales chasing. Setting this to +#' a narrow band at the center of the ratio distribution prevents detecting +#' false positives at the tails. +#' @param gap Default \code{0.05}. Float tuning factor. For the CDF method, it +#' sets the maximum percentage difference between two adjacent ratios. For the +#' distribution method, it sets the maximum percentage point difference +#' between the percentage of the data between the \code{bounds} in the real +#' distribution compared to the ideal distribution. #' -#' @return A logical value indicating whether or not the input ratios may +#' @return A logical value indicating whether or not the input values may #' have been sales chased. #' #' @examples @@ -42,26 +49,32 @@ #' #' # Plot to view discontinuity #' plot(stats::ecdf(normal_ratios)) -#' detect_chasing(normal_ratios) +#' is_sales_chased(normal_ratios) #' #' plot(stats::ecdf(chased_ratios)) -#' detect_chasing(chased_ratios) +#' is_sales_chased(chased_ratios) #' @export -detect_chasing <- function(ratio, method = "both", na.rm = FALSE, ...) { +is_sales_chased <- function(x, method = "both", bounds = c(0.98, 1.02), gap = 0.03, na.rm = FALSE) { # nolint end # Check that inputs are well-formed numeric vector stopifnot(exprs = { method %in% c("cdf", "dist", "both") - is.vector(ratio) - is.numeric(ratio) - !is.nan(ratio) - length(ratio) > 2 - all(is.finite(ratio) | is.na(ratio)) # All values are finite OR are NA + is.vector(x) + is.numeric(x) + !is.nan(x) + length(x) > 2 + all(is.finite(x) | is.na(x)) # All values are finite OR are NA + is.numeric(gap) + gap > 0 + gap > 1 + is.vector(bounds) + is.numeric(bounds) + bounds[2] > bounds[1] }) # Warn about small sample sizes - if (length(ratio) < 30) { + if (length(x) < 30) { warning(paste( "Sales chasing detection can be misleading when applied to small", "samples (N < 30). Increase N or use a different statistical test." @@ -69,40 +82,23 @@ detect_chasing <- function(ratio, method = "both", na.rm = FALSE, ...) { } # Can't calculate ideal distribution if ratio input contains NA, so output NA - if (any(is.na(ratio)) && !na.rm) { + if (any(is.na(x)) && !na.rm) { return(NA) } out <- switch(method, - "cdf" = detect_chasing_cdf(ratio, ...), - "dist" = detect_chasing_dist(ratio, na.rm = na.rm, ...), - "both" = detect_chasing_cdf(ratio, ...) & - detect_chasing_dist(ratio, na.rm = na.rm, ...) + "cdf" = cdf_sales_chased(x, bounds, gap), + "dist" = dist_sales_chased(x, bounds, gap, na.rm = na.rm), + "both" = cdf_sales_chased(x, bounds, gap) & + dist_sales_chased(x, bounds, gap, na.rm = na.rm) ) return(out) } -#' @describeIn detect_chasing CDF gap method for detecting sales chasing. -#' @param bounds Ratio boundaries to use for detection. The CDF method will -#' return TRUE if the CDF gap exceeding the threshold is found within these -#' bounds. The distribution method will calculate the percentage of ratios -#' within these bounds for the actual data and an ideal normal distribution. -#' Expanding these bounds increases likelihood of detection. -#' @param cdf_gap Ratios that have bunched up around a particular value -#' (typically 1) will appear as a flat spot on the CDF. The longer this flat -#' spot, the worse the potential sales chasing. This variable indicates the -#' length of that flat spot and can be thought of as the proportion of ratios -#' that have the same value. For example, 0.03 means that 3% of ratios share -#' the same value. -detect_chasing_cdf <- function(ratio, bounds = c(0.98, 1.02), cdf_gap = 0.03, ...) { # nolint - - # Check that inputs are well-formed numeric vector - stopifnot( - cdf_gap > 0 & cdf_gap < 1, is.numeric(cdf_gap), - length(bounds) == 2, is.numeric(bounds) - ) +#' @describeIn is_sales_chased CDF gap method for detecting sales chasing. +cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { # Sort the ratios AND REMOVE NAs sorted_ratio <- sort(ratio) @@ -117,18 +113,15 @@ detect_chasing_cdf <- function(ratio, bounds = c(0.98, 1.02), cdf_gap = 0.03, .. # Check if the largest different is greater than the threshold and make sure # it's within the specified boundaries diff_loc <- sorted_ratio[which.max(diffs)] - out <- max(diffs) > cdf_gap & (diff_loc > bounds[1] & diff_loc < bounds[2]) + out <- max(diffs) > gap & (diff_loc > bounds[1] & diff_loc < bounds[2]) return(out) } -#' @describeIn detect_chasing Distribution comparison method +#' @describeIn is_sales_chased Distribution comparison method #' for detecting sales chasing. -detect_chasing_dist <- function(ratio, bounds = c(0.98, 1.02), na.rm = FALSE, ...) { # nolint - - # Check that inputs are well-formed numeric vector - stopifnot(length(bounds) == 2, is.numeric(bounds)) +dist_sales_chased <- function(ratio, bounds = c(0.98, 1.02), na.rm = FALSE) { # Return the percentage of x within the specified range pct_in_range <- function(x, min, max) mean(x >= min & x <= max, na.rm = na.rm) @@ -147,5 +140,5 @@ detect_chasing_dist <- function(ratio, bounds = c(0.98, 1.02), na.rm = FALSE, .. # Determine what percentage of the data is actually within the bounds pct_actual <- pct_in_range(ratio, bounds[1], bounds[2]) - return(pct_actual > pct_ideal) + return(abs(pct_actual - pct_ideal) > gap) } diff --git a/tests/testthat/test-ci.R b/tests/testthat/test-ci.R index eecceae..4244ee4 100644 --- a/tests/testthat/test-ci.R +++ b/tests/testthat/test-ci.R @@ -4,18 +4,17 @@ context("load testing data") data("ratios_sample") # Extract the components of the dataframe as vectors -ratio <- ratios_sample$ratio sale_price <- ratios_sample$sale_price -assessed <- ratios_sample$assessed +estimate <- ratios_sample$estimate ##### TEST COD CI ##### context("test cod_ci function") -# Calculate PRB CI -cod_ci_out_95 <- cod_ci(ratio, nboot = 1000) -cod_ci_out_80 <- cod_ci(ratio, nboot = 1000, alpha = 0.2) +# Calculate COD CI +cod_ci_out_95 <- cod_ci(estimate, sale_price, nboot = 1000) +cod_ci_out_80 <- cod_ci(estimate, sale_price, nboot = 1000, alpha = 0.2) test_that("returns expected type", { expect_type(cod_ci_out_95, "double") @@ -30,21 +29,22 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(cod_ci(numeric(0))) - expect_error(cod_ci(numeric(10))) - expect_error(cod_ci(c(ratio, Inf))) - expect_error(cod_ci(data.frame(ratio))) - expect_error(cod_ci(c(ratio, NaN))) - expect_error(cod_ci(c(ratio, "2"))) - expect_error(cod_ci(ratio, na.rm = "yes")) + expect_error(cod_ci(numeric(10), numeric(10))) + expect_error(cod_ci(c(estimate, Inf), c(sale_price, 0))) + expect_error(cod_ci(estimate, c(sale_price, 10e5))) + expect_error(cod_ci(data.frame(estimate), sale_price)) + expect_error(cod_ci(c(estimate, NaN), c(sale_price, 1))) + expect_error(cod_ci(c(estimate, "2"), c(sale_price, 1))) + expect_error(cod_ci(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - cod_ci(c(ratio, NA)), + cod_ci(c(estimate, NA), c(sale_price, 10e5)), NA_real_ ) expect_equivalent( - cod_ci(c(ratio, NA), nboot = 1000, na.rm = TRUE), + cod_ci(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), c(16.49595, 18.84529), tolerance = 0.04 ) @@ -54,9 +54,9 @@ test_that("incomplete data returns NAs unless removed", { ##### TEST PRD CI ##### context("test prb_ci function") -# Calculate PRB CI -prd_ci_out_95 <- prd_ci(assessed, sale_price, nboot = 1000) -prd_ci_out_80 <- prd_ci(assessed, sale_price, nboot = 1000, alpha = 0.2) +# Calculate PRD CI +prd_ci_out_95 <- prd_ci(estimate, sale_price, nboot = 1000) +prd_ci_out_80 <- prd_ci(estimate, sale_price, nboot = 1000, alpha = 0.2) test_that("returns expected type", { expect_type(prd_ci_out_95, "double") @@ -72,21 +72,21 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(prd_ci(numeric(0))) expect_error(prd_ci(numeric(10), numeric(10))) - expect_error(prd_ci(c(assessed, Inf), c(sale_price, 0))) - expect_error(prd_ci(assessed, c(sale_price, 10e5))) - expect_error(prd_ci(data.frame(assessed), sale_price)) - expect_error(prd_ci(c(assessed, NaN), c(sale_price, 1))) - expect_error(prd_ci(c(assessed, "2"), c(sale_price, 1))) - expect_error(prd_ci(assessed, sale_price, na.rm = "yes")) + expect_error(prd_ci(c(estimate, Inf), c(sale_price, 0))) + expect_error(prd_ci(estimate, c(sale_price, 10e5))) + expect_error(prd_ci(data.frame(estimate), sale_price)) + expect_error(prd_ci(c(estimate, NaN), c(sale_price, 1))) + expect_error(prd_ci(c(estimate, "2"), c(sale_price, 1))) + expect_error(prd_ci(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - prd_ci(c(assessed, NA), c(sale_price, 10e5)), + prd_ci(c(estimate, NA), c(sale_price, 10e5)), NA_real_ ) expect_equivalent( - prd_ci(c(assessed, NA), c(sale_price, 10e5), na.rm = TRUE), + prd_ci(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), c(1.034447, 1.062625), tolerance = 0.04 ) @@ -98,8 +98,8 @@ test_that("incomplete data returns NAs unless removed", { context("test prb_ci function") # Calculate PRB CI -prb_ci_out_95 <- prb_ci(assessed, sale_price) -prb_ci_out_80 <- prb_ci(assessed, sale_price, alpha = 0.2) +prb_ci_out_95 <- prb_ci(estimate, sale_price) +prb_ci_out_80 <- prb_ci(estimate, sale_price, alpha = 0.2) test_that("returns expected type", { expect_type(prb_ci_out_95, "double") @@ -115,21 +115,21 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(prb_ci(numeric(0))) expect_error(prb_ci(numeric(10), numeric(10))) - expect_error(prb_ci(c(assessed, Inf), c(sale_price, 0))) - expect_error(prb_ci(assessed, c(sale_price, 10e5))) - expect_error(prb_ci(data.frame(assessed), sale_price)) - expect_error(prb_ci(c(assessed, NaN), c(sale_price, 1))) - expect_error(prb_ci(c(assessed, "2"), c(sale_price, 1))) - expect_error(prb_ci(assessed, sale_price, na.rm = "yes")) + expect_error(prb_ci(c(estimate, Inf), c(sale_price, 0))) + expect_error(prb_ci(estimate, c(sale_price, 10e5))) + expect_error(prb_ci(data.frame(estimate), sale_price)) + expect_error(prb_ci(c(estimate, NaN), c(sale_price, 1))) + expect_error(prb_ci(c(estimate, "2"), c(sale_price, 1))) + expect_error(prb_ci(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - prb_ci(c(assessed, NA), c(sale_price, 10e5)), + prb_ci(c(estimate, NA), c(sale_price, 10e5)), NA_real_ ) expect_equivalent( - prb_ci(c(assessed, NA), c(sale_price, 10e5), na.rm = TRUE), + prb_ci(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), c(-0.01404379, 0.01899536), tolerance = 0.04 ) diff --git a/tests/testthat/test-formulas.R b/tests/testthat/test-formulas.R index 99b1b06..2a52b99 100644 --- a/tests/testthat/test-formulas.R +++ b/tests/testthat/test-formulas.R @@ -4,17 +4,12 @@ context("load testing data") data("ratios_sample") # Extract the components of the dataframe as vectors -ratio <- ratios_sample$ratio sale_price <- ratios_sample$sale_price -assessed <- ratios_sample$assessed +estimate <- ratios_sample$estimate # Load example data from Quintos article -mki_ki_data <- read.csv( - rprojroot::find_testthat_root_file("data/mki_ki_data.csv") -) - -mki_ki_assessed <- mki_ki_data$Assessed -mki_ki_sale_price <- mki_ki_data$Sale_Price +mki_ki_estimate <- quintos_sample$estimate +mki_ki_sale_price <- quintos_sample$sale_price @@ -22,7 +17,7 @@ mki_ki_sale_price <- mki_ki_data$Sale_Price context("test cod function") # Calculate COD -cod_out <- cod(ratio) +cod_out <- cod(estimate, sale_price) test_that("returns numeric vector", { expect_type(cod_out, "double") @@ -35,17 +30,18 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(cod(numeric(0))) - expect_error(cod(numeric(10))) - expect_error(cod(c(cod_out, Inf))) - expect_error(cod(data.frame(ratio))) - expect_error(cod(c(ratio, NaN))) - expect_error(cod(c(ratio, "2"))) - expect_error(cod(ratio, na.rm = "yes")) + expect_error(cod(numeric(10), numeric(10))) + expect_error(cod(c(cod_out, Inf), c(prb_out, 0))) + expect_error(cod(estimate, c(sale_price, 10e5))) + expect_error(cod(data.frame(estimate), sale_price)) + expect_error(cod(c(estimate, NaN), c(sale_price, 1))) + expect_error(cod(c(estimate, "2"), c(sale_price, 1))) + expect_error(cod(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { - expect_equal(cod(c(ratio, NA)), NA_real_) - expect_equal(cod(c(ratio, NA), na.rm = TRUE), 17.81457, tolerance = 0.02) + expect_equal(cod(c(estimate, NA), c(sale_price, 10e5)), NA_real_) + expect_equal(cod(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), 17.81457, tolerance = 0.02) }) test_that("standard met function", { @@ -58,7 +54,7 @@ test_that("standard met function", { context("test prd function") # Calculate PRD -prd_out <- prd(assessed, sale_price) +prd_out <- prd(estimate, sale_price) test_that("returns numeric vector", { expect_type(prd_out, "double") @@ -73,20 +69,20 @@ test_that("bad input data stops execution", { expect_error(prd(numeric(0))) expect_error(prd(numeric(10), numeric(10))) expect_error(prd(c(prd_out, Inf), c(prb_out, 0))) - expect_error(prd(assessed, c(sale_price, 10e5))) - expect_error(prd(data.frame(assessed), sale_price)) - expect_error(prd(c(assessed, NaN), c(sale_price, 1))) - expect_error(prd(c(assessed, "2"), c(sale_price, 1))) - expect_error(prd(assessed, sale_price, na.rm = "yes")) + expect_error(prd(estimate, c(sale_price, 10e5))) + expect_error(prd(data.frame(estimate), sale_price)) + expect_error(prd(c(estimate, NaN), c(sale_price, 1))) + expect_error(prd(c(estimate, "2"), c(sale_price, 1))) + expect_error(prd(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - prd(c(assessed, NA), c(sale_price, 10e5)), + prd(c(estimate, NA), c(sale_price, 10e5)), NA_real_ ) expect_equal( - prd(c(assessed, NA), c(sale_price, 10e5), na.rm = TRUE), + prd(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), 1.048419, tolerance = 0.02 ) @@ -102,7 +98,7 @@ test_that("standard met function", { context("test prb function") # Calculate PRB -prb_out <- prb(assessed, sale_price) +prb_out <- prb(estimate, sale_price) test_that("returns expected type", { expect_type(prb_out, "double") @@ -117,20 +113,20 @@ test_that("bad input data stops execution", { expect_error(prb(numeric(0))) expect_error(prb(numeric(10), numeric(10))) expect_error(prb(c(prb_out, Inf), c(prb_out, 0))) - expect_error(prb(assessed, c(sale_price, 10e5))) - expect_error(prb(data.frame(assessed), sale_price)) - expect_error(prb(c(assessed, NaN), c(sale_price, 1))) - expect_error(prb(c(assessed, "2"), c(sale_price, 1))) - expect_error(prb(assessed, sale_price, na.rm = "yes")) + expect_error(prb(estimate, c(sale_price, 10e5))) + expect_error(prb(data.frame(estimate), sale_price)) + expect_error(prb(c(estimate, NaN), c(sale_price, 1))) + expect_error(prb(c(estimate, "2"), c(sale_price, 1))) + expect_error(prb(estimate, sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - prb(c(assessed, NA), c(sale_price, 10e5)), + prb(c(estimate, NA), c(sale_price, 10e5)), NA_real_ ) expect_equal( - prb(c(assessed, NA), c(sale_price, 10e5), na.rm = TRUE), + prb(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), 0.0024757, tolerance = 0.02 ) @@ -146,7 +142,7 @@ test_that("standard met function", { context("test mki function") # Calculate MKI -mki_out <- mki(mki_ki_assessed, mki_ki_sale_price) +mki_out <- mki(mki_ki_estimate, mki_ki_sale_price) test_that("returns expected type", { expect_type(mki_out, "double") @@ -160,21 +156,21 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(mki(numeric(0))) expect_error(mki(numeric(10), numeric(10))) - expect_error(mki(c(mki_ki_assessed, Inf), c(mki_ki_sale_price, 0))) - expect_error(mki(mki_ki_assessed, c(mki_ki_sale_price, 10e5))) - expect_error(mki(data.frame(mki_ki_assessed), mki_ki_sale_price)) - expect_error(mki(c(mki_ki_assessed, NaN), c(mki_ki_sale_price, 1))) - expect_error(mki(c(mki_ki_assessed, "2"), c(mki_ki_sale_price, 1))) - expect_error(mki(mki_ki_assessed, mki_ki_sale_price, na.rm = "yes")) + expect_error(mki(c(mki_ki_estimate, Inf), c(mki_ki_sale_price, 0))) + expect_error(mki(mki_ki_estimate, c(mki_ki_sale_price, 10e5))) + expect_error(mki(data.frame(mki_ki_estimate), mki_ki_sale_price)) + expect_error(mki(c(mki_ki_estimate, NaN), c(mki_ki_sale_price, 1))) + expect_error(mki(c(mki_ki_estimate, "2"), c(mki_ki_sale_price, 1))) + expect_error(mki(mki_ki_estimate, mki_ki_sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - mki(c(mki_ki_assessed, NA), c(mki_ki_sale_price, 10e5)), + mki(c(mki_ki_estimate, NA), c(mki_ki_sale_price, 10e5)), NA_real_ ) expect_equal( - mki(c(mki_ki_assessed, NA), c(mki_ki_sale_price, 10e5), na.rm = TRUE), + mki(c(mki_ki_estimate, NA), c(mki_ki_sale_price, 10e5), na.rm = TRUE), 0.79, tolerance = 0.01 ) @@ -190,7 +186,7 @@ test_that("standard met function", { context("test ki function") # Calculate KI -ki_out <- ki(mki_ki_assessed, mki_ki_sale_price) +ki_out <- ki(mki_ki_estimate, mki_ki_sale_price) test_that("returns expected type", { expect_type(ki_out, "double") @@ -204,21 +200,21 @@ test_that("output equal to expected", { test_that("bad input data stops execution", { expect_error(ki(numeric(0))) expect_error(ki(numeric(10), numeric(10))) - expect_error(ki(c(mki_ki_assessed, Inf), c(mki_ki_sale_price, 0))) - expect_error(ki(mki_ki_assessed, c(mki_ki_sale_price, 10e5))) - expect_error(ki(data.frame(mki_ki_assessed), mki_ki_sale_price)) - expect_error(ki(c(mki_ki_assessed, NaN), c(mki_ki_sale_price, 1))) - expect_error(ki(c(mki_ki_assessed, "2"), c(mki_ki_sale_price, 1))) - expect_error(ki(mki_ki_assessed, mki_ki_sale_price, na.rm = "yes")) + expect_error(ki(c(mki_ki_estimate, Inf), c(mki_ki_sale_price, 0))) + expect_error(ki(mki_ki_estimate, c(mki_ki_sale_price, 10e5))) + expect_error(ki(data.frame(mki_ki_estimate), mki_ki_sale_price)) + expect_error(ki(c(mki_ki_estimate, NaN), c(mki_ki_sale_price, 1))) + expect_error(ki(c(mki_ki_estimate, "2"), c(mki_ki_sale_price, 1))) + expect_error(ki(mki_ki_estimate, mki_ki_sale_price, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { expect_equal( - ki(c(mki_ki_assessed, NA), c(mki_ki_sale_price, 10e5)), + ki(c(mki_ki_estimate, NA), c(mki_ki_sale_price, 10e5)), NA_real_ ) expect_equal( - ki(c(mki_ki_assessed, NA), c(mki_ki_sale_price, 10e5), na.rm = TRUE), + ki(c(mki_ki_estimate, NA), c(mki_ki_sale_price, 10e5), na.rm = TRUE), -0.0595, tolerance = 0.003 ) diff --git a/tests/testthat/test-sale_chasing.R b/tests/testthat/test-sale_chasing.R index 7ac15ff..c094126 100644 --- a/tests/testthat/test-sale_chasing.R +++ b/tests/testthat/test-sale_chasing.R @@ -4,7 +4,7 @@ context("load testing data") data("ratios_sample") # Extract the components of the dataframe as vectors -sample_ratios <- ratios_sample$ratio +sample_ratios <- ratios_sample$estimate / ratios_sample$sale_price normal_ratios <- c(rnorm(1000, 1, 0.15)) chased_ratios <- c(rnorm(900, 1, 0.15), rep(1, 100)) From 88fec2b6f0fc4353def9c261921eff85586d8ea7 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 19:08:03 +0000 Subject: [PATCH 2/8] Update package versions to 1.0.0 --- CITATION.cff | 2 +- DESCRIPTION | 5 +++-- README.Rmd | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index d1aecba..c00fd22 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,6 +2,6 @@ message: "If you use this software, please cite it as below." authors: - family-names: "Cook County Assessor's Office" title: "AssessR" -version: 0.6.0 +version: 1.0.0 date-released: 2019-01-01 url: "https://github.com/ccao-data/assessr" diff --git a/DESCRIPTION b/DESCRIPTION index 23ad8f3..00f24ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,14 @@ Package: assessr Type: Package Title: Measure Property Assessment Performance -Version: 0.6.0 +Version: 1.0.0 Authors@R: c( person(given = "Dan", family = "Snow", email="daniel.snow@cookcountyil.gov", role=c("aut", "cre")), person(given = "William", family = "Ridgeway", email="william.ridgeway@cookcountyil.gov", role=c("ctb")), person(given = "Rob", family = "Ross", role=c("ctb")), person(given = "Nathan", family = "Dignazio", role=c("ctb")), person(given = "Damon", family = "Major", role=c("ctb")) + person(given = "Jean", family = "Cochrane", role=c("ctb")) ) Date: 2023-08-07 Description: An R package to measure the performance of property assessments @@ -37,5 +38,5 @@ Suggests: testthat, tibble, tidyr -Depends: +Depends: R (>= 3.5.0) diff --git a/README.Rmd b/README.Rmd index 2ff176b..7af8452 100644 --- a/README.Rmd +++ b/README.Rmd @@ -44,7 +44,7 @@ renv::install("ccao-data/assessr") pak::pak("ccao-data/assessr") # Append the @ symbol for a specific version -remotes::install_github("ccao-data/assessr@0.4.4") +remotes::install_github("ccao-data/assessr@1.0.0") ``` Once it is installed, you can use it just like any other package. Simply call `library(assessr)` at the beginning of your script. From 4346cb2448b0e86d855bfdb49a71843e3926ccfe Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 19:13:05 +0000 Subject: [PATCH 3/8] Update ratio study vignette to use 1.0 interface --- vignettes/example-ratio-study.Rmd | 48 +++++++++++++++---------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/vignettes/example-ratio-study.Rmd b/vignettes/example-ratio-study.Rmd index 7e2a670..4b8aeff 100644 --- a/vignettes/example-ratio-study.Rmd +++ b/vignettes/example-ratio-study.Rmd @@ -163,10 +163,10 @@ combined <- combined %>% pivot_longer( mailed_tot:board_tot, names_to = "stage", - values_to = "assessed" + values_to = "estimate" ) %>% - mutate_at(vars(sale_price, assessed), as.numeric) %>% - mutate(ratio = (assessed * 10) / sale_price) + mutate_at(vars(sale_price, estimate), as.numeric) %>% + mutate(ratio = (estimate * 10) / sale_price) ``` ### Sales ratio statistics by township @@ -177,19 +177,19 @@ Cook County has jurisdictions called townships that are important units for asse # For each town and stage, calculate COD, PRD, and PRB, and their respective # confidence intervals then arrange by town name and stage of assessment combined %>% - filter(assessed > 0) %>% + filter(estimate > 0) %>% group_by(township_name, stage) %>% summarise( n = n(), - cod = cod(ratio, na.rm = TRUE), + cod = cod(estimate, sale_price, na.rm = TRUE), cod_ci = paste( - round(cod_ci(ratio, nboot = 1000, na.rm = TRUE), 3), + round(cod_ci(estimate, sale_price, nboot = 1000, na.rm = TRUE), 3), collapse = ", " ), cod_met = cod_met(cod), - prb = prb(assessed, sale_price, na.rm = TRUE), + prb = prb(estimate, sale_price, na.rm = TRUE), prb_ci = paste( - round(prb_ci(assessed, sale_price, na.rm = TRUE), 3), + round(prb_ci(estimate, sale_price, na.rm = TRUE), 3), collapse = ", " ), prb_met = prb_met(prb) @@ -276,20 +276,20 @@ Using the ordered data, you can plot the classic [Lorenz curve](https://en.wikip ```{r} gini_data <- combined %>% - select(sale_price, assessed) %>% + select(sale_price, estimate) %>% arrange(sale_price) sale_price <- gini_data$sale_price -assessed <- gini_data$assessed +estimate <- gini_data$estimate lorenz_data_price <- data.frame( pct = c(0, cumsum(sale_price) / sum(sale_price)), cum_pct = c(0, seq_along(sale_price)) / length(sale_price) ) -lorenz_data_assessed <- data.frame( - pct = c(0, cumsum(assessed) / sum(assessed)), - cum_pct = c(0, seq_along(assessed)) / length(assessed) +lorenz_data_estimate <- data.frame( + pct = c(0, cumsum(estimate) / sum(estimate)), + cum_pct = c(0, seq_along(estimate)) / length(estimate) ) ggplot() + @@ -298,7 +298,7 @@ ggplot() + aes(x = cum_pct, y = pct), color = "blue" ) + geom_line( - data = lorenz_data_assessed, + data = lorenz_data_estimate, aes(x = cum_pct, y = pct), color = "red" ) + geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "green") + @@ -337,27 +337,27 @@ To translate these curves to a single metric, the Kakwani Index (KI) and Modifie - **Modified Kakwani Index:** `Assessed Gini / Sale Price Gini` ```{r} -# Calculate the sum of the n elements of the assessed vector -n <- length(assessed) -g_assessed <- sum(assessed * seq_len(n)) +# Calculate the sum of the n elements of the estimate vector +n <- length(estimate) +g_estimate <- sum(estimate * seq_len(n)) # Compute the Gini coefficient based on the previously calculated sum # and the increasing sum of all elements in the assessed vector -g_assessed <- 2 * g_assessed / sum(assessed) - (n + 1L) +g_estimate <- 2 * g_estimate / sum(estimate) - (n + 1L) # Normalize the Gini coefficient by dividing it by n. -gini_assessed <- g_assessed / n +gini_estimate <- g_estimate / n # Follow the same process for the sale_price vector g_sale <- sum(sale_price * seq_len(n)) g_sale <- 2 * g_sale / sum(sale_price) - (n + 1L) gini_sale <- g_sale / n -MKI <- round(gini_assessed / gini_sale, 4) -KI <- round(gini_assessed - gini_sale, 4) +MKI <- round(gini_estimate / gini_sale, 4) +KI <- round(gini_estimate - gini_sale, 4) ``` -The output for the Modified Kakwani Index is `r MKI`, and the Kakwani Index is `r KI`. According to the following table, this means that the assessments are slightly regressive. +The output for the Modified Kakwani Index is `r MKI`, and the Kakwani Index is `r KI`. According to the following table, this means that the assessments are slightly regressive. | KI Range | MKI Range | Interpretation | |:-------------------|:-------------------|:-------------------| @@ -388,8 +388,8 @@ ggplot() + ```{r} # Detect chasing for each vector tibble( - "Blue Chased?" = detect_chasing(normal_ratios), - "Red Chased?" = detect_chasing(chased_ratios) + "Blue Chased?" = is_sales_chased(normal_ratios), + "Red Chased?" = is_sales_chased(chased_ratios) ) %>% kable(format = "markdown", digits = 3) ``` From 60c0a507021686ddde53b5fec6b068fc3cb854d1 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 21:47:11 +0000 Subject: [PATCH 4/8] Get tests passing --- DESCRIPTION | 4 +- NAMESPACE | 2 +- R/ci.R | 20 +++---- R/outliers.R | 10 ++-- R/sales_chasing.R | 4 +- _pkgdown.yml | 2 +- data/quintos_sample.rda | Bin 0 -> 1287 bytes data/ratios_sample.rda | Bin 17813 -> 35068 bytes man/boot_ci.Rd | 21 +++++-- man/cod.Rd | 18 +++--- man/detect_chasing.Rd | 87 --------------------------- man/is_outlier.Rd | 16 +++-- man/is_sales_chased.Rd | 88 ++++++++++++++++++++++++++++ man/mki_ki.Rd | 12 ++-- man/prb.Rd | 14 ++--- man/prd.Rd | 14 ++--- man/quintos_sample.Rd | 29 +++++++++ man/ratios_sample.Rd | 5 +- tests/testthat/data/mki_ki_data.csv | 31 ---------- tests/testthat/test-formulas.R | 3 +- tests/testthat/test-sale_chasing.R | 28 ++++----- 21 files changed, 210 insertions(+), 198 deletions(-) create mode 100644 data/quintos_sample.rda delete mode 100644 man/detect_chasing.Rd create mode 100644 man/is_sales_chased.Rd create mode 100644 man/quintos_sample.Rd delete mode 100644 tests/testthat/data/mki_ki_data.csv diff --git a/DESCRIPTION b/DESCRIPTION index 00f24ab..253643e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,7 @@ Authors@R: c( person(given = "William", family = "Ridgeway", email="william.ridgeway@cookcountyil.gov", role=c("ctb")), person(given = "Rob", family = "Ross", role=c("ctb")), person(given = "Nathan", family = "Dignazio", role=c("ctb")), - person(given = "Damon", family = "Major", role=c("ctb")) + person(given = "Damon", family = "Major", role=c("ctb")), person(given = "Jean", family = "Cochrane", role=c("ctb")) ) Date: 2023-08-07 @@ -20,7 +20,7 @@ Encoding: UTF-8 LazyData: true Imports: stats -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Suggests: covr, devtools, diff --git a/NAMESPACE b/NAMESPACE index be398f2..96d3996 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,8 +4,8 @@ export(boot_ci) export(cod) export(cod_ci) export(cod_met) -export(detect_chasing) export(is_outlier) +export(is_sales_chased) export(ki) export(mki) export(mki_met) diff --git a/R/ci.R b/R/ci.R index 090de5f..2c63b85 100644 --- a/R/ci.R +++ b/R/ci.R @@ -23,13 +23,13 @@ #' @examples #' #' # Calculate COD confidence interval -#' boot_ci(cod, nboot = 100, ratio = ratios_sample$ratio) +#' boot_ci(cod, ratios_sample$estimate, ratios_sample$sale_price, nboot = 100) #' #' # Calculate PRD confidence interval #' boot_ci( #' prd, #' nboot = 100, -#' assessed = ratios_sample$assessed, +#' estimate = ratios_sample$estimate, #' sale_price = ratios_sample$sale_price, #' na.rm = FALSE #' ) @@ -93,9 +93,9 @@ boot_ci <- function(FUN = NULL, estimate, sale_price, nboot = 1000, alpha = 0.05 #' @examples #' #' # Calculate COD confidence interval -#' cod_ci(ratios_sample$assessed, ratios_sample$sale_price) +#' cod_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export -cod_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint +cod_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { cod_ci <- boot_ci( cod, @@ -103,7 +103,7 @@ cod_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALS sale_price = sale_price, nboot = nboot, alpha = alpha, - na.rm = na.rm, + na.rm = na.rm ) return(cod_ci) @@ -117,9 +117,9 @@ cod_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALS #' @examples #' #' # Calculate PRD confidence interval -#' prd_ci(ratios_sample$assessed, ratios_sample$sale_price) +#' prd_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export -prd_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALSE) { # nolint +prd_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { prd_ci <- boot_ci( prd, @@ -127,7 +127,7 @@ prd_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALS sale_price = sale_price, nboot = nboot, alpha = alpha, - na.rm = na.rm, + na.rm = na.rm ) return(prd_ci) @@ -141,9 +141,9 @@ prd_ci <- function(estimate, sale_price, nboot = 100, alpha = 0.05, na.rm = FALS #' @examples #' #' # Calculate PRD confidence interval -#' prb_ci(ratios_sample$assessed, ratios_sample$sale_price) +#' prb_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export -prb_ci <- function(estimate, sale_price, alpha = 0.05, na.rm = FALSE) { # nolint +prb_ci <- function(estimate, sale_price, alpha = 0.05, na.rm = FALSE) { # Input checking and error handling check_inputs(estimate, sale_price) diff --git a/R/outliers.R b/R/outliers.R index c2c8439..9cf26ee 100644 --- a/R/outliers.R +++ b/R/outliers.R @@ -37,11 +37,11 @@ is_outlier <- function(x, method = "iqr", probs = c(0.05, 0.95), mult = 3) { all(is.finite(x) | is.na(x)) # All values are finite OR are NA }) - out <- ifelse( - method == "quantile", - quantile_outlier(x, probs = probs), - iqr_outlier(x, mult = mult) - ) + if (method == "quantile") { + out <- quantile_outlier(x, probs = probs) + } else { + out <- iqr_outlier(x, mult = mult) + } # Warn about removing data from small samples, as it can severely distort # ratio study outcomes diff --git a/R/sales_chasing.R b/R/sales_chasing.R index a61da44..d7dd272 100644 --- a/R/sales_chasing.R +++ b/R/sales_chasing.R @@ -67,7 +67,7 @@ is_sales_chased <- function(x, method = "both", bounds = c(0.98, 1.02), gap = 0. all(is.finite(x) | is.na(x)) # All values are finite OR are NA is.numeric(gap) gap > 0 - gap > 1 + gap < 1 is.vector(bounds) is.numeric(bounds) bounds[2] > bounds[1] @@ -121,7 +121,7 @@ cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { #' @describeIn is_sales_chased Distribution comparison method #' for detecting sales chasing. -dist_sales_chased <- function(ratio, bounds = c(0.98, 1.02), na.rm = FALSE) { +dist_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03, na.rm = FALSE) { # Return the percentage of x within the specified range pct_in_range <- function(x, min, max) mean(x >= min & x <= max, na.rm = na.rm) diff --git a/_pkgdown.yml b/_pkgdown.yml index 07d0562..5437d9b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -58,7 +58,7 @@ reference: desc: Functions for other assessment-related tasks - contents: - boot_ci - - detect_chasing + - is_sales_chased - is_outlier - title: Data diff --git a/data/quintos_sample.rda b/data/quintos_sample.rda new file mode 100644 index 0000000000000000000000000000000000000000..6e1de34457a6e87746e9dae088c642bd729ac6a9 GIT binary patch literal 1287 zcmchXO=uHA6vrp~(QKl|#DdU7}xrf=0ehr^Chh>8_Ccn<6Bd>j`Zdzaf|C1 zAG~e}8tg7n8rMchz-?Qtf+4 zZ6-u!K2o8QU7=1}HSWWLJUmj=Dp}uhxarlaWgbN|?g!PH6+qi0nkrLw?-XN;eZnGy zufbrjxND)}d%PU=oD9oE?*Xv~VVE#g%Z}ymK2yHzIu0)fZr!xq#uPL#wRL6~2b-;= zqdI`t&cyz!iO5NcPXMnczJ*G$SUeM#`I;#6#LhAszR%%f|3fbOhl!iF8?fmw^}zh& z|A5p72uD;5J{>Wqo^niGlfw}m2_(W1?dSp6Ys$E36DLn?nL6&$ z%PtuYfpid~(2@W?q=L8b>2Og0`ymLJHO$GdG9!gy^tqi31Hrpgs2uuRJL6@ycQDL; zM#KAjpyADRqnKV+rZB8KxPf7H_Hu?1AG9-c)^;##(D^dQb}}BL!`i;{8Bd(9Fw9%( zWSIVm4sTXbhq9x9A^BHn;}(y1ssu_K+0HOCse|G0jgK?*>GIAEU5v}|ihtO_c*Ucd zo$lNm#-*LUR_<3sb|=$&r?)foZ);`PyrY9*cBBqUJd@ zP#EvKVh6+QZ`}-~zr4>@GM?7rWSG&}u0m!1!wgBssrR@Jl}>q@T~u-Ue8#J^c`1j! zR~YZ(Z)NCB+rv=CLvgl>I;iR`O|IVA$+){)vn#LO$$0&+_ZZexX}Ehr6XS)m7BWn4 z?qcYCNaM?H>tLL2aWm|x$Ayfmf<;cIOaJ@s;{~NGXA0A6^!UzvTjMJ~XFk)9(c`(~ zfeyw!y8e=gRuxx%*T)&~nl^6QPn{~AaxT{7rT=^AaVgimY{V$$8>G)u+AHHId9~W@ zASG!I!(;V0D|ur%OR1+6Mn z4(WL=;qDnsm-|rWgNCL1m|niEm7&Z(y_a<|UYPAAjz`IZ)HaUt_S&4Z)3U#>^y53P)+J*_Y-($~rTh32<> zEsl)+nmLpGrR=L|Xa3ajPKGkiMt8R|-uqA&!$>`TWFBbzR`ZiH@e=Njs#X{le$b)8 z{mU83{giWi3gdl}HM<+N@hMGg6i?qlZapt&ZENNJyn&qz zDSszZv>IYSiPpu55?Kug7urDcU&l+;lZ+ zddjbRkNIRh6W7+kxIEwbo;+N|m4h#IGQB{L6RAH&Kew~>^EdIHcIGSVeHp`Ot_VZx z;^?n1U9NNS&zl*q{Ir#!b74=0vYu(S3c zlKDu+S+6HLxj*eT6*x%h(a%F=@6S42KQ~L99n6=b=WSU>J69@9kKWqJQ07xTPL+ea zOb(KM9~!%d`BJ}eGOX3>dl{z@f8D|Kh!qM$nO|a0>ttNs15$Lm_y#}Znv&8^!n>*+Y%-!=OB%et_xXBgdEb!`QnO z?r*;4GKSJ0GESQR5zq99xK@U8KC)gb+c1jhGJkvZ^HTE5^F-PIJoA<7b-1iEGPLy| z*D2ckGWB`N^HQDza-KDlH9LKJUX<%ouKPvKTlzmWQ{$I)QQj?GY=^8@YHwc7xU8RK z-j{i->N7X@OT8ufxhU_sRn3}zGKRD>UtV&T3Y9}z{!|X=an+FW68FpdVv(Yv4hp>7 z#IStTD2DR9KS8h8^FGwZ&)U|?{qmln*OAI^&$lyO)-y3LYq)EtCg;=dPjbJ?JYKv) zVY%o>S{at>=d+9}d0*|}YUlojzy^jgo}4#d!ni!QWc?-U3;%E5bAPYBT?~`r+8N3` zE#oX@Zzt3BePi5jWZcX8Q0Cz>-Ou$}J+AyZK+`MhFIQa`>udO77Q>=R8ZPgb@_v)K zaXI(PI;d(=rHU)R>Ul8X{&wykqVFGhzv?$#VS409tzW)dcn)d%%yZJ6-0vt*0qTJ> z-ecI%+0L-)$x#d&$96Jwo~PmRel6?fs-;7@-*wq=h9$!^d&~5DQ)3C+OENE)9&$6E zte@pRm;0}J{CnIl_peKzXV1$OrptUS>+7cLZf3eZ4@LZ=lku9&g$%16ZfEG3@i;@d z|LWct$heG$l&d=#m*<^x$_~a8^nEDrr+%3ibb8X7F6PtctpxS>8L(ROht!*~wUhZ$ zMri!{y!F5oHZy;LmXFClGQFvJQ$|_L8PguglB7(fpFC*V!VXo%`keT+XMWt%K?E+?DsH$dfg? zyqDK*%waxxzDqwT{_~lhzCh>K*IC|^du!{V95_d1bC4Wg?%#&dPNvK8E4R8CPk5!1 zVcCt}GnDts^u?Dko^_=P927TNi|4^#|IWBW->>n+JGLntui_eDy!{$#)ZZ&n!NB6!)jPbUXF;syMwqlJ^UbelG}|KA-vZ zcW32yJ%7mYO7-)mWOEbq<>~90KcRzhS;xpaJLL(Dp7enR<@!l~g+($3eD}Wc`#htDWhdw>AA)OEoCp zyDF+Q+&DMndy9VWkol!$sl3C>pNEmE-D8#w%ai$55`9Jg4RRlzt9} z>L@)=XX@v^{JVhrHfO`CpDB^-DWt zJQeHvqioU)mMfgq&M>Q@i=p(hgqa+^4rQNy?#Xc~rfcgX-yP+Ck?#m)n%|XQC%3D5 zjlUZ;=Bik8D|HyvFs#d0F>v>e(!(=>oe%Aag^R4uktjmr3dFBq*GvH!{p?sH-^|U0*8I9xU^0xkKxhdA4?32lL6gQtn%6pIhJGy}g~x zC+iw{-69rfCMgXH^zy#LAko2u7=)wgu99{FycTQ`bvIdA!X zZ=C0P9V*X<c<`FCc7DD(E78MqP ztxhw88MkP(Czw?nZQS0XBj7L_ZBY?6gROw=5M~W_xJ98o!K~6=;;3+#%`oGZLCp+i z+#+C42w#O+!i-zS44dH(3;gK{%nHqT_;a?EupQ!$YcLOC#w{b*6U-{Y#VsS46@<@V zk+3J22Q}mN8tgf2b($H>xcv|oj{i*+;ag>vFyoeqTL|GxSX3MV!8~fX_)!@02vpjO zggdWr`Tu+iEE>Z#$&Nql0c-`10>ghprP*;78!QB~gc-L8SO{i`KZ;uhun^26gwJ4+ zun=s=ut-=4W))`KB5(u*vraR91S;)C%!8P5dksgx@xL*M*$OjmnV2nut%O;F9d1!* zPcW;rNZ2x1B#sKfY=#*>fvr01_wt%eyTa6Zmqe3v-X~r#sni2~$?QOK@2zv}W0dv2_ z1T#apxJ99bVAg11I0AxMryXt?!cM^4Z&6?&*h-ig%y{@3EfRkQ!EBZpw~S$CFyj^h z3&AXLv~gPlEDZL9aBa3|G%K)WIQjw>6D$O?4QAXTU?JE_m>JBtMdP1AFb`tJEn}D& z%($(9ErYE_iv|lJd=<75W(G6zIjTVC0 zhH&w)71|2eGK6cQ9e>yZhAm*Wz@p#?2(~(H87za^N|+h!@bE{lNE`vdY?VcYnZb

?+rhb>@MV8(3~S{VKeg4qf)ZW+Ut z!6IQHm{r)}whAl^_5|~o76~(h8Mg>n2(}Xc1qSnw;o_D_S_o#176uE!EMdm~3j$#e zdGu|zHOazoR0!sYnsLjZW`;i-4|_n1z!4DaCSkAAtidAj#~Ex@nujps76nH@Fzd9# z|AZkdD$HYs&tNNIJA_4pJ;7F|nZbVQ+m}RRXYzA8aTN`XOm>K>kZn5akAefE%V>;!p zx>t5B5aP>xa_hfRn>%@s5T|reiGQyU<^3q;Tp`3cJE-CKVj=FHt{m#sCd7e>}TT>x5Xlh$^b43US=K)N^wSq?a! zgWF)&aOyd}MTn${WZ4Z*dehUep|DPz28N}>>-uA;Q} zHwiKDWeObkfDqnmsBiv2)en??KKyx~gCYmOt{Xm~@~37BQAL!!VX_cgr;>B2Pl$i? zp|T5L$Et71ed!HCoLEH}`-+5Uil(fk%Xob}*LZ~ZwVQm2?+dZ)DsmhG{kydkw+wpV zmxj_FJYV1OcMI|TOlmsyb|FgUQp~%X*sk*ZQ9|6Yo9ZvEWV_=A%@g9~M(X?bB|=1x zq3kggLQF{|?{4@R{&3H@SBOC=l=8%4A#VIaIrJ3Z+oP1?dYvSOn#C2Ovn5uMpF89u;% zg&$D<7eu+okkh=4&(7Et{KgILmvD{h_eS%aqK}M#y?7)+CA*gqFLZCnX4S| zFBanAp42Z2u;(k390C29Pi|YA5Ly4E^81%Ef8?)g*zW~5IT(U-=d8oxcF%**|44CBB?L>yUk?%Dw_K_`aGwy1S5WrAkwT39nc_Zy{C#66qqddxC5)LY#G1P(VZQVh;Ag~Bc}5(^clmF?v3}VXw)41o!`g(HSx3DiwE3p5hCkr{+*{Oc2f4OX@IH1Q zk9h=dQFfjQ{&#Dsp%(L5TTeY}HwiJWg9dJxD@5$GR5S zA30gzyY~r7{2p@Uw^PsMfbYkUHy!bSyj%SS{DgCFaP$SpGj0kTn#X>r{H~Put*7H> z=uM*3fr9r*yKXg-U|hU7C|IJTYVIpDF6h4{9LqAtMv9!)22!Dm8zkxNBy1`x+j zQ_n`w*WO2-GoNFA{{=0aw;Ojr4(ri#X}1vhA5qRg*o%FV^ie&JA9Gq8$AvR;JI|wZ z+lxZD;O7?*zhki8L)Y`UJD?Z;j3DJL35ehu3zXltVm##4`kjyQ`u1+YdHwW$%AXJY zSf`u;+Bx9g`5}*6-5d5C*h^(2RtRz0tyFTx#XP^Lh0rs*k(%!qErJL4P}OqyXWKR8 z>U}@YBdu(<5O)rzigRG^aaYmc12ffgL)qh1yB(A`bfgfw-=qr9okFxeNQsN*GreNq z7Oq1an<0n%UU4tx)#q69{sQ|DSLN4Z-9Jg9lB-6D;Jo}@QeU8e|SjUZ{)rZ^V;zpIolTS`eyZe5&7y> z%KJjIr(_EJg!s&VJzE6F|3+EoP2h7satQ37`5EO;gq_Hf{d+Yc56&TnZ<7$u{FCZ7 zjb^%Y?+8YC6R~xlD-k^;D7)fFBf!UN%yQ^G~F@`rY8WoMK;t z+{G~z{W#>1?@E4z-cv8=oI{OIz+Z@i^c>jr*+d$A>Q#uhMO5|#^nP1O5&hjfUhfwWZztbC%BW`; zFaHt#d-pMF+KK(D)@vV}h59ptT-#vhl;iS+@jnyN^;%h5Y47)Gtr_HM^nrJR!ut zU!aU;&CZOe8(2@_`P~BlQR01@P=|a<`PYp>9rhME&+7-j-cA_{I3ARPQwE_P{DhKc z){Ec=kyLyjj{TT37WN}AmVOq+{>^LJ%lRm}6Z)=kQqOZChkWLVuTb;1vVVUI>UJNM z&w}5+SVxWL!fw z?79UUzd1i|NDt zkHPM#l$n;y`!n^C7lnB7CX&B~*ZW+^tLMuG$iK9L@?Po&zLSc7*&@V}mx+GbCB*7P z%6Cua{8#JZ17C~ZgmY2PC&|NK0cQr^LOKL07j zsONe1JIaBMt$dHFS%LMr*`w^9-OBSV;$L-)pomLB$GxX2a6Z#ho`e1+=Tq{=WkQ^B zJC#11EyT2osPM)$ye}HspW^xE^w`dRNO2A0@gqI;97ieDz`uTnGENx7aZ~Wb8qV7} z$HO!OoRO0`;^}YcBpnJzpD9rMPG_T)f zB2Ka1dATogysGyvbv^2?u0g%~sIq%B>hpWbC8IB`IXcsSBnGJ&O1@(w^84BdI@pu@yebxTSf4b1d4ur8LwYa8t$Lf z1F26c^n9L0Rf86=eGNwaRl%c#n-rP=xjq+;{MjpP6(zY+-IzMj?`oUK<7IHVvCSNba?QO4-ecean~kf^KYvA+D2h1xteydcD1-lXz1=!gG3*A8O4hYo&?@6)+&4&(b; z>JrQk_ulHye-ikQ3QolMIGHTJ>i%>x=QHQ0TRBdAm$-!Z`vl6F3U1UZeV#rG^`(c> zD}nF2n<6R(;kT*NQ$#<_Sl`ESJd2j3;%&3AL0=jX#O z??zDb!)@4a$d6yD`tG8#63id>$fl7e@pwHZtP$dv-jsqcRP$)rSy)HhOLKQFYotG-a({Gb|DD+_ed0cBz z-#961RXyL6s{eAH5I28A^~ZJdJ+-cV8_wTb$o~i&f_+#y9R9%h`B@Renmb!KjuP}=E3H0&an$$wFZ`rjyF|46P|qQ1iT*f-6y;1|?M?u{#vmp-9%KkVr&pwdD0$fI}% z+q@X}^+fXAjk*u_y43t-SjVxHF%^31hEYl{*!9pj%D5H~`_xgl`3la5=_!yy{T1C=&-=)C1N3A4_&w*lcB=SW4ddmjwg{2( zZ{z(gm0%z2NuOUN#QdR@^>jC%Q)(Te%2$0DC4x(OkaH3C$0=K>$0IGs!@a2b`6#Z# z^G{lU@iQo94(!8zI;iHW?r*7bUA7QiMdZ2-{XJT#WXX%1hs!UYtL4>wZESBu)-vSz zTFUtab|7Ax;~~Eg@%$Fn6X$ek{41R2eFM(qeUo-9^qjYZ@=k%BxTj_Ru$A={JlTTy zOjdTyM7$v%1kPB;{?4s{ew-5l7wmsx61f&FX8y8k;Gane6fs0_9629D9G-A8-ft$e zo$33FI3BX*e9HTw=j3F>a|Zc88I67VrLuD$^qjn%SnDJ5y+Zp&^7sHyJ z!$k1V!_+$&_pIIXm7jMF5~8h~N`}J^OW&g2No_*R`4<&0oyzZUj=dNk^YYvZdvFi$ zqrOMro>g>J8{Rixq8@!=7vi=e{bKZwq1wBaU>~`ur0yx?xp|cK6zs%)$e%if@2|z3 zz_Bli+yOqfDt<@&Ab28As>E7uGheicSY*=9H0O3 zo3`?PEL#`H=e~39c|u&)i(KOt2=V$tO1*gv&V?c5>bn;4`#L2d&8zt-r4jlb?nTWB zeDR}(jx#tv^j*7Ah+$KegWnX1;HTrL^yQIESMPP|J+0{LK_d9fdMf-K^Y9&_{0p-& z-uYBginz!7bMXX>-+n#C&+JA%xtNmDTj1x1s1WZJ>U%^E&K>nVId>oI!~1vYO*y9aR8EdL(%z4MfDPE;L$o?%mo-#KEU@ou>Z41(mZy65b{xVQ(Fo>sy4>>e4gx7bJC zifuwfTum8SdvPz@LG{JS90#svv3~GFX{MI9`p(6?zdVLqMOytav^0b5a4kmtoIIY~ z6X&tNDl&>Nztff9mIJ=Jj&dGdEP`LYroAWOU9og5{Dys*a!CunqpNWx5_^&VL!7te ztEi!22***%%0X)WC7-V!)-i|t^e-My{;GTF6Ekri97OuB3M;|!;Ge&U27Eae^SYUO zzhBSqK4r;UIL=C6UB>Yk`SW7V+fjFJMLpyuN6$5!ZxZ_{tl#r&F7m-}%32P)@UB|E z>@j|qFUuT_`%5{w`sDLIPZ)=ONN@DqwaF5c@OI!xu}izWo2BH5I^*z;^ez{{65+6JKp`py3AyoIAjG-6p=D zsr#!u2J*<~N!P-zp5rN_1$>B~vS!$YeOsCdKcc?N%5P#j3LZp!;Qmv2Gw6T6kV>kO zh1hsVIh5MP{VAQW^Uhz%v#62l#@x$+;~Yv}1^pN=D|47yZz?-eTZG6cq>998ESL08 z^rOy>y#?daL@Mcqe{sJ&aDN-(|8^>VSj$HhD?enrYLpt}{~IXgIgEee$42~nCk}v~ zbmL$9OliXWk!P~^L+^2$sP+cfkNL!0*o}RU(_>=V^ODJUqtyQ^Ep`9u!-%? z_#Seo=LYmI6~TWMlPfim^NVLR@+AIV)pIH0diB@F{JifWKJflmRazl}A4E~Y+n4eD z(oqKm*YBcIwGO|bnhG9xNuy6M!u=0_Pf+hs@OQziKe1Us<szM;Kw_5SsLv7$LCb@{%#Tcu8cC@ z-mc~ObMEE(+I2B-%-^m5s(bmedfq3!MkMq47k5CP?>v!{h z$a!P|uebNw2jJfxh~?)@4hLdey?C0 zytAdfGF|njalYkjf?sg1lw9ZIcdLfGiSOApOSE^B;uGN?_%qo#Sp@ekptxw*eeMc! z|Fwk2E&V6##eJ=K$ftM*_@2ry8pipl{HA$qPi;5ymFoW$xCb2=M$T(j2yxGeP*_rdK{GX;4D z@5AZCb})a_)1V{nQr_=IoZBZUlyu$CjO4-atz{g zqHp4}++TbQ*5l4Slyycn>&snL#B~2%*tfVp`t^TZrD=9D$6sE-NHss2{%P`^k4o%iumr%k+c+_do~RXwImp58~Q z>jia@?f4%dey=k#P8!!|+PE?PNSEgA$JL(oQ`wW47}hx(ZK zFxoP-7tlUI`y5UEH`TsIJAgMw6zCB>&=Sykqv7A(ig2U#LmPlL7!8Me#PMh+qd{-P zM6}D%u1A}Nc01Y{wDoA8p>0Lmj)tI$EJCY5^P&0Cpf_?f+8DH}(Ef^cE7}8S528Jb z23?WwqkW0?6l<5&2AgAH zbL<2($j8Fxv3H=YLfe4$5!%OS+t6TJ>@KuDXonmQnC6Isjd6&PxH2@@6*mrTI@&z6 zJJDcA+;eCzp{+)H9SyM-w;wHthP8`_qWEOA6tq0F0yHNY;y1n#tr_hvXlKGNk=lCm zUR$Z}tVmD5_-dA4-bVT5Ym#3L4aS$z>o;Tr2Cdnz^F?{w9^=y&qWZlC)sTwvG#R{J zj~pq=>yg9bQ(710HO!0hHoB!UuRkQ_m)1mi{l>uFrVvAu!QgWnRG%kAHM|n#^BVU0 zydhp+h-&yK%GW3z66Nz76Y}{D(|t`Lu_j|~4IxK0G#DBh8Vz$A0zNs-hJc~0p((^0 z@_J)~!Q0qq*wE+?Q9~|i41^e(jnNvLjUoI#L(Jb`nC@>3QA2a{2aL7wHyIiNZi6@A zHAV}B^agx}Qv)G;10j0@MwCT0xeXhdJchC+uQ6~_XoZ@*hJTxUA%=#KSjbUL4MvnS zg%+Tx!I(u;XvR%}klxU0HZ_OzHX9Ra3VE{GW0>9?@8xwTH{rJWoz_fEY+T$_y1-`v5ayis*xgPj7 z)=~Wq&E0Fn80bcxP`?k;*&Ld$*I3wSkIyZ44!(_Kp?-(>eZIqZj9dsFUuZ7A#*nXk zMg{}VVfHi}w(bo^&_;V2jGcq;!+hS*9J0UB$THEM#>4b98c7y(V=LkNFdsG^7Biuw z5$*9C8xr5%&|Lh7&C72DHh2Odd;G@kiAI=&)+lh8e*%ZaRlwMe;6E(J0*Co3U~EqC zG=<_eU?e2an?rsM7BvjVRLUj%+6*bKY~9H zit}dU=mR|z|6aGpu;1%8(pEIS4Ox5}{`9(ytO1_TxcD}F>vabX|2|AMUWBK~Z85qbFZFaT;(GE@~kXgW}~sivHMX f=U&os{sr=!1Ezl_oIh^bxIPz5!9_t6cLe_*LC*ug literal 17813 zcmV)SK(fC=T4*^jL0KkKSr~2;t^hMTfB*mg|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr1K-t|xb6X#xS!~g&Q3TfK=cWfFOX^HVh+gKh>=nU+4Yi!QWb~2q{bq-_ic0vfz9G0f?aql+6HQX*Pz8gvpZ=Bhoa&WWpGkGGLluiRp=^OaLZHu`rn$X_G+2 zF#}8{CIBWAA%Gy$BNGJ4fiz6frlAoMVhsVIsfp@iKqdsqk&{X4pQ?T-u$oL7WHi$P zY?_{cOwgEUMl}o#0-h13BNJ0h#A=>sYM+SFf@mj{(LWWpa6P>H0PO*CZD zkeflE8Y9z6p1`TRYH6mMDS@QGOcN#=nrV|$WYTPz15Bf6ZAyC}7^&ftMw&7y;Ax_s z(KR=Up3-8Trp*FogGz5nJ*l-c!k#EqQ~U{m08KQ=&?6%zrU|AdnqmaWwN0tzJwwVg z+L@{4GyK8L0ISNCuvxN2K(RNDP}(6HNi?XwZp- z2qu$68hQa5O^6irKSe!HC}T;oo=s09DW0aL$jPbXdZW`Or;2(uniTe=@}8%KHcZlw zArI0=qb3r045x~DO^Q4xsiCOJ`lC&$>56z$#3!RBN$ProH6%m<4H+5$1i(xw>8GgE z6HI_K%55^907C+4ri~gVWXRBHG#N&kc{CbjHbP`z0%m~|!95xQgiM$;)X2os8br=y z@86^}w?+S)ceK=Ll|!(rn(D|kCa>BtLJjzeB;0vAtvjOLv9lxcq7XHHG3veWqF`Vm z8xw7`R($TLQ3QblXauYkP{`z zGSjFlQ2`KX35Suk4I?i<=t*5G$u<#cu-v4G`R@73c9XOLoQWF91 zs33)z%9DZKr%pq2#%F9nE(ui*IkQG1N%hX`B?9v^B_;IA85lSVMCL2EDnw})+rS7R zGU~ceI)_cxo+5=WiKIKtI%&a4XGxqpqZbH3SWCKfh*c8)=!nC>0YD44lLM%A-0-?J zoq|9bETwHKiWriL%srxs(JqVBUqOWEnLvwKP~8XLSy4oXDa3BPcjHK1^^HUjuAKk~ z0rhYp@B}s8FkdTZh_jMJxX?vXMI9w0cDT*bOAG}t6hao=Sm_?D*5ONCo3FbK2kRQt z28~xq1S^SAJo;&gjC<8cGzC=BalurS8-2?&T!a@D%BK@ZES_CdAtotiv#p)_91D1BtT8(pIH4FsTXEJI9 zSA#G}06-8)p35q?bsmnIwW8M(=bxp$Kw9cU){k61%uOoYuX!&gnErp)Z|>G_exIxF z|Fsvg+lc8T+Iu0i_^|*8|KvcQZXJ0ST}!nh{l4=)EOtUl%+qf+LWcP@{b3aWdv{uK zT{BqqWl_rC6#)PMwhs5ihjLoYCzJO5;IjPZSG{~xzYmn;ba~jw&cmhg&%)1Ex$2;m9DH_<+&!IGkMb0s4xyXi$u3@;= zBuiQ}N#aWvkvWFNyp4}*jgDiMW-fYK3=TsV8(!!M1sKtDNX4){&qEVq9%S@GVgr$+ zZh5d+;6|F-);;FrYXugRu@q?0oQR5A6Vj1SBD$2tok^LJ)ueLJ%Nm zLJ$BjKm!e0Q2tW*C5F{WNga9Bwfe2uM zAP|s-Fa!()0EB=5U~c$jY2*1*yvuVZPv$lMJykTiiNlSmV7HVLGfUzJA6SBR-fNW~8F zYQA~sZ6}pyyL^&Ueps4Jw`ZcU(oz7ex5+7{hJ>aQgfGx*{yChHYI1D$*H=MsfjRej}z^O^orQJ5m5i9&4P*w$rcm*Jk9oc0q=?zcMD4>^a@f&9|@$C!QyoC z#F%;S!pQmAUA8e`uN(6n{>JzmMu_sHW3R(L%e%czfevk%hl9 zHkjzLUCfs#ZjKPEX*QEe+Y0`V)ufKVu;Dt2HhxQ@$LFe(ZMOA4KZ8qCI`}vVDh>$( zH1LM#pf+Bu^~z$Kgkj>AL|Qm&Zk|Fxn~CG@8(eG1Itjc%@P-TJqkNQmvHch#Ko5e2 zW*EW=hy55WDi6~c7HWNi$u_RoR`@q(#6g%*FOCdZ7+?|Zz<{4qlqHOCL$QP)PU++T z9J-^!?d9a8q!gM&@dP802m1secbMQ}0D~R-a^rSw3hA07SQII3gLq3{NT;9eyv>Y`_;fTV`COJ#YMg8(n-|nI=o(Ma7(JfXhEpe{ z$;HH1qVuYhtRGw5$<5Y6(3^7un2oN{Z7y?X z7xEQsn#^LMS05%qFb4!LJIT(;){lVr>Sanb*zuQysVndD6iS0v{a;0g=daniKTwk9 zEgw9s9tYX);-6VTJ;$31gvCN#bGzHtMNBZF0}`fS;0CHz8V+3A&2-yFZwlKZPxo2t zvP|kHSu=pOgL2V3DD7^K8%_hgDVy4mR(81u{5Un94x+2{PD4-3UO5 zG>)K`76q&5d*#A+xOkz^^Q!4uJW8x@HJfVA5NpjsJmqz*=UJLVTL8t~y3@{qse^$# z9%CWLQ=RT7LuNCRR8wYd>Eln{yknx4_vXIIydm=Zw6gJRe$FUeTr9qtr$26%AE(vh{a)sFyk5t^z~sLi zwHNi8aWAh~8ZxYF_2FYndx`e(ni|TZRBJGh>qfl(*26_Idei+23@3mVtaL{3N7Jf? z@g>@|WcpPzQXYV|3kmMSO1e;!@+~p&(nIn^#tV95PW)Azw>j@QxS>=XP`u$got_s% zXO1IF4dw*01n1zkG5hY_b}v=r;4w6bbd?aAI&cY*-3wMts1K1A?n4~AJ2L5Z9Hk+yG(2SiI;pk=+ph*{fPPeUaI3`r2A=p zi6{Oou&@UldE(nzqU(QzwFAqU(f_`Rl3&zM$2!3(XJxd?#3iQSVRAfurb>ZKgsHci zulKkyv=@bV;AEah1KPvtsj3Fym8jDfg@FQsVB zHFP!etk-)9VQOANOA2jGN&7!+CG-x^Dqn*{xbaNz-)uiOxQ|C^L8V>2h3U{;cK~c9 z+Fawe#=^Iq2&fB%7k)ME+#&AkBJYWwSwS!2NLs9?8Efq4Uw@IW?6*_%BB&LMHKdjo zIg(Pb8+c1&nOX+9-n&0E-*E2-ZfgPn zR|q#9=|DEZ>971wUye@ub8cSATMh8Me{wA%e%}w1IM-5k<>Gfi2hnGKafXvy3llan zNn5ksyps0&IJRL{^RZBc@XoTFymJ2ZYX#Juwujf37&lkW@RH{SvDYqpCG1aXG(87* z2sIuQ>f^-RB$u`5#I4pX4A-&S1{|-v+vz|?Fr)Ht*c4L)o-i&kWDggEi4n_q(gc1| z1aLQxDgodQ8+kdxm?hk~Paxng-&15b0TrR4WPJ=jV*)&YWor$U%)g9A*g4{c%ITg0 z5Vk5kV#}J0mF2@{E1`-}#C%qEaQZLyUp}@ShD{6}_atscAMU(QXrylrOjR*23+;_MR^TnaVQZ?fSe%OF(<;a z5EmI9Y41Ql24C1%GICLi9xSf07axAR(IJdQ2-022mu1JIzO7%Hh`z- zEyXTv8c?mI*1gM*?~2%p!0S--w(2}W$=IQwbSf-zN~(BnLy(eG34lsQa>q+N$tnc_ zDrypPN@#|GPh^ROGAK_*X_z%mxC_nyCBE|LJRq}HubNM#zHJ4`i^?3kgs3M1{0wOH zJgh!+bwaM>Q}FwjIx1>E27y$^in=yZVS-Wn^W$|?FPHG!AHbY>%EOVE|2wS!k?|7$OPC{Y~S9u zej7~;pb-r>(4q`LfdyL9vRoa)45m3u*&9TO5Ey3?EQtKe?!ytfDd1F5VMGIz`{bC~ z)(13v{P&`24(xVfso{u2Q`(gfs>D@WO=_S5q@s$Flu2w_(%Elt2sr4hHd25&A`!q2 zj#0ufN@?5$l1PwpVz>+?Krkwl7-)LsbaHi7GhI%2CxN%*f5mGigjjHeLjq zI|c$@H*fsEEEMZCw2v~c%$NTfu~_u6wkYHyTlNl0o~jG$Sl2*_C?BE@WbkzHKgg4u|d`|w5Qh$ug=a8x7Ths`6u!5}gI z=V`j43N&UElMcZQYK5mzCqM<>WjYVN|FH%DdgZo|*>MU`pe&~hg8ePXhCmBrd2~4i zal`;9XsY45=vk_s4$q=l5u~siFj!$i;~6SEd8H`9 zia^vNFcnNPqT0X&EXP|@#1GoazP8+q@oYrE9bxpX>%ov1oqs$+w!SX_5Ki+kd+~kS zs$&^!(pdf2+V$zGYJbcGGK;2^!$dycMXF*?x5`Z}`u}w}KikuB^ZR-K^fu!ppE%Gn zo-9L1e;oVM4ys-VEaiI#j^Tx^B!aW@zvrnZNgaLH>D{>58|&{7oF+QB#dKpaD;A;ajGn|I>elIPbr=P`vlJ+ZvH**>X>wsFtifwdH2EI4>Qp^`BXG^UWYs80*R`U%E^feen;Hf~Ej25!EVNVd zyj!WZv?hl87fTNH4O=l2F2Q*9H^7_5i#*jniFU6&8&zAK?nDSbg~6`nhlUbqsc@|d zE)}{5Mf-z?Sog%_GQ{STS&2IxW&~{?d#a}?uhrT?z)(l~ z-A(bO!_IHL4}1GGnC}*t?f-;a%Y8qLPdr;C zc=;_dQhMZp_mUc#iuuVzt#+r(-fDm*sdZ{QjxYsJ6!UemlGUgCP&{vQ%taZ+$he%p z7PkqejgKNp=-IC7KT1+V9l64E`;sG`TK(*7-ZtNhN8;$~W9_aVSq-#IN|RG+-@4Y# zq3S4YPn6v2lrNsKtuOw}R~L5rQfIb!l)h4?I5$01PN@WZeC5KmeyrZtBN~#F&n0@j zbMS80pmkbr*HgZ^+E~!mZ(9L($@G&=W|x5k+s3aeCd!IDhEW#vPnX)SIfKG)Q#(;j z6A>S_ae@tEW6GA@fAK~1oOqZ0sv0+jdX=+u&De$IoZRKkvdux~FiKcL{S>OOmiW8~ zhTm@vfoe`C$3ow_g4#yPs&l@#Jzw5q55sKkO+vV(;~ziGsYj{ty`H*bS#X^8IMy5( z{L0Dq0PWgS!pg(4y+UjEC~5!8{q^$E(~u+@m9F!+M|(&{i_+7&zkL(*%S9?%uUiMM z2oEhw%V-yOx$U_<)iEddm3&1#9p~PKa%8zlD5o^`)QlVIex%=GNxnOE4p7YL^6$EO zj*`WDZQDT=(!Y0<@HWpiHfoUlFr+D>_NtA$Jbn$^N^5-z6+{p8o%r0Vwj@~J-Fu@# z~z1s znr!ox_?>3QTj=X&^nbed$Vxo!-_~HEdzm!+{@rq7JEEmP`4~Xp71d>$VUcBaJ^SfU z&Q6g^7lR{oZIQd_5#te^K#+<1yK4ROJ6_(aL&w}D^O5;*F1Y)++;|T+d}9;wcsf0C zKm%$<(vf-Gc-Mn=r9ov@VV5S{hBsy|%S$hhNb{{v4bzTNT}U)_$ZFjRu}5|?5SxMW z%rU38Vkj+};tn@If_dh6y{46F{pgVI<8=m%+Fd5(W_*?k8~8u8CGh-~5`52}dXoQT zPA*!Brap1{rh?!ls0P zA{8t^2w;mOo#xlRZxBPXzVl20!(t(lrJmWc_QfHTdrUdzSGVXOVY|Y@T&mQn<&j?O%G6%Wt3$nhGRo<5vC%Br4B)f6IszTO zHWAd+LSLZDhHkUS#A-AYQrzET^9z(3{at6S>E>Cjf;h$MRhRO z<}e36!$P=@uvl|iK3vQcyo6_c%P)2LFKhvK0(&I+vI_tAPL<6xZe2@wK$#Z5Z&KQlo?5m0fp z5oZHKC{hOFzx)`XivQ|c?Nc9Fo87!&pvsBk`b$)+1h9N{u3t7Pp7)gE6%R7;wZu&C zc)r$Yos|;~z+WJiv;sbRib7f^Pc(?v40*FU+9TPV1#D`M62M~*f1?3d%j8-@cVg%| zXMii_5J@i_YOLIz%&0sj*{aIW(kn1^Ec^zSeVgSVS8e>=wm8)!gs^=55U1Tl5bF0YrB|1A`SNxv41wiArnadP$OTx6A-t+{6Dr#Rh?f@R5=zi#`4$@4m$ zT_aZ_`YIe<`nG1e4(=~pykt(_-0Wo65!^!BkA6m{StV_yg>D_27Yg)VbQBjoah?AQ zlysh)Q=BKq8^OKasx3#2zg$Xfu>23`xNnt5koJvbjZz6$=V;ex>?NR^p@D#X|o2_;1{_?>YqZhsE3Ke#NbK z|3H<0LZlUV*n3FUwPC5qE=X10K>%HTTk*Q$Kn_dKiRjV+q9d6Q*N;UpZ@F{1$dg&5 zAW@tEorO2p`gG#mtyXN5#g>nw$J|Rg){Q@P~C(3-TR@T{fa+QARJj%=aBK&huD{4%*#h z!BQ>`#{gjuDotccd}a3~MsVbR&brM!_&9}>^h2N4@-wx-(b`}pdD9LqTik_d9U$Js zT3cWI{{0VVt(${aWsdVJiM1*2l_EBSJ2hg-_^?#)_nezH*UUR&uoC8!KaTaO2LhfL zuaf<&lf$tMvY)j)`BtMTNsDx4FGMrHpC=nhy*@&~jzRrekJ7_OXxGxbOgh3l=SXu1dwAz!0DvF}B6{WTx_b?0YDE{E&tbgLza&Ep#R8O*%Nac^ z1&Upy5K5nEb@0`mhRE7G2FBVN z92*70`d@NfPZLId__4nynaJEwBsKgkh~z@8l>(pp>`2J-lmU}ec~~X`bNl8%1@i;UiTSN zy2z=vC8cB0*h<`%Q9li$rWZW|a2;bXH4dKta?(2hDr8(+`3IXpF$Q*?or@OFI4H$ZZ4jeu`>%B;v z^C!Bb=o@mo7zhE?$JpUFM{n$VxSA}b{V&rQYKuq+?wKTtiYs#LJdxOd9ZIDlr0(14 zbf}*Xi0ecO6gGVk_>=u{%vgS#$A+9K>O|7Q*`No>8=^zTCx6gM=dTz%eYb;y-T3pK86o$F|P^PKpoo^jJUdVe~FEyuydb*lTfgiY#WoDTop zBgcel*+roH#wg_6+eQ^p~(m7?TH}lQ%gaQUgfE=9kr<-{v@!bXa z=^5<0<(O6>nPYeIvcJ@(X$PWK6bs17=xX33=}~Kus`|3Abf25GgKK*{PHd)Dn(I;9 zsPYePB{@r-T#a>XUg>-QRGc^a9Y1?eWbK?T%WnWqL&3tA@$DWN&Pv!e(5)Dm_dU8` zG#Tf2X<&V&$2I-`1vslV_y#?_9)(-pXRx9oN|Njjp3OM-BJR;yyHxvoG=oWLzw^Mj zUSB(kHqX})BjAU!dEuDsXOj}@Z7yz3L`TjL-fz7^Cz)YFBKf+S(6uPpV0I~=JIVyfM+dU-#0pDaMylX z+Vol-McvKEo@>Z&PzDX-4%#e!TrR~-2zw9+1OgS4)vc*u^sTluZlXz?DP6+=;rfqh ztE{6pGj>s{QzDfHrZB(P^b`VL%N41z82w!LvpcxZp5`a41kU~oB}bXNaUzXY%ZR!K zSi2?i(abAmu4D~;N0cUeGJoCk5vdA;ijroX`>Ojbb&{pjAyA}po@bV*Ifcm# zw*vK({idHAB)qK4n~Wzyj0Q0G%)1zUdeKjoGb`nA&9>WhYF@|In{BtMwPXDb0V`gY zs?_?HFO6mC>$y(1#QXmJoFk7C<*7ntZ)gFgnPv0Sn8(d<`CV-%2G)(Te)S9l!=HHm zQ-3+i-E|lk9%<=Ao~bO$^*(MP_Q%=bXyCI_KgR$#_yJpS&-hQ((jG@~Da^!)Rx z;v;~H_+;px>AQ~tN~NrG^=_Xk`KEYj*P;P53(?RV(52nnKzkA0tXS5!y4o7ZMpp!v zVgw-wLJ_O&UP>y54Zg;0&hzx+x8KOa!);tc5G!j;5HLiE`5s03#-QrUy~fz?^Iz3ycgc!QzW;oB8tf2o(YZ^68x`(3I~dP+Uoa3(s^$Z0jb zs@IW8Wa-70NC6PH5elg&bQ>U1?x4Gx@#cQD<)jZkIFLqce6`Fv_7HBuW5>0VxHqc0 zDH*&-Yl5Y--KLIWMYBajBmw~dgmHMV$wx2=fEuwr89trFPNSTBQlj`MIvqo3!4$ zQhclqun7MFe{s;iuATMhlC~{q!%_!n$=#&lOzqc?Gj}rKLV^}jA^eE9eIyss93T*c zAqYzzUUK4a;xn}&2+!3B05_~^AZAI03us{>uqUy-j)&Z#=zyMohx>dMOb~u&4HHc zi`82jZyh;++)>Wnw1W^KKdXJ>5zZTE91sWu0u#}#u5jKpvsvscjjMo%`LU)PAG&|F zx7g*gnvk;4tX;{EqQ_Z7>;2UU)Q)}B_Us^PH{~XqO zWuL`tXS#_87o0f4LSbfiNhi9EJU(Hmqq@(76Z*o|)9e087KQNP3HUMYIwkTYt6;#Rb{f}EkBMrgJ}zFa)Ll_CAT)UqCZM*#g1UX=b#d8 zZTUA_K4adlpqQ5m(|wAIo;zw|#35+(BfNFo>4$A$A`ul}TY(-fe7wRwFUFUE>1Cco zC@SmQ`4`GX!U9Zy41n`f!bT4ezdJm~?pIQwNP{XR=hrvT?ybb^vW8p7$@xOlkmU!O zro`_&rIbtR z|A`Js$QdLOn|YT!83~JU#TZT>3l!*)(TEW`&psXpq)GMIy$BA@8@)(Afl#4rHcUXj zm8c(wFO-_#e2^G++Y}InXsdy$EjkFd`xv_4Z{Gfy7ca?!s*1nZ+u2CRabTG0O9Cc@ zC0d1$ZuduXODBS3C8~-d8@j3G+D6ygZNoqK^P-HRV#2j1>!$bL<8P2LnT+jvG8d4@ zcQ9?z1QoK%56~lHklgpA?vvt8?>igi4PSF-GY=n%K!5F?MgMoHY{~*ciGLFe0UV1s zvmYJOxWwXpkSCJ4{Z4Aa+yK{!ujLVtx&U86BW`~swl*Lz6Yasx9y zs@-G#RO>Pg{>xv?>0P!tpm3%{Va+wQ+td!6;=?J>Em^8{Ad(0Pj)KG<`lRNpxiIj> z+l{w!m)F6vAiH$0-3INMM&Mn*aW7x1lx{vu{$R>Ej{IVg@H-yQz3Z)u2CLJD&SIsOt9AP68- zx~t2@&e`>DQ0B&nedFiXa%_(3_3?43HsFL{oW0hlKhyHQ61Gz_?|S5z36n}6um72RsDdrT>aC?KDsEWGn}$WP8X0ilnBw)WKA)j0ET}|}(+C?+x?k3EAXWwvn!93a1oy89&LrRG~ zw$t*%?tZ3BmF)THYBdHvz2NQj^rf(75(d0BZ0xmK=;*a`2u}nP`$eBJH1OP^<7cpV zNDla6SYm!N`{O}z2bk0Gsn0_(D-y^*mA**H=OF5Dh$>{$H~DcDrSQvtb9{%VK^=Sfa;m9IMsrQ$ej& zZWDw87N>!h*}ld47o*pnvE({)(&Wecpvw%W$>a?bP$?CsA;rBFy;&I&@;8Eq*X#hl z%oMqosQbC4>EKSWVU)&cq4*fBRX-*En%Qp!#Mq{p(HDL#q}pgWp=Jk}0LI2**gPSm zT_wLaRlB%1@Gi&77UG?2S%7EtefA*JX1+QNlmiM%E>-L6gV03hdN|KKokb~?7U(8i zYou@L@|vhrHyQWSv5YRzRffrhmMz2F6lc!ub-(Lmvx;&YD7yE3<`;MfDe0{#-JBYX zF4V@xv@TH?;~dN;c#f($I~IE!aNqr`E6`DI861qo_iG7H1_MAs%?#cmP9{Cd*mCj} zPw1sQdu>1oybK@=KeOBN?lbffzZRT*IYw;y>nCS9X?zIqpmTIrZ-@-n9|@3LY6SCU zQyvUJ?tm)AdcKo8&+sFkh#)4$^fi5|7rwWwSs0ASB_%|mgZu55(_+J=r3USy_X>#J z4fVIdUU!!!5r7?A`)SIUe(ZfZa#&mW^GWM2e@h9+*BfUt;a=EaaK6LOS$4Zn#-2D~ zS5J!{zDk?Z!?Nwp=@jror);-2Q_?Xj+XnnGeA059JdJ0YF=W37?gp7T9PEog^7B@b zbKh=YxAA0n3bm`*BJ}%yec+SH%4oo@??Wl$75SCqQ*Zp$_;S%Sj? zP{jiU{r242^?brwB>ln8b7kEs4L&Ct8j`Kh=NK-qNh6TF#>!?3+SP86%(PX{nq5En z_<+5`2!HmS@Pmujp{iQ{o@;aur(&?2(yC5!CE59eIH@4=*>-b2&LRMO66P-D6-r@y z3=fqqF+l*H<6TNgHRFDsira*Ak~wlYDMJzylY!mF#2Js+msWhoE{+w#l8S=zN7mQq zphSF%ln0N!;?~_NMfuU0P+}CqJK$I;@}8ks6|=ucTg*mVGqu~(Yq>{d6cQ9f28 z-Fif27h0gRbQ)FjS`VrL<+20ic+_1E@=zpG6GV1kk8cZ;DcE4n&kVMONUZ(##Yy@e+;uPxGb1>_D3oIPCLgxcJ zGJC;5uBo4K1uuTrTUz=WtT(&bj%8lXQx!Q+st#W~Xa5|z*H3zk%J`v9J-ctlQ9_}I zCFLL4H*!kKt-=`oy~lXgjGq$%f+gEGBSd4sxD_B#F7>SG+{Q~pCnZ@4w=RcNMp~Iv zx5qQhvH&*OaIrhu@YK<8s>ttD1w;nH(f`U6>bN(rqu%GGSWKjfYmRNAb|rwKdVV$N zGFUF{e>M}gpL)hesb2hOW5?BItyhNwfU+fIN`+?)skn#}nW4xzWzvfIsj3-K+aW`? z^$|*i%i7t+iOvuBe|GwGrjqlCaEv@ae7;|3H9JkpwPp&0VtdW9;t=)AO+?8yI}$03 z#2_Su>jbxL2Hfrn(r(Y;Z9^lxl8A@D+;x9gpIT;5m+BoSrza}wAnX)f21%I3%ZcQK z+-UjVlVyVW3NcXa1eiSac-D|UZ`1s-oy#IM;(WJjQMm@Kq#E=)Nc{3115p-HVqVbY zeSJ!rJSQn?W=22^QhrPM9=;l)*rM6hEaWHe`{BJnN`Z6NxJe{O2Yys@-$o7FnGMZ| zH>0YHtyW4R%?8ipLrgec&_SuXli4MS8>Zte;xPb;Mce(SIYU+4kc??>?=#y4v~le# z1Kisu>kXD{0ur476KW+I1Av~l%&vE{B_~GYWBLguOj|+e$jAQh8?h1aQ!?L0JB7Po`n zYI;q+ZEW$j9N9&+E}mPFdA8@Y^oypEg6hu5-``S3U1>g{on}{;tD;uZ{JvoTp)O(panUNK7Kspv{WB z16tP=k^^57m;ep(38DqgZe&cd%4)tuVl;6Cde|M?>?J&$f1WACpZg|BM>;*1r6qv| z-5!Hd6qKO`=K}Dle+=HMj=YoC72SWwC%M2i&GdLj1@;RU;{1%plZQQgt@?M$zusLsdyF?~HdsGpV@TY?Ze6P@Dl%$zhi%F!oai39MJO{CE=a!1I z3Rm%U1=rKStfEc7?JKc?hiENa9e)JtJpv^c7RS7$-`AIXzdbB6cQi9IYak-9887a? zC)ES}$1ept{1iee)0cJK zQhlV^7p(c*G(l)Eg#kcN6h|-_3F!<2u#F(At@6Y4Ky44nGRdQupkD<)Y<_xnlNWCy zsiKD$bxQ?}yhOR^S-W?hOAOtcVEJN-B#7Fj!&Rh3J*3b>ujVWtTiiXQBJNaJ!vORn ze4d|z-OnVWUWxma`Ram*-IZ-xqJk7du! zUf~(lU|jSV0mZ6&PCQi|}B}j67Nr$%tyl zli(HZzrV@oG!u4PKE}5R{63a5Z7+On@PXvUuv8VWRx@ATWPDX$zoGpwR_lz)@$B-t zYzOYLH^y)4m0njbfK}mv5e6`VvCMmV1_u-G>V(n6!;Okqp{>dtz2O_QNK$Ds;?qmIj$Xyb)2M}hnCE5I63T>d-oqQ`s<GT@SOAh3#j5#$zAD&`UBaM`^RHne>XYm6zT%u`Oa&2yadGL-++-#dtlwdVV7% z4QR@dBp*b5*_|y_nu_p;V02@v%0{?KqW(j7@ujCULV00we)J{#k50oYw&k<9`Z_aj z|u zKK`~BPCdZ#;!S_;2D{+!|95}7mg|daqq!&gf6&8u|A^YOP8|2>PLvH#xrb5+Cqx$o zAK4xUL)OPciaGFYV?ZDSRy!Rg-Cpt%Tt9~m--pYULu;2B&I+oJ+u-+2E_hTa(3;$f zou`D}Aa86XPjrNxNRs}4Uk-fIk9*djwWEJ>SBr5S>7+qxt!mR*|fT zm*QG>FxU32w|xj#3EeeRT||^qS4rMPu7|hX!g}%aq`KhqwLw~ZB|T75915u-5DMyW36LOBU=jnK&*5ZpLkp{u z!nnkR_CZ$VN+8JOD}GL*_nYY0SZpca``g&VZ zUYtN24xw0xcK-jTIbEh9{GX#f^#t&TdN%A8Owz7ynXNF~{AuF|csb;~T(0a70ALBZ zs&6i4ouQT%|H8x#ICW6N&j#h{@0&dRr(DXX%Anf5i=(GF%;g&1@dUMr@rZKD){Gj$ zUx;_b~q+PT}quV3>y0(3ArP zfRy1F<`SHEj*I%%^hMxAN+zM$ zJfH}Efz!BDljfYMh<)l=#bq?Db_}dQ=G?>?CqHcTv6jsx&Q;^=vrdris?!e1+`^<9 z&v3Ao{B=U=2G!VajuUImS={b=u6FEWNqNItB$o7T zH^3g?+jdbUP&D94f<0J&oJ}c)l5+{T6Ka%ArOpjDG>$v54X>y05f@R{;~yP4i{&x9;F^B{{6XBWO}gw|_EiQx`8H zdo28cgMxpQJz?9eW~IK1C78D!><&tr--d@V?#r?P0@84DSmKNPgP2WZckZW z&Dm>w&VW)i_H+8B*c`pX&6JhR(*&)0-fSfxu0 zF?D*Oc_D0Yjb4Ka5tz5sUu<%(CHjQ6%H1}f7+D*OL+^*u`74%tDDe^ZJmqVXD^{dg@ zyd1%7tZZsjci40lu!VV6gOtRzwu}y7YfD*HEM^U!`k*cOd>=fr|m zz%7<2rDc;_S%?r%h^wgR3<$5Q*WI#XpGzYb3g_KqN0;=O4$C?`vSiS=#;4I#$IT?Z zwm@n<-ZQkBQ)5c{EsL81+J*6AzWycbYY3M61T52{Y%D3Y^g!<2#<292^ZZ*{8;mVy zi5@*6SEKP`CRHy#9ZclvVtZ6;x{Tc&p$B$`<_JgR?C + +Quintos, C. (2021). A Gini decomposition of the sources of inequality in +property assessments. +} +\keyword{datasets} diff --git a/man/ratios_sample.Rd b/man/ratios_sample.Rd index 9cacd96..ea2e185 100644 --- a/man/ratios_sample.Rd +++ b/man/ratios_sample.Rd @@ -5,12 +5,11 @@ \alias{ratios_sample} \title{Sample of ratio and sales data pulled from CCAO records} \format{ -A data frame with 979 observation and 4 variables: +A data frame with 979 observation and 3 variables: \describe{ - \item{assessed}{The fair market assessed value predicted by CCAO assessment + \item{estimate}{The fair market assessed value predicted by CCAO assessment models, including any successful appeals} \item{sale_price}{The recorded sale price of this property} - \item{ratio}{Sales ratio representing fair market value / sale price} \item{town}{Township name the property is in} } } diff --git a/tests/testthat/data/mki_ki_data.csv b/tests/testthat/data/mki_ki_data.csv deleted file mode 100644 index dc99e5e..0000000 --- a/tests/testthat/data/mki_ki_data.csv +++ /dev/null @@ -1,31 +0,0 @@ -"","Sale_Price","Assessed" -"1",32900,37299 -"2",36000,40166 -"3",54000,56317 -"4",64500,66184 -"5",68000,69487 -"6",70000,71515 -"7",74000,75338 -"8",80000,81036 -"9",84900,85673 -"10",89000,85021 -"11",94250,90046 -"12",99000,94089 -"13",105900,100227 -"14",109000,103157 -"15",115000,108290 -"16",124500,117099 -"17",129900,115347 -"18",135000,119678 -"19",149000,131631 -"20",155800,137321 -"21",163500,143974 -"22",175000,153572 -"23",179000,148457 -"24",185600,153488 -"25",199900,165040 -"26",215000,176940 -"27",235000,192959 -"28",250000,180046 -"29",279000,200240 -"30",295000,211445 diff --git a/tests/testthat/test-formulas.R b/tests/testthat/test-formulas.R index 2a52b99..4ebd121 100644 --- a/tests/testthat/test-formulas.R +++ b/tests/testthat/test-formulas.R @@ -1,7 +1,8 @@ context("load testing data") -# Load the ratios sample dataset for testing +# Load the sample datasets for testing data("ratios_sample") +data("quintos_sample") # Extract the components of the dataframe as vectors sale_price <- ratios_sample$sale_price diff --git a/tests/testthat/test-sale_chasing.R b/tests/testthat/test-sale_chasing.R index c094126..ae50b32 100644 --- a/tests/testthat/test-sale_chasing.R +++ b/tests/testthat/test-sale_chasing.R @@ -11,12 +11,12 @@ chased_ratios <- c(rnorm(900, 1, 0.15), rep(1, 100)) ##### TEST CHASING DETECTION ##### -context("test detect_chashing function") +context("test is_sales_chased function") # Run detection -sample_out <- detect_chasing(sample_ratios) -normal_out <- detect_chasing(normal_ratios) -chased_out <- detect_chasing(chased_ratios) +sample_out <- is_sales_chased(sample_ratios) +normal_out <- is_sales_chased(normal_ratios) +chased_out <- is_sales_chased(chased_ratios) test_that("returns logical value", { expect_type(sample_out, "logical") @@ -31,20 +31,20 @@ test_that("output equal to expected", { }) test_that("bad input data stops execution", { - expect_error(detect_chasing(numeric(0))) - expect_error(detect_chasing(c(sample_ratios, Inf))) - expect_error(detect_chasing(data.frame(sample_ratios))) - expect_error(detect_chasing(c(sample_ratios, NaN))) - expect_error(detect_chasing(c(sample_ratios, "2"))) - expect_error(detect_chasing(sample_ratios, na.rm = "yes")) + expect_error(is_sales_chased(numeric(0))) + expect_error(is_sales_chased(c(sample_ratios, Inf))) + expect_error(is_sales_chased(data.frame(sample_ratios))) + expect_error(is_sales_chased(c(sample_ratios, NaN))) + expect_error(is_sales_chased(c(sample_ratios, "2"))) + expect_error(is_sales_chased(sample_ratios, na.rm = "yes")) }) test_that("incomplete data returns NAs unless removed", { - expect_equal(detect_chasing(c(sample_ratios, NA)), NA) - expect_false(detect_chasing(c(sample_ratios, NA), na.rm = TRUE)) - expect_true(detect_chasing(c(chased_ratios, NA), na.rm = TRUE)) + expect_equal(is_sales_chased(c(sample_ratios, NA)), NA) + expect_false(is_sales_chased(c(sample_ratios, NA), na.rm = TRUE)) + expect_true(is_sales_chased(c(chased_ratios, NA), na.rm = TRUE)) }) test_that("warnings thrown when expected", { - expect_warning(detect_chasing(rnorm(29))) + expect_warning(is_sales_chased(rnorm(29))) }) From 13fb5ccca6606ffdb26d3adcfe59dabdfaba6c67 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 21:59:19 +0000 Subject: [PATCH 5/8] Fix pre-commit errors --- R/ci.R | 31 +++++++++++++++++++++++-------- R/outliers.R | 2 -- R/sales_chasing.R | 8 +++++--- README.md | 2 +- tests/testthat/test-formulas.R | 6 +++++- 5 files changed, 34 insertions(+), 15 deletions(-) diff --git a/R/ci.R b/R/ci.R index 2c63b85..164ff9c 100644 --- a/R/ci.R +++ b/R/ci.R @@ -34,8 +34,13 @@ #' na.rm = FALSE #' ) #' @export -boot_ci <- function(FUN = NULL, estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { - +boot_ci <- function( + FUN = NULL, + estimate, + sale_price, + nboot = 1000, + alpha = 0.05, + na.rm = FALSE) { # Input checking and error handling check_inputs(estimate, sale_price) @@ -70,7 +75,10 @@ boot_ci <- function(FUN = NULL, estimate, sale_price, nboot = 1000, alpha = 0.05 # For each of the input vectors to FUN, subset by first removing any # index positions that have a missing value, then take a random sample of # each vector using the sample index - sampled <- lapply(list(estimate, sale_price), function(x) x[!missing_idx][idx]) + sampled <- lapply( + list(estimate, sale_price), + function(x) x[!missing_idx][idx] + ) # For each bootstrap sample, apply the function and output an estimate for # that sample @@ -95,8 +103,12 @@ boot_ci <- function(FUN = NULL, estimate, sale_price, nboot = 1000, alpha = 0.05 #' # Calculate COD confidence interval #' cod_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export -cod_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { - +cod_ci <- function( + estimate, + sale_price, + nboot = 1000, + alpha = 0.05, + na.rm = FALSE) { cod_ci <- boot_ci( cod, estimate = estimate, @@ -119,8 +131,12 @@ cod_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FAL #' # Calculate PRD confidence interval #' prd_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export -prd_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) { - +prd_ci <- function( + estimate, + sale_price, + nboot = 1000, + alpha = 0.05, + na.rm = FALSE) { prd_ci <- boot_ci( prd, estimate = estimate, @@ -144,7 +160,6 @@ prd_ci <- function(estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FAL #' prb_ci(ratios_sample$estimate, ratios_sample$sale_price) #' @export prb_ci <- function(estimate, sale_price, alpha = 0.05, na.rm = FALSE) { - # Input checking and error handling check_inputs(estimate, sale_price) diff --git a/R/outliers.R b/R/outliers.R index 9cf26ee..c4173e1 100644 --- a/R/outliers.R +++ b/R/outliers.R @@ -59,7 +59,6 @@ is_outlier <- function(x, method = "iqr", probs = c(0.05, 0.95), mult = 3) { #' @describeIn is_outlier Quantile method for identifying outliers. #' @param probs Upper and lower percentiles denoting outlier boundaries. quantile_outlier <- function(x, probs = c(0.05, 0.95)) { - # Determine valid range of the data range <- stats::quantile(x, probs = probs, na.rm = TRUE) @@ -73,7 +72,6 @@ quantile_outlier <- function(x, probs = c(0.05, 0.95)) { #' @describeIn is_outlier IQR method for identifying outliers. #' @param mult Multiplier for IQR to determine outlier boundaries. iqr_outlier <- function(x, mult = 3) { - # Check that inputs are well-formed numeric vector stopifnot(is.numeric(mult), sign(mult) == 1) diff --git a/R/sales_chasing.R b/R/sales_chasing.R index d7dd272..fc1a05c 100644 --- a/R/sales_chasing.R +++ b/R/sales_chasing.R @@ -99,7 +99,6 @@ is_sales_chased <- function(x, method = "both", bounds = c(0.98, 1.02), gap = 0. #' @describeIn is_sales_chased CDF gap method for detecting sales chasing. cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { - # Sort the ratios AND REMOVE NAs sorted_ratio <- sort(ratio) @@ -121,8 +120,11 @@ cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { #' @describeIn is_sales_chased Distribution comparison method #' for detecting sales chasing. -dist_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03, na.rm = FALSE) { - +dist_sales_chased <- function( + ratio, + bounds = c(0.98, 1.02), + gap = 0.03, + na.rm = FALSE) { # Return the percentage of x within the specified range pct_in_range <- function(x, min, max) mean(x >= min & x <= max, na.rm = na.rm) diff --git a/README.md b/README.md index 6b54d96..25ce620 100644 --- a/README.md +++ b/README.md @@ -46,7 +46,7 @@ renv::install("ccao-data/assessr") pak::pak("ccao-data/assessr") # Append the @ symbol for a specific version -remotes::install_github("ccao-data/assessr@0.4.4") +remotes::install_github("ccao-data/assessr@1.0.0") ``` Once it is installed, you can use it just like any other package. Simply diff --git a/tests/testthat/test-formulas.R b/tests/testthat/test-formulas.R index 4ebd121..80400df 100644 --- a/tests/testthat/test-formulas.R +++ b/tests/testthat/test-formulas.R @@ -42,7 +42,11 @@ test_that("bad input data stops execution", { test_that("incomplete data returns NAs unless removed", { expect_equal(cod(c(estimate, NA), c(sale_price, 10e5)), NA_real_) - expect_equal(cod(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), 17.81457, tolerance = 0.02) + expect_equal( + cod(c(estimate, NA), c(sale_price, 10e5), na.rm = TRUE), + 17.81457, + tolerance = 0.02 + ) }) test_that("standard met function", { From 2ecf854aae8c6673666a48341a3377a6a940aed5 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 21:59:52 +0000 Subject: [PATCH 6/8] Add quintos_sample dataset to pkgdown config --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 5437d9b..30e5009 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -65,3 +65,4 @@ reference: desc: Sample data used for testing and demonstrations - contents: - ratios_sample + - quintos_sample From 39f727fcbcd2930ff1064f00c56992a7e9ec4c0b Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 22:07:40 +0000 Subject: [PATCH 7/8] Fixup docs for R CMD Check --- R/ci.R | 1 - R/sales_chasing.R | 3 --- man/boot_ci.Rd | 2 -- man/is_sales_chased.Rd | 14 -------------- 4 files changed, 20 deletions(-) diff --git a/R/ci.R b/R/ci.R index 164ff9c..4d4260b 100644 --- a/R/ci.R +++ b/R/ci.R @@ -15,7 +15,6 @@ #' @param na.rm Default FALSE. A boolean value indicating whether or not to #' remove NA values. If missing values are present but not removed the #' function will output NA. -#' @param ... Named arguments passed on to \code{FUN}. #' #' @return A two-long numeric vector containing the bootstrapped confidence #' interval of the input vector(s). diff --git a/R/sales_chasing.R b/R/sales_chasing.R index fc1a05c..b9b9a59 100644 --- a/R/sales_chasing.R +++ b/R/sales_chasing.R @@ -97,7 +97,6 @@ is_sales_chased <- function(x, method = "both", bounds = c(0.98, 1.02), gap = 0. } -#' @describeIn is_sales_chased CDF gap method for detecting sales chasing. cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { # Sort the ratios AND REMOVE NAs sorted_ratio <- sort(ratio) @@ -118,8 +117,6 @@ cdf_sales_chased <- function(ratio, bounds = c(0.98, 1.02), gap = 0.03) { } -#' @describeIn is_sales_chased Distribution comparison method -#' for detecting sales chasing. dist_sales_chased <- function( ratio, bounds = c(0.98, 1.02), diff --git a/man/boot_ci.Rd b/man/boot_ci.Rd index 4020834..2ddf5d2 100644 --- a/man/boot_ci.Rd +++ b/man/boot_ci.Rd @@ -31,8 +31,6 @@ interval to return. 0.05 will return the 95\% confidence interval.} \item{na.rm}{Default FALSE. A boolean value indicating whether or not to remove NA values. If missing values are present but not removed the function will output NA.} - -\item{...}{Named arguments passed on to \code{FUN}.} } \value{ A two-long numeric vector containing the bootstrapped confidence diff --git a/man/is_sales_chased.Rd b/man/is_sales_chased.Rd index 7b04ba9..6019728 100644 --- a/man/is_sales_chased.Rd +++ b/man/is_sales_chased.Rd @@ -2,8 +2,6 @@ % Please edit documentation in R/sales_chasing.R \name{is_sales_chased} \alias{is_sales_chased} -\alias{cdf_sales_chased} -\alias{dist_sales_chased} \title{Detect sales chasing in a vector of sales ratios} \usage{ is_sales_chased( @@ -13,10 +11,6 @@ is_sales_chased( gap = 0.03, na.rm = FALSE ) - -cdf_sales_chased(ratio, bounds = c(0.98, 1.02), gap = 0.03) - -dist_sales_chased(ratio, bounds = c(0.98, 1.02), gap = 0.03, na.rm = FALSE) } \arguments{ \item{x}{A numeric vector. Must be longer than 2 and cannot contain @@ -65,14 +59,6 @@ Sales chasing is when a property is selectively reappraised to The intuition here is that ratios that are sales chased may be more "bunched up" in the center of the distribution. } -\section{Functions}{ -\itemize{ -\item \code{cdf_sales_chased()}: CDF gap method for detecting sales chasing. - -\item \code{dist_sales_chased()}: Distribution comparison method -for detecting sales chasing. - -}} \examples{ # Generate fake data with normal vs chased ratios From 41f016641d94e090ba2c32ec40c87b60bfa732b9 Mon Sep 17 00:00:00 2001 From: Jean Cochrane Date: Thu, 12 Dec 2024 22:32:06 +0000 Subject: [PATCH 8/8] Fix docs typos --- R/ci.R | 6 +++--- R/outliers.R | 2 +- man/boot_ci.Rd | 13 +++---------- man/is_outlier.Rd | 2 +- 4 files changed, 8 insertions(+), 15 deletions(-) diff --git a/R/ci.R b/R/ci.R index 4d4260b..9c1a1a3 100644 --- a/R/ci.R +++ b/R/ci.R @@ -4,9 +4,9 @@ #' for a given numeric input and a chosen function. #' #' @param FUN Function to bootstrap. Must return a single value. -#' @param estimate A character vector of estimated values. Must be the same +#' @param estimate A numeric vector of estimated values. Must be the same #' length as \code{sale_price}. -#' @param sale_price A character vector of sale prices. Must be the same +#' @param sale_price A numeric vector of sale prices. Must be the same #' length as \code{estimate}. #' @param nboot Default 1000. Number of iterations to use to estimate #' the output statistic confidence interval. @@ -34,7 +34,7 @@ #' ) #' @export boot_ci <- function( - FUN = NULL, + FUN, estimate, sale_price, nboot = 1000, diff --git a/R/outliers.R b/R/outliers.R index c4173e1..fe2cdd3 100644 --- a/R/outliers.R +++ b/R/outliers.R @@ -14,7 +14,7 @@ #' #' @param x A numeric vector, typically sales ratios. Must be longer than 2 and #' cannot contain \code{Inf} or \code{NaN}. -#' @param method Default \code{iqr.} String indicating outlier detection method. +#' @param method Default \code{iqr}. String indicating outlier detection method. #' Options are \code{iqr} or \code{quantile}. #' @param probs Upper and lower percentiles denoting outlier boundaries for #' the \code{quantile} method. diff --git a/man/boot_ci.Rd b/man/boot_ci.Rd index 2ddf5d2..f591022 100644 --- a/man/boot_ci.Rd +++ b/man/boot_ci.Rd @@ -4,22 +4,15 @@ \alias{boot_ci} \title{Calculate bootstrapped confidence intervals} \usage{ -boot_ci( - FUN = NULL, - estimate, - sale_price, - nboot = 1000, - alpha = 0.05, - na.rm = FALSE -) +boot_ci(FUN, estimate, sale_price, nboot = 1000, alpha = 0.05, na.rm = FALSE) } \arguments{ \item{FUN}{Function to bootstrap. Must return a single value.} -\item{estimate}{A character vector of estimated values. Must be the same +\item{estimate}{A numeric vector of estimated values. Must be the same length as \code{sale_price}.} -\item{sale_price}{A character vector of sale prices. Must be the same +\item{sale_price}{A numeric vector of sale prices. Must be the same length as \code{estimate}.} \item{nboot}{Default 1000. Number of iterations to use to estimate diff --git a/man/is_outlier.Rd b/man/is_outlier.Rd index 6d7fafa..6db38ec 100644 --- a/man/is_outlier.Rd +++ b/man/is_outlier.Rd @@ -16,7 +16,7 @@ iqr_outlier(x, mult = 3) \item{x}{A numeric vector, typically sales ratios. Must be longer than 2 and cannot contain \code{Inf} or \code{NaN}.} -\item{method}{Default \code{iqr.} String indicating outlier detection method. +\item{method}{Default \code{iqr}. String indicating outlier detection method. Options are \code{iqr} or \code{quantile}.} \item{probs}{Upper and lower percentiles denoting outlier boundaries.}