researchR:

#'Generate a Term Lookup Table
#'
#' @description
#' The following functions generate a Term Lookup table
#' in order to make identifying term-specific information easier.
#'
#'@param start Year as an integer
#'@param end Year as an integer
#'@param seasons Character vector with any combination of the following elements: c("CSU", "CFA", "CSP")
#'
#'@return Returns a dataframe with information for each term
#'
#'@details For \code{terms_dates()}, you need to have an ODBC connection to the
#'EDS Database, named "Research". You also need the \code{DBI} package installed.
#'
#'@examples
#'
#'# Run with default arguments
#'terms_lu()
#'
#'# Specify date range and seasons
#'terms_lu(start = 1990, end = 2008, seasons = c("CFA"))
#'@name terms
NULL


#' @rdname terms
#' @export
term_lu <- function(start = 2005, end = as.numeric(format(Sys.Date(), "%Y")), seasons = c("CSU", "CSP", "CFA")){

  seasons <- seasons[which(seasons %in% c("CSU", "CSP", "CFA"))]

  each <- length(seasons)

  term <- paste0(rep(start:end, each = each), seasons)

  term_calendar_year <- rep(start:end, each = each)

  term_numeric <- gsub(pattern = "CSP", replacement = "3",
                  gsub(pattern = "CSU", replacement = "5",
                  gsub(pattern = "CFA", replacement = "7", x = term)))

  term_season <- ifelse(grepl("CSP", x = term), "Spring",
                 ifelse(grepl("CFA", x = term), "Fall", "Summer"))

  term_start_year <- ifelse(term_season == "Spring", term_calendar_year-1, term_calendar_year)

  term_academic_year <- paste0(term_start_year, "-", term_start_year+1)

  term_rank <- rank(term_numeric)

  term_rank_primary <- replace(rep(NA, length(term_rank)),
                               which(term_season %in% c("Spring", "Fall")),
                               rank(term_numeric[term_season != "Summer"]))

  term_gi03 <- paste0(substr(as.character(term_start_year), 3, 4),
                     ifelse(grepl("CSP", x = term), "3",
                     ifelse(grepl("CFA", x = term), "7", "5")))

  term_next <- ifelse(grepl("CSP", x = term), paste0(term_calendar_year, "CSU"),
               ifelse(grepl("CFA", x = term), paste0(term_calendar_year+1, "CSP"),
                      paste0(term_calendar_year, "CFA")))

  term_next_primary <- ifelse(grepl("CSP", x = term), paste0(term_calendar_year, "CFA"),
                       ifelse(grepl("CFA", x = term), paste0(term_calendar_year+1, "CSP"),
                              paste0(term_calendar_year, "CFA")))

  term_next_year <- paste0(rep((start+1):(end+1), each = each), seasons)

  dd <- data.frame(term,
                   term_numeric,
                   term_season,
                   term_academic_year,
                   term_start_year,
                   term_rank,
                   term_rank_primary,
                   term_gi03,
                   term_next,
                   term_next_year,
                   term_next_primary,
                   term_calendar_year,
                   stringsAsFactors = FALSE)

  dd <- as.data.frame(dd[with(dd, order(term_numeric)), ], stringAsFactors = FALSE)

  rownames(dd) <- NULL

  out <- dd

  return(out)
}


#'@rdname terms
#'@export
term_summer <- function(start = 2005, end = as.numeric(format(Sys.Date(), "%Y"))){

  summer_lu <- term_lu(start, end, seasons = "CSU")

  out <- summer_lu$term

  return(out)
}

#'@rdname terms
#'@export
term_fall <- function(start = 2005, end = as.numeric(format(Sys.Date(), "%Y"))){

  fall_lu <- term_lu(start, end, seasons = "CFA")

  out <- fall_lu$term

  return(out)
}


#'@rdname terms
#'@export
term_spring <- function(start = 2005, end = as.numeric(format(Sys.Date(), "%Y"))){

  spring_lu <- term_lu(start, end, seasons = "CSP")

  out <- spring_lu$term

  return(out)
}


