df1<-df
df1$COHORT<-as.factor(df1$COHORT)

Descriptive statistics

columns_to_convert<- c("TRANSFER_STATUS","GENDER","RESIDENCY","INDIGENOUS","FIRSTGEN","ADMITTED_FACULTY","ADMITTED_PROGRAM")
df1[columns_to_convert] <- lapply(df1[columns_to_convert], factor)
summary(df1)

##      KEY               COHORT          ID            GRADUATED_100   
##  Length:5898        201670:1350   Length:5898        Min.   :0.0000  
##  Class :character   201770:1617   Class :character   1st Qu.:0.0000  
##  Mode  :character   201870:1467   Mode  :character   Median :0.0000  
##                     201970:1464                      Mean   :0.4135  
##                                                      3rd Qu.:1.0000  
##                                                      Max.   :1.0000  
##                                                                      
##  PROGRAM_GPA_100 TRANSFER_STATUS      AGE                 GENDER    
##  Min.   :42.60   Block :1549     Min.   :16.00   Female      :3727  
##  1st Qu.:72.50   Credit: 513     1st Qu.:18.00   Male        :2160  
##  Median :77.20   None  :3836     Median :20.00   Not Reported:  11  
##  Mean   :77.22                   Mean   :21.48                      
##  3rd Qu.:82.30                   3rd Qu.:22.00                      
##  Max.   :96.20                   Max.   :59.00                      
##  NA's   :2265                    NA's   :1                          
##          RESIDENCY    INDIGENOUS FIRSTGEN    ADMITTED_GPA    ADMITTED_FACULTY
##  Domestic     :5119      :  58      :  58   Min.   :  0.00   FAST: 237       
##  International: 779   No :5765   No :4506   1st Qu.: 69.50   FHSW: 137       
##                       Yes:  75   Yes:1334   Median : 74.50   FMCA:1129       
##                                             Mean   : 74.21   FSCS:1893       
##                                             3rd Qu.: 80.00   LFB :2502       
##                                             Max.   :100.00                   
##                                             NA's   :620                      
##      ADMITTED_PROGRAM PREV_INST_TYPE     PREV_INST_COUNT TRANSFER_CREDITS
##  SOCSCI_CJ_BA: 990    Length:5898        Min.   :1.000   Min.   :  0.00  
##  PARALEGAL_BA: 502    Class :character   1st Qu.:1.000   1st Qu.: 27.00  
##  CHILD_YOU_BA: 440    Mode  :character   Median :1.000   Median : 51.00  
##  ACCOUNT_BA  : 356                       Mean   :1.078   Mean   : 42.68  
##  BEHAV_SCI_BA: 329                       3rd Qu.:1.000   3rd Qu.: 60.00  
##  FILM_PROD_BA: 290                       Max.   :4.000   Max.   :129.00  
##  (Other)     :2991                       NA's   :3836    NA's   :3836

library(dplyr)
df1$GRADUATED_100<-as.numeric(df1$GRADUATED_100)

# summary of DVs by transfer status
summary_table<-df1 %>%
  group_by(TRANSFER_STATUS) %>%
  summarize(
    GRADUATED_100 = mean(GRADUATED_100),
    PROGRAM_GPA_100 = mean(PROGRAM_GPA_100, na.rm = TRUE)
  )

library(knitr)
kable(summary_table)

TRANSFER_STATUS	GRADUATED_100	PROGRAM_GPA_100
Block	0.5635894	77.49118
Credit	0.5048733	78.46377
None	0.3407195	76.90181

df1$GRADUATED_100 <- as.factor(as.character(df1$GRADUATED_100))

# number of students with values in PROGRAM_GAP_100 (not NA)
count_table<-df1[!is.na(df1$PROGRAM_GPA_100),] %>%
  group_by(TRANSFER_STATUS) %>%
  summarise(count = n())
count_table

## # A tibble: 3 × 2
##   TRANSFER_STATUS count
##   <fct>           <int>
## 1 Block            1069
## 2 Credit            347
## 3 None             2217

# number of students in the full data
count_table1<-df1 %>%
  group_by(TRANSFER_STATUS) %>%
  summarise(count = n())
count_table1

## # A tibble: 3 × 2
##   TRANSFER_STATUS count
##   <fct>           <int>
## 1 Block            1549
## 2 Credit            513
## 3 None             3836

T-test and Chi-square test to see if the Block transfer and None transfer groups are comparable

df1$GENDER[df$GENDER == "Not Reported"] <- NA
df3<-df1
df3[, 8] <- ifelse(df3[, "GENDER"] == "Male", 1, 0)
df3[, 9] <- ifelse(df3[, "RESIDENCY"] == "Domestic", 1, 0)
df3[, 10] <- ifelse(df3[, "INDIGENOUS"] == "Yes", 1, 0)
df3[, 11] <- ifelse(df3[, "FIRSTGEN"] == "Yes", 1, 0)

subset_data<-df3[!df3$TRANSFER_STATUS=="Credit",7:11]
df3<-df3[!df3$TRANSFER_STATUS=="Credit",]

# Perform t-test for each column based on TRANSFER_STATUS
result <- lapply(subset_data, function(col) {
 t.test(col ~ df3$TRANSFER_STATUS)
})

result

## $AGE
## 
##  Welch Two Sample t-test
## 
## data:  col by df3$TRANSFER_STATUS
## t = 15.999, df = 2185.6, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Block and group None is not equal to 0
## 95 percent confidence interval:
##  2.327657 2.977976
## sample estimates:
## mean in group Block  mean in group None 
##            23.18528            20.53246 
## 
## 
## $GENDER
## 
##  Welch Two Sample t-test
## 
## data:  col by df3$TRANSFER_STATUS
## t = 2.4632, df = 2812.8, p-value = 0.01383
## alternative hypothesis: true difference in means between group Block and group None is not equal to 0
## 95 percent confidence interval:
##  0.00738129 0.06499799
## sample estimates:
## mean in group Block  mean in group None 
##           0.4007757           0.3645861 
## 
## 
## $RESIDENCY
## 
##  Welch Two Sample t-test
## 
## data:  col by df3$TRANSFER_STATUS
## t = 12.473, df = 4405.4, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Block and group None is not equal to 0
## 95 percent confidence interval:
##  0.0892405 0.1225258
## sample estimates:
## mean in group Block  mean in group None 
##           0.9406068           0.8347237 
## 
## 
## $INDIGENOUS
## 
##  Welch Two Sample t-test
## 
## data:  col by df3$TRANSFER_STATUS
## t = 0.59024, df = 2665.4, p-value = 0.5551
## alternative hypothesis: true difference in means between group Block and group None is not equal to 0
## 95 percent confidence interval:
##  -0.004557549  0.008482850
## sample estimates:
## mean in group Block  mean in group None 
##          0.01291156          0.01094891 
## 
## 
## $FIRSTGEN
## 
##  Welch Two Sample t-test
## 
## data:  col by df3$TRANSFER_STATUS
## t = 3.3535, df = 2703, p-value = 0.0008091
## alternative hypothesis: true difference in means between group Block and group None is not equal to 0
## 95 percent confidence interval:
##  0.01794006 0.06846033
## sample estimates:
## mean in group Block  mean in group None 
##           0.2543577           0.2111575

faculty_table_data <- table(df1$TRANSFER_STATUS, df1$ADMITTED_FACULTY)
chisq.test(faculty_table_data)

## 
##  Pearson's Chi-squared test
## 
## data:  faculty_table_data
## X-squared = 441.52, df = 8, p-value < 2.2e-16

program_table_data <- table(df1$TRANSFER_STATUS, df1$ADMITTED_PROGRAM)
chisq.test(program_table_data)

## Warning in chisq.test(program_table_data): Chi-squared approximation may be
## incorrect

## 
##  Pearson's Chi-squared test
## 
## data:  program_table_data
## X-squared = 731.45, df = 46, p-value < 2.2e-16

Use propensity score matching to find matching Non-transfer students for block transfer students

library(MatchIt)
df3$TRANSFER_STATUS <- relevel(df3$TRANSFER_STATUS, ref = "None")

# finding non-transfer matches, cannot specify all match criterion due to control size limitations
formula <- TRANSFER_STATUS ~ COHORT + AGE + GENDER + RESIDENCY 
df4 <- df3[complete.cases(df3[, c(7:11,13,14)]), ]

# Perform propensity score matching
matched_data <- matchit(formula, data = df4, method = "nearest", distance = "logit")

# Obtain the matched data
matched_df <- match.data(matched_data)
df5<-matched_df

table(df5$TRANSFER_STATUS, df5$ADMITTED_PROGRAM)

