Code
## Libraries
library(tidyverse)
library(haven)
library(knitr)
library(Hmisc)
library(stats)BTS Barriers Data Analysis
Import libraries and data
Code
## Data
barriers <- read_sav("final_data.sav")Code
## Codebook
codebookSPSS <- function(df) {
return(data.frame(variable = names(df),
label = sapply(df, function(x) { ifelse(!is.null(attr(x,"label")),attr(x,"label"),NA)}),
levels = sapply(df, function(x) { ifelse(!is.null(attr(x,"labels")), paste0(attr(x,"labels"),": ",names(attr(x,"labels")), collapse=", "),NA) }))
)
}
codebook <- codebookSPSS(barriers) |>
mutate(label2 = str_match(label, " - (.*)")[,2]) # keep only the part of the label after the hyphen surrounded by spaces, which Qualtrics often uses to separate the stem and leaf parts of questions.Clean data
Code
## Change 'spss-labelled' data to R factors
barriers2 <- barriers |>
mutate(across(where(is.labelled), ~as_factor(.x)))Code
## Create a new variable for the outcome to see how many responses are valid and how many are not
barriers3 <- barriers2 |>
mutate(Outcome = case_when(as.numeric(Q1.1) == 2 ~ "Declined to participate",
as.numeric(Confirm.Role) == 1 ~ "Does not work with elementary school",
as.numeric(Confirm2.NonBTS.SCH) == 1 ~ "School currently in BTS",
as.numeric(Confirm2.NonBTS.LEA) == 1 ~ "Schools currently in BTS",
TRUE ~ "Valid observations"))Code
## Create new variable (with shorter label) for educator role and filter to only valid observations
barriers4 <- barriers3 |>
mutate(Educator_Role = case_when(as.numeric(Ed.Role) == 1 ~ "Principal",
as.numeric(Ed.Role) == 2 ~ "District/LEA")) |>
filter(Outcome == "Valid observations")Code
## Fix factor levels for the Familiarity variables
barriers5 <- barriers4 |>
mutate(Familiar.Self = fct_relevel(barriers4$Familiar.Self, "Very Familiar (i.e., I know a lot about the program goals, key components, and specific requirements)\n", after = Inf),
Familiar.Others = fct_relevel(Familiar.Others, "Very Familiar (i.e., I expect that they would know a lot about the program goals, key components, and specific requirements)\n", after = Inf))
# for some reason, factor levels for Familiar.Self and Familiar.Others are off. We fixed them here.Number of Responses Retained and Eliminated
Some of the survey respondents declined to participate or gave answers to preliminary questions that indicated that they were ineligible to participate. The distribution of those responses, as well as the number of valid observations, is presented below in Table 1.
Code
observations <-barriers3 |>
count(Outcome)
kable(observations)| Outcome | n |
|---|---|
| Declined to participate | 2 |
| School currently in BTS | 20 |
| Schools currently in BTS | 4 |
| Valid observations | 74 |
Familiarity with the program
How familiar are you with the BTS Arts program and its requirements?
Code
familiarity_self <- barriers5 |>
count(Educator_Role, Familiar.Self, .drop = FALSE) |>
group_by(Educator_Role) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1),
nPercent = paste0(Percent," (",n,")")) |>
select(-c(n, Percent)) |>
pivot_wider(names_from = Educator_Role, values_from = nPercent) |>
mutate(Principal = ifelse(is.na(Principal), "0% (0)", Principal),
`District/LEA` = ifelse(is.na(`District/LEA`), "0% (0)", `District/LEA`),
Familiar.Self = ifelse(is.na(Familiar.Self), "Did Not Answer", as.character(Familiar.Self)))
kable(familiarity_self)| Familiar.Self | District/LEA | Principal |
|---|---|---|
| Not At All Familiar (i.e., I’ve never heard of it) | 0% (0) | 4% (2) |
| Slightly Familiar (i.e., The name rings a bell) | 6% (1) | 19% (11) |
| Moderately Familiar (i.e., I generally understand the program goals and key components, but not specifics) | 29% (5) | 47% (27) |
| Very Familiar (i.e., I know a lot about the program goals, key components, and specific requirements) | 59% (10) | 30% (17) |
| Did Not Answer | 6% (1) | 0% (0) |
Code
# is association significant?
chisq.test(table(barriers5$Familiar.Self, barriers5$Educator_Role)) # chi-square test of independence
Pearson's Chi-squared test
data: table(barriers5$Familiar.Self, barriers5$Educator_Role)
X-squared = 6.2022, df = 3, p-value = 0.1022Code
# not significantBarriers to Participation
Knowledge of the program
How much of a barrier were the following factors to participation in the BTS Arts Program?
Code
# “Know” matrix items. (4 of these)
# goal: get mean and upper and lower limit of 95% CI for each item, by Educator_Role
know <- barriers5 |>
select(starts_with("Know")) %>%
mutate(across(starts_with("Know"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Know"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(know)
know |>
mutate(label2 = str_wrap(label2, width = 36)) |> # label2 was picked up from the codebook in the previous step. This wraps the text at 20 characters.
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) + # set y limits (now on horizontal axis due to coord_flip) here: 1 to 4
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Know_01), angle = 90, alpha = 0.4) + # x and y coordinates are "reversed" due to coord_flip. angle=90 rotates text 90 degrees. Alpha makes text semi-transparent.
scale_y_continuous(breaks = 1:4) + # set y-axis breaks to integers. I'd recommend that we keep the full 1-4 scale across domains (knowledge, interest, etc.) so that it's easier to compare across domains and to appreciate when means are low (as they are here).
labs(x = "", # removes x-axis label
y = "Mean with 95% Confidence Interval")
Interest
How much of a barrier were the following factors to participation in the BTS Arts Program? Insufficient or lack of belief in the value of arts education & integration among…
Code
# same approach as knowledge, but for “Interest” items. (6 of these)
interest <- barriers5 |>
select(starts_with("Interest")) %>%
mutate(across(starts_with("Interest"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Interest"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(interest)
interest |>
mutate(label2 = str_wrap(label2, width = 36)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Interest_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")
Resource availability
How much of a barrier were the following factors to participation in the BTS Arts Program?
Code
# same approach as above but for "Resource" items. (9 of these)
resource <- barriers5 |>
select(starts_with("Resource")) %>%
mutate(across(starts_with("Resource"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Resource"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(resource)
resource |>
mutate(label2 = str_wrap(label2, width = 36)) |> #wrap a bit wider since labels are too long
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Resource_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")
Feasibility
How much of a barrier were the following factors to participation in the BTS Arts Program?
Code
# same approach as know and interest, but for “Feasible” items. (7 of these)
feasible <- barriers5 |>
select(starts_with("Feasible")) %>%
mutate(across(starts_with("Feasible"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Feasible"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(feasible)
feasible |>
mutate(label2 = str_wrap(label2, width = 36)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Feasible_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")
Time
How much of a barrier were the following factors to participation in the BTS Arts Program?
Code
# same approach as above but for "Time" items. (7 of these)
time <- barriers5 |>
select(starts_with("Time")) %>%
mutate(across(starts_with("Time"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Time"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(time)
time |>
mutate(label2 = str_wrap(label2, width = 36)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Time_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")
Support
How much of a barrier were the following factors to participation in the BTS Arts Program?
Code
#same approach as above but for "Support" items. (7 of these)
support <- barriers5 |>
select(starts_with("Support")) %>%
mutate(across(starts_with("Support"), ~ as.numeric(.x))) |>
pivot_longer(cols = starts_with("Support"), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#kable(support)
support |>
mutate(label2 = str_wrap(label2, width = 36)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(2.5,4), label = levels(barriers5$Support_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")
Top 10 Barriers
Code
allbarriers <- barriers5 |>
select(starts_with("Know"), starts_with("Interest"), starts_with("Resource"), starts_with("Feasible"), starts_with("Time"), starts_with("Support")) |>
mutate(across(everything(), ~ as.numeric(.x))) |>
pivot_longer(cols = everything(), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) |> # upper limit of 95% CI
left_join(codebook |>
select(variable, label2), by = c("varname" = "variable")) # join to codebook to get labels
#order by mean
top10 <- allbarriers |>
arrange(desc(mean)) |>
head(10)
#graph top 10
top10 <- top10 |>
mutate(label2 = case_when(label2 == "Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement" ~ "Interest among currently employed educators in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement",
label2 == "Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement)" ~ "Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher",
TRUE ~ as.character(label2)))
top10 |>
arrange(desc(mean)) |>
mutate(label2 = str_wrap(label2, width = 50)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(5.5,4), label = levels(barriers5$Support_01), angle = 90, alpha = 0.4, size=5) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")+
#ggtitle("Top 10 Barriers to Participation in BTS Arts Program")+
theme(axis.text.y = element_text(size = 15)) + # make the y-axis text bigger
theme(axis.text.x = element_text(size = 15)) + #make the text in x-axis bigger for the graph above:
theme(axis.title.x = element_text(size = 15)) +
geom_pointrange(aes(ymin = ll, ymax = ul), color = "#c00000") # make the points red
Mean + 1sd top barriers
Code
allbarriers |>
arrange(desc(mean)) |>
filter(mean > (mean(allbarriers$mean) + sd(allbarriers$mean))) |>
mutate(label2 = str_wrap(label2, width = 36)) |>
ggplot(aes(x = reorder(label2, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(3,4), label = levels(barriers5$Support_01), angle = 90, alpha = 0.4) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")+
ggtitle("Top 5 Barriers to Participation in BTS Arts Program")
Code
top5 <- allbarriers |>
arrange(desc(mean)) |>
head(5)Additional Barriers (Open ended Question)
Please describe any additional barriers to participation in BTS Arts at [Field-Unit] that were not captured above.
Code
# Get the open ended answer for the additional barriers question. Drop if there are no answers.
additional_barriers <- barriers5 |>
select(Misc) |>
filter(Misc!="" & Misc!="none") |>
pull(Misc)
print(additional_barriers) [1] "Our major barrier was money. Our school is so small and is shrinking, so we continue losing funding each year."
[2] "When I started at SLArts, I was informed that our school does not qualify to participate in this program."
[3] "Our non participating schools have found highly effective art teachers who do amazing work. They are not opposed to the BTS program but are extremely happy with the person whom they hired and because their art teacher is not certified they cannot participate in the BTS program. Again they are not opposed to BTS but have been able to make a program work without the additional cost or requirements."
[4] "Distance, people to hire and funding"
[5] "My teachers are already overwhelmed with finishing LETRS and now our district is implementing a completely new program that is going to be intense so I am not going to add one more thing to their plate. We are also implementing a new intervention program."
[6] "When I did this at another school, the BTS teacher would inconsistently show up, required an entire classroom (which was not available, and she was upset about that). She honestly just disappeared and we never new what happened. (this teacher was funded by the district)."
[7] "I would suggest considering this archival research study that promotes holistic instruction in Utah's schools:\nchrome-extension://efaidnbmnnnibpcajpcglclefindmkaj/https://scholarsarchive.byu.edu/cgi/viewcontent.cgi?article=9675&context=etd"
[8] "One of the schools is under construction at present and has absolutely no space to house a specialist, but is thinking about it for when the school is finished. \n\nThe other school is a smaller, rural school and is in a different neighboring town from the other schools so if the BTS specialist were to split between two schools it would be logistically difficult. Also, they have an art teacher who could not become a BTS specialist, and she would have to lose her job in order to make room for a BTS specialist."
[9] "At this time we do not have sufficient funds allocated to hire a licensed Art teacher."
[10] "Biggest barrier is the size of the school. Hanksville Elementary serves less than 15 students Pre K through 4th grade. There is only one teacher for grades K-4 and one para that covers preschool. Art and music are provided within the constraints of the school, but providing consistent instruction is difficult within this system."
[11] "I am new to the school this year as principal, so I'm not well acquainted with consideration of BTS Arts at this school in the past at all. Teachers are deep into pd for LETRS and will be very deep into PD for new ELA adopted curriculum this year and new Math adopted curriculum next year, so this is a worry."
[12] "At Enterprise Elementary, we would love to have this available. Our problem is that we have 0 dollars to fund it."
[13] "Our school already has a full-time visual art teacher and a general music teacher. Students spend 50 minutes each week in music and in art. The art and music teacher work with general classroom teachers to coordinate projects and learning with the essential core topics. Both our music and art teachers are very familiar with BTS and would be happy to meet the requirements of the program. The only reason we don't participate is because we have already hired the teachers and pay them a full-time salary. We don't have time in our day to add theater or another type of art teacher and instruction and BTS doesn't allow us to apply and use funds to pay our existing teachers."
[14] "No additional barriers, it is mostly time, money, and another thing added to a teacher's plate."
[15] "Overall concern is finding the time to do \"one more thing\" Teachers are stretched thin as is the budget."
[16] "The biggest barrier would be time and the complexity of the schedule when you look at core instruction and tiered interventions. Finding time to collaborate has been a challenge."
[17] "We are such a small school and wear many hats so dedicating time and funds to this program was challenging as we have the components necessary already in place that supplement our curriculum and emphasize our cultural focus."
[18] "The major barrier we have is from classroom teachers feeling that it is worth their time to give up instructional time to teach what someone else should teach by themselves. This removes prep time for teachers when the BTS teacher isn't able to take full responsibility for their lesson. It also adds prepping for additional lessons."
[19] "Our biggest barriers are funding and scheduling. \n \nOur district was paying 10% of the 20% and the school made up the rest. However, this year we have had major budget cuts, and the district is not able to pay the additional 10% so it all falls on the schools. Principals want the program, but they are having a hard time shifting money to pay for this when they have so many other needs.\n \nWith this comes the major barrier of having to share a teacher with another school. Many of our schools are just under the numbers to receive a 0.75 FTE, this makes it very difficult for them to schedule with just a 0.5 FTE and puts a lot of strain on the BTS teacher to meet the requirements at both schools."
[20] "No being able to advocate as much as needed on behalf of the BTS Arts Program in the district. The focus is on core content teaching, with a research-based curriculum."
[21] "We had applied in the past and not received the grant so we stopped applying."
[22] "Elementary teachers in our district already feel overextended and overutilized. Any mention of additional responsibilities or meeting attendance is viewed in negative light."
[23] "Getting certified teachers is the biggest barrier for us. This year we have worked with a specialist from our Regional Service Center, and that has been somewhat effective."
[24] "We have done arts instruction the Manila way for 15 years--from before BTS even existed. This model works for us. No real interest in changing. Our students already get a rich Arts experience."
[25] "It is my understanding that it must be a new program in order to qualify for funds."
[26] "The major barriers are funding and time. Coming up with matching funds is always a challenge for schools because they are competing with many other needs. BTS Art Specialists aren't given prep time in their schedule so getting with teams to plan instruction is challenging. They need to be in their collaboration meetings but are unable to make that work because they aren't granted that time. I think if co-teaching wasn't a requirement of the program, many schools would pick up the program to support the collaboration time for teachers. Another barrier is the certification required. Elementary teachers are required to get an endorsement and the time it takes isn't something they want to do so we lose good teachers after the time granted for the endorsement expires."
[27] "The questions cover the barriers we are seeing."
[28] "We don't know what the reporting requirements are for the grant funds, and we aren't sure how the program could work with our model which is already arts intensive and integrated with core subjects."
attr(,"label")
[1] "Additional Barriers\nPlease describe any additional barriers to participation in BTS Arts at [Field-Unit] that were not captured above."
attr(,"format.spss")
[1] "A2000"
attr(,"display_width")
[1] 15Likelihood of Applying to BTS Arts Program
If the barriers identified were to persist or remain unchanged, how likely do you think [Field-Unit] would be to apply to BTS Arts in the future?
Code
likelihood_current_f <- barriers5 |>
select(Likelihood.Current) |>
drop_na() |>
count(Likelihood.Current, .drop = FALSE) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1))
kable(likelihood_current_f)| Likelihood.Current | n | Percent |
|---|---|---|
| Very Unlikely | 15 | 22% |
| Unlikely | 37 | 55% |
| Likely | 15 | 22% |
| Very Likely | 0 | 0% |
Code
likelihood.current <- barriers5 |>
select(Likelihood.Current) |>
mutate(across(everything(), ~ as.numeric(.x))) |>
pivot_longer(cols = everything(), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) # upper limit of 95% CI
likelihood.current |>
mutate(varname=case_when(varname == "Likelihood.Current" ~ "Likelihood of Applying If the Barriers Identified Persist or Remain Unchanged")) |>
mutate(varname = str_wrap(varname, width = 36)) |>
ggplot(aes(x = reorder(varname, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(1,4), label = levels(barriers5$Likelihood.Current), angle = 90, alpha = 0.4, size=5) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")+
theme(axis.text.y = element_text(size = 15)) + # make the y-axis text bigger
theme(axis.text.x = element_text(size = 15)) + #make the text in x-axis bigger for the graph above:
theme(axis.title.x = element_text(size = 15)) +
geom_pointrange(aes(ymin = ll, ymax = ul), color = "#c00000") # make the points red
If the barriers identified were overcome or were no longer an issue, to what extent do you think that would increase the likelihood that [Field-Unit] would apply to BTS Arts in the future?
Code
likelihood_changes_f <- barriers5 |>
select(Likelihood.Changes) |>
drop_na() |>
count(Likelihood.Changes, .drop = FALSE) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1))
kable(likelihood_changes_f)| Likelihood.Changes | n | Percent |
|---|---|---|
| Not at All | 1 | 2% |
| To a Small Extent | 11 | 17% |
| To a Moderate Extent | 20 | 30% |
| To a Large Extent | 34 | 52% |
Code
likelihood.changes <- barriers5 |>
select(Likelihood.Changes) |>
mutate(across(everything(), ~ as.numeric(.x))) |>
pivot_longer(cols = everything(), names_to = "varname", values_to = "response") |>
group_by(varname) |>
summarise(mean = mean(response, na.rm = TRUE),
ll = t.test(response, na.rm=TRUE)$conf.int[1], # lower limit of 95% CI
ul = t.test(response, na.rm=TRUE)$conf.int[2]) # upper limit of 95% CI
likelihood.changes |>
mutate(varname=case_when(varname == "Likelihood.Changes" ~ "Change in Likelihood of Applying If the Barriers Identified are Overcome or No Longer an Issue")) |>
mutate(varname = str_wrap(varname, width = 30)) |>
ggplot(aes(x = reorder(varname, mean), y = mean)) +
geom_pointrange(aes(ymin = ll, ymax = ul),
position = position_dodge(width = 0.2)) +
coord_flip(ylim = c(1,4)) +
theme_bw() +
annotate(geom = "text", y = 1:4, x = rep(1,4), label = levels(barriers5$Likelihood.Changes), angle = 90, alpha = 0.4, size=5) +
scale_y_continuous(breaks = 1:4) +
labs(x = "",
y = "Mean with 95% Confidence Interval")+
theme(axis.text.y = element_text(size = 15)) + # make the y-axis text bigger
theme(axis.text.x = element_text(size = 15)) + #make the text in x-axis bigger for the graph above:
theme(axis.title.x = element_text(size = 15)) +
geom_pointrange(aes(ymin = ll, ymax = ul), color = "#c00000") # make the points red
Bivariate associations between barriers and likelihood variables
Here, I looked at the bivariate associations between the Likelihood variables and the barriers. I only included the significant correlations.
Likelihood Current
Code
# Instead of multivariate regression models, we could look at bivariate associations between the Likelihood variables and the barriers. This would be a simpler way to see if the barriers are related to the likelihood of applying.
all_items_corr <- rcorr(as.matrix(barriers5 |>
select(Likelihood.Current, Likelihood.Changes, starts_with("Know"), starts_with("Interest"), starts_with("Resource"), starts_with("Feasible"), starts_with("Time"), starts_with("Support")) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
all_items_corr_r <-as.data.frame(all_items_corr$r)
all_items_corr_p <- as.data.frame(all_items_corr$P)
all_items_corr_r <- all_items_corr_r |>
rownames_to_column(var = "rowname")
all_items_corr_p <- all_items_corr_p |>
rownames_to_column(var = "rowname")
all_items_corr_table <- all_items_corr_r |>
select(rowname, Likelihood.Current, Likelihood.Changes) |>
left_join(all_items_corr_p |>
select(rowname, Likelihood.Current, Likelihood.Changes), by = "rowname", suffix = c("_r", "_p")) |>
select(rowname, Likelihood.Current_r, Likelihood.Current_p, Likelihood.Changes_r, Likelihood.Changes_p) |>
filter(rowname != "Likelihood.Current" & rowname != "Likelihood.Changes")
likelihood_current_corr <- all_items_corr_table |>
select(rowname, Likelihood.Current_r, Likelihood.Current_p) |>
filter(Likelihood.Current_p < 0.05) |>
left_join(codebook |>
select(variable, label2), by = c("rowname" = "variable")) |>
select(label2, Likelihood.Current_r, Likelihood.Current_p) |>
rename(Barrier = label2)
likelihood_current_corr |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Barrier | Likelihood.Current_r | Likelihood.Current_p |
|---|---|---|
| Knowledge of the program among school administrators | 0.38 | 0.00 |
| Understanding of potential BTS Arts implementation strategies or models in practice | 0.48 | 0.00 |
| Understanding of the BTS Arts application process | 0.45 | 0.00 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | -0.26 | 0.04 |
Here, a negative correlation makes sense. It means that as the barrier increases, the likelihood of applying to the program (if the barriers identified were to persist or remain unchanged) decreases. Positive correlation means that as the barrier increases, the likelihood of applying to the program increases.
Likelihood Changes
Code
likelihood_changes_corr <- all_items_corr_table |>
select(rowname, Likelihood.Changes_r, Likelihood.Changes_p) |>
filter(Likelihood.Changes_p < 0.05) |>
left_join(codebook |>
select(variable, label2), by = c("rowname" = "variable")) |>
select(label2, Likelihood.Changes_r, Likelihood.Changes_p) |>
rename(Barrier = label2)
likelihood_changes_corr |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Barrier | Likelihood.Changes_r | Likelihood.Changes_p |
|---|---|---|
| Ability to adhere to BTS Arts program requirements | -0.40 | 0.00 |
| Willingness of district/LEA leadership and/or staff to provide leadership & implementation support | -0.25 | 0.05 |
Here, a positive correlation would make sense. It means that as the barrier increases, the likelihood of applying to the program (if the barriers identified were overcome or were no longer an issue) increases. Negative correlation means that as the barrier increases, the likelihood of applying to the program decreases even if the barriers are removed.
Overall, the only significant correlation that makes sense to me is the one between “Time for classroom teachers to co-teach lessons with BTS Arts Teachers” and Likelihood.Current.
School level variables vs likelihoods and barriers
Here, I look at the school level variables and how they relate to the likelihoods and barriers. Because there are 40 barriers, I will only look at the top 10 barriers.
I started by joining the school data to the barriers data.
I only included the principals. LEA representatives are removed. There were 57 principals in our data set. 1 had missing data for the school name. I removed this person from the data. N=56
Code
# Join school data
# school data is in a separate file. We need to join it to the barriers data.
library(readxl)
school_data <- read_excel("BTS_by_school2.xlsx")
# create a new df for the principals
principals <- barriers5 |>
filter(Educator_Role == "Principal")
# fix the school names in principals and school data to match the school names
# specify the district of these schools to avoid confusion
principals2 <- principals |>
mutate(School = case_when(School == "Wasatch School" ~ "Wasatch School - Davis",
School == "Sunset School" ~ "Sunset School - Davis",
School == "Morgan School" ~ "Morgan School - Davis",
TRUE ~ as.character(School)))
# change the school names in the school data to match the school names in the principals data
school_data2 <- school_data |>
mutate(school_name = case_when(school_name == "Copper Canyon School" & district_name=="Tooele" ~ "Copper Canyon School - Tooele",
school_name == "Snowville School" ~ "Snowville School, Grouse Creek School, & Park Valley School",
school_name == "Valley View School" & district_name=="Davis" ~ "Valley View School - Davis",
school_name == "Uintah School" & district_name=="Weber" ~ "Uintah School - Weber",
school_name == "Canyon School" & district_name=="Nebo" ~ "Canyon School - Nebo",
school_name == "Taylor School" & district_name=="Nebo" ~ "Taylor School - Nebo",
school_name == "Lakeview School" & district_name=="Weber" ~ "Lakeview School - Weber",
school_name == "Majestic School" & district_name=="Weber" ~ "Majestic School - Weber",
school_name == "Wilson School" & district_name=="Nebo" ~ "Wilson School - Nebo",
school_name == "Kay's Creek Elementary" ~ "Kay's Creek School",
school_name == "Wasatch School" & district_name=="Davis" ~ "Wasatch School - Davis",
school_name == "Sunset School" & district_name=="Davis" ~ "Sunset School - Davis",
school_name == "Morgan School" & district_name=="Davis" ~ "Morgan School - Davis",
TRUE ~ as.character(school_name)))
# join the data and do not drop key variables
principals3 <- principals2 |>
left_join(school_data2, by = c( "School" = "school_name"), keep = TRUE)
#there is a superintendent in the data. Doesn't have any schools. We should remove this person from the data.
principals4 <- principals3 |>
filter(!is.na(school_name))Enrollment
Code
# First, let's recode enrollment into 3 categories: <700, 700-1000, >1000.
principals4 <- principals4 |>
mutate(enrollment_cat = case_when(enrollment < 700 ~ "<700",
enrollment >= 700 & enrollment <= 1000 ~ "700-1000",
enrollment > 1000 ~ ">1000"))
principals4 <- principals4 |>
mutate(enrollment_cat = factor(enrollment_cat, levels = c("<700", "700-1000", ">1000")))
principals4 |>
group_by(enrollment_cat) |>
summarise(n = n()) |>
kable()| enrollment_cat | n |
|---|---|
| <700 | 48 |
| 700-1000 | 7 |
| >1000 | 1 |
There are 3 categories of enrollment: <700, 700-1000, and >1000. However, there is only 1 principal in the >1000 category. This principal also had missing data on barriers and likelihoods. I removed this principal from the analysis. N=55
Enrollment vs. Likelihoods
Code
enrollment_likelihoods <- principals4 |>
select(Likelihood.Current, Likelihood.Changes, enrollment_cat) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(enrollment_cat) |>
summarise(likelihood_current = mean(Likelihood.Current, na.rm = TRUE),
likelihood_changes = mean(Likelihood.Changes, na.rm = TRUE)) |>
drop_na() |>
pivot_longer(cols = -enrollment_cat, names_to = "Likelihood", values_to = "mean") |>
pivot_wider(names_from = enrollment_cat, values_from = mean) |>
rename("<700" = "1", "700-1000" = "2")
# t-tests between <700 and 700-1000
p_values_enrollment_likelihoods <- map_dbl(c("Likelihood.Current", "Likelihood.Changes"), ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$enrollment_cat)$p.value)
# add the p-values to the enrollment_barriers df
enrollment_likelihoods <- enrollment_likelihoods |>
mutate(p_value = p_values_enrollment_likelihoods)
enrollment_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Likelihood | <700 | 700-1000 | p_value |
|---|---|---|---|
| likelihood_current | 1.98 | 2 | 0.95 |
| likelihood_changes | 3.42 | 3 | 0.27 |
There is a slight trend that schools with a lower enrollment are more likely to apply to the BTS Arts Program if the barriers were overcome. This is not a significant or strong relationship, but it is worth noting.
Enrollment vs. Barriers
Code
# get a list of top 10 barriers
top_10_list <- top10 |>
select(varname) |>
pull()
# Top10 vs enrollment
enrollment_barriers <- principals4 |>
select(top_10_list, enrollment_cat) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(enrollment_cat) |>
summarise_all(mean, na.rm = TRUE) |>
drop_na() |>
pivot_longer(cols = -enrollment_cat, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = enrollment_cat, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, "1", "2") |>
rename("<700" = "1", "700-1000" = "2", "Top 10 Barrier"="label2")
# add the p-values to the enrollment_barriers df
p_values_enrollment_barriers <- map_dbl(top_10_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$enrollment_cat)$p.value)
enrollment_barriers <- enrollment_barriers |>
mutate(p_value = p_values_enrollment_barriers)
enrollment_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | <700 | 700-1000 | p_value |
|---|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 3.24 | 3.00 | 0.63 |
| Availability of school funding | 3.24 | 3.00 | 0.57 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | 2.85 | 2.83 | 0.96 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 2.78 | 2.83 | 0.90 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 2.77 | 2.40 | 0.58 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 2.52 | 2.83 | 0.50 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 2.65 | 2.40 | 0.66 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 2.67 | 2.67 | 0.98 |
| Availability of district or LEA funding | 2.81 | 2.60 | 0.72 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | 2.56 | 2.50 | 0.90 |
There aren’t any significant differences in the top 10 barriers between schools with different enrollment sizes.
Title 1 Status
Code
principals4 |>
mutate(title1sw = factor(title1sw, levels = c(0, 1), labels = c("Not Title 1", "Title 1"))) |>
count(title1sw) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1)) |>
kable()| title1sw | n | Percent |
|---|---|---|
| Not Title 1 | 42 | 75% |
| Title 1 | 14 | 25% |
Title 1 vs. Likelihoods
Code
title1_likelihoods <- principals4 |>
select(Likelihood.Current, Likelihood.Changes, title1sw) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(title1sw) |>
summarise(likelihood_current = mean(Likelihood.Current, na.rm = TRUE),
likelihood_changes = mean(Likelihood.Changes, na.rm = TRUE)) |>
pivot_longer(cols = -title1sw, names_to = "Likelihoods", values_to = "mean") |>
pivot_wider(names_from = title1sw, values_from = mean) |>
rename("Title 1" = "1", "Not Title 1" = "0")
# add p-values from t-tests
p_values_title1_likelihoods <- map_dbl(c("Likelihood.Current", "Likelihood.Changes"), ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$title1sw)$p.value)
title1_likelihoods <- title1_likelihoods |>
mutate(p_value = p_values_title1_likelihoods)
title1_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Likelihoods | Not Title 1 | Title 1 | p_value |
|---|---|---|---|
| likelihood_current | 1.97 | 2.00 | 0.9 |
| likelihood_changes | 3.43 | 3.23 | 0.5 |
There is a slight trend that Not-Title 1 schools are more likely to apply to the BTS Arts Program if the barriers were overcome. This is not a significant or strong relationship, but it is worth noting.
Title 1 vs. Barriers
Code
# Top 10 barriers vs Title 1
title1_barriers <- principals4 |>
select(top_10_list, title1sw) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(title1sw) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -title1sw, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = title1sw, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, "0", "1") |>
rename("Not Title 1" = "0", "Title 1" = "1", "Top 10 Barrier"="label2")
# add the p-values to the title1_barriers df
p_values_title1_barriers <- map_dbl(top_10_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$title1sw)$p.value)
title1_barriers <- title1_barriers |>
mutate(p_value = p_values_title1_barriers)
title1_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | Not Title 1 | Title 1 | p_value |
|---|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 2.94 | 3.86 | 0.00 |
| Availability of school funding | 3.16 | 3.36 | 0.49 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | 2.88 | 2.77 | 0.70 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 2.88 | 2.54 | 0.32 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 2.59 | 3.08 | 0.18 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 2.63 | 2.38 | 0.42 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 2.41 | 3.15 | 0.01 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 2.55 | 3.00 | 0.12 |
| Availability of district or LEA funding | 2.84 | 2.64 | 0.65 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | 2.53 | 2.62 | 0.79 |
Some barriers in the top 10 are significantly different between Not-Title 1 and Title 1 schools. Both are related to resources (Resource_06 and Resource_05).
Location
Code
principals4 |>
count(locale_type_long) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1)) |>
kable()| locale_type_long | n | Percent |
|---|---|---|
| City: Midsize | 2 | 4% |
| City: Small | 3 | 5% |
| Rural: Distant | 1 | 2% |
| Rural: Fringe | 2 | 4% |
| Rural: Remote | 5 | 9% |
| Suburb: Large | 35 | 62% |
| Suburb: Small | 1 | 2% |
| Town: Distant | 6 | 11% |
| Town: Remote | 1 | 2% |
Code
# collapse the locale_type_long variable into 2 categories: Urban and Rural
# if begins with "Rural" or "Town", then "Rural", if begins with "City" or "Suburb", then "Urban"
principals4 <- principals4 |>
mutate(location = case_when(str_detect(locale_type_long, "^Rural") | str_detect(locale_type_long, "^Town") ~ "Rural",
str_detect(locale_type_long, "^City") | str_detect(locale_type_long, "^Suburb") ~ "Urban"))Collapsed location to: Rural: All Rural and Town Subcategories (n=15) Urban: All City and Suburb Subcategories (n=41)
Location vs likelihoods
Code
# Location vs likelihood
location_likelihoods <- principals4 |>
select(Likelihood.Current, Likelihood.Changes, location) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(location) |>
summarise(likelihood_current = mean(Likelihood.Current, na.rm = TRUE),
likelihood_changes = mean(Likelihood.Changes, na.rm = TRUE)) |>
pivot_longer(cols = -location, names_to = "Likelihoods", values_to = "mean") |>
pivot_wider(names_from = location, values_from = mean)
# add p-values from t-tests
p_values_location_likelihoods <- map_dbl(c("Likelihood.Current", "Likelihood.Changes"), ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$location)$p.value)
location_likelihoods <- location_likelihoods |>
mutate(p_value = p_values_location_likelihoods)
location_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Likelihoods | Rural | Urban | p_value |
|---|---|---|---|
| likelihood_current | 1.73 | 2.05 | 0.09 |
| likelihood_changes | 3.45 | 3.35 | 0.72 |
There is a slight trend that Urban schools are more likely to apply to the BTS Arts Program if nothing changes. This is not a significant or strong relationship, but it is worth noting.
Location vs barriers
Code
# Top 10 barriers vs Location
location_barriers <- principals4 |>
select(top_10_list, location) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(location) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -location, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = location, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, "Rural", "Urban") |>
rename("Top 10 Barrier"="label2")
# add the p-values to the location_barriers df
p_values_location_barriers <- map_dbl(top_10_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$location)$p.value)
location_barriers <- location_barriers |>
mutate(p_value = p_values_location_barriers)
location_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | Rural | Urban | p_value |
|---|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 3.67 | 3.06 | 0.03 |
| Availability of school funding | 3.58 | 3.10 | 0.10 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | 2.60 | 2.92 | 0.44 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 2.50 | 2.86 | 0.42 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 2.89 | 2.69 | 0.67 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 2.27 | 2.65 | 0.32 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 3.30 | 2.43 | 0.04 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 2.60 | 2.69 | 0.80 |
| Availability of district or LEA funding | 3.09 | 2.68 | 0.36 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | 2.30 | 2.62 | 0.44 |
Some barriers in the top 10 are significantly different between Urban and Rural schools. Both are related to resources (Resource_06 and Resource_05).
Low-income
Low-income vs likelihoods
Code
# Note: low-income is a percentage, so wee need correlations instead of t-tests
# Low-income vs likelihood
lowincome_likelihoods <- rcorr(as.matrix(principals4 |>
select(Likelihood.Current, Likelihood.Changes, validated_low_income) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
low_income_likelihood_corrs=c(lowincome_likelihoods$r[3,1], lowincome_likelihoods$r[3,2])
low_income_likelihood_ps=c(lowincome_likelihoods$P[3,1], lowincome_likelihoods$P[3,2])
lowincome_likelihoods <- data.frame(likelihood = c("Likelihood.Current", "Likelihood.Changes"), correlation = low_income_likelihood_corrs, p_value = low_income_likelihood_ps)
lowincome_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| likelihood | correlation | p_value |
|---|---|---|
| Likelihood.Current | 0.04 | 0.81 |
| Likelihood.Changes | -0.07 | 0.65 |
No significant correlations here.
Low-income vs barriers
Code
# Top 10 barriers vs Low-income
low_income_barriers <- rcorr(as.matrix(principals4 |>
select(validated_low_income, top_10_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
low_income_barriers_corrs <- low_income_barriers$r[1,2:11]
low_income_barriers_ps <- low_income_barriers$P[1,2:11]
low_income_barriers <- data.frame(correlation = low_income_barriers_corrs, p_value = low_income_barriers_ps)
low_income_barriers<- low_income_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, correlation, p_value) |>
rename("Top 10 Barrier"="label2")
low_income_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | correlation | p_value |
|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 0.44 | 0.00 |
| Availability of school funding | 0.06 | 0.66 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | -0.26 | 0.07 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | -0.24 | 0.11 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 0.21 | 0.17 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | -0.31 | 0.03 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 0.31 | 0.04 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 0.07 | 0.67 |
| Availability of district or LEA funding | -0.10 | 0.51 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | -0.01 | 0.93 |
Some barriers are correlated with low_income.
Schools with higher low-income populations are more likely to have barriers related to resources (Resource_06 and Resource_05)
“Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers” (Support_06) is less likely to be a barrier in schools with higher low-income populations.
English Learner Status
English Learner Status vs likelihoods
Code
# Note: ell status is a percentage so we need correlations instead of t-tests
# English Learner Status vs likelihood
ell_likelihoods <- rcorr(as.matrix(principals4 |>
select(Likelihood.Current, Likelihood.Changes, ell_status) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
ell_likelihood_corrs=c(ell_likelihoods$r[3,1], ell_likelihoods$r[3,2])
ell_likelihood_ps=c(ell_likelihoods$P[3,1], ell_likelihoods$P[3,2])
ell_likelihoods <- data.frame(likelihood = c("Likelihood.Current", "Likelihood.Changes"), correlation = ell_likelihood_corrs, p_value = ell_likelihood_ps)
ell_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| likelihood | correlation | p_value |
|---|---|---|
| Likelihood.Current | 0.11 | 0.44 |
| Likelihood.Changes | -0.07 | 0.65 |
No significant correlations here.
English Learner Status vs barriers
Code
# Top 10 barriers vs English Learner Status
ell_barriers <- rcorr(as.matrix(principals4 |>
select(ell_status, top_10_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
ell_barriers_corrs <- ell_barriers$r[1,2:11]
ell_barriers_ps <- ell_barriers$P[1,2:11]
ell_barriers <- data.frame(correlation = ell_barriers_corrs, p_value = ell_barriers_ps)
ell_barriers<- ell_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, correlation, p_value) |>
rename("Top 10 Barrier"="label2")
ell_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | correlation | p_value |
|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 0.09 | 0.56 |
| Availability of school funding | 0.02 | 0.89 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | 0.04 | 0.80 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 0.04 | 0.78 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | -0.02 | 0.89 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 0.00 | 1.00 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 0.02 | 0.91 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 0.14 | 0.35 |
| Availability of district or LEA funding | -0.06 | 0.70 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | 0.19 | 0.20 |
No significant correlations here.
Special Education Status
Special Education Status vs likelihoods
Code
# Note: special education status is a percentage so we need correlations instead of t-tests
# Special Education Status vs likelihood
special_ed_likelihoods <- rcorr(as.matrix(principals4 |>
select(Likelihood.Current, Likelihood.Changes, special_ed) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
special_ed_likelihood_corrs=c(special_ed_likelihoods$r[3,1], special_ed_likelihoods$r[3,2])
special_ed_likelihood_ps=c(special_ed_likelihoods$P[3,1], special_ed_likelihoods$P[3,2])
special_ed_likelihoods <- data.frame(likelihood = c("Likelihood.Current", "Likelihood.Changes"), correlation = special_ed_likelihood_corrs, p_value = special_ed_likelihood_ps)
special_ed_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| likelihood | correlation | p_value |
|---|---|---|
| Likelihood.Current | -0.17 | 0.24 |
| Likelihood.Changes | 0.10 | 0.52 |
No significant correlations here.
Special Education Status vs barriers
Code
# Top 10 barriers vs Special Education Status
special_ed_barriers <- rcorr(as.matrix(principals4 |>
select(special_ed, top_10_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
special_ed_barriers_corrs <- special_ed_barriers$r[1,2:11]
special_ed_barriers_ps <- special_ed_barriers$P[1,2:11]
special_ed_barriers <- data.frame(correlation = special_ed_barriers_corrs, p_value = special_ed_barriers_ps)
special_ed_barriers<- special_ed_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, correlation, p_value) |>
rename("Top 10 Barrier"="label2")
special_ed_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | correlation | p_value |
|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 0.13 | 0.40 |
| Availability of school funding | 0.01 | 0.93 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | -0.33 | 0.02 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | -0.16 | 0.28 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 0.04 | 0.82 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | -0.19 | 0.19 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 0.01 | 0.94 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | -0.22 | 0.14 |
| Availability of district or LEA funding | -0.12 | 0.44 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | -0.19 | 0.21 |
“Time for classroom teachers to co-teach lessons with BTS Arts Teachers” (Time_06) is less likely to be a barrier in schools with higher special education populations
White percentage
White percentage vs likelihoods
Code
# Note: white percentage is a percentage so we need correlations instead of t-tests
# White percentage vs likelihood
white_likelihoods <- rcorr(as.matrix(principals4 |>
select(Likelihood.Current, Likelihood.Changes, race_C) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
white_likelihood_corrs=c(white_likelihoods$r[3,1], white_likelihoods$r[3,2])
white_likelihood_ps=c(white_likelihoods$P[3,1], white_likelihoods$P[3,2])
white_likelihoods <- data.frame(likelihood = c("Likelihood.Current", "Likelihood.Changes"), correlation = white_likelihood_corrs, p_value = white_likelihood_ps)
white_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| likelihood | correlation | p_value |
|---|---|---|
| Likelihood.Current | -0.22 | 0.13 |
| Likelihood.Changes | 0.03 | 0.84 |
No significant correlations here.
White percentage vs barriers
Code
# Top 10 barriers vs White percentage
white_barriers <- rcorr(as.matrix(principals4 |>
select (race_C, top_10_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
white_barriers_corrs <- white_barriers$r[1,2:11]
white_barriers_ps <- white_barriers$P[1,2:11]
white_barriers <- data.frame(correlation = white_barriers_corrs, p_value = white_barriers_ps)
white_barriers<- white_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, correlation, p_value) |>
rename("Top 10 Barrier"="label2")
white_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | correlation | p_value |
|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | -0.16 | 0.28 |
| Availability of school funding | 0.06 | 0.68 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | -0.01 | 0.97 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 0.02 | 0.89 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 0.02 | 0.90 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 0.05 | 0.73 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | -0.11 | 0.47 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | -0.10 | 0.52 |
| Availability of district or LEA funding | 0.14 | 0.37 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | -0.03 | 0.86 |
No significant correlations here.
Charter Status
Code
principals4 |>
mutate(charter_flag = factor(charter_flag, levels = c(0, 1), labels = c("Not Charter", "Charter"))) |>
count(charter_flag) |>
mutate(Percent = scales::percent(n/sum(n), accuracy = 1)) |>
kable()| charter_flag | n | Percent |
|---|---|---|
| Not Charter | 48 | 86% |
| Charter | 8 | 14% |
Charter vs likelihoods
Code
# Charter is binary so use the same t-test method as Title 1
# Charter vs likelihood
charter_likelihoods <- principals4 |>
select(Likelihood.Current, Likelihood.Changes, charter_flag) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(charter_flag) |>
summarise(likelihood_current = mean(Likelihood.Current, na.rm = TRUE),
likelihood_changes = mean(Likelihood.Changes, na.rm = TRUE)) |>
pivot_longer(cols = -charter_flag, names_to = "Likelihoods", values_to = "mean") |>
pivot_wider(names_from = charter_flag, values_from = mean) |>
rename("Charter" = "1", "Not Charter" = "0")
# add p-values from t-tests
p_values_charter_likelihoods <- map_dbl(c("Likelihood.Current", "Likelihood.Changes"), ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$charter_flag)$p.value)
charter_likelihoods <- charter_likelihoods |>
mutate(p_value = p_values_charter_likelihoods)
charter_likelihoods |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Likelihoods | Not Charter | Charter | p_value |
|---|---|---|---|
| likelihood_current | 1.95 | 2.17 | 0.54 |
| likelihood_changes | 3.33 | 3.67 | 0.21 |
No significant differences here.
Charter vs barriers
Code
# Top 10 barriers vs Charter
charter_barriers <- principals4 |>
select(top_10_list, charter_flag) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(charter_flag) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -charter_flag, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = charter_flag, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(label2, "0", "1") |>
rename("Not Charter" = "0", "Charter" = "1", "Top 10 Barrier"="label2")
# add the p-values to the charter_barriers df
p_values_charter_barriers <- map_dbl(top_10_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$charter_flag)$p.value)
charter_barriers <- charter_barriers |>
mutate(p_value = p_values_charter_barriers)
charter_barriers |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Top 10 Barrier | Not Charter | Charter | p_value |
|---|---|---|---|
| Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 3.38 | 2.29 | 0.08 |
| Availability of school funding | 3.40 | 2.00 | 0.04 |
| Time for classroom teachers to co-teach lessons with BTS Arts Teachers | 2.78 | 3.33 | 0.06 |
| Time for classroom teachers to participate in BTS Arts-related professional development activities | 2.76 | 3.00 | 0.52 |
| Interest among currently employed educators at [Field-Unit] in becoming a BTS Arts Teacher by pursuing a professional licensure and/or endorsement | 2.84 | 2.14 | 0.20 |
| Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | 2.55 | 2.67 | 0.66 |
| Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 2.71 | 2.14 | 0.28 |
| Time for classroom teachers to prepare curriculum & other materials to share with BTS Arts Teachers | 2.71 | 2.40 | 0.50 |
| Availability of district or LEA funding | 2.94 | 2.00 | 0.14 |
| Time for classroom teachers to collaborate on lesson planning with BTS Arts Teachers | 2.63 | 2.00 | 0.15 |
“Availability of school funding” (Resource_01) is less likely to be a barrier in charter schools.
School level variables vs ALL barriers
Above, I looked at the relationships bewtween school-level variables and only top 10 barriers. Here, I will look at the relationships between school-level variables and all barriers. I report only significant results.
Enrollment
Code
# or maybe all barriers?
all_barriers_list <- allbarriers |>
arrange(desc(mean)) |>
select(varname) |>
pull()
# All barriers vs enrollment
enrollment_all_barriers <- principals4 |>
select(all_barriers_list, enrollment_cat) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(enrollment_cat) |>
summarise_all(mean, na.rm = TRUE) |>
drop_na() |>
pivot_longer(cols = -enrollment_cat, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = enrollment_cat, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, "1", "2") |>
rename("<700" = "1", "700-1000" = "2", "All Barriers"="label2")
# add the p-values to the enrollment_all_barriers df
principals4 <- principals4 |>
filter(enrollment_cat != ">1000")
p_values_enrollment_all_barriers <- map_dbl(all_barriers_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$enrollment_cat)$p.value)
enrollment_all_barriers <- enrollment_all_barriers |>
mutate(p_value = p_values_enrollment_all_barriers)
# show only significant results
enrollment_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | <700 | 700-1000 | p_value |
|---|---|---|---|---|
| Time_01 | Time to complete required administrative tasks (e.g., paperwork, reporting) | 2.19 | 1.5 | 0.04 |
| Interest_02 | …school administrators | 1.22 | 1.0 | 0.01 |
| Interest_06 | …students | 1.21 | 1.0 | 0.01 |
| Interest_05 | …families | 1.20 | 1.0 | 0.02 |
Title 1
Code
# All barriers vs Title 1
title1_all_barriers <- principals4 |>
select(all_barriers_list, title1sw) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(title1sw) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -title1sw, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = title1sw, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, "0", "1") |>
rename("Not Title 1" = "0", "Title 1" = "1", "All Barriers"="label2")
# add the p-values to the title1_all_barriers df
p_values_title1_all_barriers <- map_dbl(all_barriers_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$title1sw)$p.value)
title1_all_barriers <- title1_all_barriers |>
mutate(p_value = p_values_title1_all_barriers)
# show only significant results
title1_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | Not Title 1 | Title 1 | p_value |
|---|---|---|---|---|
| Resource_06 | Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 2.94 | 3.86 | 0.00 |
| Resource_05 | Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 2.41 | 3.15 | 0.01 |
Location
Code
# All barriers vs Location
location_all_barriers <- principals4 |>
select(all_barriers_list, location) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(location) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -location, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = location, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, "Rural", "Urban") |>
rename("Rural" = "Rural", "Urban" = "Urban", "All Barriers"="label2")
# add the p-values to the location_all_barriers df
p_values_location_all_barriers <- map_dbl(all_barriers_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$location)$p.value)
location_all_barriers <- location_all_barriers |>
mutate(p_value = p_values_location_all_barriers)
# show only significant results
location_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | Rural | Urban | p_value |
|---|---|---|---|---|
| Resource_06 | Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 3.67 | 3.06 | 0.03 |
| Resource_05 | Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 3.30 | 2.43 | 0.04 |
Low-income
Code
# All barriers vs Low-income
# Top 10 barriers vs Low-income
low_income_all_barriers <- rcorr(as.matrix(principals4 |>
select(validated_low_income, all_barriers_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
low_income_all_barriers_corrs <- low_income_all_barriers$r[1,2:41]
low_income_all_barriers_ps <- low_income_all_barriers$P[1,2:41]
low_income_all_barriers <- data.frame(correlation = low_income_all_barriers_corrs, p_value = low_income_all_barriers_ps)
low_income_all_barriers<- low_income_all_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, correlation, p_value) |>
rename("All Barriers"="label2")
# show only significant results
low_income_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | correlation | p_value |
|---|---|---|---|
| Resource_06 | Ability to offer BTS Arts teachers full-time employment (i.e., program may only allocate partial FTE based on school enrollment) | 0.44 | 0.00 |
| Support_06 | Willingness of classroom teachers to co-teach lessons with BTS Arts Teachers | -0.31 | 0.03 |
| Resource_05 | Availability of other qualified educators in your local job market to hire as a BTS Arts Teacher (i.e., a professional educator license in Utah, with either a K-12 art-form specific endorsement or an elementary art-form specific endorsement) | 0.31 | 0.04 |
| Feasible_07 | Ability to coordinate BTS Arts Teachers’ time across multiple schools | 0.41 | 0.01 |
| Know_03 | Understanding of potential BTS Arts implementation strategies or models in practice | 0.36 | 0.01 |
English Learner Status
Code
# same as above
# All barriers vs English Learner Status
ell_all_barriers <- rcorr(as.matrix(principals4 |>
select(ell_status, all_barriers_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
ell_all_barriers_corrs <- ell_all_barriers$r[1,2:41]
ell_all_barriers_ps <- ell_all_barriers$P[1,2:41]
ell_all_barriers <- data.frame(correlation = ell_all_barriers_corrs, p_value = ell_all_barriers_ps)
ell_all_barriers<- ell_all_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, correlation, p_value) |>
rename("All Barriers"="label2")
# show only significant results
ell_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | correlation | p_value |
|---|---|---|---|
| Feasible_07 | Ability to coordinate BTS Arts Teachers’ time across multiple schools | 0.32 | 0.03 |
| Support_02 | Willingness of school administrators to provide leadership & implementation support | 0.34 | 0.02 |
Special Education Status
Code
# same as above
# All barriers vs Special Education Status
special_ed_all_barriers <- rcorr(as.matrix(principals4 |>
select(special_ed, all_barriers_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
special_ed_all_barriers_corrs <- special_ed_all_barriers$r[1,2:41]
special_ed_all_barriers_ps <- special_ed_all_barriers$P[1,2:41]
special_ed_all_barriers <- data.frame(correlation = special_ed_all_barriers_corrs, p_value = special_ed_all_barriers_ps)
special_ed_all_barriers<- special_ed_all_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, correlation, p_value) |>
rename("All Barriers"="label2")
# show only significant results
special_ed_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | correlation | p_value |
|---|---|---|---|
| Time_06 | Time for classroom teachers to co-teach lessons with BTS Arts Teachers | -0.33 | 0.02 |
| Know_04 | Understanding of the BTS Arts application process | -0.31 | 0.03 |
| Time_01 | Time to complete required administrative tasks (e.g., paperwork, reporting) | -0.34 | 0.03 |
| Know_02 | Knowledge of the program among school administrators | -0.30 | 0.04 |
| Know_01 | Knowledge of the program among district/LEA leadership and/or staff | -0.31 | 0.03 |
White percentage
Code
# same as above
# All barriers vs White percentage
white_all_barriers <- rcorr(as.matrix(principals4 |>
select(race_C, all_barriers_list) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
white_all_barriers_corrs <- white_all_barriers$r[1,2:41]
white_all_barriers_ps <- white_all_barriers$P[1,2:41]
white_all_barriers <- data.frame(correlation = white_all_barriers_corrs, p_value = white_all_barriers_ps)
white_all_barriers<- white_all_barriers |>
rownames_to_column(var = "barrier") |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, correlation, p_value) |>
rename("All Barriers"="label2")
# show only significant results
white_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | correlation | p_value |
|---|---|---|---|
| Time_01 | Time to complete required administrative tasks (e.g., paperwork, reporting) | -0.36 | 0.02 |
Charter Status
Code
# same as enrollment strategy
# All barriers vs Charter
charter_all_barriers <- principals4 |>
select(all_barriers_list, charter_flag) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(charter_flag) |>
summarise_all(mean, na.rm = TRUE) |>
pivot_longer(cols = -charter_flag, names_to = "barrier", values_to = "mean") |>
pivot_wider(names_from = charter_flag, values_from = mean) |>
left_join(codebook |>
select(variable, label2), by = c("barrier" = "variable")) |>
select(barrier, label2, "0", "1") |>
rename("Not Charter" = "0", "Charter" = "1", "All Barriers"="label2")
# add the p-values to the charter_all_barriers df
p_values_charter_all_barriers <- map_dbl(all_barriers_list, ~ t.test(as.numeric(principals4[[.x]]) ~ principals4$charter_flag)$p.value)
charter_all_barriers <- charter_all_barriers |>
mutate(p_value = p_values_charter_all_barriers)
# show only significant results
charter_all_barriers |>
filter(p_value < 0.05) |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| barrier | All Barriers | Not Charter | Charter | p_value |
|---|---|---|---|---|
| Resource_01 | Availability of school funding | 3.40 | 2.00 | 0.04 |
| Resource_08 | Insufficient space for BTS Arts instruction | 2.58 | 1.50 | 0.00 |
| Feasible_07 | Ability to coordinate BTS Arts Teachers’ time across multiple schools | 2.39 | 1.43 | 0.00 |
School level variables vs. familiarity
Title 1
Code
title1_familiarity <- principals4 |>
select(Familiar.Self, title1sw) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(title1sw) |>
summarise(familiarity = mean(Familiar.Self, na.rm = TRUE)) |>
pivot_wider(names_from = title1sw, values_from = familiarity) |>
rename("Not Title 1" = "0", "Title 1" = "1")
# add p-values from t-tests
p_values_title1_familiarity <- t.test(as.numeric(principals4$Familiar.Self) ~ principals4$title1sw)$p.value
title1_familiarity <- title1_familiarity |>
mutate(p_value = p_values_title1_familiarity)
title1_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Not Title 1 | Title 1 | p_value |
|---|---|---|
| 3 | 3 | 1 |
Location
Code
location_familiarity <- principals4 |>
select(Familiar.Self, location) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(location) |>
summarise(familiarity = mean(Familiar.Self, na.rm = TRUE)) |>
pivot_wider(names_from = location, values_from = familiarity)
# add p-values from t-tests
p_values_location_familiarity <- t.test(as.numeric(principals4$Familiar.Self) ~ principals4$location)$p.value
location_familiarity <- location_familiarity |>
mutate(p_value = p_values_location_familiarity)
location_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Rural | Urban | p_value |
|---|---|---|
| 3.14 | 2.95 | 0.43 |
Enrollment
Code
enrollment_familiarity <- principals4 |>
select(Familiar.Self, enrollment_cat) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(enrollment_cat) |>
summarise(familiarity = mean(Familiar.Self, na.rm = TRUE)) |>
pivot_wider(names_from = enrollment_cat, values_from = familiarity) |>
rename("<700" = "1", "700-1000" = "2")
# add p-values from t-tests
p_values_enrollment_familiarity <- t.test(as.numeric(principals4$Familiar.Self) ~ principals4$enrollment_cat)$p.value
enrollment_familiarity <- enrollment_familiarity |>
mutate(p_value = p_values_enrollment_familiarity)
enrollment_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| <700 | 700-1000 | p_value |
|---|---|---|
| 2.94 | 3.43 | 0.06 |
Charter Status
Code
charter_familiarity <- principals4 |>
select(Familiar.Self, charter_flag) |>
mutate(across(where(is.factor), ~ as.numeric(.x))) |>
group_by(charter_flag) |>
summarise(familiarity = mean(Familiar.Self, na.rm = TRUE)) |>
pivot_wider(names_from = charter_flag, values_from = familiarity) |>
rename("Not Charter" = "0", "Charter" = "1")
# add p-values from t-tests
p_values_charter_familiarity <- t.test(as.numeric(principals4$Familiar.Self) ~ principals4$charter_flag)$p.value
charter_familiarity <- charter_familiarity |>
mutate(p_value = p_values_charter_familiarity)
charter_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| Not Charter | Charter | p_value |
|---|---|---|
| 3.04 | 2.75 | 0.4 |
Low-income
Code
# Note: low-income is a percentage, so wee need correlations instead of t-tests
# Low-income vs familiarity
lowincome_familiarity <- rcorr(as.matrix(principals4 |>
select(Familiar.Self, validated_low_income) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
low_income_familiarity_corrs=c(lowincome_familiarity$r[2,1])
low_income_familiarity_ps=c(lowincome_familiarity$P[2,1])
lowincome_familiarity <- data.frame(correlation = low_income_familiarity_corrs, p_value = low_income_familiarity_ps)
lowincome_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| correlation | p_value |
|---|---|
| -0.09 | 0.51 |
English Learner Status
Code
# Note: ell status is a percentage so we need correlations instead of t-tests
# English Learner Status vs familiarity
ell_familiarity <- rcorr(as.matrix(principals4 |>
select(Familiar.Self, ell_status) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
ell_familiarity_corrs=c(ell_familiarity$r[2,1])
ell_familiarity_ps=c(ell_familiarity$P[2,1])
ell_familiarity <- data.frame(correlation = ell_familiarity_corrs, p_value = ell_familiarity_ps)
ell_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| correlation | p_value |
|---|---|
| 0 | 0.98 |
Special Education Status
Code
# Note: special education status is a percentage so we need correlations instead of t-tests
# Special Education Status vs familiarity
special_ed_familiarity <- rcorr(as.matrix(principals4 |>
select(Familiar.Self, special_ed) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
special_ed_familiarity_corrs=c(special_ed_familiarity$r[2,1])
special_ed_familiarity_ps=c(special_ed_familiarity$P[2,1])
special_ed_familiarity <- data.frame(correlation = special_ed_familiarity_corrs, p_value = special_ed_familiarity_ps)
special_ed_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| correlation | p_value |
|---|---|
| -0.01 | 0.94 |
White percentage
Code
# Note: white percentage is a percentage so we need correlations instead of t-tests
# White percentage vs familiarity
white_familiarity <- rcorr(as.matrix(principals4 |>
select(Familiar.Self, race_C) |>
mutate(across(where(is.factor), ~ as.numeric(.x)))), type = "spearman")
white_familiarity_corrs=c(white_familiarity$r[2,1])
white_familiarity_ps=c(white_familiarity$P[2,1])
white_familiarity <- data.frame(correlation = white_familiarity_corrs, p_value = white_familiarity_ps)
white_familiarity |>
mutate_if(is.numeric, ~ round(., 2)) |>
kable()| correlation | p_value |
|---|---|
| 0.08 | 0.57 |
Let me know if you have any questions!