Executive Summary

This report analyzes evaluation data from the Crisis Intervention Training (CIT) program to assess participant perceptions, interest levels, and overall program effectiveness across multiple agencies and units.

Question 1: Interest Level Distribution

How many participants selected each interest level option?

interest_counts <- data %>%
  count(interest_level, sort = TRUE)

kable(interest_counts, 
      col.names = c("Interest Level", "Count"),
      caption = "Distribution of Interest Level Responses")

Distribution of Interest Level Responses
Interest Level	Count
Interesting & Informative	5082
NA	214
Interesting & Not Informative	55
Uninteresting	36
A Waste of Time	15

# Add percentage for visualization
interest_counts_pct <- interest_counts %>%
  mutate(
    percentage = n / sum(n) * 100,
    interest_level = ifelse(is.na(interest_level), "No Response", interest_level)
  )

# Create visualization
interest_counts_pct %>%
  mutate(interest_level = reorder(interest_level, n)) %>%
  ggplot(aes(x = interest_level, y = n, fill = interest_level)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = paste0(n, "\n(", round(percentage, 1), "%)")), 
            hjust = -0.1, size = 4, fontface = "bold") +
  coord_flip() +
  scale_fill_manual(values = c(
    "Interesting & Informative" = cit_colors["success"],
    "Interesting & Not Informative" = cit_colors["info"],
    "Uninteresting" = cit_colors["warning"],
    "A Waste of Time" = cit_colors["accent"],
    "No Response" = "#95A5A6"
  )) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(
    title = "Distribution of Interest Level Selections",
    subtitle = "Crisis Intervention Training Program Evaluation",
    x = "Interest Level",
    y = "Number of Participants"
  ) +
  theme(panel.grid.major.y = element_blank())

Key Finding: The vast majority of participants (94.1%) found the training both interesting and informative.

Question 2: Average Interest Level

What is the average interest level across all participants?

mean_interest <- data %>%
  summarise(avg_perception = mean(perception_score, na.rm = TRUE))

kable(mean_interest,
      col.names = c("Average Perception Score"),
      digits = 2,
      caption = "Average Perception Score (out of 4)")

Average Perception Score (out of 4)
Average Perception Score
3.81

# Distribution of perception scores
data %>%
  filter(!is.na(perception_score)) %>%
  ggplot(aes(x = perception_score)) +
  geom_histogram(binwidth = 0.5, fill = cit_colors["secondary"], 
                 color = "white", alpha = 0.8) +
  geom_vline(aes(xintercept = mean(perception_score, na.rm = TRUE)),
             color = cit_colors["accent"], linewidth = 1.5, linetype = "dashed") +
  annotate("text", 
           x = mean(data$perception_score, na.rm = TRUE) + 0.3,
           y = Inf, 
           label = paste("Mean =", round(mean(data$perception_score, na.rm = TRUE), 2)),
           vjust = 2, hjust = 0, color = cit_colors["accent"], 
           fontface = "bold", size = 5) +
  scale_x_continuous(breaks = 0:4) +
  labs(
    title = "Distribution of Perception Scores",
    subtitle = "Higher scores indicate more positive perceptions",
    x = "Perception Score",
    y = "Number of Participants"
  )

Key Finding: The average perception score is 3.81 out of 4, indicating highly positive participant perceptions.

Question 3: Participant Sentiments

General participant sentiments about training effectiveness

all_comments <- data %>%
  filter(!is.na(comments) & comments != "9999") %>%
  pull(comments)

all_words <- unlist(str_split(tolower(all_comments), "\\W+"))

common_words <- c("the","and","to","of","a","in","for","was",
                  "is","on","that","it","with","as","this",
                  "be","were","are","at","by","an","i","my",
                  "we","they","you","he","she","but","had","have",
                  "or","not","so","can","all","would","there")

word_table_clean <- as.data.frame(table(all_words), stringsAsFactors = FALSE) %>%
  rename(word = all_words, frequency = Freq) %>%
  filter(word != "" & !word %in% common_words & nchar(as.character(word)) > 2) %>%
  arrange(desc(frequency)) %>%
  head(20)

kable(word_table_clean,
      col.names = c("Word", "Frequency"),
      caption = "Top 20 Most Frequent Words in Participant Comments")

Top 20 Most Frequent Words in Participant Comments
Word	Frequency
very	624
great	569
good	568
informative	392
information	325
info	195
scenarios	160
exercise	152
helpful	141
about	130
interesting	127
how	119
resources	104
unit	92
more	87
what	86
999	82
class	78
people	74
training	72

