Exploratory Data Analysis

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)
library(qcc)

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

## Package 'qcc' version 2.7

## Type 'citation("qcc")' for citing this R package in publications.

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 = 6, tl.col = "black", lab=TRUE, lab_size=1, p.mat=p.mat, insig="pch", pch=4)
  print(myplot)}

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

##  [1] "Subject"         "Term"            "Gender"          "Ethnicity"      
##  [5] "Age"             "Yr"              "DaysBetween"     "GPA"            
##  [9] "T_GPA"           "PrePost"         "Vision"          "Communication"  
## [13] "Professionalism" "Negotiation"     "Finance"         "Management"     
## [17] "Personnel"       "Systems"         "HR"              "IM"             
## [21] "Leadership"      "Change"          "Climate"         "Governance"     
## [25] "Accountability"  "PD"              "QI"              "Quant"          
## [29] "Relationships"   "RM"              "Strategy"        "Community"      
## [33] "Legal"           "Patient"         "Score"           "Rank"           
## [37] "Time"

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

Check Missing

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

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

Descriptives

Descriptive statistics for those with complete pre-posts, all terms.

Gender

mydatabackup=mydata  #eliminate individual without pre-test
mydata=mydata[1:54,]
#########################################################################
as.data.frame(100*round(table(mydata$Gender)/length(mydata$Gender),4))%>%
  kbl(col.names = c("Gender", "%"))%>%kable_classic(full_width=F)

Gender	%
F	70.37
M	29.63

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

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	11.11
B	29.63
C	25.93
H	18.52
I	14.81

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

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="Age")%>%kable_classic(full_width=F)

	Age
vars	1.000
n	54.000
mean	26.074
sd	3.875
median	25.000
trimmed	25.318
mad	1.483
min	23.000
max	44.000
range	21.000
skew	3.658
kurtosis	14.049
se	0.527

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

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	54.000
mean	3.535
sd	0.231
median	3.500
trimmed	3.541
mad	0.208
min	3.070
max	3.930
range	0.860
skew	-0.097
kurtosis	-0.436
se	0.031

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

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	54.000
mean	525.297
sd	191.211
median	582.605
trimmed	526.657
mad	218.871
min	146.971
max	1017.856
range	870.885
skew	0.030
kurtosis	0.618
se	26.021

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

Correlations

We look at hierarchically-clustered correlations to see which competency evaluations are related and in what directions. An “X” indicates no statistically significant correlation. Obviously “score” (the final score) and “rank” (the percentile rank) must be colinear. Interestingly, the student scores on the strategy area are highly correlated to their overall performance. This reinforces the use of strategy as a capstone course.

#########################################################################
mycorr=cor(mydata[, -c(1:4,6,10,28)])
corfunction(mycorr)

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

Kernel Density Estimates

#########################################################################
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:27], mydata$Score[28:54]))%>%kbl(col.names="Pre-Post Test Score Correlation")%>%kable_classic()

Pre-Post Test Score Correlation
0.3504154

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

Pre-Test

We would expect poor performance on the pre-test scores, as there is no incentive.

