## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, message=FALSE-----------------------------------------------------
#load packages
library(dplyr)
library(magrittr)
library(IPEDSuploadables)

## ----create_dummy_data, message=FALSE-----------------------------------------
#create data
adm_dat <- data.frame(StudentId = seq(1:24),
                      FtPt = c(rep('FT', 23), 'PT'),
                      Sex = rep(c("M", "F"), 12),
                      GenderDetail = c(rep(c("M", "F"), 11), "U", "A"),
                      Admit = c(rep(1, 16), rep(0, 8)),
                      Enroll = c(rep(1, 12), rep(0, 12)),
                      SAT = c(rep(1, 8), rep(0, 16)),
                      SAT_V = c(500, 560, 600, 660, 700, 760, 800, 800, rep(NA, 16)),
                      SAT_M = c(400, 460, 500, 560, 600, 660, 700, 700, rep(NA, 16)),
                      ACT = c(rep(0, 8), rep(1, 16)),
                      ACT_CMP = c(rep(NA, 8), 32, 32, 31, 31, 30, 30, 29, 29, 28, 28, 27, 27, 26, 26, 25, 25)
                      )

## ----printdat, echo=FALSE-----------------------------------------------------
knitr::kable(adm_dat, 
            format = 'html')

## ----produceA-----------------------------------------------------------------
#### PART A: General Admissions Criteria
partA <- data.frame(UNITID = 999999,
                    SURVSECT = 'ADM',
                    PART = 'A',
                    ADMCON1 = 2, #GPA
                    ADMCON2 = 1, #Rank
                    ADMCON3 = 1, #Record
                    ADMCON4 = 2, #HS grad
                    ADMCON5 = 1, #Recs
                    ADMCON6 = 3, #Portfolio
                    ADMCON7 = 5, #SAT/ACT  #1 or 5 = have to do part C
                    ADMCON8 = 2, #TOEFL
                    ADMCON9 = 3, #other test
                    ADMCON10 = 2, #work exp
                    ADMCON11 = 1, #personal statement
                    ADMCON12 = 3 #legacy
                    )

## ----printA, echo=FALSE-------------------------------------------------------
knitr::kable(partA, 
            format = 'html')

## ----produceB-----------------------------------------------------------------
##### PART B: Admission Counts; FirstTime UG only
partB <- data.frame(UNITID = 999999,
                    SURVSECT = 'ADM',
                    PART = 'B',
                    APPLCNM = nrow(adm_dat[adm_dat$GenderDetail == 'M', ]),
                    APPLCNW = nrow(adm_dat[adm_dat$GenderDetail == 'F', ]),
                    APPLCNT = nrow(adm_dat),
                    ADMSSNM = nrow(adm_dat[adm_dat$GenderDetail == 'M' & 
                                             adm_dat$Admit == 1,]),
                    ADMSSNW = nrow(adm_dat[adm_dat$GenderDetail == 'F' & 
                                             adm_dat$Admit == 1,]),
                    ADMSSNT = nrow(adm_dat[adm_dat$Admit == 1,]),
                    ENRLFTM = nrow(adm_dat[adm_dat$GenderDetail == 'M' & 
                                             adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'FT', ]),
                    ENRLFTW = nrow(adm_dat[adm_dat$GenderDetail == 'F' & 
                                             adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'FT', ]),
                    ENRLFTT = nrow(adm_dat[adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'FT', ]),
                    ENRLPTM = nrow(adm_dat[adm_dat$GenderDetail == 'M' & 
                                             adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'PT', ]),
                    ENRLPTW = nrow(adm_dat[adm_dat$GenderDetail == 'F' & 
                                             adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'PT', ]),
                    ENRLPTT = nrow(adm_dat[adm_dat$Enroll == 1 & 
                                             adm_dat$FtPt == 'PT', ]),
                    #can you report another gender? 1 = yes, 2 = no
                    ADMGU01 = 1,
                    #if you said 1, keep the code below as-is
                    #if you said 2, remove code, and assign -2 to all 4 columns
                    APPLCNAG = nrow(adm_dat[adm_dat$GenderDetail == 'A', ]),
                    ADMSSNAG = nrow(adm_dat[adm_dat$GenderDetail == 'A' & 
                                              adm_dat$Admit == 1, ]),
                    ENRLFTAG = nrow(adm_dat[adm_dat$GenderDetail == 'A' & 
                                              adm_dat$Enroll == 1 & 
                                              adm_dat$FtPt == 'FT', ]),
                    ENRLPTAG = nrow(adm_dat[adm_dat$GenderDetail == 'A' & 
                                              adm_dat$Enroll == 1 & 
                                              adm_dat$FtPt == 'PT', ])
                    )