# Visualize top words
word_table_clean %>%
  mutate(
    word = reorder(word, frequency),
    category = case_when(
      word %in% c("good", "great", "helpful", "excellent") ~ "Positive",
      word %in% c("informative", "information", "scenarios", "exercise") ~ "Content",
      TRUE ~ "Neutral"
    )
  ) %>%
  ggplot(aes(x = word, y = frequency, fill = category)) +
  geom_col() +
  geom_text(aes(label = frequency), hjust = -0.2, size = 3.5, fontface = "bold") +
  coord_flip() +
  scale_fill_manual(values = c(
    "Positive" = cit_colors["success"],
    "Content" = cit_colors["secondary"],
    "Neutral" = cit_colors["info"]
  )) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.12))) +
  labs(
    title = "Most Frequently Used Words in Participant Comments",
    subtitle = "Excluding common stop words",
    x = "Word",
    y = "Frequency",
    fill = "Category"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "top"
  )

Key Finding: Participant comments are overwhelmingly positive, with frequent use of words like “good,” “great,” and “informative.”

Question 4: Most Selected Interest Level

most_selected <- data %>%
  count(interest_level) %>%
  arrange(desc(n)) %>%
  slice(1)

kable(most_selected,
      col.names = c("Interest Level", "Count"),
      caption = "Most Frequently Selected Interest Level")

Most Frequently Selected Interest Level
Interest Level	Count
Interesting & Informative	5082

Key Finding: “Interesting & Informative” was selected 5082 times.

Question 5: Least Selected Interest Level

least_selected <- data %>%
  count(interest_level) %>%
  arrange(n) %>%
  slice(1)

kable(least_selected,
      col.names = c("Interest Level", "Count"),
      caption = "Least Frequently Selected Interest Level")

Least Frequently Selected Interest Level
Interest Level	Count
A Waste of Time	15

Key Finding: “A Waste of Time” was selected only 15 times.

Question 6: Interest Levels by Agency

Which interest level options were most popular by agency?

agency_interest <- data %>%
  group_by(agency_standardized, interest_level) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(agency_standardized) %>%
  slice_max(count, n = 1)

kable(head(agency_interest, 15),
      col.names = c("Agency", "Most Popular Interest Level", "Count"),
      caption = "Top 15 Agencies: Most Popular Interest Level Selection")

Top 15 Agencies: Most Popular Interest Level Selection
Agency	Most Popular Interest Level	Count
0	Interesting & Informative	1218
8a	Interesting & Informative	1
Agency Unknown	Interesting & Informative	1172
Bay Arenac Behavioral Health	Interesting & Informative	17
Bay City Department of Public Safety	Interesting & Informative	20
CMH	Interesting & Informative	4
CMTT	Interesting & Informative	3
Canton Police Department	Interesting & Informative	85
Community Mental Health of Ottawa County	Interesting & Informative	2
Dearborn Police Department	Interesting & Informative	25
Detroit Medical Center	Interesting & Informative	20
Detroit Police Department	Interesting & Informative	1831
Detroit Public Schools Community District Police Department	Interesting & Informative	59
Detroit Wayne Integrated Health Network	Interesting & Informative	17
Fulton County Sheriff’s Office	Interesting & Informative	2

# Visualize top 10 agencies
agency_interest %>%
  head(10) %>%
  mutate(agency_standardized = reorder(agency_standardized, count)) %>%
  ggplot(aes(x = agency_standardized, y = count, fill = interest_level)) +
  geom_col() +
  geom_text(aes(label = count), hjust = -0.2, size = 4, fontface = "bold") +
  coord_flip() +
  scale_fill_manual(values = c(
    "Interesting & Informative" = cit_colors["success"],
    "Interesting & Not Informative" = cit_colors["info"],
    "Uninteresting" = cit_colors["warning"]
  )) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.12))) +
  labs(
    title = "Most Popular Interest Level by Agency",
    subtitle = "Top 10 agencies by response count",
    x = "Agency",
    y = "Number of Responses",
    fill = "Interest Level"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "top"
  )

Key Finding: Across all agencies, “Interesting & Informative” was consistently the most selected interest level.

Question 7: Overall Success and Effectiveness

Comprehensive evaluation of the CIT program

overall_effectiveness <- data %>%
  summarise(
    avg_score = mean(perception_score, na.rm = TRUE),
    total_responses = n()
  )

positive_rate <- data %>%
  summarise(
    positive_percent = sum(perception_score == 4, na.rm = TRUE) / n() * 100
  )

negative_rate <- data %>%
  summarise(
    negative_percent = sum(perception_score <= 2, na.rm = TRUE) / n() * 100
  )

# Combine metrics
effectiveness_summary <- data.frame(
  Metric = c("Average Perception Score", "Positive Response Rate", "Negative Response Rate", 
             "Total Responses"),
  Value = c(
    paste(round(overall_effectiveness$avg_score, 2), "/ 4"),
    paste0(round(positive_rate$positive_percent, 1), "%"),
    paste0(round(negative_rate$negative_percent, 1), "%"),
    overall_effectiveness$total_responses
  )
)

kable(effectiveness_summary,
      caption = "Overall Program Effectiveness Summary")

