Exploratory Data Analysis

Pre-Clean

Load libraries and data

#####################Read and Pre-Clean the Data#######################
require(Amelia)

## Loading required package: Amelia

## Loading required package: Rcpp

## ## 
## ## Amelia II: Multiple Imputation
## ## (Version 1.7.6, built: 2019-11-24)
## ## Copyright (C) 2005-2020 James Honaker, Gary King and Matthew Blackwell
## ## Refer to http://gking.harvard.edu/amelia/ for more information
## ##

library(car)

## Loading required package: carData

library(corrplot)

## corrplot 0.84 loaded

library(ggcorrplot)

## Loading required package: ggplot2

library(heplots)
library(kableExtra)
library(MANOVA.RM)

## Warning: package 'MANOVA.RM' was built under R version 4.0.3

library(MASS)
library(MVN)

## Warning: package 'MVN' was built under R version 4.0.3

## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2

## sROC 0.1-2 loaded

library(mvtnorm)
require(psych) #to describe

## Loading required package: psych

## 
## Attaching package: 'psych'

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

## The following object is masked from 'package:car':
## 
##     logit

require(ggplot2)
library(ggcorrplot)
require(reticulate) #to use Python in R as well

## Loading required package: reticulate

require(ResourceSelection)

## Loading required package: ResourceSelection

## ResourceSelection 0.3-5   2019-07-22

library(rstatix)

## Warning: package 'rstatix' was built under R version 4.0.3

## 
## Attaching package: 'rstatix'

## The following object is masked from 'package:MASS':
## 
##     select

## The following object is masked from 'package:ggcorrplot':
## 
##     cor_pmat

## The following object is masked from 'package:stats':
## 
##     filter

library(tidyverse)

## -- Attaching packages --------------------------------------------- tidyverse 1.3.0 --

## v tibble  3.0.3     v dplyr   1.0.2
## v tidyr   1.1.2     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.5.0
## v purrr   0.3.4

## -- Conflicts ------------------------------------------------ tidyverse_conflicts() --
## x psych::%+%()        masks ggplot2::%+%()
## x psych::alpha()      masks ggplot2::alpha()
## x dplyr::filter()     masks rstatix::filter(), stats::filter()
## x dplyr::group_rows() masks kableExtra::group_rows()
## x dplyr::lag()        masks stats::lag()
## x dplyr::recode()     masks car::recode()
## x dplyr::select()     masks rstatix::select(), MASS::select()
## x purrr::some()       masks car::some()

corfunction=function(d){
  mycorr=cor(d[, 1:ncol(d)]); p.mat=ggcorrplot::cor_pmat(d[,1:ncol(d)])
  myplot=ggcorrplot(mycorr, hc.order=TRUE,type="lower",colors=c("red", "white","green"),tl.cex = 8, tl.col = "black", lab=TRUE, lab_size=3, p.mat=p.mat, insig="pch", pch=4)
  print(myplot)}

mydata=read.csv("C:/Users/lfult/Desktop/Education/2020spring.csv", stringsAsFactors = TRUE)
colnames(mydata)

##  [1] "Subject"     "Gender"      "Ethnicity"   "Age"         "Yr"         
##  [6] "DaysBetween" "GPA"         "T_GPA"       "PrePost"     "Fin"        
## [11] "Mgt"         "HR"          "Sys"         "HIM"         "Ldr"        
## [16] "Chg"         "Cli"         "QI"          "Strat"       "Com"        
## [21] "Lgl"         "Score"       "Rank"        "Time"

#########################################################################

Check Missing

#########################################################################
missmap(mydata)

#########################################################################

Descriptives

Gender

#########################################################################
as.data.frame(100*round(table(mydata$Gender)/length(mydata$Gender),4))%>%
  kbl(col.names = c("Gender", "%"))%>%kable_classic(full_width=F)

Gender	%
F	79.63
M	20.37

#########################################################################

Ethnicity

#########################################################################
as.data.frame(100*round(table(mydata$Ethnicity)/length(mydata$Ethnicity),4))%>%
  kbl(col.names = c("Ethnicity", "%"))%>%kable_classic(full_width=F)

Ethnicity	%
A	3.70
B	22.22
C	37.04
H	37.04

#########################################################################

Age

#########################################################################
par(mfrow=c(1,3))
boxplot(mydata$Age, horizontal=TRUE, main="Age", col="blue")
boxplot(mydata$Age~mydata$Gender, horizontal=TRUE, main="Age~Gender", col="red")
boxplot(mydata$Age~mydata$Ethnicity, horizontal=TRUE, main="Age~Ethnicity", col="orange")

kable(t(round(describe(mydata$Age),3)), col.names="GPA")%>%kable_classic(full_width=F)

	GPA
vars	1.000
n	108.000
mean	22.963
sd	3.304
median	22.000
trimmed	22.295
mad	1.483
min	20.000
max	42.000
range	22.000
skew	3.863
kurtosis	18.162
se	0.318

#########################################################################

GPA

#########################################################################
par(mfrow=c(1,3))
boxplot(mydata$GPA, horizontal=TRUE, main="GPA", col="blue")
boxplot(mydata$GPA~mydata$Gender, horizontal=TRUE, main="GPA~Gender", col="red")
boxplot(mydata$GPA~mydata$Ethnicity, horizontal=TRUE, main="GPA~Ethnicity", col="orange")