##         
##          ACCOUNT_BA BEHAV_SCI_BA CHILD_YOU_BA CMTY_DVLP_BA COMM_FIN_BA
##   None           94          113          110           29          76
##   Block         100           59          176           77          55
##   Credit          0            0            0            0           0
##         
##          COMM_MGMT_BA COMM_MKTG_BA COMM_SUPP_BA CREA_ADV_BA DESIGN_BA
##   None             16           35           37          40        21
##   Block            52           44           36          35         9
##   Credit            0            0            0           0         0
##         
##          DGTL_COMM_BA DIG_BU_MG_BA FASHION_BA FILM_PROD_BA HLTH_MGT_BA
##   None             61           36         18           51          38
##   Block            36           31         44           11           9
##   Credit            0            0          0            0           0
##         
##          HLTH_SC_W_BA HRM_MGMT_BA INTE_DESG_BA INTNL_BUS_BA JOURNALSM_BA
##   None             30          57           51           36           45
##   Block            25          39           28           11           14
##   Credit            0           0            0            0            0
##         
##          PARALEGAL_BA PUBL_RELA_BA SOCSCI_CJ_BA TOUR_MGMT_BA
##   None            135           95          301           22
##   Block           127            8          482           39
##   Credit            0            0            0            0

columns_to_convert1<- c("GENDER","RESIDENCY","INDIGENOUS","FIRSTGEN","GRADUATED_100")
df5[columns_to_convert1] <- lapply(df5[columns_to_convert1], as.character)

df5 %>%
  group_by(TRANSFER_STATUS) %>%
  summarise(mean_age = mean(AGE, na.rm = TRUE), sd_age = sd(AGE, na.rm = TRUE),
            mean_adm_GPA = mean(ADMITTED_GPA, na.rm = TRUE), sd_adm_GPA = sd(ADMITTED_GPA, na.rm = TRUE))

## # A tibble: 2 × 5
##   TRANSFER_STATUS mean_age sd_age mean_adm_GPA sd_adm_GPA
##   <fct>              <dbl>  <dbl>        <dbl>      <dbl>
## 1 None                22.8   5.46         73.5       7.75
## 2 Block               23.2   5.97         74.2      16.0

table(df5$TRANSFER_STATUS,df5$GENDER)

##         
##            0   1
##   None   928 619
##   Block  927 620
##   Credit   0   0

T-tests of the matched data

columns_to_convert1<- c("GENDER","RESIDENCY","INDIGENOUS","FIRSTGEN","GRADUATED_100")
df5[columns_to_convert1] <- lapply(df5[columns_to_convert1], as.numeric)
subset_data1<-df5[,7:12]

# Perform t-test for each column based on TRANSFER_STATUS
result <- lapply(subset_data1, function(col) {
 t.test(col ~ df5$TRANSFER_STATUS)
})

result

## $AGE
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = -1.6592, df = 3068.5, p-value = 0.09718
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -0.74464095  0.06202944
## sample estimates:
##  mean in group None mean in group Block 
##            22.84680            23.18811 
## 
## 
## $GENDER
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = -0.036679, df = 3092, p-value = 0.9707
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -0.03520179  0.03390896
## sample estimates:
##  mean in group None mean in group Block 
##           0.4001293           0.4007757 
## 
## 
## $RESIDENCY
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = 0, df = 3092, p-value = 1
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -0.01667875  0.01667875
## sample estimates:
##  mean in group None mean in group Block 
##           0.9405301           0.9405301 
## 
## 
## $INDIGENOUS
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = -0.49603, df = 3072.3, p-value = 0.6199
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -0.009604737  0.005726262
## sample estimates:
##  mean in group None mean in group Block 
##          0.01098901          0.01292825 
## 
## 
## $FIRSTGEN
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = 1.2632, df = 3090.2, p-value = 0.2066
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -0.01106611  0.05114368
## sample estimates:
##  mean in group None mean in group Block 
##           0.2747253           0.2546865 
## 
## 
## $ADMITTED_GPA
## 
##  Welch Two Sample t-test
## 
## data:  col by df5$TRANSFER_STATUS
## t = -1.1746, df = 1264.2, p-value = 0.2404
## alternative hypothesis: true difference in means between group None and group Block is not equal to 0
## 95 percent confidence interval:
##  -1.7261496  0.4332405
## sample estimates:
##  mean in group None mean in group Block 
##            73.52740            74.17385

summary(df5)

##      KEY               COHORT         ID            GRADUATED_100  
##  Length:3094        201670:612   Length:3094        Min.   :0.000  
##  Class :character   201770:854   Class :character   1st Qu.:0.000  
##  Mode  :character   201870:785   Mode  :character   Median :0.000  
##                     201970:843                      Mean   :0.435  
##                                                     3rd Qu.:1.000  
##                                                     Max.   :1.000  
##                                                                    
##  PROGRAM_GPA_100 TRANSFER_STATUS      AGE            GENDER      
##  Min.   :42.60   None  :1547     Min.   :17.00   Min.   :0.0000  
##  1st Qu.:72.33   Block :1547     1st Qu.:20.00   1st Qu.:0.0000  
##  Median :77.20   Credit:   0     Median :21.00   Median :0.0000  
##  Mean   :77.21                   Mean   :23.02   Mean   :0.4005  
##  3rd Qu.:82.50                   3rd Qu.:24.00   3rd Qu.:1.0000  
##  Max.   :96.20                   Max.   :59.00   Max.   :1.0000  
##  NA's   :1188                                                    
##    RESIDENCY        INDIGENOUS         FIRSTGEN       ADMITTED_GPA   
##  Min.   :0.0000   Min.   :0.00000   Min.   :0.0000   Min.   :  0.00  
##  1st Qu.:1.0000   1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.: 69.17  
##  Median :1.0000   Median :0.00000   Median :0.0000   Median : 74.17  
##  Mean   :0.9405   Mean   :0.01196   Mean   :0.2647   Mean   : 73.78  
##  3rd Qu.:1.0000   3rd Qu.:0.00000   3rd Qu.:1.0000   3rd Qu.: 80.00  
##  Max.   :1.0000   Max.   :1.00000   Max.   :1.0000   Max.   :100.00  
##                                                      NA's   :581     
##  ADMITTED_FACULTY     ADMITTED_PROGRAM PREV_INST_TYPE     PREV_INST_COUNT
##  FAST:  79        SOCSCI_CJ_BA: 783    Length:3094        Min.   :1.000  
##  FHSW:  55        CHILD_YOU_BA: 286    Class :character   1st Qu.:1.000  
##  FMCA: 426        PARALEGAL_BA: 262    Mode  :character   Median :1.000  
##  FSCS:1347        ACCOUNT_BA  : 194                       Mean   :1.063  
##  LFB :1187        BEHAV_SCI_BA: 172                       3rd Qu.:1.000  
##                   COMM_FIN_BA : 131                       Max.   :3.000  
##                   (Other)     :1266                       NA's   :1547   
##  TRANSFER_CREDITS    distance          weights     subclass   
##  Min.   :  0.00   Min.   :0.07843   Min.   :1   1      :   2  
##  1st Qu.: 39.00   1st Qu.:0.26205   1st Qu.:1   2      :   2  
##  Median : 57.00   Median :0.30460   Median :1   3      :   2  
##  Mean   : 52.77   Mean   :0.34073   Mean   :1   4      :   2  
##  3rd Qu.: 63.00   3rd Qu.:0.37465   3rd Qu.:1   5      :   2  
##  Max.   :129.00   Max.   :0.96093   Max.   :1   6      :   2  
##  NA's   :1547                                   (Other):3082

# summary of DVs by transfer status
summary_table1<-df5 %>%
  group_by(TRANSFER_STATUS) %>%
  summarize(GRADUATED_100 = mean(GRADUATED_100),
    PROGRAM_GPA_100 = mean(PROGRAM_GPA_100, na.rm = TRUE)
  )

summary_table2<-df5 %>%
  group_by(TRANSFER_STATUS) %>%
  summarize(
    SD_PRGRAM_GPA = sd(PROGRAM_GPA_100, na.rm=TRUE)
  )

library(knitr)
kable(summary_table1)

TRANSFER_STATUS	GRADUATED_100	PROGRAM_GPA_100
None	0.3063995	76.83437
Block	0.5636716	77.50531

kable(summary_table2)

TRANSFER_STATUS	SD_PRGRAM_GPA
None	7.296851
Block	7.272886

Count table of demographic variables

# df5 %>%
#   group_by(TRANSFER_STATUS) %>%
#   count(GENDER, RESIDENCY, FIRSTGEN, INDIGENOUS, name = "Count")