#mask data if you ARE able to report "Another Gender", 
# but the count is below 5 in any category
#if you are NOT able to report "Another Gender", 
# this code will not change your data, even if you run it
if((partB$APPLCNAG < 5 | partB$ADMSSNAG < 5 | 
    partB$ENRLFTAG < 5 | partB$ENRLPTAG < 5) & partB$ADMGU01 == 1){
  partB$ADMGU01 <- 3
  partB$APPLCNAG <- -2
  partB$ADMSSNAG <- -2
  partB$ENRLFTAG <- -2
  partB$ENRLPTAG <- -2
}

## ----printB, echo=FALSE-------------------------------------------------------
knitr::kable(partB, 
            format = 'html')

## ----produceC-----------------------------------------------------------------
#### PART C: Test Scores

adm_enr <- adm_dat %>%
  filter(Enroll == 1)

#in this example we are not supplying ACT test percentiles by subject
partC <- data.frame(UNITID = 999999,
                    SURVSECT = 'ADM',
                    PART = 'C',
                    SATINUM = nrow(adm_enr[adm_enr$SAT == 1, ]),
                    SATIPCT = round(nrow(adm_enr[adm_enr$SAT == 1, ])*100/nrow(adm_enr), 0),
                    ACTNUM = nrow(adm_enr[adm_enr$ACT == 1,]),
                    ACTPCT = round(nrow(adm_enr[adm_enr$ACT == 1,])*100/nrow(adm_enr), 0),
                    SATVR25 = quantile(adm_enr$SAT_V[!is.na(adm_enr$SAT_V)], .25),
                    SATVR75 = quantile(adm_enr$SAT_V[!is.na(adm_enr$SAT_V)], .75),
                    SATMT25 = quantile(adm_enr$SAT_M[!is.na(adm_enr$SAT_M)], .25),
                    SATMT75 = quantile(adm_enr$SAT_M[!is.na(adm_enr$SAT_M)], .75),
                    ACTCM25 = quantile(adm_enr$ACT_CMP[!is.na(adm_enr$ACT_CMP)], .25),
                    ACTCM75 = quantile(adm_enr$ACT_CMP[!is.na(adm_enr$ACT_CMP)], .75),
                    ACTEN25 = -2,
                    ACTEN75 = -2,
                    ACTMT25 = -2,
                    ACTMT75 = -2,
                    SATVR50 = quantile(adm_enr$SAT_V[!is.na(adm_enr$SAT_V)], .5),
                    SATMT50 = quantile(adm_enr$SAT_M[!is.na(adm_enr$SAT_M)], .5),
                    ACTCM50 = quantile(adm_enr$ACT_CMP[!is.na(adm_enr$ACT_CMP)], .5),
                    ACTEN50 = -2,
                    ACTMT50 = -2)

#mask data for an exam if you have fewer than 5 students counted for it
if(partC$SATINUM < 5){
  partC <- partC %>%
    mutate(across(c("SATVR25", "SATVR75", "SATVR50",
                    "SATMT25", "SATMT75", "SATMT50"), 
                  function(x) -2))
}
if(partC$ACTNUM < 5){
  partC <- partC %>%
    mutate(across(c("ACTCM25", "ACTCM75", "ACTCM50", 
                    "ACTMT25", "ACTMT75", "ACTMT50", 
                    "ACTEN25", "ACTEN75", "ACTEN50"), 
                  function(x) -2))
}

## ----printC, echo=FALSE-------------------------------------------------------
knitr::kable(partC, 
            format = 'html', 
            row.names = FALSE)

## ----producefinal, echo=TRUE, eval=FALSE, message=FALSE-----------------------
# produce_other_report(partA, partB, partC, survey = "Admissions")

## ----showfinal, echo=FALSE, eval=TRUE, message=FALSE--------------------------
rbind(IPEDSuploadables:::apply_upload_format(partA),
      IPEDSuploadables:::apply_upload_format(partB),
      IPEDSuploadables:::apply_upload_format(partC)) %>%
  knitr::kable(format = 'html',
               row.names = FALSE,
               col.names = '')