kable(t(round(describe(mydata$GPA),3)), col.names="GPA")%>%kable_classic(full_width=F)

	GPA
vars	1.000
n	108.000
mean	3.195
sd	0.229
median	3.185
trimmed	3.181
mad	0.274
min	2.850
max	3.700
range	0.850
skew	0.441
kurtosis	-0.850
se	0.022

#########################################################################

Inter-Test Days

#########################################################################
par(mfrow=c(1,3))
boxplot(mydata$DaysBetween, horizontal=TRUE, main="Days Between Test", col="blue")
boxplot(mydata$DaysBetween~mydata$Gender, horizontal=TRUE, main="Days Between Tests~Gender", col="red")
boxplot(mydata$DaysBetween~mydata$Ethnicity, horizontal=TRUE, main="Days Between Tests~Ethnicity", col="orange")

kable(t(round(describe(mydata$DaysBetween),3)), col.names="Days Between Tests")%>%kable_classic(full_width=F)

	Days Between Tests
vars	1.000
n	108.000
mean	435.537
sd	43.973
median	430.000
trimmed	430.045
mad	22.980
min	333.000
max	560.000
range	227.000
skew	1.186
kurtosis	1.649
se	4.231

#########################################################################

Correlations

#########################################################################
mycorr=cor(mydata[, -c(1:3,5,9)])
corfunction(mycorr)

#########################################################################

Kernel Density Estimates

Look at bivariate pairs

#########################################################################
mysub=subset(mydata, select=c(Age, GPA, Score)) #get a subset for plotting
colnames(mysub)=c("Age", "GPA", "Score") #set column names
kdepairs(mysub) #plot

as.data.frame(cor(mydata$Score[1:54], mydata$Score[55:108]))%>%kbl(col.names="Pre-Post Test Score Correlation")%>%kable_classic()

Pre-Post Test Score Correlation
0.1988327

#########################################################################

Pre-Test

#########################################################################
pre=round(describe(mydata[1:54,10:24]),3)
post=round(describe(mydata[55:108, 10:24]),3)
mydelta=mydata[55:108, 10:24]-mydata[1:54, 10:24]
delta=round(describe(mydelta),3)
mynames=c("Financial Management", "General Management", "Healthcare Personnel", "Healthcare Systems & Organizations", "Information Managment", "Leadership Skills and Behavior", "Managing Change", "Organizational Climate and Culture", "Quality Improvement", "Strategic Planning and Marketing", "Community and the Environment", "Legal Environment of Healthcare Administration", "Final Score", "Percentile Rank", "Time" )
row.names(pre)=row.names(post)=row.names(delta)=mynames

pre%>%kbl(caption="Pre-Test")%>%kable_classic(full_width = F, html_font = "Cambria")

Pre-Test
	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
Financial Management	1	54	55.926	18.173	50.00	55.909	14.826	10.00	100.00	90.00	0.011	-0.165	2.473
General Management	2	54	59.259	16.119	60.00	59.545	14.826	30.00	90.00	60.00	-0.148	-0.752	2.194
Healthcare Personnel	3	54	64.630	14.500	60.00	65.000	14.826	30.00	90.00	60.00	-0.238	-0.178	1.973
Healthcare Systems & Organizations	4	54	53.333	19.230	50.00	52.727	14.826	10.00	100.00	90.00	0.281	-0.239	2.617
Information Managment	5	54	58.333	18.300	60.00	59.318	14.826	10.00	90.00	80.00	-0.393	-0.539	2.490
Leadership Skills and Behavior	6	54	58.704	15.667	60.00	59.091	14.826	20.00	90.00	70.00	-0.165	-0.369	2.132
Managing Change	7	54	61.481	12.945	60.00	61.591	14.826	30.00	90.00	60.00	-0.168	-0.033	1.762
Organizational Climate and Culture	8	54	63.889	16.981	60.00	64.091	14.826	30.00	100.00	70.00	-0.085	-0.390	2.311
Quality Improvement	9	54	57.963	18.262	60.00	58.409	14.826	20.00	90.00	70.00	-0.251	-0.770	2.485
Strategic Planning and Marketing	10	54	56.111	17.953	60.00	56.364	14.826	10.00	90.00	80.00	-0.149	-0.565	2.443
Community and the Environment	11	54	53.148	16.577	50.00	52.727	14.826	20.00	100.00	80.00	0.284	-0.057	2.256
Legal Environment of Healthcare Administration	12	54	61.111	16.214	60.00	60.455	14.826	30.00	100.00	70.00	0.319	-0.521	2.206
Final Score	13	54	58.654	7.920	59.58	58.879	8.036	39.16	78.33	39.17	-0.124	-0.100	1.078
Percentile Rank	14	54	58.685	22.862	63.00	60.045	26.687	7.00	98.00	91.00	-0.361	-0.680	3.111
Time	15	54	41.721	15.714	39.75	40.428	16.019	13.75	82.08	68.33	0.672	-0.159	2.138

Post-Test

post%>%kbl(caption="Post-Test")%>%kable_classic(full_width = F, html_font = "Cambria")