#'@rdname terms
#'@export
term_dates <- function(start = 2005, end = as.numeric(format(Sys.Date(), "%Y")), seasons = c("CSU", "CSP", "CFA")){

 SQL <- "SELECT
  TERM_BASIC.TERM_ID,
  TERM_BASIC.SCHOOL,
  TERM_BASIC.TERM_FISCAL_YEAR,
  TERM_BASIC.REPORTING_TERM,
  TERM_BASIC.TERM_DESCRIPTION,
  TERM_BASIC.TERM_SESSION,
  TERM_BASIC.TERM_START,
  TERM_BASIC.TERM_END,
  TERM_BASIC.TERM_PREREG_START,
  TERM_BASIC.TERM_PREREG_END,
  TERM_BASIC.TERM_REG_START,
  TERM_BASIC.TERM_REG_END,
  TERM_BASIC.TERM_ADD_START,
  TERM_BASIC.TERM_ADD_END,
  TERM_BASIC.TERM_DROP_START,
  TERM_BASIC.TERM_DROP_END,
  TERM_BASIC.TERM_BILLING_DATE,
  TERM_BASIC.TERM_DROP_GRADES_REQD,
  TERM_BASIC.TERM_CENSUS
FROM
  TERM_BASIC
WHERE
  ( TERM_BASIC.SCHOOL  IN  ( 'CC'  ) )
"

temp_term_dates <- qry_eds(SQL)

dd <- merge(x = term_lu(start, end, seasons),
            y = temp_term_dates,
            by.x = "term",
            by.y = "TERM_ID",
            all.x = TRUE)

dd <- as.data.frame(dd[with(dd, order(term_numeric)), ], stringAsFactors = FALSE)

rownames(dd) <- NULL

out <- dd

return(out)

}

#'@rdname terms
#'@export
term_current <- function(){

sql_term_dates <- "SELECT
TERM_BASIC.TERM_ID,
TERM_BASIC.TERM_START,
TERM_BASIC.TERM_END
FROM
TERM_BASIC
WHERE
( TERM_BASIC.SCHOOL  IN  ( 'CC'  ) )
"

  # Extract Term Information From EDS Database
  term_information <- researchR::qry_eds(sql_term_dates, network = TRUE)

  # Convert Term Information into Date
  term_information <- term_information %>%
    mutate_at(vars(TERM_START:TERM_END), funs(as.Date))

  # Identify today's date
  today <- Sys.Date()

  # Today must be inbetween PRE_REG_START AND TERM_END
  current_term <- term_information$TERM_ID[today >= term_information$TERM_START & today <= term_information$TERM_END]

  return(current_term)

}

#'@rdname terms
#'@export
term_active <- function(type = "active"){
  # Pull in term information
  # Define Necessary SQL
  sql_term_dates <- "SELECT
  TERM_BASIC.TERM_ID,
  TERM_BASIC.SCHOOL,
  TERM_BASIC.TERM_FISCAL_YEAR,
  TERM_BASIC.REPORTING_TERM,
  TERM_BASIC.TERM_DESCRIPTION,
  TERM_BASIC.TERM_SESSION,
  TERM_BASIC.TERM_START,
  TERM_BASIC.TERM_END,
  TERM_BASIC.TERM_PREREG_START,
  TERM_BASIC.TERM_PREREG_END,
  TERM_BASIC.TERM_REG_START,
  TERM_BASIC.TERM_REG_END,
  TERM_BASIC.TERM_ADD_START,
  TERM_BASIC.TERM_ADD_END,
  TERM_BASIC.TERM_DROP_START,
  TERM_BASIC.TERM_DROP_END,
  TERM_BASIC.TERM_BILLING_DATE,
  TERM_BASIC.TERM_DROP_GRADES_REQD,
  TERM_BASIC.TERM_CENSUS
  FROM
  TERM_BASIC
  WHERE
  ( TERM_BASIC.SCHOOL  IN  ( 'CC'  ) )
  "

  # Extract Term Information From EDS Database
  term_information <- researchR::qry_eds(sql_term_dates)

  # Convert Term Information into Date
  term_information <- term_information %>%
    mutate_at(vars(TERM_START:TERM_CENSUS), funs(as.Date))%>%
    arrange(TERM_START)

  # Identify today's date
  today <- Sys.Date()

  # Today must be inbetween PRE_REG_START AND TERM_END
  if(type == "active"){
    out <- term_information$TERM_ID[today >= term_information$TERM_PREREG_START & today <= term_information$TERM_END]
  }

  if(type == "current"){
    out <- term_information$TERM_ID[today >= term_information$TERM_START & today <= term_information$TERM_END]
  }

  if(type == "newest"){
    actives <- term_information$TERM_ID[today >= term_information$TERM_PREREG_START & today <= term_information$TERM_END]
    out <- actives[[length(actives)]]
  }

  if(type == "recent"){
    active_index <- which(today >= term_information$TERM_PREREG_START & today <= term_information$TERM_END)
    ind <- unique(c(active_index - 1, active_index))
    out <- term_information$TERM_ID[ind]
  }

  return(out)

}