#########################################################################
pre=round(describe(mydata[1:27,11:37]),3)
post=round(describe(mydata[28:54, 11:37]),3)
mydelta=mydata[28:54, 11:37]-mydata[1:27, 11:37]
delta=round(describe(mydelta),3)
mynames=c("Communicating Vision", "Communication Skills", 
          "Contributions to Community / Profession", 
          "Facilitation / Negotiation", "Financial Mgt", "General Mgt",
          "HC Personnel","HC Systems & Org", "HR Mgt", "Information Mgt", 
          "Leadership Skills/Beh", "Change Mgt", "Org Climate & Culture",
          "Org Dynamics & Governance", 
          "Personal / Prof. Accountability", "Professional Dev. / Lifelong Lrng", 
          "Quality Improvement", "Quant Res & Stats", "Relationship Mgt", 
          "Risk Mgt", "Strategic Mgt", "Community & Env.", "Legal Env. of HA", 
          "Patient Perspective", 
          "Total Score", "Percentile Rank", "Duration")
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
Communicating Vision	1	27	65.556	18.046	60.00	65.217	14.826	30.00	100.00	70.00	0.159	-0.745	3.473
Communication Skills	2	27	70.741	15.915	70.00	70.870	14.826	40.00	100.00	60.00	-0.061	-0.611	3.063
Contributions to Community / Profession	3	27	61.852	16.879	60.00	62.609	14.826	20.00	90.00	70.00	-0.465	-0.552	3.248
Facilitation / Negotiation	4	27	55.556	18.046	60.00	55.652	14.826	20.00	90.00	70.00	-0.143	-1.043	3.473
Financial Mgt	5	27	51.852	18.818	50.00	52.174	14.826	10.00	90.00	80.00	-0.124	-0.464	3.622
General Mgt	6	27	64.444	18.046	70.00	65.217	14.826	30.00	90.00	60.00	-0.424	-0.694	3.473
HC Personnel	7	27	64.815	16.495	70.00	65.652	14.826	30.00	100.00	70.00	-0.414	-0.169	3.174
HC Systems & Org	8	27	57.407	18.101	60.00	57.391	14.826	20.00	90.00	70.00	-0.077	-0.793	3.483
HR Mgt	9	27	60.741	13.566	60.00	60.435	14.826	40.00	90.00	50.00	0.139	-0.817	2.611
Information Mgt	10	27	56.667	19.215	60.00	57.391	14.826	20.00	90.00	70.00	-0.292	-0.957	3.698
Leadership Skills/Beh	11	27	62.593	12.276	60.00	62.174	14.826	40.00	90.00	50.00	0.361	-0.744	2.363
Change Mgt	12	27	60.741	18.590	60.00	60.435	14.826	30.00	100.00	70.00	0.208	-0.865	3.578
Org Climate & Culture	13	27	60.741	18.796	60.00	61.304	14.826	10.00	100.00	90.00	-0.270	0.547	3.617
Org Dynamics & Governance	14	27	54.815	19.488	60.00	53.913	14.826	20.00	100.00	80.00	0.387	-0.295	3.750
Personal / Prof. Accountability	15	27	63.333	16.172	70.00	63.913	14.826	30.00	90.00	60.00	-0.368	-1.065	3.112
Professional Dev. / Lifelong Lrng	16	27	64.815	18.053	70.00	65.652	14.826	30.00	90.00	60.00	-0.443	-0.994	3.474
Quality Improvement	17	27	51.111	15.275	50.00	50.870	14.826	30.00	80.00	50.00	0.195	-1.366	2.940
Quant Res & Stats	18	10	44.000	24.585	40.00	43.750	22.239	10.00	80.00	70.00	0.108	-1.320	7.775
Relationship Mgt	19	27	62.222	17.831	60.00	62.609	14.826	30.00	90.00	60.00	-0.127	-0.741	3.432
Risk Mgt	20	27	55.556	19.677	60.00	55.652	14.826	10.00	90.00	80.00	-0.211	-0.558	3.787
Strategic Mgt	21	27	55.926	17.598	60.00	56.087	14.826	20.00	90.00	70.00	-0.250	-0.945	3.387
Community & Env.	22	27	48.889	18.674	50.00	48.696	14.826	20.00	80.00	60.00	0.189	-0.981	3.594
Legal Env. of HA	23	27	51.852	17.105	50.00	51.739	14.826	10.00	90.00	80.00	-0.055	0.041	3.292
Patient Perspective	24	27	60.741	21.109	60.00	61.739	29.652	10.00	90.00	80.00	-0.353	-0.794	4.062
Total Score	25	27	58.996	9.817	56.52	58.888	8.436	39.58	78.69	39.11	0.224	-0.802	1.889
Percentile Rank	26	27	35.556	25.497	26.00	34.261	23.722	1.00	84.00	83.00	0.467	-1.200	4.907
Duration	27	27	120.597	71.116	103.27	109.442	29.949	58.13	422.35	364.22	2.804	9.177	13.686

