R/add_timely_term.R

In midfieldr: Tools and Methods for Working with MIDFIELD Data in 'R'

# Documentation described below using an inline R code chunk, e.g.,
# "`r dframe_add_timely_term`" or "`r return_data_frame`", are 
# documented in the R/roxygen.R file.
 


#' Calculate a timely completion term for every student
#'
#' Add a column to a data frame of student-level records that indicates the
#' latest term by which degree completion  would be considered timely for every
#' student.
#' 
#' By "completion" we mean an undergraduate earning their first baccalaureate
#' degree (or degrees, for students earning more than one degree in the same
#' term).
#'
#' In many studies, students must complete their programs in a specified time
#' span, for example 4-, 6-, or 8-years after admission. If they do, their
#' completion is timely; if not, their completion is late and they are grouped
#' with the non-completers when computing a metric such as graduation rate.
#'
#' Our heuristic assigns `span` number of years (default is 6 years) to every
#' student. For students admitted at second-year level or higher, the span is
#' reduced by one year for each full year the student is assumed to have
#' completed. For example, a student admitted at the second-year level is
#' assumed to have completed one year of a program, so their span is reduced by
#' one year.
#'
#' The adjusted span is added to the initial term to create the timely
#' completion term in the `timely_term` column.
#'
#' @param dframe        `r dframe_add_timely_term`
#' @param midfield_term `r midfield_term_add_timely_term`
#' @param ...           `r param_dots`
#' @param span Optional integer scalar, number of years to define timely
#'   completion. Commonly used values are are 100, 150, and 200 percent of
#'   `sched_span.` Default 6 years.
#' @param sched_span Optional integer scalar, the number of years an institution
#'   officially schedules for completing a program. Default 4 years.
#'        
#' @return `r return_data_frame`
#' \describe{
#'  \item{`term_i`}{Character. Initial term of a student's longitudinal 
#'  record, encoded YYYYT}
#'  \item{`level_i`}{Character. Student level (01 Freshman, 02 Sophomore, 
#'  etc.) in their initial term}
#'  \item{`adj_span`}{Numeric. Integer span of years for timely completion 
#'  adjusted for a student's initial level.}
#'  \item{`timely_term`}{Character. Latest term by which program 
#'  completion would be considered timely for every student. Encoded YYYYT.}
#' }
#'
#' @family add_*
#' @example man/examples/add_timely_term_exa.R
#' @export
#'
add_timely_term <- function(dframe,
                            midfield_term = term,
                            ...,
                            span = NULL,
                            sched_span = NULL) {
    
    # remove keys if any 
    on.exit(setkey(dframe, NULL))
    on.exit(setkey(midfield_term, NULL), add = TRUE)
    
    # required arguments
    qassert(dframe, "d+")
    qassert(midfield_term, "d+")
    
    # assert arguments after dots used by name
    wrapr::stop_if_dot_args(
        substitute(list(...)),
        paste(
            "Arguments after ... must be named.\n",
            "* Did you forget to write `details = ` or `span = `?\n *"
        )
    )
    
    # optional arguments
    span <- span %?% 6
    sched_span <- sched_span %?% 4
    
    # optional arguments assertions
    assert_int(sched_span, lower = 0)
    assert_int(span, lower = sched_span)
    
    # ensure data.table format
    setDT(dframe)
    setDT(midfield_term) # immediately subset, so no changes by reference
    
    # required columns
    assert_names(colnames(dframe),
                 must.include = c("mcid")
    )
    assert_names(colnames(midfield_term),
                 must.include = c("mcid", "term", "level")
    )
    
    # class of required columns
    qassert(dframe[, mcid], "s+")
    qassert(midfield_term[, mcid], "s+")
    qassert(midfield_term[, term], "s+")
    qassert(midfield_term[, level], "s+")
    
    # bind names due to NSE notes in R CMD check
    timely_term <- NULL
    adj_span <- NULL
    level_i <- NULL
    term_i <- NULL
    delta <- NULL
    yyyy <- NULL
    
    # do the work
    
    # variables added by this function and functions called (if any)
    initial_traits_cols <- c("term_i", "level_i")
    new_cols <- c(initial_traits_cols, "adj_span", "timely_term")
    
    # retain original variables NOT in the vector of new columns 
    old_cols <- find_old_cols(dframe, new_cols) 
    dframe <- dframe[, .SD, .SDcols = old_cols]
    
    # begin
    DT <- copy(dframe)
    
    # add first recorded term_i and level_i 
    DT <- add_initial_term(DT, midfield_term)
    DT <- add_initial_level(DT, midfield_term)
    DT <- DT[, .SD, .SDcols = c("mcid", initial_traits_cols)]
    
    # begin constructing the timely term
    DT[, `:=`(
        yyyy = substr(term_i, 1, 4),
        t    = substr(term_i, 5, 5)
    )]
    
    # for month terms, (letters A, B, C, ...), set first term to zero
    DT <- DT[t %chin% LETTERS | t %chin% letters, t := "0"]
    
    # make year and term numeric
    DT[, `:=`(
        yyyy = as.numeric(yyyy),
        t    = as.numeric(t)
    )] 
    
    # if first term is in summer, delay to the subsequent Fall
    DT[t > 3, `:=`(yyyy = yyyy + 1, t = 1)]
    
    # reduce span by assumed number of completed years by level
    DT[, delta := fcase(
        level_i %like% "04", 3,
        level_i %like% "03", 2,
        level_i %like% "02", 1,
        default = 0
    )]
    DT[, adj_span := span - delta]
    
    # use adj_span to construct estimated timely-completion term
    DT[t == 0 | t == 1, timely_term := paste0(yyyy + adj_span - 1, 3)]
    DT[t > 1, timely_term := paste0(yyyy + adj_span, 1)]
    
    # remove all but essential variables
    DT <- DT[, .SD, .SDcols = c("mcid", new_cols)]
    
    # ensure no duplicate rows
    setkeyv(DT, "mcid")
    DT <- DT[, .SD[1], by = "mcid"]
    
    # left join new columns to dframe by key(s)
    setkeyv(dframe, "mcid")
    dframe <- DT[dframe]
    
    # select columns to return
    final_cols <- c(old_cols, new_cols) 
    dframe <- dframe[, .SD, .SDcols = final_cols]
    
    # old columns as keys, order columns and rows
    set_colrow_order(dframe, old_cols)
    
    # enable printing (see data.table FAQ 2.23)
    dframe[]  
}

