Nothing
#' Grade Businesses.
#'
#' \code{gradeAllBus} takes in a vector of business inspection scores, business
#' ZIP codes and a data frame of ZIP code cutoff scores (generated by the
#' \code{findCutoffs} function) and returns a vector of business grades.
#'
#'As explained in the \code{findCutoffs} documentation, we use the language "ZIP
#'code" and "restaurant", however, our grading algorithm can be applied to grade
#'other inspected entities. As with \code{findCutoffs}, where "ZIP code" is
#'referenced, please read "ZIP code or other subunit of a jurisdiction" and
#'"restaurant" should read "restaurant or other entity to be graded".
#'
#' \code{gradeAllBus} takes a vector of inspection scores (one score for each
#' restaurant: the score can be a mean across multiple inspections or the result
#' of a single inspection), a vector of ZIP codes and a dataframe of ZIP code
#' cutoffs (most likely generated by the \code{findCutoffs} function). It
#' compares each restaurant's inspection score to cutoff scores in the
#' restaurant's ZIP code. It finds the smallest cutoff score in the restaurant's
#' ZIP code that the restaurant's inspection score is less than or equal to -
#' let's say this is the (\code{letter.index})th cutoff score - and returns the
#' (\code{letter.index})th letter of the alphabet as the grade for the
#' restaurant. The returned vector of grades maintains the order of businesses
#' in vector inputs \code{scores} and in \code{z}).
#'
#' @param scores Numeric vector of length \code{n}, where \code{n} is the number is
#' restaurants to be graded. Each entry is the inspection score for one
#' business.
#' @param z Character vector of length \code{n}, where each entry is the ZIP
#' code (or other geographic area) of a business. The order of businesses in
#' \code{z} is the same as the order of businesses in \code{scores}.
#' @param zip.cutoffs A dataframe with the first column containing all of the
#' ZIP codes in z and later columns containing cutoff scores for each ZIP code
#' for grade classification. Cutoff scores for each ZIP code should be
#' ordered from lowest score in column 2 (representing the cutoff for the best
#' grade) to the largest cutoff score in the final column (representing the
#' cutoff inspection score for the second worst grade). This dataframe will
#' most likely have been generated by the \code{findCutoffs} function.
#' @return A character vector of length n, with each entry corresponding to the
#' grade that the restaurant received.
#' @examples
#'
#'
#'## ===== Quantile-Adjusted Grading =====
#'## ZIP Code Cutoffs (see findCutoffs documentation for an explanation of how
#'## these are calculated)
#'
#' zipcode.cutoffs.df <- findCutoffs(X.kc, zips.kc, gamma = c(0, 30))
#'
#'## In King County, we use a restaurant's mean inspection score over the last
#'## four inspections for grading (see Ho, D.E.,
#'## Ashwood, Z.C., and Elias, B. "Improving the Reliability of Food Safety
#'## Disclosure: A Quantile Adjusted Restaurant Grading System for Seattle-King
#'## County" (working paper)). Calculate these mean scores:
#'
#' mean.scores <- rowMeans(X.kc, na.rm = TRUE)
#'
#'## We then use the mean scores and the zipcode.cutoffs.df dataframe to perform
#'## grading:
#'
#' adj.grades <- gradeAllBus(mean.scores, zips.kc, zipcode.cutoffs.df)
#'
#'
#'## ===== Traditional Grading Systems =====
#'## For comparison, calculate grades as if we had used a traditional grading
#'## system in King County, with 0 and 30 as the A/B and B/C cutoffs for all ZIP
#'## codes.
#'
#'## Cutoffs:
#'
#' unadj.cutoffs.df <- createCutoffsDF(X.kc, zips.kc, gamma = c(0, 30), type = "unadj")
#'
#'## Grades (traditional grading systems only use the most recent inspection score
#'## for grading):
#'
#' unadj.grades <- gradeAllBus(scores = X.kc[,c(1)], zips.kc, zip.cutoffs = unadj.cutoffs.df)
#'
#'
#'## ===== Comparison: Quantile-Adjusted Grading and Traditional Grading ===
#'## Proportion of restaurants in each grading category varies dramatically
#'## between ZIPs in traditional compared to quantile-adjusted grading; these
#'## differences do not reflect sanitation differences, but rather differences in
#'## stringency across inpectors (see: Ho, D.E., Ashwood, Z.C., and Elias, B.
#'## "Improving the Reliability of Food Safety Disclosure: A Quantile Adjusted
#'## Restaurant Grading System for Seattle-King County" (working paper)).
#'## Tabulate restaurants in each ZIP code in each grading category and then
#'## divide by total number of restaurants in each ZIP to obtain proportions.
#'## Proportions are rounded to 2 decimal places.
#'
#' ## Traditional Grading
#'
#' foo1 <- round(table(zips.kc, unadj.grades)/apply(table(unadj.grades, zips.kc), 2, sum), 2)
#'
#' ## Quantile-Adjusted Grading
#'
#' foo2 <- round(table(zips.kc, adj.grades)/apply(table(adj.grades, zips.kc), 2, sum), 2)
#'
#' @export
gradeAllBus<- function(scores, z, zip.cutoffs){
#============
# Preliminary Checks
X<- as.numeric(scores)
z<- as.character(z)
zip.cutoffs<- as.data.frame(zip.cutoffs)
#Check that length of z and number of rows of X match. If not, throw an error.
if(length(X) != length(z)) stop("length of X and length of z do not match!")
#=================
# Grading all businesses
# Use gradeBus function and apply to all businesses
all.bus.grades<- lapply(1:length(X), FUN = function(i) gradeBus(scores[i], z[i], zip.cutoffs))
# Return a character vector of grades
return(as.character(all.bus.grades))
}
#' Grade a Business.
#'
#' \code{gradeBus} takes in the inspection score for one restaurant, the ZIP
#' code for the restaurant, a data frame of ZIP
#' code cutoff information and returns the grade for the business in question.
#'
#' \code{gradeBus} takes one inspection score for a restaurant (this may be a
#' mean or the result of a single inspection), the restaurant's ZIP code and a
#' dataframe of ZIP code cutoffs. It compares each restaurant's inspection score
#' to cutoff scores in the restaurant's ZIP code. It finds the smallest cutoff
#' score in the restaurant's ZIP code that the restaurant's inspection score is
#' less than or equal to - let's say this is the (\code{letter.index})th cutoff
#' score - and returns the (\code{letter.index})th letter of the alphabet as the
#' grade for the restaurant. \code{gradeBus} is the function called by
#' \code{\link{gradeAllBus}} in order to grade all businesses.
#'
#' @param x.bar.i Numeric inspection score (or mean score) for restaurant in
#' question.
#' @param z.i Character representing ZIP code (or other geographic area) of
#' business in question.
#' @param zip.cutoffs A dataframe with the first column containing ZIP codes and
#' later columns containing grade cutoff scores for each ZIP code. Cutoff
#' scores for each ZIP code should be ordered from lowest score in column 2
#' (representing the cutoff for the best grade) to largest cutoff score in the
#' final column (representing the cutoff inspection score for the second worst
#' grade).
#' @return A character representing the grade assigned to the restaurant in
#' question ('A', 'B', 'C' etc).
#' @keywords internal
#' @export
gradeBus<- function(x.bar.i, z.i, zip.cutoffs){
#=====
# Preliminary Checks
x.bar.i<- as.numeric(x.bar.i)
z.i<- as.character(z.i)
zip.cutoffs<- as.data.frame(zip.cutoffs)
#Check that across each row, if there is more than 1 cutoff, that
# scores are increasing - i.e. that the ZIP
#code cutoff frame is correctly specified to be interpretted as we expect
#(col 2 represents cutoff for A grade, col 3 represents cutoff for B grade
#and so on)
if(ncol(zip.cutoffs) >= 3){
for(j in 2:(ncol(zip.cutoffs)-1)){
if(FALSE %in% (as.numeric(zip.cutoffs[,c(j)]) <= as.numeric(zip.cutoffs[,c(j+1)]))) stop("incorrect specification of ZIP code cutoff frame - cutoffs are not ordered from lowest to highest for each ZIP!")
}
}
#======
# Grading
zip.of.interest<- zip.cutoffs[which(zip.cutoffs[,c(1)] == z.i),]
no.grades<- ncol(zip.cutoffs)
## if no ZIP exists for restaurant, we cannot score restaurant
if(is.na(z.i)==TRUE){
bus.grade=NA
} else if(is.na(x.bar.i)==TRUE){ ## if no score exists for restaurant, we cannot score restaurant
bus.grade= NA
} else{
## compare x.bar.i to cutoff values in zip.of.interest:
## what is the smallest cutoff value that x.bar.i is less than or equal to?
## find the index of the smallest cutoff value in zip.of.interest frame and map to letter grade for restaurant of interest
letter.index<-match(TRUE, x.bar.i<= as.numeric(zip.of.interest[,c(2:ncol(zip.cutoffs))]), nomatch = ncol(zip.cutoffs))
bus.grade<- LETTERS[letter.index]
}
return(bus.grade)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.