Post-Test

We would hope that our work teaching the students resulted in better scores. These are the raw descriptives. We will look at pre-post later.

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
Communicating Vision	1	27	86.667	12.089	90.00	87.826	14.826	60.00	100.00	40.00	-0.629	-0.515	2.327
Communication Skills	2	27	90.000	8.771	90.00	90.870	14.826	70.00	100.00	30.00	-0.659	-0.246	1.688
Contributions to Community / Profession	3	27	79.630	13.440	80.00	80.435	14.826	50.00	100.00	50.00	-0.851	0.160	2.586
Facilitation / Negotiation	4	27	81.481	13.215	80.00	82.174	14.826	50.00	100.00	50.00	-0.261	-0.649	2.543
Financial Mgt	5	27	73.333	15.689	70.00	73.478	14.826	40.00	100.00	60.00	-0.192	-0.783	3.019
General Mgt	6	27	76.296	14.182	80.00	76.522	14.826	50.00	100.00	50.00	0.097	-0.697	2.729
HC Personnel	7	27	82.593	9.443	80.00	82.609	0.000	60.00	100.00	40.00	0.022	-0.065	1.817
HC Systems & Org	8	27	81.852	11.107	80.00	82.174	14.826	50.00	100.00	50.00	-0.676	0.429	2.138
HR Mgt	9	27	76.667	12.089	80.00	76.957	14.826	50.00	100.00	50.00	-0.252	-0.723	2.327
Information Mgt	10	27	71.111	16.013	70.00	72.609	14.826	20.00	100.00	80.00	-1.094	2.047	3.082
Leadership Skills/Beh	11	27	85.185	10.514	90.00	85.652	14.826	60.00	100.00	40.00	-0.334	-0.533	2.023
Change Mgt	12	27	81.852	12.101	90.00	82.174	14.826	60.00	100.00	40.00	-0.216	-1.294	2.329
Org Climate & Culture	13	27	84.815	8.932	90.00	84.783	14.826	70.00	100.00	30.00	-0.103	-0.876	1.719
Org Dynamics & Governance	14	27	73.333	14.412	70.00	73.043	14.826	50.00	100.00	50.00	0.025	-0.785	2.774
Personal / Prof. Accountability	15	27	81.852	11.107	80.00	82.174	14.826	60.00	100.00	40.00	-0.189	-0.772	2.138
Professional Dev. / Lifelong Lrng	16	27	87.778	9.337	90.00	88.261	14.826	70.00	100.00	30.00	-0.118	-1.104	1.797
Quality Improvement	17	27	77.407	13.183	80.00	76.957	14.826	60.00	100.00	40.00	0.172	-1.189	2.537
Quant Res & Stats	18	27	46.296	16.904	40.00	46.087	14.826	10.00	80.00	70.00	0.153	-0.452	3.253
Relationship Mgt	19	27	87.407	12.276	90.00	88.696	14.826	60.00	100.00	40.00	-0.842	-0.367	2.363
Risk Mgt	20	27	83.333	9.199	80.00	83.478	14.826	60.00	100.00	40.00	-0.381	-0.069	1.770
Strategic Mgt	21	27	85.556	11.875	90.00	86.522	14.826	60.00	100.00	40.00	-0.591	-0.580	2.285
Community & Env.	22	27	73.333	15.442	80.00	73.913	14.826	50.00	90.00	40.00	-0.302	-1.493	2.972
Legal Env. of HA	23	27	85.926	8.884	90.00	86.087	14.826	70.00	100.00	30.00	-0.111	-0.835	1.710
Patient Perspective	24	27	86.667	10.742	90.00	87.391	14.826	60.00	100.00	40.00	-0.418	-0.496	2.067
Total Score	25	27	80.012	3.822	80.00	79.997	4.314	73.75	86.25	12.50	0.016	-1.126	0.735
Percentile Rank	26	27	85.778	7.170	87.00	86.130	5.930	72.00	95.00	23.00	-0.496	-1.002	1.380
Duration	27	27	149.314	36.822	148.52	147.539	44.537	92.57	229.13	136.56	0.449	-0.710	7.086

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
Communicating Vision	1	27	21.111	17.614	20.00	20.870	14.826	-10.00	50.00	60.00	0.041	-1.198	3.390
Communication Skills	2	27	19.259	19.201	20.00	19.565	14.826	-30.00	60.00	90.00	-0.244	0.126	3.695
Contributions to Community / Profession	3	27	17.778	21.721	20.00	17.826	14.826	-30.00	60.00	90.00	-0.094	-0.676	4.180
Facilitation / Negotiation	4	27	25.926	23.576	30.00	26.522	29.652	-20.00	60.00	80.00	-0.120	-1.222	4.537
Financial Mgt	5	27	21.481	21.250	20.00	21.304	14.826	-20.00	70.00	90.00	0.277	-0.581	4.090
General Mgt	6	27	11.852	20.198	20.00	11.739	14.826	-20.00	50.00	70.00	-0.162	-1.069	3.887
HC Personnel	7	27	17.778	21.001	20.00	17.826	14.826	-40.00	70.00	110.00	-0.101	1.089	4.042
HC Systems & Org	8	27	24.444	19.480	20.00	24.783	14.826	-20.00	60.00	80.00	-0.040	-0.685	3.749
HR Mgt	9	27	15.926	20.617	20.00	16.957	14.826	-30.00	50.00	80.00	-0.508	-0.219	3.968
Information Mgt	10	27	14.444	26.214	20.00	15.217	29.652	-40.00	60.00	100.00	-0.260	-1.030	5.045
Leadership Skills/Beh	11	27	22.593	14.830	20.00	22.174	14.826	0.00	50.00	50.00	0.182	-1.108	2.854
Change Mgt	12	27	21.111	23.260	20.00	20.870	29.652	-20.00	60.00	80.00	0.012	-1.258	4.476
Org Climate & Culture	13	27	24.074	19.067	20.00	23.043	14.826	-10.00	80.00	90.00	0.682	0.834	3.669
Org Dynamics & Governance	14	27	18.519	21.786	20.00	18.261	29.652	-30.00	70.00	100.00	0.182	-0.169	4.193
Personal / Prof. Accountability	15	27	18.519	18.544	10.00	17.826	14.826	-10.00	60.00	70.00	0.522	-0.671	3.569
Professional Dev. / Lifelong Lrng	16	27	22.963	21.089	20.00	22.609	14.826	-10.00	60.00	70.00	0.049	-0.989	4.059
Quality Improvement	17	27	26.296	22.214	30.00	26.522	14.826	-10.00	60.00	70.00	-0.176	-1.161	4.275
Quant Res & Stats	18	10	3.000	30.930	10.00	5.000	29.652	-50.00	40.00	90.00	-0.476	-1.395	9.781
Relationship Mgt	19	27	25.185	22.079	20.00	24.783	14.826	-30.00	70.00	100.00	-0.024	0.089	4.249
Risk Mgt	20	27	27.778	20.631	30.00	26.957	29.652	-10.00	80.00	90.00	0.414	-0.280	3.970
Strategic Mgt	21	27	29.630	23.119	30.00	29.565	29.652	-10.00	70.00	80.00	0.043	-1.076	4.449
Community & Env.	22	27	24.444	19.871	30.00	23.913	29.652	-10.00	70.00	80.00	0.249	-0.464	3.824
Legal Env. of HA	23	27	34.074	18.242	30.00	34.348	14.826	-10.00	70.00	80.00	-0.223	-0.379	3.511
Patient Perspective	24	27	25.926	24.378	20.00	25.217	29.652	-10.00	80.00	90.00	0.168	-0.983	4.692
Total Score	25	27	21.016	9.202	23.48	21.204	9.370	0.06	38.01	37.95	-0.296	-0.520	1.771
Percentile Rank	26	27	50.222	23.769	59.00	51.174	25.204	1.00	88.00	87.00	-0.429	-1.074	4.574
Duration	27	27	28.718	62.180	35.60	33.697	33.166	-202.28	143.05	345.33	-1.649	4.837	11.966

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