# ------------------------------------------------------------------------

# Add students' initial terms

add_initial_term <- function(dframe, midfield_term) {
    
    # remove keys if any 
    on.exit(setkey(dframe, NULL))
    on.exit(setkey(midfield_term, NULL), add = TRUE)
    
    # ensure data.table format, changes by reference 
    setDT(dframe)
    setDT(midfield_term)
    
    # variables added by this function
    new_cols <- c("term_i")
    
    # retain original variables NOT in the vector of new columns 
    old_cols <- find_old_cols(dframe, new_cols) 
    dframe <- dframe[, .SD, .SDcols = old_cols]
    
    # obtain new_cols keyed by ID
    # DT <- filter_match(
    #     dframe = midfield_term,
    #     match_to = dframe,
    #     by_col = "mcid",
    #     select = c("mcid", "term")
    # )
    
    
    
    # Inner join using two columns of term
    x <- midfield_term[, .(mcid, term)]
    y <- unique(dframe[, .(mcid)])
    DT <- y[x, on = .(mcid), nomatch = NULL]
    
    
    
    
    
    
    # retain first term by ID
    setkeyv(DT, c("mcid", "term"))
    DT <- DT[, .SD[1], by = c("mcid")]
    
    # rename new columns 
    setnames(DT,
             old = c("term"),
             new = c("term_i")
    )
    
    # left join new columns to dframe by key(s)
    setkeyv(DT, "mcid")
    setkeyv(dframe, "mcid")
    dframe <- DT[dframe] 
    
    # enable printing (see data.table FAQ 2.23)
    dframe[]  
}

# ------------------------------------------------------------------------

# Add students' initial levels

add_initial_level <- function(dframe, midfield_term) {
    
    # remove keys if any 
    on.exit(setkey(dframe, NULL))
    on.exit(setkey(midfield_term, NULL), add = TRUE)
    
    # ensure data.table format, changes by reference 
    setDT(dframe)
    setDT(midfield_term)
    
    # variables added by this function and functions called (if any)
    new_cols <- c("level_i")
    
    # retain original variables NOT in the vector of new columns 
    old_cols <- find_old_cols(dframe, new_cols) 
    dframe <- dframe[, .SD, .SDcols = old_cols]
    
    # # obtain new_cols keyed by ID
    # DT <- filter_match(
    #     dframe = midfield_term,
    #     match_to = dframe,
    #     by_col = "mcid",
    #     select = c("mcid", "term", "level")
    # )
    
    # Inner join using three columns of term
    x <- midfield_term[, .(mcid, term, level)]
    y <- unique(dframe[, .(mcid)])
    DT <- y[x, on = .(mcid), nomatch = NULL]
    
    # retain first term by ID
    setkeyv(DT, c("mcid", "term"))
    DT <- DT[, .SD[1], by = c("mcid")]
    
    # rename new columns 
    setnames(DT,
             old = c("level"),
             new = c("level_i")
    )
    
    # left join new columns to dframe by key(s)
    setkeyv(DT, "mcid")
    setkeyv(dframe, "mcid")
    dframe <- DT[dframe] 
    
    # enable printing (see data.table FAQ 2.23)
    dframe[]  
}