Post-Test
	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
Financial Management	1	54	73.519	15.192	70.000	73.636	14.826	40.00	100.0	60.00	-0.087	-0.537	2.067
General Management	2	54	77.222	11.561	80.000	77.500	14.826	50.00	100.0	50.00	-0.178	-0.248	1.573
Healthcare Personnel	3	54	79.444	13.091	80.000	80.227	14.826	30.00	100.0	70.00	-0.940	1.867	1.782
Healthcare Systems & Organizations	4	54	67.963	16.297	70.000	68.636	14.826	30.00	100.0	70.00	-0.191	-0.796	2.218
Information Managment	5	54	66.667	12.286	70.000	66.136	14.826	50.00	90.0	40.00	0.100	-0.973	1.672
Leadership Skills and Behavior	6	54	77.037	15.126	80.000	77.273	14.826	50.00	100.0	50.00	-0.047	-1.078	2.058
Managing Change	7	54	70.556	13.656	70.000	71.364	14.826	40.00	90.0	50.00	-0.447	-0.620	1.858
Organizational Climate and Culture	8	54	75.741	16.206	80.000	76.364	14.826	30.00	100.0	70.00	-0.483	-0.330	2.205
Quality Improvement	9	54	72.963	13.822	70.000	73.409	14.826	40.00	100.0	60.00	-0.192	-0.622	1.881
Strategic Planning and Marketing	10	54	77.407	12.004	80.000	77.955	14.826	50.00	100.0	50.00	-0.339	-0.609	1.634
Community and the Environment	11	54	68.148	16.261	70.000	69.318	14.826	0.00	90.0	90.00	-1.463	3.879	2.213
Legal Environment of Healthcare Administration	12	54	74.630	17.344	80.000	75.455	14.826	30.00	100.0	70.00	-0.461	-0.520	2.360
Final Score	13	54	71.505	5.129	71.915	71.691	4.559	58.46	82.3	23.84	-0.348	-0.142	0.698
Percentile Rank	14	54	80.389	15.674	84.000	82.864	8.896	0.00	97.0	97.00	-2.801	10.824	2.133
Time	15	54	74.930	19.011	73.665	74.719	18.147	34.77	119.9	85.13	0.152	-0.364	2.587

Difference Scores

delta%>%kbl(caption="Difference, Post Minus Pre")%>%kable_classic(full_width = F, html_font = "Cambria")

Difference, Post Minus Pre
	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
Financial Management	1	54	17.593	22.565	20.00	17.500	29.652	-20.00	60.00	80.00	0.053	-1.230	3.071
General Management	2	54	17.963	20.775	20.00	17.273	14.826	-20.00	70.00	90.00	0.193	-0.533	2.827
Healthcare Personnel	3	54	14.815	21.168	10.00	15.000	14.826	-40.00	60.00	100.00	-0.080	-0.226	2.881
Healthcare Systems & Organizations	4	54	14.630	26.330	15.00	15.455	37.065	-40.00	70.00	110.00	-0.175	-0.662	3.583
Information Managment	5	54	8.333	21.956	10.00	8.182	29.652	-30.00	50.00	80.00	0.135	-0.847	2.988
Leadership Skills and Behavior	6	54	18.333	20.990	20.00	17.727	14.826	-20.00	70.00	90.00	0.288	-0.386	2.856
Managing Change	7	54	9.074	19.549	10.00	9.091	14.826	-50.00	60.00	110.00	-0.081	0.516	2.660
Organizational Climate and Culture	8	54	11.852	19.433	10.00	11.591	14.826	-30.00	60.00	90.00	0.243	-0.406	2.644
Quality Improvement	9	54	15.000	20.443	20.00	14.318	14.826	-30.00	60.00	90.00	0.156	-0.460	2.782
Strategic Planning and Marketing	10	54	21.296	19.815	20.00	20.909	29.652	-20.00	70.00	90.00	0.167	-0.655	2.696
Community and the Environment	11	54	15.000	22.882	15.00	15.682	22.239	-40.00	70.00	110.00	-0.195	-0.136	3.114
Legal Environment of Healthcare Administration	12	54	13.519	23.804	10.00	13.182	22.239	-40.00	60.00	100.00	0.049	-0.628	3.239
Final Score	13	54	12.851	8.537	12.37	12.344	9.592	0.76	35.45	34.69	0.456	-0.586	1.162
Percentile Rank	14	54	21.704	25.458	20.00	20.523	26.687	-48.00	82.00	130.00	0.193	-0.100	3.464
Time	15	54	33.209	18.266	33.21	31.934	17.732	-5.55	77.88	83.43	0.479	-0.194	2.486

#########################################################################

Table 1

a=pre[1:14,3]; b=post[1:14,3]; g=delta[1:14,3]
m1=pre[1:14,5 ]; m2=post[1:14,5]; m3=delta[1:14,5]
s1=pre[1:14,4 ]; s2=post[1:14,4]; s3=delta[1:14,4]
mydf=data.frame(PreXbar=a, PostXbar=b, DeltaXbar=g,
                PreMed=m1, PostMed=m2, DeltaMed=m3, 
                PreSD=s1, PostSD=s2, DeltaSD=s3)
