#' @title RIT "Height Weight" Growth, with NPR bands
#'
#' @description
#' \code{height_weight_npr} returns a ggplot object meant to be used as a template
#'
#'
#' @param desired_subj
#'
#' @return a ggplot object
#' @export
height_weight_npr <- function(
desired_subj
#this lives in /data/norms_2011_dense.rda
,norms_dense
,color_list = rainbow_colors()
,ribbon_alpha = .35
,annotation_style = 'points'
,line_style = 'none'
) {
require(ggplot2)
e <- new.env()
#only spring, desired percentiles
norms_dense <- norms_dense[norms_dense$measurementscale==desired_subj &
(norms_dense$percentile %in% c(1,5,95,99) | norms_dense$percentile %% 10==0) &
(norms_dense$fallwinterspring == 'Spring' | (norms_dense$grade==0 & norms_dense$fallwinterspring == 'Fall')), ]
#modify grade level
norms_dense$grade_mod <- sapply(norms_dense$fallwinterspring, grade_level_season)
norms_dense$grade <- norms_dense$grade + norms_dense$grade_mod
#match df to account for sparsity of NWEA norms
match_df <- data.frame(
measurementscale = c('Reading', 'Mathematics', 'Science - General Science', 'Language Usage')
,match_min = c(-0.8, -0.8, 3, 2)
,match_max = c(11, 11, 10, 11)
,n_row = c(15, 15, 10, 12)
)
npr_grades <- list(
'Reading' = c(-3,-0.8,0,1,2,3,4,5,6,7,8,9,10,11,14)
,'Mathematics' = c(-3,-0.8,0,1,2,3,4,5,6,7,8,9,10,11,14)
,'Science - General Science' = c(-3,3,4,5,6,7,8,9,10,14)
,'Language Usage' = c(-3,2,3,4,5,6,7,8,9,10,11,14)
)
n_rep <- match_df[match_df$measurementscale==desired_subj, 'n_row']
#add y axis margins
placeholder1 <- norms_dense[norms_dense$grade==match_df[match_df$measurementscale==desired_subj, 'match_max'], ]
#arbitrary, just needs to be bigger than 11
placeholder1$grade <- 14
norms_dense <- rbind(norms_dense, placeholder1)
placeholder2 <- norms_dense[norms_dense$grade==match_df[match_df$measurementscale==desired_subj, 'match_min'],]
#arbitrary, just needs to be smaller than -0.8
placeholder2$grade <- -3
norms_dense <- rbind(norms_dense, placeholder2)
e$norms_dense <- norms_dense[with(norms_dense, order(measurementscale, grade)), ]
#had a lot of trouble here.
#cutting into ribbon bins
e$npr_grades <- npr_grades[[desired_subj]]
e$nprs <- c(1,5,10,20,30,40,50,60,70,80,90,95,99)
e$npr_band01 <- subset(e$norms_dense, percentile == e$nprs[1])
e$npr_band05 <- subset(e$norms_dense, percentile == e$nprs[2])
e$npr_band10 <- subset(e$norms_dense, percentile == e$nprs[3])
e$npr_band20 <- subset(e$norms_dense, percentile == e$nprs[4])
e$npr_band30 <- subset(e$norms_dense, percentile == e$nprs[5])
e$npr_band40 <- subset(e$norms_dense, percentile == e$nprs[6])
e$npr_band50 <- subset(e$norms_dense, percentile == e$nprs[7])
e$npr_band60 <- subset(e$norms_dense, percentile == e$nprs[8])
e$npr_band70 <- subset(e$norms_dense, percentile == e$nprs[9])
e$npr_band80 <- subset(e$norms_dense, percentile == e$nprs[10])
e$npr_band90 <- subset(e$norms_dense, percentile == e$nprs[11])
e$npr_band95 <- subset(e$norms_dense, percentile == e$nprs[12])
e$npr_band99 <- subset(e$norms_dense, percentile == e$nprs[13])
#what is needed is a data frame with ribbon, x, ymin, and ymax
#make them per band, then rbind
#first make the top and bottom - custom
e$df_npr1 <- data.frame(
rib = rep('below_1', n_rep)
,x = e$npr_band01$grade
#dummy value - just needs to be small
,ymin = rep(100, n_rep)
,ymax = e$npr_band01$RIT
)
e$df_npr99 <- data.frame(
rib = rep('above_99', n_rep)
,x = e$npr_band99$grade
#dummy value - just needs to be big
,ymin = e$npr_band99$RIT
,ymax = rep(300, n_rep)
)
e$df <- rbind(e$df_npr1, e$df_npr99)
#then generate the others in a loop
bands <- ls(pattern="npr_band*", envir=e)
#list to hold ribbon names
e$ribbons <- rep(NA, 12)
for (i in 1:(length(bands)-1)) {
new_df_name <- paste(bands[i], bands[i+1], sep='_')
#remove 'band'
new_df_name <- gsub('band', '', new_df_name)
#lower and upper df
lower <- get(bands[i], envir=e)
upper <- get(bands[i+1], envir=e)
#make a new df for this ribbon
inner_df <- data.frame(
rib = rep(new_df_name, n_rep)
,x = e$npr_grades
,ymin = lower$RIT
,ymax = upper$RIT
)
#rbind to existing df
e$df <- rbind(e$df, inner_df)
#update list of ribbons
e$ribbons[i] <- new_df_name
}
#now make the geom_ribbons
#first make top & bottom
e$rib_under_1 <- geom_ribbon(
data = e$df[e$df$rib == 'below_1', ]
,aes(
x = x
,ymin = ymin
,ymax = ymax
)
,fill = color_list[1]
,alpha = ribbon_alpha
,environment = e
)
e$rib_above_99 <- geom_ribbon(
data = e$df[e$df$rib == 'above_99', ]
,aes(
x = x
,ymin = ymin
,ymax = ymax
)
,fill = color_list[14]
,alpha = ribbon_alpha
,environment = e
)
for (i in 1:length(e$ribbons)) {
new_rib_name <- paste('rib', e$ribbons[i], sep='_')
#make ribbon
inner_ribbon <- geom_ribbon(
data = e$df[e$df$rib == e$ribbons[i], ]
,aes(
x = x
,ymin = ymin
,ymax = ymax
)
,fill = color_list[i+1]
,alpha = ribbon_alpha
,environment = e
)
#appropriate df
assign(new_rib_name, inner_ribbon, envir=e)
}
#base ggplot
p <- ggplot(
data = norms_dense
,environment = e
)
#annotation style options
if (grepl('points', annotation_style)) {
npr_annotation <- geom_point(
aes(
x = grade
,y = RIT
)
)
} else if (grepl('big numbers', annotation_style)) {
npr_annotation <- geom_text(
aes(
x = grade
,y = RIT
,label = percentile
)
)
} else if (grepl('small numbers', annotation_style)) {
npr_annotation <- geom_text(
aes(
x = grade
,y = RIT
,label = percentile
)
,size = 3
,fontface="italic"
,color = 'gray40'
,alpha = 0.8
)
} else {
npr_annotation <- NULL
}
#lines
if (grepl('gray lines', line_style)) {
npr_lines <- geom_line(
aes(
x = grade
,y = RIT
,group = percentile
)
,size = 0.5
,color = 'gray80'
)
} else {
npr_lines <- NULL
}
#put it all together
p <- p +
e$rib_under_1 +
e$rib_npr_01_npr_05 +
e$rib_npr_05_npr_10 +
e$rib_npr_10_npr_20 +
e$rib_npr_20_npr_30 +
e$rib_npr_30_npr_40 +
e$rib_npr_40_npr_50 +
e$rib_npr_50_npr_60 +
e$rib_npr_60_npr_70 +
e$rib_npr_70_npr_80 +
e$rib_npr_80_npr_90 +
e$rib_npr_90_npr_95 +
e$rib_npr_95_npr_99 +
e$rib_above_99 +
npr_annotation +
npr_lines
return(p)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.