Fall 2020 Analysis

This analysis includes one individual without a pre-test, omitted from the differences scores

subdata=mydatabackup[mydatabackup$Term==1,]
subdata2=subdata[11:20, 11:37]-subdata[1:10, 11:37]
delta2=describe(subdata2)
delta2=delta2[order(-delta2$mean),]
delta2%>%kbl(caption="Difference, Post Minus Pre, Fall 2020 Only")%>%kable_classic(full_width = F, html_font = "Cambria")

Difference, Post Minus Pre, Fall 2020 Only
	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
Rank	26	10	48.100000	22.168296	53.000	48.875000	26.686800	12.00	78.00	66.00	-0.2341777	-1.5300788	7.010231
Legal	23	10	35.000000	13.540064	30.000	35.000000	7.413000	10.00	60.00	50.00	0.1208535	-0.5119835	4.281744
Systems	8	10	34.000000	15.776213	35.000	35.000000	22.239000	10.00	50.00	40.00	-0.1405824	-1.8526722	4.988876
Strategy	21	10	34.000000	27.968236	40.000	35.000000	37.065000	-10.00	70.00	80.00	-0.1788149	-1.5376801	8.844333
Patient	24	10	31.000000	23.781412	40.000	31.250000	29.652000	0.00	60.00	60.00	-0.1507839	-1.8117764	7.520343
QI	17	10	30.000000	22.110832	25.000	30.000000	29.652000	0.00	60.00	60.00	0.0555055	-1.5607438	6.992059
RM	20	10	29.000000	25.144030	25.000	27.500000	22.239000	-10.00	80.00	90.00	0.4408486	-0.6041902	7.951240
Personnel	7	10	27.000000	15.670212	25.000	27.500000	22.239000	0.00	50.00	50.00	-0.1777589	-1.3618401	4.955356
Professionalism	3	10	24.000000	24.129281	25.000	23.750000	22.239000	-10.00	60.00	70.00	-0.0820010	-1.5194761	7.630349
HR	9	10	22.000000	12.292726	25.000	22.500000	7.413000	0.00	40.00	40.00	-0.3359232	-1.2608824	3.887301
Relationships	19	10	22.000000	26.583203	20.000	22.500000	22.239000	-30.00	70.00	100.00	-0.1609755	-0.3789142	8.406347
Negotiation	4	10	21.000000	24.698178	20.000	21.250000	29.652000	-20.00	60.00	80.00	-0.0629236	-1.3996318	7.810250
Score	25	10	20.389000	8.013059	19.655	19.547500	7.420413	10.84	36.67	25.83	0.5696762	-0.8543715	2.533952
Time	27	10	19.691000	83.480354	37.710	36.461250	27.479991	-202.28	107.50	309.78	-1.7273851	2.1411966	26.398806
Leadership	11	10	18.000000	11.352924	20.000	17.500000	14.826000	0.00	40.00	40.00	0.3444350	-0.7587753	3.590110
Climate	13	10	18.000000	13.984118	20.000	18.750000	0.000000	-10.00	40.00	50.00	-0.5616761	-0.4511777	4.422166
PD	16	10	18.000000	18.737959	20.000	16.250000	14.826000	-10.00	60.00	70.00	0.7149908	0.1313684	5.925463
Vision	1	10	17.000000	14.944341	15.000	16.250000	22.239000	0.00	40.00	40.00	0.1006721	-1.7550167	4.725816
Finance	5	10	17.000000	24.060110	15.000	17.500000	29.652000	-20.00	50.00	70.00	0.0585865	-1.4644642	7.608475
Community	22	10	17.000000	18.885621	15.000	16.250000	22.239000	-10.00	50.00	60.00	0.0320671	-1.1591467	5.972158
Change	12	10	16.000000	24.585452	10.000	13.750000	22.239000	-10.00	60.00	70.00	0.5378001	-1.2937273	7.774603
Communication	2	10	15.000000	19.578900	20.000	17.500000	14.826000	-30.00	40.00	70.00	-0.9593291	0.1619093	6.191392
Accountability	15	10	14.000000	13.498971	15.000	13.750000	7.413000	-10.00	40.00	50.00	0.0682979	-0.4909756	4.268750
Governance	14	10	13.000000	15.670212	15.000	12.500000	22.239000	-10.00	40.00	50.00	0.1777589	-1.3618401	4.955356
Management	6	10	11.000000	16.633300	15.000	12.500000	14.826000	-20.00	30.00	50.00	-0.5319565	-1.1540528	5.259911
IM	10	10	5.000000	22.236107	0.000	5.000000	29.652000	-30.00	40.00	70.00	0.0272863	-1.3899192	7.031674
Quant	18	9	1.111111	32.188680	0.000	1.111111	44.478000	-50.00	40.00	90.00	-0.3286319	-1.5833813	10.729560