row.names(mydf)=mynames[1:14]
mydf%>%kbl()%>%kable_classic(full_width=F, html_font="Calibri")

	PreXbar	PostXbar	DeltaXbar	PreMed	PostMed	DeltaMed	PreSD	PostSD	DeltaSD
Financial Management	55.926	73.519	17.593	50.00	70.000	20.00	18.173	15.192	22.565
General Management	59.259	77.222	17.963	60.00	80.000	20.00	16.119	11.561	20.775
Healthcare Personnel	64.630	79.444	14.815	60.00	80.000	10.00	14.500	13.091	21.168
Healthcare Systems & Organizations	53.333	67.963	14.630	50.00	70.000	15.00	19.230	16.297	26.330
Information Managment	58.333	66.667	8.333	60.00	70.000	10.00	18.300	12.286	21.956
Leadership Skills and Behavior	58.704	77.037	18.333	60.00	80.000	20.00	15.667	15.126	20.990
Managing Change	61.481	70.556	9.074	60.00	70.000	10.00	12.945	13.656	19.549
Organizational Climate and Culture	63.889	75.741	11.852	60.00	80.000	10.00	16.981	16.206	19.433
Quality Improvement	57.963	72.963	15.000	60.00	70.000	20.00	18.262	13.822	20.443
Strategic Planning and Marketing	56.111	77.407	21.296	60.00	80.000	20.00	17.953	12.004	19.815
Community and the Environment	53.148	68.148	15.000	50.00	70.000	15.00	16.577	16.261	22.882
Legal Environment of Healthcare Administration	61.111	74.630	13.519	60.00	80.000	10.00	16.214	17.344	23.804
Final Score	58.654	71.505	12.851	59.58	71.915	12.37	7.920	5.129	8.537
Percentile Rank	58.685	80.389	21.704	63.00	84.000	20.00	22.862	15.674	25.458

Ethnicity / Race

#########################################################################
levels(mydata$Ethnicity)=c("Asian", "African American", "Caucasian", "Any Hispanic") #Assign new names to factor levels
ethtable=as.data.frame(table(mydata$Ethnicity[1:54],mydata$Gender[1:54])/length(mydata$Ethnicity[1:54])) #get a cross-tabs table for race and gender
colnames(ethtable)=c("Race","Gender", "Percentage")#set the colum names for the table
mylab=paste0(round(ethtable$Percentage,2)*100,"%, ", ethtable$Percentage*54, " students") #Get the labels for the graph

ggplot(data=ethtable, aes(x=Race,y=Percentage, fill=Gender))+
  geom_bar(stat="identity")+
  geom_text(aes( label = mylab,  vjust = 1))

#########################################################################

Age~Race & Gender

Analyze age as a function of race and gender

#########################################################################
describe(mydata$Age[1:54]) #get the descriptive statistics

##    vars  n  mean   sd median trimmed  mad min max range skew kurtosis   se
## X1    1 54 22.96 3.32     22    22.3 1.48  20  42    22 3.81    17.77 0.45

ggplot(data=mydata[1:54,], aes(x=Age,color=Gender))+
  geom_histogram(fill="white", binwidth=1)+
  ylab("Frequency")  #plot Age ~Gender

ggplot(data=mydata[1:54,], aes(x=Age,color=Ethnicity))+
  geom_histogram(fill="white", binwidth=1)+
  ylab("Frequency")  #plot Age~ Race

#########################################################################

GPA

#########################################################################
describe(mydata$GPA[1:54]) #Get descriptives

##    vars  n mean   sd median trimmed  mad  min max range skew kurtosis   se
## X1    1 54 3.19 0.23   3.18    3.18 0.27 2.85 3.7  0.85 0.44    -0.89 0.03

ggplot(mydata[1:54, ], aes(x = Ethnicity, y = GPA, fill=Ethnicity))+
  geom_boxplot(aes(color=Gender))+
  coord_flip()  #plot based on ethnicity and gender

#########################################################################

GPA~Race+Gender

Evaluating GPA as a function of race and gender

#########################################################################
newdata1=aggregate(mydata$GPA[1:54], b=list(mydata$Ethnicity[1:54],mydata$Gender[1:54]), FUN=mean) #aggregate the data based on race and gender, get the means by those groups

newdata2=aggregate(mydata$GPA[1:54],b=list(mydata$Ethnicity[1:54],mydata$Gender[1:54]),function(x){qnorm(.975)*sd(x)/sqrt(length(x))}) #get the CI adjustment

newdata=cbind(newdata1,newdata2$x)  #bind the data together by columns
colnames(newdata)=c("Race", "Gender", "GPA", "SD") #name the columns
newdata$RaceGender=as.factor(paste0(newdata$Race,", ",newdata$Gender)) #make a new variable that has both race and gender
ggplot(   #plot
  newdata, 
  aes(x = GPA, y = RaceGender, xmin = GPA-SD, xmax = GPA+SD)
  ) +
  geom_point(aes(color = Gender)) +
  geom_errorbarh(aes(color = Gender), height=.2)+
  theme_light()+
  xlab("95% Confidence Interval for GPA")

#########################################################################

Days between Tests

Analyze the time between pretests and posttests

#########################################################################
describe(mydata$DaysBetween[1:54])  #describe the days between

