Correct Vs. Incorrect Effect Graph with Applied Method
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
raw <- matrix(c(
110, 13, 123, 63, 18, 81,
158, 12, 170, 48, 40, 88,
119, 17, 136, 114, 30, 144,
116, 12, 128, 90, 26, 116,
119, 18, 137, 69, 45, 114
), nrow = 5, byrow = TRUE)
colnames(raw) <- c(
"Alu_Correct", "Alu_Incorrect", "Alu_Total",
"Cup_Correct", "Cup_Incorrect", "Cup_Total"
)
df <- as_tibble(raw)
cond <- df %>% mutate(Session = factor(1:5))
long <- cond %>%
pivot_longer(cols = -Session, names_to = "metric", values_to = "count") %>%
separate(metric, into = c("Container", "Type"), sep = "_")
plot_data <- long %>% filter(Type %in% c("Correct", "Incorrect"))
beige_bg <- "#F5F0E6"
panel_bg <- "#FBF7EE"
accent1 <- "#CBB79B"
accent2 <- "#8C6A45"
text_col <- "#3E3A36"
# Create the plot
p <- ggplot(plot_data, aes(x = Session, y = count, fill = Type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7, color = NA) +
facet_wrap(~Container, nrow = 1) +
labs(
title = "Correct vs Incorrect — Aluminium cans and Paper cups",
subtitle = "With Proper Instructions/Signages",
x = "Session",
y = "Count",
caption = "Generated with tidyverse & ggplot2"
) +
scale_fill_manual(values = c("Correct" = accent1, "Incorrect" = accent2),
name = NULL) +
theme_minimal(base_family = "Helvetica") +
theme(
plot.background = element_rect(fill = beige_bg, color = NA),
panel.background = element_rect(fill = panel_bg, color = NA),
strip.background = element_rect(fill = "#EFE6D8", color = NA),
strip.text = element_text(color = text_col, face = "bold"),
panel.grid.major = element_line(color = "#EFE6D8"),
panel.grid.minor = element_blank(),
axis.text = element_text(color = text_col),
plot.title = element_text(size = 16, face = "bold", color = text_col),
plot.subtitle = element_text(size = 11, color = text_col),
plot.caption = element_text(size = 8, color = text_col),
legend.position = "top",
legend.text = element_text(color = text_col)
)
p <- p + geom_text(aes(label = count),
position = position_dodge(width = 0.8),
vjust = -0.4, size = 3, color = text_col)
print(p)
ggsave("beige_correct_incorrect.png", p, width = 10, height = 5, dpi = 300)
ggsave("beige_correct_incorrect.svg", p, width = 10, height = 5)
Correct Vs. Incorrect Effect Graph with Applied Method
library(tidyverse)
raw <- matrix(c(
135, 119, 254, 20, 10, 30,
98, 56, 154, 17, 10, 27,
70, 50, 120, 55, 25, 80,
112, 114, 226, 38, 17, 55,
76, 35, 111, 50, 40, 90,
63, 36, 99, 19, 16, 35
), nrow = 6, byrow = TRUE)
colnames(raw) <- c(
"Alu_Correct", "Alu_Incorrect", "Alu_Total",
"Cup_Correct", "Cup_Incorrect", "Cup_Total"
)
df <- as_tibble(raw)
cond <- df %>% mutate(Session = factor(1:6))
long <- cond %>%
pivot_longer(cols = -Session, names_to = "metric", values_to = "count") %>%
separate(metric, into = c("Container", "Type"), sep = "_")
plot_data <- long %>% filter(Type %in% c("Correct", "Incorrect"))
beige_bg <- "#F5F0E6"
panel_bg <- "#FBF7EE"
accent1 <- "#CBB79B"
accent2 <- "#8C6A45"
text_col <- "#3E3A36"
p <- ggplot(plot_data, aes(x = Session, y = count, fill = Type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7, color = NA) +
facet_wrap(~Container, nrow = 1) +
labs(
title = "Correct vs Incorrect — Aluminium cans and Paper cups",
subtitle = "Without Proper Instructions/Signages",
x = "Session",
y = "Count",
caption = "Generated with tidyverse & ggplot2"
) +
scale_fill_manual(values = c("Correct" = accent1, "Incorrect" = accent2),
name = NULL) +
theme_minimal(base_family = "Helvetica") +
theme(
plot.background = element_rect(fill = beige_bg, color = NA),
panel.background = element_rect(fill = panel_bg, color = NA),
strip.background = element_rect(fill = "#EFE6D8", color = NA),
strip.text = element_text(color = text_col, face = "bold"),
panel.grid.major = element_line(color = "#EFE6D8"),
panel.grid.minor = element_blank(),
axis.text = element_text(color = text_col),
plot.title = element_text(size = 16, face = "bold", color = text_col),
plot.subtitle = element_text(size = 11, color = text_col),
plot.caption = element_text(size = 8, color = text_col),
legend.position = "top",
legend.text = element_text(color = text_col)
)
p <- p + geom_text(aes(label = count),
position = position_dodge(width = 0.8),
vjust = -0.4, size = 3, color = text_col)
print(p)
ggsave("beige_correct_incorrect_sessions6.png", p, width = 10, height = 5, dpi = 300)
ggsave("beige_correct_incorrect_sessions6.svg", p, width = 10, height = 5)
Attitude on recycling
library(tidyverse)
attitude_data <- tribble(
~Item, ~Statement, ~`1`, ~`2`, ~`3`, ~`4`, ~`5`,
"2.1", "Uni's must carry out waste sorting activities", 4.9, 12.0, 22.8, 32.1, 27.9,
"2.2", "Waste sorting is meaningful", 4.4, 8.9, 36.5, 34.2, 15.5,
"2.3", "Participating shows good quality", 4.8, 11.5, 38.8, 30.8, 14.0,
"2.4", "Won’t take too much time/resources", 8.5, 10.1, 38.5, 32.6, 15.3,
"2.5", "Important to protect environment", 3.8, 8.8, 37.9, 33.9, 15.3,
"2.6", "Students need waste sorting habit", 2.8, 8.0, 27.3, 40.8, 20.8,
"2.7", "Willing to participate in activities", 6.7, 11.1, 29.7, 34.2, 17.2,
"2.8", "Would like to take a course", 6.6, 29.7, 13.9, 37.1, 11.9
)
# -----------------------------
# 2. Transform data
# -----------------------------
attitude_long <- attitude_data %>%
pivot_longer(cols = `1`:`5`, names_to = "Rating", values_to = "Percent") %>%
mutate(
Rating = factor(Rating,
levels = c("1", "2", "3", "4", "5"),
labels = c("Strongly Disagree",
"Disagree",
"Neutral",
"Agree",
"Strongly Agree"))
)
beige_palette <- c(
"Strongly Disagree" = "#C97B63",
"Disagree" = "#DAB893",
"Neutral" = "#CBB47C",
"Agree" = "#E8D7B4",
"Strongly Agree" = "#F4ECD8"
)
ggplot(attitude_long, aes(x = Rating, y = Percent, fill = Rating)) +
geom_col(width = 0.7, color = "white") +
coord_flip() +
facet_wrap(~ Statement, ncol = 2, scales = "free_y") +
scale_fill_manual(values = beige_palette, name = "Attitude Standing") +
theme_minimal(base_size = 13) +
theme(
strip.background = element_rect(fill = "#F8F3E8", color = NA),
strip.text = element_text(face = "bold", color = "#3E3E3E", size = 11),
panel.background = element_rect(fill = "#FAF8F0", color = NA),
plot.background = element_rect(fill = "#FAF8F0", color = NA),
legend.position = "bottom",
legend.title = element_text(face = "bold", color = "#3E3E3E"),
legend.text = element_text(color = "#4A4A4A"),
axis.text.x = element_text(color = "#4A4A4A"),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank()
) +
labs(
title = "College Students’ Attitudes Toward Waste Sorting",
subtitle = "Faceted by individual survey statements",
x = NULL,
y = "Percent (%)"
)
Antecedent Intervention Model Graph
library(ggplot2)
library(dplyr)
data <- data.frame(
Week = 1:20,
Recycling = c(
16, 17, 18, 19, 19,
68, 70, 71, 71, 72,
18, 30, 11, 27, 21,
80, 71, 60, 72, 62
),
TrashItems = c(
4, 43, 20, 21, 22,
10, 15, 25, 15,11,
31, 41, 47, 22, 21,
140, 159, 100, 60, 30
)
)
beige_theme <- theme_minimal(base_size = 14) +
theme(
panel.background = element_rect(fill = "#f5f2e9", color = NA),
plot.background = element_rect(fill = "#f5f2e9", color = NA),
panel.grid.major = element_line(color = "#d7d2c5"),
panel.grid.minor = element_line(color = "#e5e1d7"),
strip.background = element_rect(fill = "#f5f2e9", color = NA),
text = element_text(color = "#3c3c3c")
)
ggplot(data, aes(x = Week)) +
geom_line(aes(y = Recycling, color = "Correct Recycling (%)"), size = 1.2) +
geom_point(aes(y = Recycling, color = "Correct Recycling (%)"), size = 2.5) +
geom_line(aes(y = TrashItems * 0.6, color = "Trash Items"),
size = 1.2, linetype = "dashed") +
geom_point(aes(y = TrashItems * 0.6, color = "Trash Items"), size = 2.5) +
geom_vline(xintercept = c(5.5, 10.5, 15.5),
linetype = "solid", color = "#8c8577") +
annotate("text", x = 3, y = 105, label = "BL", color = "#3c3c3c", size = 5) +
annotate("text", x = 8, y = 105, label = "Intervention", color = "#3c3c3c", size = 5) +
annotate("text", x = 13, y = 105, label = "BL", color = "#3c3c3c", size = 5) +
annotate("text", x = 18, y = 105, label = "Intervention", color = "#3c3c3c", size = 5) +
scale_y_continuous(
name = "Percentage of Correct Recycling",
limits = c(0, 100),
sec.axis = sec_axis(~./0.6, name = "Number of Trash Items")
) +
scale_color_manual(
name = "",
values = c(
"Correct Recycling (%)" = "#4a4a4a",
"Trash Items" = "#a65e24"
)
) +
labs(
x = "Weeks",
title = "Graph with Antecedent Intervention Model",
subtitle = "(0-5) (10-15) Weeks with Model Implemented"
) +
beige_theme
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_text()`).
## Removed 1 row containing missing values or values outside the scale range
## (`geom_text()`).
## Removed 1 row containing missing values or values outside the scale range
## (`geom_text()`).
## Removed 1 row containing missing values or values outside the scale range
## (`geom_text()`).
Public Feedback Model
library(ggplot2)
library(dplyr)
sessions <- 1:27
weight <- c(
2, 4, 3, 2, 1, 2, 2, 1,
8, 7, 5, 4, 6, 9,
6, 7, 10, 12,
7, 6, 4, 5, 3, 3, 4, 5, 6
)
phases <- c(
rep("Baseline", 8),
rep("Written Feedback", 6),
rep("Written + Graphic Feedback", 4),
rep("Withdrawal", 9)
)
df <- data.frame(sessions, weight, phases)
rects <- data.frame(
xmin = c(0.5, 8.5, 14.5, 18.5),
xmax = c(8.5, 14.5, 18.5, 27.5),
phase = c("Baseline", "Written Feedback",
"Written + Graphic Feedback", "Withdrawal")
)
beige_bg <- "#f5f0e6" # whole-plot background
beige_panel <- "#f8f5ee" # panel background
line_col <- "black"
ggplot() +
geom_rect(data = rects,
aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
fill = beige_panel, color = NA, alpha = 0.6) +
geom_line(data = df, aes(x = sessions, y = weight),
color = line_col, size = 1) +
geom_point(data = df, aes(x = sessions, y = weight),
shape = 21, fill = beige_bg, color = line_col, size = 3) +
geom_vline(xintercept = c(8.5, 14.5, 18.5), size = 1) +
annotate("text", x = c(4, 11, 16.5, 22.5), y = 15.5,
label = c("Baseline", "Written\nFeedback",
"Written +\nGraphic", "Withdrawal"),
size = 5) +
scale_x_continuous(breaks = seq(1, 27, 2),
name = "Consecutive Observation Sessions") +
scale_y_continuous(limits = c(0, 16),
breaks = seq(0, 16, 2),
name = "Weight of Recyclable Papers Collected (kg)") +
theme_classic(base_size = 14) +
theme(
plot.background = element_rect(fill = beige_bg, color = NA),
panel.background = element_rect(fill = beige_panel, color = "black", size = 1),
axis.line = element_line(color = "black"),
panel.border = element_rect(color = "black", fill = NA),
text = element_text(color = "black")
)
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
