Getting tricked but still happy
- sam33frodon
- Sep 3, 2021
- 4 min read
Richard H. Thaler is the 2017 recipient of the Nobel Memorial Prize in Economic Sciences for his contributions to behavioral economics. In his book Misbehaving: The Making of Behavioral Economics (2015), he describes his experience at the beginning of his academic career. His students were not happy as the midterm exam was too hard. The average score was 72 on a scale from 0 to 100. In the next exam, he set the maximum score at 137 points instead of 100 points. The average score increased to 96 points. Students were happy. In subsequent exams, Prof. Thaler kept the maximum score at 137 points but outlined in his syllabus: “Exams will have a total of 137 points rather than the usual 100. This scoring system has no effect on the grade you get in the course, but it seems to make you happier.”
To picture 96 in comparison to 137 in your head is hard. Data visualization certainly helps.
Figure 1. The average scores of two examples (See R code here).
Note: I made the above figure from ggplot2. The figure is inspired from the book The Truthful Art: Data, Charts, and Maps for Communication by Alberto Cairo (2016)
Code for figure 1
theme_1 <- theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.line.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.line.x = element_blank(),
legend.position = "none",
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
plot.margin = unit(c(0, 3, 0, 3), "lines"))
df <- data.frame()
p1 <- ggplot(df) + geom_point() +
xlim(0, 100) +
ylim(0, 100) +
coord_cartesian(clip = "off") +
annotate("segment", x = 0, xend = 100, y = 50, yend =50, colour = "#454545") +
annotate("pointrange", x = 100*72/100, y = 50, ymin = 42.5, ymax = 57.5, colour = "#FF5349", size = 1) +
annotate("text", x = 100*72/100, y = 65, label = "72", size = 8, color ="#FF5349") +
annotate("text", x = 100*72/100, y = 75, label = "Average score", size = 5, color ="black") +
annotate("text", x =0, y = 57.5, label = "Minimum", size = 5, color ="black") +
annotate("text", x = 100, y = 57.5, label = "Maximum", size = 5, color ="black") +
annotate("text", x = 0, y = 42.5, label = "0", size = 5, color ="black") +
annotate("text", x = 100, y = 42.5, label = "100", size = 5, color ="black") +
annotate("text", x = 50*100/100, y = 42.5, label = "50", colour = "black", size = 5) +
annotate("segment", x = 0, xend = 0, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6) +
annotate("segment", x = 100, xend = 100, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6)+
annotate("segment", x = 50*100/100, xend = 50*100/100, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6) +
annotate("text", x = 0, y = 90, label = "MIDTERM EXAM", size = 5, color ="#FF5349", hjust = 0, fontface = "bold") + theme_1
p2 <- ggplot(df) + geom_point() +
xlim(0, 100) +
ylim(0, 100) +
coord_cartesian(clip = "off") +
annotate("segment", x = 0, xend = 100, y = 50, yend =50, colour = "#454545") +
annotate("pointrange", x = 100*96/137, y = 50, ymin = 42.5, ymax = 57.5, colour = "#FF5349", size = 1) +
annotate("text", x = 100*96/137, y = 65, label = "96", size = 8, color ="#FF5349") +
annotate("text", x = 100*96/137, y = 75, label = "Average score", size = 5, color ="black") +
annotate("text", x =0, y = 57.5, label = "Minimum", size = 5, color ="black") +
annotate("text", x = 100, y = 57.5, label = "Maximum", size = 5, color ="black") +
annotate("text", x = 0, y = 42.5, label = "0", size = 5, color ="black") +
annotate("text", x = 100, y = 42.5, label = "137", size = 5, color ="black") +
annotate("text", x = 50*100/137, y =42.5, label = "50", size=5, colour = "black") +
annotate("segment", x = 0, xend = 0, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6) +
annotate("segment", x = 100, xend = 100, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6)+
annotate("segment", x = 50*100/137, xend = 50*100/137, y = 47.5, yend = 52.5, colour = "#454545", size=2, alpha=0.6) +
annotate("text", x = 0, y = 90, label = "FINAL EXAM", size = 5, color ="#FF5349", hjust = 0, fontface = "bold") +
theme_1
theme_pie <- theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.line.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.line.x = element_blank(),
legend.position = "none",
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
plot.margin = unit(c(1, 1, 1, 1), "lines"))
df1 <- data.frame(
class = c("average score", "2nd"),
n = c(72, 28),
prop = c(72, 28))
df1 <- df1 %>%
arrange(desc(class)) %>%
mutate(lab.ypos = cumsum(prop) - 0.5*prop)
df2 <- data.frame(
class = c("average score", "2nd"),
n = c(96, 41),
prop = c(70.07, 29.93))
df2 <- df2 %>%
arrange(desc(class)) %>%
mutate(lab.ypos = cumsum(prop) - 0.5*prop)
p3 <- ggplot(df1,aes(x = "", y = prop, fill = class)) +
geom_bar(width = 1, stat = "identity", color = "white") +
coord_polar("y", start = 0)+
geom_text(aes(y = lab.ypos, label = n), color = "white", size= 8)+
scale_fill_manual(values = c("grey", "#FF5349")) +
labs(title= "Total score = 100") +
annotate("text", x = 0, y = 50, label = "MIDTERM", size = 3.5, color ="#FF5349",fontface = "bold") +theme_pie
p4 <- ggplot(df2, aes(x = "", y = prop, fill = class)) +
geom_bar(width = 1, stat = "identity", color = "white") +
coord_polar("y", start = 0)+
geom_text(aes(y = lab.ypos, label = n), color = "white",size = 8) +
scale_fill_manual(values = c("grey", "#FF5349")) +
labs(title= "Total score = 137") +
annotate("text", x = 0, y = 50, label = "FINAL", size = 3.5, color ="#FF5349",fontface = "bold") +
theme_pie
plot_grid(plot_grid(p1,p2, ncol = 1, nrow = 2,rel_heights = c(1, 1)),
plot_grid(p3,p4, ncol = 1, nrow = 2,rel_heights = c(1, 1)),
ncol = 2, rel_widths = c(2.5, 1))
Comments