##    vars  n   mean    sd median trimmed   mad min max range skew kurtosis   se
## X1    1 54 435.54 44.18    430  430.05 22.98 333 560   227 1.17     1.56 6.01

ggplot(data=mydata[1:54,], aes(x=DaysBetween,color=Gender))+  #plot it
  geom_histogram(fill="white", binwidth=30)+
  ylab("Frequency")

#########################################################################

Delta Score Boxplots

Plot the Delta scores.

#########################################################################
par(mfrow=c(1,1))

myscores=as.data.frame(mydelta[1:13]) #Variables for plotting
mybars=error.bars(myscores)

plot(error.bars(myscores),ylab="Variable", xlab="Delta Score", 
     xlim=c(.5, 13.5), ylim=c(0,length(myscores)),lty="dashed", las=2)

#########################################################################

Simple Inferential Analysis

Paired t-tests

#########################################################################
myf=function(x){
  myt=t.test(x)
  newp=round(p.adjust(myt$p.value),3)
  a=c(round(myt$estimate,3),round(myt$conf.int[1],3),
      round(myt$conf.int[2],3),round(myt$statistic,3), round(myt$parameter,3),
      round(newp,3))
  return(a)
  
}

a=matrix(rep(NA, 6*15), 15)
for (i in 1:15){a[i,1:6]=myf(mydelta[i])}
a=as.data.frame(a)
for (i in 1:6){a[,i]=as.numeric(a[,i])}
rownames(a)=c("Financial Management", "General Management", "Healthcare Personnel", "Healthcare Systems and Organizations", "Information Management", "Leadership Skills and Behavior", "Managing Change","Organizational Climate and Culture", "Quality Improvement", "Strategic Planning and Marketing","The Community and the Environment","The Legal Environment", "Total Score", "Percentile Rank", "Test Time")
colnames(a)=c("Estimate","Lower 95% CI", "Upper 95% CI", "t-Value", "df", "Holm-Adjusted p")
a%>%kbl()%>%kable_classic()

	Estimate	Lower 95% CI	Upper 95% CI	t-Value	df	Holm-Adjusted p
Financial Management	17.593	11.433	23.752	5.729	53	0.000
General Management	17.963	12.292	23.634	6.354	53	0.000
Healthcare Personnel	14.815	9.037	20.593	5.143	53	0.000
Healthcare Systems and Organizations	14.630	7.443	21.816	4.083	53	0.000
Information Management	8.333	2.340	14.326	2.789	53	0.007
Leadership Skills and Behavior	18.333	12.604	24.062	6.418	53	0.000
Managing Change	9.074	3.738	14.410	3.411	53	0.001
Organizational Climate and Culture	11.852	6.548	17.156	4.482	53	0.000
Quality Improvement	15.000	9.420	20.580	5.392	53	0.000
Strategic Planning and Marketing	21.296	15.888	26.705	7.898	53	0.000
The Community and the Environment	15.000	8.754	21.246	4.817	53	0.000
The Legal Environment	13.519	7.021	20.016	4.173	53	0.000
Total Score	12.851	10.521	15.181	11.062	53	0.000
Percentile Rank	21.704	14.755	28.652	6.265	53	0.000
Test Time	33.209	28.224	38.195	13.360	53	0.000

#########################################################################

Unpaired t-tests

#########################################################################

myf=function(x,y){
  
  myt=t.test(x, y)
  newp=round(p.adjust(myt$p.value),3)
  a=c(round(myt$estimate[1],3),round(myt$estimate[2],3),
      round(myt$conf.int[1],3),   
      round(myt$conf.int[2],3),round(myt$statistic,3), 
      round(myt$parameter,3),round(newp,3))
  return(a)
  
}

a=matrix(rep(NA, 7*15), 15)
for (i in 1:15){a[i,1:7]=myf(mydata[1:54,i+9], mydata[55:108,i+9])}
a=as.data.frame(a)
for (i in 1:6){a[,i]=as.numeric(a[,i])}
rownames(a)=c("Financial Management", "General Management", "Healthcare Personnel", "Healthcare Systems and Organizations", "Information Management", "Leadership Skills and Behavior", "Managing Change","Organizational Climate and Culture", "Quality Improvement", "Strategic Planning and Marketing","The Community and the Environment","The Legal Environment", "Total Score", "Percentile Rank", "Test Time")
colnames(a)=c("Mean Pre","Mean Post","Lower 95% CI", "Upper 95% CI", "t-Value", "df", "Holm-Adjusted p")
a%>%kbl()%>%kable_classic()

	Mean Pre	Mean Post	Lower 95% CI	Upper 95% CI	t-Value	df	Holm-Adjusted p
