## ----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 = '')