Results by Time / Area

This is the “money” table, as it provides the mean pre-test scores by area (PreXbar), the mean post-test scores by area (PostXbar), and the mean differences scores by area (DeltaXbar). We would expect that our curriculum would result in improved performance (DeltaXbar >0). Medians and standard deviations are shown as well. This is for ALL test scores.

a=pre[1:24,3]; b=post[1:24,3]; g=delta[1:24,3]
m1=pre[1:24,5 ]; m2=post[1:24,5]; m3=delta[1:24,5]
s1=pre[1:24,4 ]; s2=post[1:24,4]; s3=delta[1:24,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:24]
mydf[order(-mydf$DeltaXbar),]%>%kbl(caption="Difference, Post Minus Pre, All Terms")%>%kable_classic(full_width=F, html_font="Calibri")

Difference, Post Minus Pre, All Terms
	PreXbar	PostXbar	DeltaXbar	PreMed	PostMed	DeltaMed	PreSD	PostSD	DeltaSD
Legal Env. of HA	51.852	85.926	34.074	50	90	30	17.105	8.884	18.242
Strategic Mgt	55.926	85.556	29.630	60	90	30	17.598	11.875	23.119
Risk Mgt	55.556	83.333	27.778	60	80	30	19.677	9.199	20.631
Quality Improvement	51.111	77.407	26.296	50	80	30	15.275	13.183	22.214
Facilitation / Negotiation	55.556	81.481	25.926	60	80	30	18.046	13.215	23.576
Patient Perspective	60.741	86.667	25.926	60	90	20	21.109	10.742	24.378
Relationship Mgt	62.222	87.407	25.185	60	90	20	17.831	12.276	22.079
HC Systems & Org	57.407	81.852	24.444	60	80	20	18.101	11.107	19.480
Community & Env.	48.889	73.333	24.444	50	80	30	18.674	15.442	19.871
Org Climate & Culture	60.741	84.815	24.074	60	90	20	18.796	8.932	19.067
Professional Dev. / Lifelong Lrng	64.815	87.778	22.963	70	90	20	18.053	9.337	21.089
Leadership Skills/Beh	62.593	85.185	22.593	60	90	20	12.276	10.514	14.830
Financial Mgt	51.852	73.333	21.481	50	70	20	18.818	15.689	21.250
Communicating Vision	65.556	86.667	21.111	60	90	20	18.046	12.089	17.614
Change Mgt	60.741	81.852	21.111	60	90	20	18.590	12.101	23.260
Communication Skills	70.741	90.000	19.259	70	90	20	15.915	8.771	19.201
Org Dynamics & Governance	54.815	73.333	18.519	60	70	20	19.488	14.412	21.786
Personal / Prof. Accountability	63.333	81.852	18.519	70	80	10	16.172	11.107	18.544
Contributions to Community / Profession	61.852	79.630	17.778	60	80	20	16.879	13.440	21.721
HC Personnel	64.815	82.593	17.778	70	80	20	16.495	9.443	21.001
HR Mgt	60.741	76.667	15.926	60	80	20	13.566	12.089	20.617
Information Mgt	56.667	71.111	14.444	60	70	20	19.215	16.013	26.214
General Mgt	64.444	76.296	11.852	70	80	20	18.046	14.182	20.198
Quant Res & Stats	44.000	46.296	3.000	40	40	10	24.585	16.904	30.930