Overall Program Effectiveness Summary
Metric	Value
Average Perception Score	3.81 / 4
Positive Response Rate	94.1%
Negative Response Rate	4.9%
Total Responses	5402

# Create effectiveness distribution chart
effectiveness_data <- data.frame(
  category = c("Highly Positive\n(Score = 4)", 
               "Somewhat Positive\n(Score = 3)", 
               "Negative\n(Score ≤ 2)"),
  percentage = c(
    sum(data$perception_score == 4, na.rm = TRUE) / sum(!is.na(data$perception_score)) * 100,
    sum(data$perception_score == 3, na.rm = TRUE) / sum(!is.na(data$perception_score)) * 100,
    sum(data$perception_score <= 2, na.rm = TRUE) / sum(!is.na(data$perception_score)) * 100
  ),
  color = c(cit_colors["success"], cit_colors["info"], cit_colors["accent"])
)

ggplot(effectiveness_data, aes(x = "", y = percentage, fill = category)) +
  geom_col(width = 1, color = "white", linewidth = 2) +
  coord_polar("y", start = 0) +
  scale_fill_manual(values = effectiveness_data$color) +
  geom_text(aes(label = paste0(round(percentage, 1), "%")),
            position = position_stack(vjust = 0.5),
            size = 6, fontface = "bold", color = "white") +
  labs(
    title = "Overall Program Effectiveness Distribution",
    subtitle = "Based on participant perception scores",
    fill = "Response Category"
  ) +
  theme_void(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16, hjust = 0.5, color = cit_colors["primary"]),
    plot.subtitle = element_text(size = 12, hjust = 0.5, color = cit_colors["secondary"]),
    legend.title = element_text(face = "bold"),
    legend.position = "right"
  )

Effectiveness by Unit

unit_effectiveness <- data %>%
  group_by(unit_standardized) %>%
  summarise(
    avg_score = mean(perception_score, na.rm = TRUE),
    responses = n()
  ) %>%
  arrange(desc(avg_score))

kable(head(unit_effectiveness, 10),
      col.names = c("Unit", "Average Score", "Number of Responses"),
      digits = 2,
      caption = "Top 10 Units by Average Perception Score")

Top 10 Units by Average Perception Score
Unit	Average Score	Number of Responses
44440	4.00	1
0	3.96	53
2	3.88	278
5	3.87	271
17	3.86	230
1	3.86	273
21	3.85	219
8a	3.84	264
7	3.83	254
18	3.83	235

# Visualize unit effectiveness
unit_effectiveness %>%
  filter(responses >= 10) %>%  # Only units with 10+ responses
  head(15) %>%
  mutate(
    unit_standardized = reorder(unit_standardized, avg_score),
    performance = case_when(
      avg_score >= 3.9 ~ "Excellent",
      avg_score >= 3.8 ~ "Very Good",
      avg_score >= 3.7 ~ "Good",
      TRUE ~ "Satisfactory"
    )
  ) %>%
  ggplot(aes(x = unit_standardized, y = avg_score, fill = performance)) +
  geom_col() +
  geom_hline(yintercept = mean(data$perception_score, na.rm = TRUE),
             linetype = "dashed", color = cit_colors["accent"], linewidth = 1) +
  geom_text(aes(label = round(avg_score, 2)), 
            hjust = -0.2, size = 3.5, fontface = "bold") +
  coord_flip() +
  scale_fill_manual(values = c(
    "Excellent" = cit_colors["success"],
    "Very Good" = cit_colors["secondary"],
    "Good" = cit_colors["info"],
    "Satisfactory" = cit_colors["warning"]
  )) +
  scale_y_continuous(limits = c(0, 4.1), expand = c(0, 0)) +
  labs(
    title = "Average Perception Score by Training Unit",
    subtitle = paste0("Top 15 units (minimum 10 responses) | Overall average: ", 
                     round(mean(data$perception_score, na.rm = TRUE), 2)),
    x = "Unit",
    y = "Average Perception Score",
    fill = "Performance Level"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "top"
  )

Conclusions

Key Findings Summary

Overwhelming Positive Reception: 94.1% of participants rated the training as highly positive.
High Satisfaction Scores: The average perception score of 3.81/4.0 indicates very strong participant satisfaction.
Minimal Negative Feedback: Only 4.9% of participants provided negative ratings.
Positive Sentiment: Participant comments emphasize quality (“good,” “great”), informativeness, and practical value.
Consistent Success: All major agencies showed positive engagement with the training.

Recommendations

Continue Current Approach: The program’s high success rate suggests the current training methodology is highly effective.
Address Low Performers: Investigate the small percentage of negative responses for improvement opportunities.
Share Best Practices: Units with the highest scores could mentor other units.
Expand Program: Given strong positive reception, consider expanding to additional agencies.

Report Generated: March 31, 2026 at 04:19 PM

Assessing Program Quality in CIT Training

Shelby S.

2026-02-16