Financial Management	55.926	73.519	-23.985	-11.200	-5.458	102.769	0.000
General Management	59.259	77.222	-23.321	-12.605	-6.655	96.117	0.000
Healthcare Personnel	64.630	79.444	-20.086	-9.544	-5.573	104.912	0.000
Healthcare Systems and Organizations	53.333	67.963	-21.433	-7.827	-4.265	103.222	0.000
Information Management	58.333	66.667	-14.290	-2.377	-2.778	92.708	0.007
Leadership Skills and Behavior	58.704	77.037	-24.209	-12.458	-6.186	105.869	0.000
Managing Change	61.481	70.556	-14.151	-3.997	-3.544	105.699	0.001
Organizational Climate and Culture	63.889	75.741	-18.185	-5.519	-3.710	105.770	0.000
Quality Improvement	57.963	72.963	-21.185	-8.815	-4.813	98.720	0.000
Strategic Planning and Marketing	56.111	77.407	-27.133	-15.460	-7.246	92.494	0.000
The Community and the Environment	53.148	68.148	-21.265	-8.735	-4.747	105.961	0.000
The Legal Environment	61.111	74.630	-19.924	-7.113	-4.184	105.523	0.000
Total Score	58.654	71.505	-15.401	-10.300	-10.009	90.803	0.000
Percentile Rank	58.685	80.389	-29.193	-14.214	-5.754	93.808	0.000
Test Time	41.721	74.930	-39.867	-26.552	-9.894	102.375	0.000

#########################################################################

Models

MANOVA Prep

#########################################################################

Fin=-mydata$Fin[1:54]+mydata$Fin[55:108]
Mgt=-mydata$Mgt[1:54]+mydata$Mgt[55:108]
HR=-mydata$HR[1:54]+mydata$HR[55:108]
Sys=-mydata$Sys[1:54]+mydata$Sys[55:108]
HIM=-mydata$HIM[1:54]+mydata$HIM[55:108]
Ldr=-mydata$Ldr[1:54]+mydata$Ldr[55:108]
Chg=-mydata$Chg[1:54]+mydata$Chg[55:108]
Cli=-mydata$Cli[1:54]+mydata$Cli[55:108]
QI=-mydata$QI[1:54]+mydata$QI[55:108]
Strat=-mydata$Strat[1:54]+mydata$Strat[55:108]
Com=-mydata$Com[1:54]+mydata$Com[55:108]
Lgl=-mydata$Lgl[1:54]+mydata$Lgl[55:108]

newdata=mydata[1:54,]

newdata$Fin=Fin;newdata$Mgt=Mgt;newdata$HR=HR;newdata$Sys=Sys
newdata$HIM=HIM;newdata$Ldr=Ldr;newdata$Chg=Chg;newdata$Cli=Cli
newdata$QI=QI;newdata$Strat=Strat;newdata$Com=Com;newdata$Lgl=Lgl

corcheck=cor(cbind(Fin, Mgt, HR, Sys, HIM, Ldr,
          Chg, Cli, QI, Strat, Com, Lgl)) #no significant correlations


mvn(newdata[, 10:21])$multivariateNormality #multivariate normal, Mardia

##              Test         Statistic           p value Result
## 1 Mardia Skewness  343.159997680128  0.77720968699161    YES
## 2 Mardia Kurtosis -1.42054530581446 0.155448988576426    YES
## 3             MVN              <NA>              <NA>    YES

myt=powerTransform(as.matrix(newdata[, 10:21]+100)~1)#Likelihood after location shift
testTransform(myt)%>%kbl()%>%kable_classic(full_width = F, html_font = "Cambria")

	LRT	df	pval
LR test, lambda = (1 1 1 1 1 1 1 1 1 1 1 1)	4.409743	12	0.97486

corfunction(corcheck)

#########################################################################

MANOVA Prep2

#########################################################################
temp=matrix(rep(NA, 12*3), nrow=12)
mynames=colnames(newdata[, 10:21])
newdata$GPA2=newdata$GPA
newdata$GPA2[newdata$GPA2<3]=0
newdata$GPA2[newdata$GPA2>=3.0]=1
newdata$GPA2=as.factor(newdata$GPA2)
for (i in 1:12){temp[i,1]=leveneTest(newdata[,i+9], newdata$Gender)$`Pr(>F)`[1]
  temp[i,2]=leveneTest(newdata[,i+9], newdata$Ethnicity)$`Pr(>F)`[1]
  temp[i,3]=leveneTest(newdata[,i+9], newdata$GPA2)$`Pr(>F)`[1]}
row.names(temp)=mynames
colnames(temp)=c("Gender", "Ethnicity", "GPA>=3.0")
temp%>%kbl(caption="Levene's Test p-values")%>%kable_classic()

Levene’s Test p-values
	Gender	Ethnicity	GPA>=3.0
Fin	0.0928212	0.6074220	0.5080666
Mgt	0.1716459	0.2030549	0.0856700
HR	0.0599184	0.2881177	0.7126853
Sys	0.7212492	0.1477615	0.1697116
HIM	0.0860040	0.1563606	0.8221869
Ldr	0.0168099	0.7034436	0.4775388
Chg	0.5583924	0.0373990	0.4825184
Cli	0.2084158	0.6818831	0.5671587
QI	0.4336224	0.8549995	0.2452317
Strat	0.6999897	0.2740675	0.2025926
Com	0.3335336	0.1772415	0.1896661
Lgl	0.4015062	0.7404763	0.4932374

#########################################################################

MANOVA 1

#########################################################################
res.man <- manova(cbind(Fin, Mgt, HR, Sys, HIM, Ldr,
                        Chg, Cli, QI, Strat, Com, Lgl) ~
                    1+Gender+Ethnicity+GPA2, data = newdata)