Ethnicity / Race

#########################################################################
levels(mydata$Ethnicity)=c("Asian", "African American", "Caucasian", "Any Hispanic", "International") #Assign new names to factor levels
ethtable=as.data.frame(table(mydata$Ethnicity[28:55],mydata$Gender[28:55])/length(mydata$Ethnicity[28:55])) #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*84, " 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[28:55]) #get the descriptive statistics

##    vars  n  mean   sd median trimmed  mad min max range skew kurtosis   se
## X1    1 27 26.07 3.91     25   25.35 1.48  23  44    21 3.56    13.41 0.75

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

## Warning: Removed 1 rows containing non-finite values (stat_bin).

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

## Warning: Removed 1 rows containing non-finite values (stat_bin).

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

GPA

#########################################################################
describe(mydata$GPA[28:55]) #Get descriptives

##    vars  n mean   sd median trimmed  mad  min  max range  skew kurtosis   se
## X1    1 27 3.54 0.23    3.5    3.54 0.21 3.07 3.93  0.86 -0.09    -0.53 0.04

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

## Warning: Removed 1 rows containing non-finite values (stat_boxplot).

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

GPA~Race+Gender

Evaluating GPA as a function of race and gender

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

newdata2=aggregate(mydata$GPA[28:55],b=list(mydata$Ethnicity[28:55],mydata$Gender[28:55]),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[28:54])  #describe the days between