df5 %>%
  group_by(TRANSFER_STATUS) %>%
  count(GENDER, RESIDENCY, FIRSTGEN, INDIGENOUS) %>%
  summarize(
    Count_GENDER = sum(n[GENDER == 0]),
    Count_RESIDENCY = sum(n[RESIDENCY == 0]),
    Count_FIRSTGEN = sum(n[FIRSTGEN == 0]),
    Count_INDIGENOUS = sum(n[INDIGENOUS == 0])
  )

## # A tibble: 2 × 5
##   TRANSFER_STATUS Count_GENDER Count_RESIDENCY Count_FIRSTGEN Count_INDIGENOUS
##   <fct>                  <int>           <int>          <int>            <int>
## 1 None                     928              92           1122             1530
## 2 Block                    927              92           1153             1527

program_table<-df5 %>%
  group_by(TRANSFER_STATUS) %>%
  count(ADMITTED_PROGRAM)
program_table

## # A tibble: 48 × 3
## # Groups:   TRANSFER_STATUS [2]
##    TRANSFER_STATUS ADMITTED_PROGRAM     n
##    <fct>           <fct>            <int>
##  1 None            ACCOUNT_BA          94
##  2 None            BEHAV_SCI_BA       113
##  3 None            CHILD_YOU_BA       110
##  4 None            CMTY_DVLP_BA        29
##  5 None            COMM_FIN_BA         76
##  6 None            COMM_MGMT_BA        16
##  7 None            COMM_MKTG_BA        35
##  8 None            COMM_SUPP_BA        37
##  9 None            CREA_ADV_BA         40
## 10 None            DESIGN_BA           21
## # ℹ 38 more rows

write.csv(program_table, "program_table1.csv")

DV by Cohort graphs

Likelihood to graduate at 100%

alpha <- 0.05
z_value <- qnorm(1 - alpha / 2)

ldf <- df5 %>%
  group_by(COHORT, TRANSFER_STATUS) %>%
  summarise(mean_gpa = mean(PROGRAM_GPA_100, na.rm = TRUE),
            sd_gpa = sd(PROGRAM_GPA_100, na.rm = TRUE),
            lower_ci = mean_gpa - z_value * (sd_gpa / sqrt(n())),
            upper_ci = mean_gpa + z_value * (sd_gpa / sqrt(n()))) %>%
  ungroup()

## `summarise()` has grouped output by 'COHORT'. You can override using the
## `.groups` argument.

library(ggplot2)
plot1<-ggplot(ldf, aes(x = COHORT, y = mean_gpa, group = TRANSFER_STATUS, color = TRANSFER_STATUS)) +
  geom_line() +
  geom_point() +
  geom_errorbar(
    aes(ymin = lower_ci, ymax = upper_ci),
    width = 0.2,
    position = position_dodge(0.05)
  ) +
  labs(x = "Cohort", y = "GPA at 100% program length", color = "TRANSFER STATUS") +
  theme_minimal()


# Custom x-axis labels
custom_labels <- c("Fall 2016", "Fall 2017", "Fall 2018", "Fall 2019")

# Update the x-axis labels
plot1 + scale_x_discrete(labels = custom_labels)

### GPA at 100%

df5$GRADUATED_100<-as.numeric(as.character(df5$GRADUATED_100))
ldf2 <- df5 %>%
  group_by(COHORT, TRANSFER_STATUS) %>%
  summarise(mean_grad = mean(GRADUATED_100, na.rm = TRUE),
            sd_grad = sd(GRADUATED_100, na.rm = TRUE),
            lower_ci = mean_grad - z_value * (sd_grad / sqrt(n())),
            upper_ci = mean_grad + z_value * (sd_grad / sqrt(n()))) %>%
  ungroup()

## `summarise()` has grouped output by 'COHORT'. You can override using the
## `.groups` argument.

library(ggplot2)
plot2<-ggplot(ldf2, aes(x = COHORT, y = mean_grad, group = TRANSFER_STATUS, color = TRANSFER_STATUS)) +
  geom_line() +
  geom_point() +
  geom_errorbar(
    aes(ymin = lower_ci, ymax = upper_ci),
    width = 0.2,
    position = position_dodge(0.05)
  ) +
  labs(x = "Cohort", y = "Likelihood of graduation at 100% program length", color = "TRANSFER STATUS") +
  theme_minimal()

# Custom x-axis labels
custom_labels <- c("Fall 2016", "Fall 2017", "Fall 2018", "Fall 2019")

# Update the x-axis labels
plot2 + scale_x_discrete(labels = custom_labels)

Graduation at 100%

All students

Main effect model

df5$TRANSFER_STATUS <- relevel(df5$TRANSFER_STATUS, ref = "None")
main_m1<-glm(GRADUATED_100~ COHORT + TRANSFER_STATUS + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM, df5, family="binomial")
summary(main_m1)

## 
## Call:
## glm(formula = GRADUATED_100 ~ COHORT + TRANSFER_STATUS + AGE + 
##     GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + 
##     ADMITTED_FACULTY + ADMITTED_PROGRAM, family = "binomial", 
##     data = df5)
## 
## Coefficients: (4 not defined because of singularities)
##                               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   0.644140   0.473133   1.361 0.173376    
## COHORT201770                  0.410695   0.164528   2.496 0.012553 *  
## COHORT201870                  0.439773   0.163830   2.684 0.007268 ** 
## COHORT201970                  0.285080   0.162854   1.751 0.080028 .  
## TRANSFER_STATUSBlock          1.247603   0.101447  12.298  < 2e-16 ***
## AGE                          -0.027960   0.008781  -3.184 0.001452 ** 
## GENDER                       -0.395305   0.099687  -3.965 7.33e-05 ***
## RESIDENCY                    -0.667245   0.188670  -3.537 0.000405 ***
## INDIGENOUS                    0.043550   0.423187   0.103 0.918035    
## FIRSTGEN                     -0.207864   0.099856  -2.082 0.037376 *  
## ADMITTED_GPA                  0.004309   0.003714   1.160 0.245939    
## ADMITTED_FACULTYFHSW         -0.972132   0.402630  -2.414 0.015759 *  
## ADMITTED_FACULTYFMCA         -0.191513   0.342354  -0.559 0.575890    
## ADMITTED_FACULTYFSCS         -0.770608   0.290518  -2.653 0.007989 ** 
## ADMITTED_FACULTYLFB          -0.237295   0.322072  -0.737 0.461257    
## ADMITTED_PROGRAMBEHAV_SCI_BA  0.531000   0.206410   2.573 0.010095 *  
## ADMITTED_PROGRAMCHILD_YOU_BA  0.362484   0.180696   2.006 0.044852 *  
## ADMITTED_PROGRAMCMTY_DVLP_BA -0.000303   0.253236  -0.001 0.999045    
## ADMITTED_PROGRAMCOMM_FIN_BA  -0.535652   0.270689  -1.979 0.047833 *  
## ADMITTED_PROGRAMCOMM_MGMT_BA -0.435483   0.330745  -1.317 0.187948    
## ADMITTED_PROGRAMCOMM_MKTG_BA  0.240674   0.332639   0.724 0.469356    
## ADMITTED_PROGRAMCOMM_SUPP_BA -0.161346   0.332267  -0.486 0.627256    
## ADMITTED_PROGRAMCREA_ADV_BA  -4.604784   1.037199  -4.440 9.01e-06 ***
## ADMITTED_PROGRAMDESIGN_BA    -0.757230   0.466185  -1.624 0.104309    
## ADMITTED_PROGRAMDGTL_COMM_BA  0.049120   0.309922   0.158 0.874070    
## ADMITTED_PROGRAMDIG_BU_MG_BA  0.049099   0.347094   0.141 0.887509    
## ADMITTED_PROGRAMFASHION_BA   -0.062433   0.336001  -0.186 0.852593    
## ADMITTED_PROGRAMFILM_PROD_BA -0.513044   0.363554  -1.411 0.158188    
## ADMITTED_PROGRAMHLTH_MGT_BA  -0.419929   0.366138  -1.147 0.251418    
## ADMITTED_PROGRAMHLTH_SC_W_BA        NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA  -0.501022   0.308991  -1.621 0.104916    
## ADMITTED_PROGRAMINTE_DESG_BA        NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA -0.477545   0.391500  -1.220 0.222547    
## ADMITTED_PROGRAMJOURNALSM_BA -0.407657   0.366836  -1.111 0.266448    
## ADMITTED_PROGRAMPARALEGAL_BA -1.835815   0.252955  -7.257 3.94e-13 ***
## ADMITTED_PROGRAMPUBL_RELA_BA        NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA        NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA -0.154016   0.391454  -0.393 0.693990    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3399.4  on 2512  degrees of freedom
## Residual deviance: 2987.5  on 2479  degrees of freedom
##   (581 observations deleted due to missingness)
## AIC: 3055.5
## 
## Number of Fisher Scoring iterations: 6