summary(res.man, intercept=TRUE)

##             Df  Pillai approx F num Df den Df    Pr(>F)    
## (Intercept)  1 0.80864  13.0292     12     37 7.214e-10 ***
## Gender       1 0.20957   0.8175     12     37    0.6316    
## Ethnicity    3 0.65806   0.9132     36    117    0.6122    
## GPA2         1 0.12783   0.4519     12     37    0.9296    
## Residuals   48                                             
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

summary.aov(res.man, intercept = TRUE)

##  Response Fin :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 16713.0 16713.0 33.7286 4.925e-07 ***
## Gender       1  1062.7  1062.7  2.1447    0.1496    
## Ethnicity    3  1727.4   575.8  1.1620    0.3340    
## GPA2         1   412.3   412.3  0.8320    0.3663    
## Residuals   48 23784.6   495.5                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Mgt :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 17424.1 17424.1 40.2935 7.364e-08 ***
## Gender       1    17.6    17.6  0.0406    0.8411    
## Ethnicity    3  1971.0   657.0  1.5193    0.2215    
## GPA2         1   130.7   130.7  0.3024    0.5850    
## Residuals   48 20756.6   432.4                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response HR :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 11851.9 11851.9 25.0833 7.836e-06 ***
## Gender       1     1.0     1.0  0.0021    0.9635    
## Ethnicity    3   933.8   311.3  0.6587    0.5815    
## GPA2         1   133.4   133.4  0.2823    0.5977    
## Residuals   48 22680.0   472.5                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Sys :
##             Df Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1  11557 11557.4 15.5446 0.0002612 ***
## Gender       1    174   174.3  0.2344 0.6304536    
## Ethnicity    3    857   285.7  0.3842 0.7648231    
## GPA2         1     23    23.3  0.0314 0.8600875    
## Residuals   48  35688   743.5                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response HIM :
##             Df  Sum Sq Mean Sq F value   Pr(>F)   
## (Intercept)  1  3750.0  3750.0  7.6056 0.008207 **
## Gender       1   586.4   586.4  1.1892 0.280927   
## Ethnicity    3  1101.2   367.1  0.7445 0.530859   
## GPA2         1   195.6   195.6  0.3968 0.531756   
## Residuals   48 23666.8   493.1                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Ldr :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 18150.0 18150.0 39.3321 9.635e-08 ***
## Gender       1   434.1   434.1  0.9408    0.3369    
## Ethnicity    3   372.0   124.0  0.2687    0.8476    
## GPA2         1   394.0   394.0  0.8539    0.3601    
## Residuals   48 22149.9   461.5                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Chg :
##             Df  Sum Sq Mean Sq F value   Pr(>F)   
## (Intercept)  1  4446.3  4446.3 11.6939 0.001289 **
## Gender       1   181.0   181.0  0.4760 0.493574   
## Ethnicity    3  1437.5   479.2  1.2602 0.298591   
## GPA2         1   384.5   384.5  1.0112 0.319648   
## Residuals   48 18250.8   380.2                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Cli :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1  7585.2  7585.2 18.6813 7.744e-05 ***
## Gender       1   289.7   289.7  0.7134    0.4025    
## Ethnicity    3   228.0    76.0  0.1871    0.9046    
## GPA2         1     7.7     7.7  0.0189    0.8912    
## Residuals   48 19489.5   406.0                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response QI :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 12150.0 12150.0 28.9819 2.159e-06 ***
## Gender       1   231.2   231.2  0.5515    0.4613    
## Ethnicity    3  1783.4   594.5  1.4180    0.2490    
## GPA2         1    12.5    12.5  0.0299    0.8635    
## Residuals   48 20122.9   419.2                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Strat :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 24490.7 24490.7 60.8063 4.455e-10 ***
## Gender       1   134.0   134.0  0.3327    0.5668    
## Ethnicity    3  1226.3   408.8  1.0149    0.3944    
## GPA2         1   116.2   116.2  0.2884    0.5937    
## Residuals   48 19332.8   402.8                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Com :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1 12150.0 12150.0 23.0392 1.588e-05 ***
## Gender       1    71.4    71.4  0.1353    0.7146    
## Ethnicity    3  2364.9   788.3  1.4948    0.2279    
## GPA2         1     0.4     0.4  0.0007    0.9793    
## Residuals   48 25313.4   527.4                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##  Response Lgl :
##             Df  Sum Sq Mean Sq F value    Pr(>F)    
## (Intercept)  1  9868.5  9868.5 18.0073 9.999e-05 ***
## Gender       1   580.3   580.3  1.0589    0.3086    
## Ethnicity    3  1957.8   652.6  1.1908    0.3232    
## GPA2         1  1188.0  1188.0  2.1678    0.1475    
## Residuals   48 26305.4   548.0                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#########################################################################

MANCOVA

#########################################################################
newdata$Gender=as.integer(newdata$Gender)
mymancova=jmv::mancova(
  data=newdata, 
  deps=vars(Fin, Mgt, HR, Sys, HIM, Ldr,
          Chg, Cli, QI, Strat, Com, Lgl), 
  factors=c(Ethnicity), 
  covs=c(Age, GPA, Gender), 
  multivar = list("pillai", "wilks", "hotel", "roy"),
)