##    vars  n  mean     sd median trimmed    mad    min     max  range skew
## X1    1 27 525.3 193.04  582.6  524.51 218.87 146.97 1017.86 870.89 0.03
##    kurtosis    se
## X1     0.48 37.15

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

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

Simple Inferentials

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*26), 26)
for (i in 1:26){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)=mynames[1:26]
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
Communicating Vision	21.111	14.143	28.079	6.228	26	0.000
Communication Skills	19.259	11.664	26.855	5.212	26	0.000
Contributions to Community / Profession	17.778	9.185	26.370	4.253	26	0.000
Facilitation / Negotiation	25.926	16.599	35.252	5.714	26	0.000
Financial Mgt	21.481	13.075	29.888	5.253	26	0.000
General Mgt	11.852	3.862	19.842	3.049	26	0.005
HC Personnel	17.778	9.470	26.085	4.399	26	0.000
HC Systems & Org	24.444	16.738	32.151	6.520	26	0.000
HR Mgt	15.926	7.770	24.082	4.014	26	0.000
Information Mgt	14.444	4.074	24.814	2.863	26	0.008
Leadership Skills/Beh	22.593	16.726	28.459	7.916	26	0.000
Change Mgt	21.111	11.910	30.312	4.716	26	0.000
Org Climate & Culture	24.074	16.532	31.617	6.561	26	0.000
Org Dynamics & Governance	18.519	9.900	27.137	4.417	26	0.000
Personal / Prof. Accountability	18.519	11.183	25.854	5.189	26	0.000
Professional Dev. / Lifelong Lrng	22.963	14.621	31.305	5.658	26	0.000
Quality Improvement	26.296	17.509	35.084	6.151	26	0.000
Quant Res & Stats	3.000	-19.126	25.126	0.307	9	0.766
Relationship Mgt	25.185	16.451	33.919	5.927	26	0.000
Risk Mgt	27.778	19.616	35.939	6.996	26	0.000
Strategic Mgt	29.630	20.484	38.775	6.660	26	0.000
Community & Env.	24.444	16.584	32.305	6.392	26	0.000
Legal Env. of HA	34.074	26.858	41.290	9.706	26	0.000
Patient Perspective	25.926	16.282	35.570	5.526	26	0.000
Total Score	21.016	17.376	24.657	11.867	26	0.000
Percentile Rank	50.222	40.820	59.625	10.979	26	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*26), 26)
for (i in 1:26){a[i,1:7]=myf(mydata[1:27,i+10], mydata[28:54,i+10])}
a=as.data.frame(a)
for (i in 1:6){a[,i]=as.numeric(a[,i])}
rownames(a)=mynames[1:26]
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
Communicating Vision	65.556	86.667	-29.528	-12.694	-5.050	45.426	0.000
Communication Skills	70.741	90.000	-26.325	-12.194	-5.507	40.459	0.000
Contributions to Community / Profession	61.852	79.630	-26.120	-9.436	-4.281	49.516	0.000
Facilitation / Negotiation	55.556	81.481	-34.582	-17.269	-6.023	47.658	0.000
Financial Mgt	51.852	73.333	-30.950	-12.013	-4.556	50.370	0.000
General Mgt	64.444	76.296	-20.727	-2.977	-2.683	49.249	0.010
HC Personnel	64.815	82.593	-25.163	-10.393	-4.860	41.390	0.000
HC Systems & Org	57.407	81.852	-32.686	-16.203	-5.981	43.148	0.000
HR Mgt	60.741	76.667	-22.946	-8.906	-4.554	51.324	0.000
Information Mgt	56.667	71.111	-24.111	-4.778	-3.001	50.362	0.004
Leadership Skills/Beh	62.593	85.185	-28.838	-16.347	-7.263	50.799	0.000
Change Mgt	60.741	81.852	-29.711	-12.512	-4.945	44.680	0.000
Org Climate & Culture	60.741	84.815	-32.187	-15.961	-6.011	37.172	0.000
Org Dynamics & Governance	54.815	73.333	-27.898	-9.139	-3.970	47.891	0.000
Personal / Prof. Accountability	63.333	81.852	-26.118	-10.919	-4.905	46.064	0.000
Professional Dev. / Lifelong Lrng	64.815	87.778	-30.875	-15.051	-5.871	38.980	0.000
Quality Improvement	51.111	77.407	-34.092	-18.500	-6.772	50.911	0.000
Quant Res & Stats	44.000	46.296	-20.610	16.017	-0.272	12.297	0.790
Relationship Mgt	62.222	87.407	-33.571	-16.800	-6.045	46.127	0.000
Risk Mgt	55.556	83.333	-36.249	-19.307	-6.645	36.846	0.000
Strategic Mgt	55.926	85.556	-37.856	-21.404	-7.252	45.613	0.000
Community & Env.	48.889	73.333	-33.810	-15.079	-5.242	50.229	0.000
Legal Env. of HA	51.852	85.926	-41.577	-26.572	-9.186	39.074	0.000
Patient Perspective	60.741	86.667	-35.149	-16.703	-5.688	38.619	0.000
Total Score	58.996	80.012	-25.138	-16.895	-10.366	33.703	0.000
Percentile Rank	35.556	85.778	-60.631	-39.814	-9.853	30.087	0.000

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

MHA Examination Results, Pre-Post

Doc Larry Fulton

7 November 2020