Create stats table for main_m1

library(broom)
library(DescTools)
library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

main_m1_coef <- tidy(main_m1)[5:11,1:5]
                  
  # remove rownames
  rownames(main_m1_coef) <- c(1:nrow(main_m1_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(main_m1_coef) <- c("term", "beta", "beta_SE", "z_val", "p_val")

# finally, create df
main_m1_t <- 
      rbind(main_m1_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(main_m1)$fstatistic[2], summary(main_m1)$r.squared, nrow(main_m1$model)), 
             "beta_SE" = c(summary(main_m1)$fstatistic[3], summary(main_m1)$adj.r.squared, NA), 
             "z_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

# show kable table
kable(main_m1_t, caption = "Logistic Regression Model (Main effects only) Predicting Graduation Rate at 100% Program Length ", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "z-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Logistic Regression Model (Main effects only) Predicting Graduation Rate at 100% Program Length
		Beta	Beta’s SE	z-value	p-value
1	TRANSFER_STATUSBlock	1.248	0.101	12.298	0.000
2	AGE	-0.028	0.009	-3.184	0.001
3	GENDER	-0.395	0.100	-3.965	0.000
4	RESIDENCY	-0.667	0.189	-3.537	0.000
5	INDIGENOUS	0.044	0.423	0.103	0.918
6	FIRSTGEN	-0.208	0.100	-2.082	0.037
7	ADMITTED_GPA	0.004	0.004	1.160	0.246
8	f_stat	2513.000
9	R2/Adj.R2	2513.000
10	N	2513.000
Note:
…

write.csv(main_m1_t,"GRAD_Main.csv", row.names = T)

# reset NA vals in kable tables to "NA"
options(knitr.kable.NA = NA) 

# a<-tidy(main_m1)[,1]
# a<-as.data.frame(a)
# reversed_column <- rev(a$term)
# quoted_elements <- paste0("'", as.character(reversed_column), "'")
# names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'TRANSFER_STATUSBlock',"ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
main_m1_plot <- 
  sjPlot::plot_model(model = main_m1, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age', 'Transfer Status'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
main_m1_plot

With interaction effects

# column_names <- paste0(colnames(df1)[c(1,8:16)], collapse = " + ")

interact_m1<-glm(GRADUATED_100~COHORT + TRANSFER_STATUS + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM + TRANSFER_STATUS*RESIDENCY + TRANSFER_STATUS*GENDER + TRANSFER_STATUS*AGE + TRANSFER_STATUS*ADMITTED_GPA, df5, family="binomial")

summary(interact_m1)

## 
## Call:
## glm(formula = GRADUATED_100 ~ COHORT + TRANSFER_STATUS + AGE + 
##     GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + 
##     ADMITTED_FACULTY + ADMITTED_PROGRAM + TRANSFER_STATUS * RESIDENCY + 
##     TRANSFER_STATUS * GENDER + TRANSFER_STATUS * AGE + TRANSFER_STATUS * 
##     ADMITTED_GPA, family = "binomial", data = df5)
## 
## Coefficients: (4 not defined because of singularities)
##                                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                        0.6088444  0.6908256   0.881 0.378140    
## COHORT201770                       0.3953481  0.1653525   2.391 0.016805 *  
## COHORT201870                       0.4244326  0.1642577   2.584 0.009768 ** 
## COHORT201970                       0.2703645  0.1632594   1.656 0.097713 .  
## TRANSFER_STATUSBlock               1.8921039  0.8706184   2.173 0.029759 *  
## AGE                                0.0008236  0.0111010   0.074 0.940860    
## GENDER                            -0.5077537  0.1278322  -3.972 7.13e-05 ***
## RESIDENCY                         -0.5336524  0.2366594  -2.255 0.024137 *  
## INDIGENOUS                         0.0548280  0.4175732   0.131 0.895537    
## FIRSTGEN                          -0.2215437  0.1002341  -2.210 0.027087 *  
## ADMITTED_GPA                      -0.0066071  0.0075851  -0.871 0.383724    
## ADMITTED_FACULTYFHSW              -0.8542920  0.4028189  -2.121 0.033940 *  
## ADMITTED_FACULTYFMCA              -0.0784893  0.3446280  -0.228 0.819840    
## ADMITTED_FACULTYFSCS              -0.6634439  0.2923587  -2.269 0.023251 *  
## ADMITTED_FACULTYLFB               -0.0764866  0.3262927  -0.234 0.814666    
## ADMITTED_PROGRAMBEHAV_SCI_BA       0.4965175  0.2061094   2.409 0.015996 *  
## ADMITTED_PROGRAMCHILD_YOU_BA       0.4021082  0.1810428   2.221 0.026346 *  
## ADMITTED_PROGRAMCMTY_DVLP_BA       0.1120245  0.2560574   0.437 0.661751    
## ADMITTED_PROGRAMCOMM_FIN_BA       -0.5597396  0.2732744  -2.048 0.040534 *  
## ADMITTED_PROGRAMCOMM_MGMT_BA      -0.5311037  0.3358984  -1.581 0.113845    
## ADMITTED_PROGRAMCOMM_MKTG_BA       0.1899006  0.3360960   0.565 0.572061    
## ADMITTED_PROGRAMCOMM_SUPP_BA      -0.2009921  0.3364679  -0.597 0.550268    
## ADMITTED_PROGRAMCREA_ADV_BA       -4.6854161  1.0411403  -4.500 6.79e-06 ***
## ADMITTED_PROGRAMDESIGN_BA         -0.7506152  0.4774530  -1.572 0.115922    
## ADMITTED_PROGRAMDGTL_COMM_BA       0.0639550  0.3115989   0.205 0.837378    
## ADMITTED_PROGRAMDIG_BU_MG_BA       0.0735717  0.3498730   0.210 0.833448    
## ADMITTED_PROGRAMFASHION_BA        -0.1159336  0.3393013  -0.342 0.732589    
## ADMITTED_PROGRAMFILM_PROD_BA      -0.4535696  0.3653162  -1.242 0.214391    
## ADMITTED_PROGRAMHLTH_MGT_BA       -0.4808439  0.3666538  -1.311 0.189710    
## ADMITTED_PROGRAMHLTH_SC_W_BA              NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA       -0.5386113  0.3095005  -1.740 0.081813 .  
## ADMITTED_PROGRAMINTE_DESG_BA              NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA      -0.5108542  0.3930204  -1.300 0.193664    
## ADMITTED_PROGRAMJOURNALSM_BA      -0.4006622  0.3680534  -1.089 0.276331    
## ADMITTED_PROGRAMPARALEGAL_BA      -1.8907994  0.2544020  -7.432 1.07e-13 ***
## ADMITTED_PROGRAMPUBL_RELA_BA              NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA              NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA      -0.1836617  0.3941936  -0.466 0.641275    
## TRANSFER_STATUSBlock:RESIDENCY    -0.4153295  0.3999083  -1.039 0.299009    
## TRANSFER_STATUSBlock:GENDER        0.2448619  0.1912963   1.280 0.200540    
## TRANSFER_STATUSBlock:AGE          -0.0627140  0.0167115  -3.753 0.000175 ***
## TRANSFER_STATUSBlock:ADMITTED_GPA  0.0147898  0.0087329   1.694 0.090346 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3399.4  on 2512  degrees of freedom
## Residual deviance: 2965.9  on 2475  degrees of freedom
##   (581 observations deleted due to missingness)
## AIC: 3041.9
## 
## Number of Fisher Scoring iterations: 6

interact_m1_coef <- tidy(interact_m1)[c(5:11,39:42),1:5]
                  
  # remove rownames
  rownames(interact_m1_coef) <- c(1:nrow(interact_m1_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(interact_m1_coef) <- c("term", "beta", "beta_SE", "z_val", "p_val")

# finally, create df
interact_m1_t <- 
      rbind(interact_m1_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(interact_m1)$fstatistic[2], summary(interact_m1)$r.squared, nrow(interact_m1$model)), 
             "beta_SE" = c(summary(interact_m1)$fstatistic[3], summary(interact_m1)$adj.r.squared, NA), 
             "z_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

# show kable table
kable(interact_m1_t, caption = "Logistic Regression Model (with Interaction effects) Predicting Graduation Rate at 100% Program Length ", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "z-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Logistic Regression Model (with Interaction effects) Predicting Graduation Rate at 100% Program Length
		Beta	Beta’s SE	z-value	p-value
1	TRANSFER_STATUSBlock	1.892	0.871	2.173	0.030
2	AGE	0.001	0.011	0.074	0.941
3	GENDER	-0.508	0.128	-3.972	0.000
4	RESIDENCY	-0.534	0.237	-2.255	0.024
5	INDIGENOUS	0.055	0.418	0.131	0.896
6	FIRSTGEN	-0.222	0.100	-2.210	0.027
7	ADMITTED_GPA	-0.007	0.008	-0.871	0.384
8	TRANSFER_STATUSBlock:RESIDENCY	-0.415	0.400	-1.039	0.299
9	TRANSFER_STATUSBlock:GENDER	0.245	0.191	1.280	0.201
10	TRANSFER_STATUSBlock:AGE	-0.063	0.017	-3.753	0.000
11	TRANSFER_STATUSBlock:ADMITTED_GPA	0.015	0.009	1.694	0.090
12	f_stat	2513.000
13	R2/Adj.R2	2513.000
14	N	2513.000
Note:
…

write.csv(interact_m1_t,"GRAD_INTERACT.csv", row.names = T)

# reset NA vals in kable tables to "NA"
options(knitr.kable.NA = NA) 

# a<-tidy(main_m1)[,1]
# a<-as.data.frame(a)
# reversed_column <- rev(a$term)
# quoted_elements <- paste0("'", as.character(reversed_column), "'")
# names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'TRANSFER_STATUSBlock',"ADMITTED_GPA","TRANSFER_STATUSBlock:RESIDENCY","TRANSFER_STATUSBlock:GENDER","TRANSFER_STATUSBlock:AGE","TRANSFER_STATUSBlock:ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
interact_m1_plot <- 
  sjPlot::plot_model(model = interact_m1, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Transfer Status * Adm_GPA","Transfer Status * Age","Transfer Status * Gender","Transfer Status * Res","Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age', 'Transfer Status'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
interact_m1_plot

Transfer student previous institution info as predictors

m1_transfer_prev <- glm(GRADUATED_100~COHORT + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM+PREV_INST_TYPE+PREV_INST_COUNT+TRANSFER_CREDITS, df5, family= "binomial")
summary(m1_transfer_prev)

## 
## Call:
## glm(formula = GRADUATED_100 ~ COHORT + AGE + GENDER + RESIDENCY + 
##     INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + 
##     ADMITTED_PROGRAM + PREV_INST_TYPE + PREV_INST_COUNT + TRANSFER_CREDITS, 
##     family = "binomial", data = df5)
## 
## Coefficients: (4 not defined because of singularities)
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   2.671e+00  1.216e+00   2.197 0.028013 *  
## COHORT201770                  6.792e-01  7.019e-01   0.968 0.333182    
## COHORT201870                  7.983e-01  6.985e-01   1.143 0.253106    
## COHORT201970                  4.898e-01  6.972e-01   0.702 0.482369    
## AGE                          -6.239e-02  1.351e-02  -4.617  3.9e-06 ***
## GENDER                       -3.185e-01  1.633e-01  -1.951 0.051054 .  
## RESIDENCY                    -9.507e-01  3.501e-01  -2.715 0.006619 ** 
## INDIGENOUS                    9.058e-02  5.971e-01   0.152 0.879428    
## FIRSTGEN                     -9.776e-02  1.545e-01  -0.633 0.526859    
## ADMITTED_GPA                  5.531e-03  4.690e-03   1.179 0.238261    
## ADMITTED_FACULTYFHSW         -1.382e+00  8.332e-01  -1.659 0.097120 .  
## ADMITTED_FACULTYFMCA          1.559e+01  1.656e+03   0.009 0.992487    
## ADMITTED_FACULTYFSCS         -9.758e-01  7.513e-01  -1.299 0.193995    
## ADMITTED_FACULTYLFB          -9.095e-02  8.086e-01  -0.112 0.910438    
## ADMITTED_PROGRAMBEHAV_SCI_BA -9.900e-02  4.671e-01  -0.212 0.832133    
## ADMITTED_PROGRAMCHILD_YOU_BA  1.259e-01  2.740e-01   0.459 0.645935    
## ADMITTED_PROGRAMCMTY_DVLP_BA  2.845e-01  3.269e-01   0.870 0.384174    
## ADMITTED_PROGRAMCOMM_FIN_BA  -1.010e+00  4.836e-01  -2.088 0.036774 *  
## ADMITTED_PROGRAMCOMM_MGMT_BA -3.691e-01  4.764e-01  -0.775 0.438394    
## ADMITTED_PROGRAMCOMM_MKTG_BA  2.575e-01  6.308e-01   0.408 0.683168    
## ADMITTED_PROGRAMCOMM_SUPP_BA -1.990e-01  6.056e-01  -0.329 0.742514    
## ADMITTED_PROGRAMCREA_ADV_BA  -3.342e+01  1.721e+03  -0.019 0.984504    
## ADMITTED_PROGRAMDESIGN_BA    -1.592e+01  1.656e+03  -0.010 0.992328    
## ADMITTED_PROGRAMDGTL_COMM_BA -1.510e+01  1.656e+03  -0.009 0.992723    
## ADMITTED_PROGRAMDIG_BU_MG_BA  8.484e-01  8.494e-01   0.999 0.317850    
## ADMITTED_PROGRAMFASHION_BA   -1.157e-01  5.158e-01  -0.224 0.822515    
## ADMITTED_PROGRAMFILM_PROD_BA -1.672e+01  1.656e+03  -0.010 0.991943    
## ADMITTED_PROGRAMHLTH_MGT_BA  -7.151e-01  8.668e-01  -0.825 0.409369    
## ADMITTED_PROGRAMHLTH_SC_W_BA         NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA  -1.099e+00  6.202e-01  -1.771 0.076493 .  
## ADMITTED_PROGRAMINTE_DESG_BA         NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA  1.344e-01  1.189e+00   0.113 0.910051    
## ADMITTED_PROGRAMJOURNALSM_BA -1.714e+01  1.656e+03  -0.010 0.991741    
## ADMITTED_PROGRAMPARALEGAL_BA -1.516e+00  4.066e-01  -3.728 0.000193 ***
## ADMITTED_PROGRAMPUBL_RELA_BA         NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA         NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA  1.329e-01  7.023e-01   0.189 0.849944    
## PREV_INST_TYPEOTH-O           5.056e-01  7.500e-01   0.674 0.500265    
## PREV_INST_TYPEOTH-PSE        -2.577e-01  3.271e-01  -0.788 0.430797    
## PREV_INST_COUNT              -5.581e-01  2.709e-01  -2.060 0.039362 *  
## TRANSFER_CREDITS              9.857e-03  6.723e-03   1.466 0.142641    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1330.1  on 973  degrees of freedom
## Residual deviance: 1182.6  on 937  degrees of freedom
##   (2120 observations deleted due to missingness)
## AIC: 1256.6
## 
## Number of Fisher Scoring iterations: 15

m1_transfer_prev_coef <- tidy(m1_transfer_prev)[c(5:10,40,41),1:5]
                  
  # remove rownames
  rownames(m1_transfer_prev_coef) <- c(1:nrow(m1_transfer_prev_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(m1_transfer_prev_coef) <- c("term", "beta", "beta_SE", "z_val", "p_val")

# finally, create df
m1_transfer_prev_t <- 
      rbind(m1_transfer_prev_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(m1_transfer_prev)$fstatistic[2], summary(m1_transfer_prev)$r.squared, nrow(m1_transfer_prev$model)), 
             "beta_SE" = c(summary(m1_transfer_prev)$fstatistic[3], summary(m1_transfer_prev)$adj.r.squared, NA), 
             "z_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

# show kable table
kable(m1_transfer_prev_t, caption = "Logistic Regression Model predicting Transfer Students Graduation Rate at 100% Program Length ", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "z-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Logistic Regression Model predicting Transfer Students Graduation Rate at 100% Program Length
		Beta	Beta’s SE	z-value	p-value
1	AGE	-0.062	0.014	-4.617	0.000
2	GENDER	-0.319	0.163	-1.951	0.051
3	RESIDENCY	-0.951	0.350	-2.715	0.007
4	INDIGENOUS	0.091	0.597	0.152	0.879
5	FIRSTGEN	-0.098	0.154	-0.633	0.527
6	ADMITTED_GPA	0.006	0.005	1.179	0.238
7	PREV_INST_COUNT	-0.558	0.271	-2.060	0.039
8	TRANSFER_CREDITS	0.010	0.007	1.466	0.143
9	f_stat	974.000
10	R2/Adj.R2	974.000
11	N	974.000
Note:
…

write.csv(m1_transfer_prev_t,"GRAD_TRANSFER.csv", row.names = T)

options(knitr.kable.NA = NA) 

# a<-tidy(main_m1)[,1]
# a<-as.data.frame(a)
# reversed_column <- rev(a$term)
# quoted_elements <- paste0("'", as.character(reversed_column), "'")
# names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'PREV_INST_COUNT',"TRANSFER_CREDITS","ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
m1_transfer_plot <- 
  sjPlot::plot_model(model = m1_transfer_prev, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Transfer Credits","Previous Inst Count","Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
m1_transfer_plot

Program GPA

All students

Main effects

main_m2<-lm(PROGRAM_GPA_100~ COHORT + TRANSFER_STATUS + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM , df5)
summary(main_m2)

## 
## Call:
## lm(formula = PROGRAM_GPA_100 ~ COHORT + TRANSFER_STATUS + AGE + 
##     GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + 
##     ADMITTED_FACULTY + ADMITTED_PROGRAM, data = df5)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -36.723  -3.918   0.463   4.371  22.357 
## 
## Coefficients: (4 not defined because of singularities)
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  67.04044    1.85665  36.108  < 2e-16 ***
## COHORT201770                  0.94557    0.64769   1.460 0.144516    
## COHORT201870                  1.14707    0.64968   1.766 0.077660 .  
## COHORT201970                  1.51134    0.64305   2.350 0.018885 *  
## TRANSFER_STATUSBlock          1.35597    0.38485   3.523 0.000439 ***
## AGE                           0.15264    0.03372   4.526 6.46e-06 ***
## GENDER                       -0.87850    0.37955  -2.315 0.020766 *  
## RESIDENCY                     0.10985    0.70389   0.156 0.876008    
## INDIGENOUS                   -2.77570    1.88259  -1.474 0.140578    
## FIRSTGEN                     -1.01058    0.39050  -2.588 0.009746 ** 
## ADMITTED_GPA                  0.12608    0.01395   9.041  < 2e-16 ***
## ADMITTED_FACULTYFHSW         -2.29302    1.59677  -1.436 0.151195    
## ADMITTED_FACULTYFMCA         -5.02219    1.42309  -3.529 0.000429 ***
## ADMITTED_FACULTYFSCS         -4.47167    1.19637  -3.738 0.000192 ***
## ADMITTED_FACULTYLFB          -2.39946    1.33075  -1.803 0.071569 .  
## ADMITTED_PROGRAMBEHAV_SCI_BA  6.11972    0.85033   7.197 9.59e-13 ***
## ADMITTED_PROGRAMCHILD_YOU_BA  2.03009    0.70579   2.876 0.004078 ** 
## ADMITTED_PROGRAMCMTY_DVLP_BA  2.02101    1.02545   1.971 0.048921 *  
## ADMITTED_PROGRAMCOMM_FIN_BA  -2.70513    1.09314  -2.475 0.013444 *  
## ADMITTED_PROGRAMCOMM_MGMT_BA -2.37954    1.28223  -1.856 0.063675 .  
## ADMITTED_PROGRAMCOMM_MKTG_BA -0.84686    1.30568  -0.649 0.516699    
## ADMITTED_PROGRAMCOMM_SUPP_BA -2.40293    1.33637  -1.798 0.072356 .  
## ADMITTED_PROGRAMCREA_ADV_BA   5.36858    1.31130   4.094 4.46e-05 ***
## ADMITTED_PROGRAMDESIGN_BA     0.19316    1.66881   0.116 0.907869    
## ADMITTED_PROGRAMDGTL_COMM_BA  0.85775    1.23490   0.695 0.487416    
## ADMITTED_PROGRAMDIG_BU_MG_BA -2.52471    1.35599  -1.862 0.062808 .  
## ADMITTED_PROGRAMFASHION_BA   -3.41380    2.06688  -1.652 0.098806 .  
## ADMITTED_PROGRAMFILM_PROD_BA  2.67267    1.51401   1.765 0.077713 .  
## ADMITTED_PROGRAMHLTH_MGT_BA  -5.45929    1.48878  -3.667 0.000254 ***
## ADMITTED_PROGRAMHLTH_SC_W_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA  -4.47949    1.30651  -3.429 0.000623 ***
## ADMITTED_PROGRAMINTE_DESG_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA -3.13103    1.54709  -2.024 0.043161 *  
## ADMITTED_PROGRAMJOURNALSM_BA -2.05147    1.54928  -1.324 0.185651    
## ADMITTED_PROGRAMPARALEGAL_BA -0.37724    0.88309  -0.427 0.669307    
## ADMITTED_PROGRAMPUBL_RELA_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA -1.37377    1.53361  -0.896 0.370510    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.718 on 1541 degrees of freedom
##   (1519 observations deleted due to missingness)
## Multiple R-squared:  0.1749, Adjusted R-squared:  0.1572 
## F-statistic: 9.896 on 33 and 1541 DF,  p-value: < 2.2e-16

Create model summary table for main_m2

main_m2_coef <- tidy(main_m2)[5:11,1:5]
                  
  # remove rownames
  rownames(main_m2_coef) <- c(1:nrow(main_m2_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(main_m2_coef) <- c("term", "beta", "beta_SE", "t_val", "p_val")

# finally, create df
main_m2_t <- 
      rbind(main_m2_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(main_m2)$fstatistic[2], summary(main_m2)$r.squared, nrow(main_m2$model)), 
             "beta_SE" = c(summary(main_m2)$fstatistic[3], summary(main_m2)$adj.r.squared, NA), 
             "t_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

library(kableExtra)
# show kable table
kable(main_m2_t, caption = "Multiple Regression Model (Main effects only) Predicting GPA at 100% Program Length", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "t-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Multiple Regression Model (Main effects only) Predicting GPA at 100% Program Length
		Beta	Beta’s SE	t-value	p-value
1	TRANSFER_STATUSBlock	1.356	0.385	3.523	0.000
2	AGE	0.153	0.034	4.526	0.000
3	GENDER	-0.879	0.380	-2.315	0.021
4	RESIDENCY	0.110	0.704	0.156	0.876
5	INDIGENOUS	-2.776	1.883	-1.474	0.141
6	FIRSTGEN	-1.011	0.390	-2.588	0.010
7	ADMITTED_GPA	0.126	0.014	9.041	0.000
8	f_stat	33.000	1541.000
9	R2/Adj.R2	0.175	0.157
10	N	1575.000
Note:
…

write.csv(main_m2_t,"GPA_MAIN.csv", row.names = T)

# reset NA vals in kable tables to "NA"
options(knitr.kable.NA = NA) 

a<-tidy(main_m2)[,1]
a<-as.data.frame(a)
reversed_column <- rev(a$term)
quoted_elements <- paste0("'", as.character(reversed_column), "'")
names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'TRANSFER_STATUSBlock',"ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
main_m2_plot <- 
  sjPlot::plot_model(model = main_m2, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age', 'Transfer Status'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
main_m2_plot

With interaction effects

interact_m2<-lm(PROGRAM_GPA_100~ COHORT + TRANSFER_STATUS + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM +TRANSFER_STATUS*GENDER + TRANSFER_STATUS*AGE + TRANSFER_STATUS*FIRSTGEN + TRANSFER_STATUS*ADMITTED_GPA , df5)

summary(interact_m2)

## 
## Call:
## lm(formula = PROGRAM_GPA_100 ~ COHORT + TRANSFER_STATUS + AGE + 
##     GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + 
##     ADMITTED_FACULTY + ADMITTED_PROGRAM + TRANSFER_STATUS * GENDER + 
##     TRANSFER_STATUS * AGE + TRANSFER_STATUS * FIRSTGEN + TRANSFER_STATUS * 
##     ADMITTED_GPA, data = df5)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -38.681  -4.001   0.364   4.258  21.422 
## 
## Coefficients: (4 not defined because of singularities)
##                                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                       62.00321    2.63582  23.523  < 2e-16 ***
## COHORT201770                       0.79831    0.64741   1.233 0.217735    
## COHORT201870                       1.11996    0.64759   1.729 0.083933 .  
## COHORT201970                       1.46973    0.64076   2.294 0.021941 *  
## TRANSFER_STATUSBlock               8.92256    2.89440   3.083 0.002088 ** 
## AGE                                0.19067    0.04485   4.252 2.25e-05 ***
## GENDER                            -1.31373    0.50543  -2.599 0.009433 ** 
## RESIDENCY                          0.27677    0.70321   0.394 0.693946    
## INDIGENOUS                        -2.68190    1.87605  -1.430 0.153049    
## FIRSTGEN                          -0.23388    0.54993  -0.425 0.670687    
## ADMITTED_GPA                       0.18542    0.02922   6.347 2.89e-10 ***
## ADMITTED_FACULTYFHSW              -2.76687    1.60926  -1.719 0.085753 .  
## ADMITTED_FACULTYFMCA              -5.29231    1.43096  -3.698 0.000225 ***
## ADMITTED_FACULTYFSCS              -4.85345    1.20583  -4.025 5.97e-05 ***
## ADMITTED_FACULTYLFB               -2.77059    1.34962  -2.053 0.040254 *  
## ADMITTED_PROGRAMBEHAV_SCI_BA       6.03451    0.84950   7.104 1.85e-12 ***
## ADMITTED_PROGRAMCHILD_YOU_BA       2.25015    0.70599   3.187 0.001465 ** 
## ADMITTED_PROGRAMCMTY_DVLP_BA       2.57290    1.03489   2.486 0.013018 *  
## ADMITTED_PROGRAMCOMM_FIN_BA       -2.65711    1.09153  -2.434 0.015034 *  
## ADMITTED_PROGRAMCOMM_MGMT_BA      -2.65331    1.28854  -2.059 0.039647 *  
## ADMITTED_PROGRAMCOMM_MKTG_BA      -0.86030    1.30219  -0.661 0.508932    
## ADMITTED_PROGRAMCOMM_SUPP_BA      -2.50432    1.33268  -1.879 0.060411 .  
## ADMITTED_PROGRAMCREA_ADV_BA        5.23332    1.30828   4.000 6.63e-05 ***
## ADMITTED_PROGRAMDESIGN_BA          0.02001    1.66725   0.012 0.990427    
## ADMITTED_PROGRAMDGTL_COMM_BA       0.79250    1.23299   0.643 0.520485    
## ADMITTED_PROGRAMDIG_BU_MG_BA      -2.29123    1.35242  -1.694 0.090436 .  
## ADMITTED_PROGRAMFASHION_BA        -3.36370    2.06624  -1.628 0.103744    
## ADMITTED_PROGRAMFILM_PROD_BA       2.60468    1.51516   1.719 0.085801 .  
## ADMITTED_PROGRAMHLTH_MGT_BA       -5.37178    1.48654  -3.614 0.000312 ***
## ADMITTED_PROGRAMHLTH_SC_W_BA            NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA       -4.50825    1.30231  -3.462 0.000551 ***
## ADMITTED_PROGRAMINTE_DESG_BA            NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA      -3.03338    1.54388  -1.965 0.049620 *  
## ADMITTED_PROGRAMJOURNALSM_BA      -2.10233    1.54475  -1.361 0.173730    
## ADMITTED_PROGRAMPARALEGAL_BA      -0.26907    0.88505  -0.304 0.761160    
## ADMITTED_PROGRAMPUBL_RELA_BA            NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA            NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA      -1.40114    1.52898  -0.916 0.359606    
## TRANSFER_STATUSBlock:GENDER        1.05361    0.71030   1.483 0.138193    
## TRANSFER_STATUSBlock:AGE          -0.08940    0.06460  -1.384 0.166583    
## TRANSFER_STATUSBlock:FIRSTGEN     -1.55436    0.76601  -2.029 0.042613 *  
## TRANSFER_STATUSBlock:ADMITTED_GPA -0.07475    0.03331  -2.244 0.024976 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.693 on 1537 degrees of freedom
##   (1519 observations deleted due to missingness)
## Multiple R-squared:  0.1831, Adjusted R-squared:  0.1635 
## F-statistic: 9.312 on 37 and 1537 DF,  p-value: < 2.2e-16

interact_m2_coef <- tidy(interact_m2)[c(5:11, 39:42),1:5]
                  
  # remove rownames
  rownames(interact_m2_coef) <- c(1:nrow(interact_m2_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(interact_m2_coef) <- c("term", "beta", "beta_SE", "t_val", "p_val")

# finally, create df
interact_m2_t <- 
      rbind(interact_m2_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(interact_m2)$fstatistic[2], summary(interact_m2)$r.squared, nrow(interact_m2$model)), 
             "beta_SE" = c(summary(interact_m2)$fstatistic[3], summary(interact_m2)$adj.r.squared, NA), 
             "t_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

# show kable table
kable(interact_m2_t, caption = "Multiple Regression Model with Interaction Terms Predicting GPA at 100% Program Length", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "t-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Multiple Regression Model with Interaction Terms Predicting GPA at 100% Program Length
		Beta	Beta’s SE	t-value	p-value
1	TRANSFER_STATUSBlock	8.923	2.894	3.083	0.002
2	AGE	0.191	0.045	4.252	0.000
3	GENDER	-1.314	0.505	-2.599	0.009
4	RESIDENCY	0.277	0.703	0.394	0.694
5	INDIGENOUS	-2.682	1.876	-1.430	0.153
6	FIRSTGEN	-0.234	0.550	-0.425	0.671
7	ADMITTED_GPA	0.185	0.029	6.347	0.000
8	TRANSFER_STATUSBlock:GENDER	1.054	0.710	1.483	0.138
9	TRANSFER_STATUSBlock:AGE	-0.089	0.065	-1.384	0.167
10	TRANSFER_STATUSBlock:FIRSTGEN	-1.554	0.766	-2.029	0.043
11	TRANSFER_STATUSBlock:ADMITTED_GPA	-0.075	0.033	-2.244	0.025
12	f_stat	37.000	1537.000
13	R2/Adj.R2	0.183	0.163
14	N	1575.000
Note:
…

write.csv(interact_m2_t,"GPA_INTERACT.csv", row.names = T)

# reset NA vals in kable tables to "NA"
options(knitr.kable.NA = NA) 

# a<-tidy(main_m1)[,1]
# a<-as.data.frame(a)
# reversed_column <- rev(a$term)
# quoted_elements <- paste0("'", as.character(reversed_column), "'")
# names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'TRANSFER_STATUSBlock',"ADMITTED_GPA","TRANSFER_STATUSBlock:FIRSTGEN","TRANSFER_STATUSBlock:GENDER","TRANSFER_STATUSBlock:AGE","TRANSFER_STATUSBlock:ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
interact_m2_plot <- 
  sjPlot::plot_model(model = interact_m2, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Transfer Status * Adm_GPA","Transfer Status * FirstGen","Transfer Status * Age","Transfer Status * Gender","Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age', 'Transfer Status'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
interact_m2_plot

Transfer student previous institution info as predictors

m2_transfer_prev <- lm(PROGRAM_GPA_100~COHORT + AGE + GENDER + RESIDENCY + INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + ADMITTED_PROGRAM+PREV_INST_TYPE+PREV_INST_COUNT+TRANSFER_CREDITS, df5)
summary(m2_transfer_prev)

## 
## Call:
## lm(formula = PROGRAM_GPA_100 ~ COHORT + AGE + GENDER + RESIDENCY + 
##     INDIGENOUS + FIRSTGEN + ADMITTED_GPA + ADMITTED_FACULTY + 
##     ADMITTED_PROGRAM + PREV_INST_TYPE + PREV_INST_COUNT + TRANSFER_CREDITS, 
##     data = df5)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -27.8902  -4.1567   0.5808   4.2476  21.2393 
## 
## Coefficients: (4 not defined because of singularities)
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  63.56656    4.92134  12.917  < 2e-16 ***
## COHORT201770                  6.04169    3.49946   1.726 0.084703 .  
## COHORT201870                  6.41054    3.49089   1.836 0.066726 .  
## COHORT201970                  6.35459    3.49029   1.821 0.069086 .  
## AGE                           0.09521    0.05104   1.866 0.062519 .  
## GENDER                       -0.19482    0.57332  -0.340 0.734098    
## RESIDENCY                     1.46579    1.01835   1.439 0.150490    
## INDIGENOUS                   -0.70781    2.59436  -0.273 0.785065    
## FIRSTGEN                     -1.97096    0.56353  -3.497 0.000499 ***
## ADMITTED_GPA                  0.10981    0.01749   6.277 6.05e-10 ***
## ADMITTED_FACULTYFHSW         -2.06619    3.24709  -0.636 0.524775    
## ADMITTED_FACULTYFMCA         -4.75815    5.61908  -0.847 0.397403    
## ADMITTED_FACULTYFSCS         -5.79971    2.89545  -2.003 0.045556 *  
## ADMITTED_FACULTYLFB          -2.10563    3.06755  -0.686 0.492674    
## ADMITTED_PROGRAMBEHAV_SCI_BA  6.57295    1.89520   3.468 0.000556 ***
## ADMITTED_PROGRAMCHILD_YOU_BA  2.16691    0.99742   2.173 0.030149 *  
## ADMITTED_PROGRAMCMTY_DVLP_BA  2.85633    1.23319   2.316 0.020833 *  
## ADMITTED_PROGRAMCOMM_FIN_BA  -5.46816    1.79951  -3.039 0.002464 ** 
## ADMITTED_PROGRAMCOMM_MGMT_BA -3.77128    1.66961  -2.259 0.024202 *  
## ADMITTED_PROGRAMCOMM_MKTG_BA -0.19829    2.01646  -0.098 0.921694    
## ADMITTED_PROGRAMCOMM_SUPP_BA -2.81531    2.02170  -1.393 0.164198    
## ADMITTED_PROGRAMCREA_ADV_BA   3.65915    5.10223   0.717 0.473510    
## ADMITTED_PROGRAMDESIGN_BA     1.07309    5.37056   0.200 0.841687    
## ADMITTED_PROGRAMDGTL_COMM_BA -0.80786    5.01806  -0.161 0.872146    
## ADMITTED_PROGRAMDIG_BU_MG_BA -1.64623    2.33698  -0.704 0.481401    
## ADMITTED_PROGRAMFASHION_BA   -6.80924    3.61928  -1.881 0.060333 .  
## ADMITTED_PROGRAMFILM_PROD_BA -2.16992    5.72375  -0.379 0.704722    
## ADMITTED_PROGRAMHLTH_MGT_BA  -4.16350    2.81236  -1.480 0.139206    
## ADMITTED_PROGRAMHLTH_SC_W_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMHRM_MGMT_BA  -6.08835    2.34824  -2.593 0.009720 ** 
## ADMITTED_PROGRAMINTE_DESG_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMINTNL_BUS_BA -4.30057    3.63601  -1.183 0.237300    
## ADMITTED_PROGRAMJOURNALSM_BA -0.20583    5.74550  -0.036 0.971433    
## ADMITTED_PROGRAMPARALEGAL_BA -1.16856    1.39526  -0.838 0.402584    
## ADMITTED_PROGRAMPUBL_RELA_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMSOCSCI_CJ_BA       NA         NA      NA       NA    
## ADMITTED_PROGRAMTOUR_MGMT_BA -0.39649    2.33491  -0.170 0.865208    
## PREV_INST_TYPEOTH-O          -2.42625    2.08898  -1.161 0.245853    
## PREV_INST_TYPEOTH-PSE        -0.46090    1.06129  -0.434 0.664217    
## PREV_INST_COUNT               0.37841    0.95293   0.397 0.691413    
## TRANSFER_CREDITS              0.02832    0.02389   1.185 0.236263    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.789 on 703 degrees of freedom
##   (2354 observations deleted due to missingness)
## Multiple R-squared:  0.1688, Adjusted R-squared:  0.1263 
## F-statistic: 3.967 on 36 and 703 DF,  p-value: 4.64e-13

m2_transfer_prev_coef <- tidy(m2_transfer_prev)[c(5:10,40,41),1:5]
                  
  # remove rownames
  rownames(m2_transfer_prev_coef) <- c(1:nrow(m2_transfer_prev_coef))

## Warning: Setting row names on a tibble is deprecated.

  # rename cols
  colnames(m2_transfer_prev_coef) <- c("term", "beta", "beta_SE", "t_val", "p_val")

# finally, create df
m2_transfer_prev_t <- 
      rbind(m2_transfer_prev_coef,
      tibble("term" = c("f_stat", "R2/Adj.R2", "N"), 
             "beta" = c(summary(m2_transfer_prev)$fstatistic[2], summary(m2_transfer_prev)$r.squared, nrow(m2_transfer_prev$model)), 
             "beta_SE" = c(summary(m2_transfer_prev)$fstatistic[3], summary(m2_transfer_prev)$adj.r.squared, NA), 
             "t_val" = rep(NA, 3), 
             "p_val" = rep(NA, 3)
             )
      )

# remove NA from kable tables
options(knitr.kable.NA = '') 

# show kable table
kable(m2_transfer_prev_t, caption = "Multiple Regression Model Predicting GPA at 100% Program Length (Transfer students only)", align = rep('lcccc'), digits = 3, row.names = T, col.names = c("", "Beta", "Beta's SE",  "t-value", "p-value")) %>% 
  kable_paper(full_width = F) %>%
  # add_header_above(c(" ", "mturk" = 2, "Mturk" = 2)) %>%
  # pack_rows("Criterion(s)", 1, 6) %>%
  # # column_spec(1, width = "10em") %>% 
  # pack_rows("Predictor(s)", 7, 19) %>%
  footnote(general = "...") %>% 
  column_spec(c(4), border_left = T) %>% 
  kable_classic()

Multiple Regression Model Predicting GPA at 100% Program Length (Transfer students only)
		Beta	Beta’s SE	t-value	p-value
1	AGE	0.095	0.051	1.866	0.063
2	GENDER	-0.195	0.573	-0.340	0.734
3	RESIDENCY	1.466	1.018	1.439	0.150
4	INDIGENOUS	-0.708	2.594	-0.273	0.785
5	FIRSTGEN	-1.971	0.564	-3.497	0.000
6	ADMITTED_GPA	0.110	0.017	6.277	0.000
7	PREV_INST_COUNT	0.378	0.953	0.397	0.691
8	TRANSFER_CREDITS	0.028	0.024	1.185	0.236
9	f_stat	36.000	703.000
10	R2/Adj.R2	0.169	0.126
11	N	740.000
Note:
…

write.csv(m2_transfer_prev_t,"GPA_TRANSFER.csv", row.names = T)

options(knitr.kable.NA = NA) 

# a<-tidy(main_m1)[,1]
# a<-as.data.frame(a)
# reversed_column <- rev(a$term)
# quoted_elements <- paste0("'", as.character(reversed_column), "'")
# names <- paste(quoted_elements, collapse = ", ")


reg_colours <- c("#414535", "#08605F", "#3F826D", "#858585", "#DDA448", "#F0803C", "#98410B" ) # green > orange

selected_terms <- c('GENDER', 'RESIDENCY', 'FIRSTGEN', 'INDIGENOUS', 'AGE', 'PREV_INST_COUNT',"TRANSFER_CREDITS","ADMITTED_GPA")

# plot lm
  # plot standardized betas to compare cooefficients
m2_transfer_plot <- 
  sjPlot::plot_model(model = m2_transfer_prev, terms = selected_terms,# lm output 
              title = "", 
                     colors = reg_colours,
                     show.values = T, # show betas
                     show.p = T, # show * for sig p
                     p.threshold = c(.049, .009, .0009), # state up to 3 cut-offs for pvals, the number is inclusive**
                     value.offset = 0.4, # offset to beta labels
                     value.size = 3, # size of beta labels
                     digits = 2, # num decimals in beta labels
                     dot.size = 2.5, line.size = 1, 
                     vline.color = "#F98B99",
                     # group.terms = c(1, 2, 3, 3, 3, 3, 3, 4, 5, 6, 7, 7, 7),
                     axis.labels = c("Transfer Credits","Previous Inst Count","Admitted GPA","FirstGen","Indigenous","Residency","Gender", 'Age'), 
                     axis.title = "", 
                     width = 0.2, transform = NULL
                     ) +
    # font_size(offset.x = 10) +
    # font_size(base.theme = theme_classic()) +
    theme(text = element_text(color = "black"), 
          axis.text = element_text(colour = "black", size = 11), 
          axis.ticks.y = element_blank(),
          )

## Model matrix is rank deficient. Parameters
##   `ADMITTED_PROGRAMHLTH_SC_W_BA, ADMITTED_PROGRAMINTE_DESG_BA,
##   ADMITTED_PROGRAMPUBL_RELA_BA, ADMITTED_PROGRAMSOCSCI_CJ_BA` were not
##   estimable.

# show plot
m2_transfer_plot

ONCAT report analysis

2023-07-07

Descriptive statistics

T-test and Chi-square test to see if the Block transfer and None transfer groups are comparable

Use propensity score matching to find matching Non-transfer students for block transfer students

T-tests of the matched data

Count table of demographic variables

DV by Cohort graphs

Likelihood to graduate at 100%

Graduation at 100%

All students

Main effect model

Create stats table for main_m1

With interaction effects

Transfer student previous institution info as predictors

Program GPA

All students

Main effects

Create model summary table for main_m2

With interaction effects

Transfer student previous institution info as predictors