options(digits=3)
a=mymancova$multivar
a

## 
##  Multivariate Tests                                                            
##  ----------------------------------------------------------------------------- 
##                                       value     F        df1    df2    p       
##  ----------------------------------------------------------------------------- 
##    Ethnicity    Pillai's Trace        0.7352    1.028     36    114    0.441   
##                 Wilks' Lambda          0.423    1.007     36    107    0.472   
##                 Hotelling's Trace     1.0223    0.984     36    104    0.505   
##                 Roy's Largest Root    0.5379    1.703     12     38    0.105   
##                                                                                
##    Age          Pillai's Trace        0.2460    0.979     12     36    0.486   
##                 Wilks' Lambda          0.754    0.979     12     36    0.486   
##                 Hotelling's Trace     0.3263    0.979     12     36    0.486   
##                 Roy's Largest Root    0.3263    0.979     12     36    0.486   
##                                                                                
##    GPA          Pillai's Trace        0.2593    1.050     12     36    0.428   
##                 Wilks' Lambda          0.741    1.050     12     36    0.428   
##                 Hotelling's Trace     0.3500    1.050     12     36    0.428   
##                 Roy's Largest Root    0.3500    1.050     12     36    0.428   
##                                                                                
##    Gender       Pillai's Trace        0.0783    0.255     12     36    0.993   
##                 Wilks' Lambda          0.922    0.255     12     36    0.993   
##                 Hotelling's Trace     0.0850    0.255     12     36    0.993   
##                 Roy's Largest Root    0.0850    0.255     12     36    0.993   
##  -----------------------------------------------------------------------------

#########################################################################

Appendix A

Program Outcomes (PO) and Student Learning Objectives (SLO)

Teaching

T1. All faculty evaluations (100%) each term have a median of 4.0 or greater out of 5.0 on the question, “Instructor provided the opportunity to learn.” {1=Strongly Disagree,…5=Strongly Agree} PO
T2. 100% of faculty members support opportunities for learning professional behavior as evidenced by in class learning activities and activities in SOHA- sponsored functions. PO
T3. BHA majors will successfully complete (with a grade of 80% or better) a case study/project in HA 3376 (Financial Management). SLO
T4. BHA majors will successfully complete (with a grade of 80% or better) a final exam in HA 3375 (Financial Accounting). SLO
T5. 100% of students will successfully complete the field experience (HA 4848) with a passing evaluation by their preceptor. A preceptor analysis will be used to determine application of the above referenced skills needing improvement. SLO
T6. 100% of students will successfully complete the final project requirements in the field experience (HA 4848) with a passing evaluation by their preceptor. SLO
T7. BHA majors will successfully complete (with a grade of 80% or better) a capstone case study in HA 4325 (strategic management) including an internal audit of strategic assessment; an external environmental assessment; and an assessment of a healthcare organization strategic plan. SLO
T8. 90% of students will demonstrate success in the writing intensive courses by scoring B’s or better on the final writing intensive (WI) assignments in HA3324. SLO
T9. 90% of students will demonstrate success in oral communication by achieving B’s or better on HA3344 group presentations. SLO
T10. 80% of our students will attain IISE Lean Six Sigma Green Belt Certification. SLO
T11. 80% of our students will attain Excel Basic MOS Certification. SLO
T12. 80% of our students will attain Excel Expert MOS Certification. SLO
T13. 80% of our students will attain QuickBooks Certification. SLO
T14. 100% of students will successfully complete the comprehensive exam with greater than median (nationwide) comparative scores. SLO
T15. 100% of students will have higher post-test scores than pre-test scores on the Peregrine exit exam. SLO

Research

R1. 100% of faculty members are engaged in research activities that support the body of knowledge in their respective fields as evidenced by at least one peer-reviewed publication each year. PO
R2. 50% of faculty acquire research funding for the University and the Department (stretch goal). PO
R3. 50% of students present a paper, poster or other research outcome at a professional conference or research symposium. SLO
R4. 10% of students are a named author on an article submitted for publication in a peer- reviewed journal. SLO
R5. 100% of faculty will collaborate either internally or externally for research purposes to build the research portfolio of our program. PO

Service

S1. 100% of faculty members will have demonstrated professional service each year as evidenced by review of CV’s. PO
S2. 100% of faculty members will have demonstrated community service each year as evidenced by review of CV’s. PO
S3. 100% of faculty provide service at the University, College, School, or Department level. PO

Student Success and Admissions

SS1. 50% of students seeking employment will have jobs within 1 month after graduation. SLO
SS2. 100% of students seeking employment will have jobs within 9 months after graduation. SLO
SS3. 80% or more of available seats will be filled with highly qualified students each term. PO
SS4. 70% of original cohort graduate together. SLO
SS5. 25% or more of admitted students will be of minority status. SLO

Program Success

P1. The program will maintain AUPHA certification (binary). PO
P2. One or more students will receive national awards. PO
P3. The BHA budget remains static or grows but does not shrink. PO
P4. 100% of vacant positions are filled. PO
P5. Alumni will serve as preceptors and speakers for the program as well as board members. PO
P6. In-building student computer facilities increase (binary). PO

BHA Examination Results, Pre-Post

Doc Larry Fulton

7 April 2020