-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathREADME.Rmd
More file actions
245 lines (176 loc) · 9.53 KB
/
Copy pathREADME.Rmd
File metadata and controls
245 lines (176 loc) · 9.53 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
---
output: github_document
---
<!-- README.md is generated from README.Rmd. Please edit that file -->
```{r setup, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
message = FALSE,
dpi = 192,
fig.width = 4,
fig.height = 3,
out.width = 500
)
```
# TheseusPlot: Visualizing Decomposition of Differences in Rate Metrics
<!-- badges: start -->
[](https://cran.r-project.org/package=TheseusPlot)
[](https://cran.r-project.org/package=TheseusPlot)
[](https://github.com/hoxo-m/TheseusPlot/actions/workflows/R-CMD-check.yaml)
<!-- badges: end -->
## 1. Overview
In data analysis, when a metric differs between two groups, we often want to investigate whether a particular subgroup is driving that difference.
For example, when you observe a decline in a key metric compared with the previous year, you may want to conduct a more detailed analysis.
In such an analysis, you might focus on one attribute, such as gender, and examine whether the decline was driven by male users, female users, or both.
However, this type of analysis is challenging when the metric is a rate, because each subgroup’s contribution to the rate difference cannot be simply calculated, unlike in the case of volume metrics.
To address this issue, we propose an approach inspired by the story of the *[Ship of Theseus](https://en.wikipedia.org/wiki/Ship_of_Theseus)*.
This approach involves gradually replacing the components of one group with those of another, recalculating the metric at each step.
The change in the metric at each step can then be interpreted as the contribution of each subgroup to the overall difference.
For instance, suppose the click-through rate (CTR) was 6.2% in 2024 and decreased to 5.2% in 2025.
Again, we focus on gender.
We replace the male users in the 2024 dataset with the male users from 2025 and recalculate the CTR.
As a result, the CTR would drop by 0.8 percentage points, reaching 5.4%.
In this case, the contribution of male users to the change in CTR is -0.8 percentage points.
Next, we replace the female users from 2024 with those from 2025.
The dataset then consists entirely of 2025 data, and CTR drops by 0.2 percentage points, reaching 5.2%.
Thus, the contribution of female users is -0.2 percentage points.
When visualized, the results appear as follows:
```{r overview, echo=FALSE}
library(dplyr)
library(nycflights13)
library(TheseusPlot)
data <- flights |>
filter(!is.na(arr_delay)) |>
mutate(y = (arr_delay <= 0) / 10) |>
mutate(gender = case_when(origin == "JFK" ~ "male",
origin == "LGA" ~ "female",
TRUE ~ "unknown")) |>
filter(gender != "unknown")
df1 <- data |> filter(month == 1L)
df2 <- data |> filter(month == 7L)
ship <- create_ship(df1, df2, y = y, labels = c("2024", "2025"),
ylab = "CTR (%)", digits = 1L)
ship$plot(gender)
```
From this plot, we can see that the decline in CTR is primarily driven by male users.
We call this visualization the “Theseus Plot.”
The **TheseusPlot** package is designed to make it easy to generate Theseus Plots for any column that defines subgroups.
## 2. Installation
You can install the **TheseusPlot** package from [CRAN](https://cran.r-project.org/package=TheseusPlot).
```r
install.packages("TheseusPlot")
```
You can install the development version from [GitHub](https://github.com/hoxo-m/TheseusPlot) with:
``` r
remotes::install_github("hoxo-m/TheseusPlot")
```
## 3. Details
### 3.1 Prepare Data
To create Theseus Plots, you need two data frames that share common columns.
We use the 2013 New York City flight data from [nycflights13](https://cran.r-project.org/package=nycflights13) as a demo dataset.
Here, we will define the rate metric as the proportion of flights that arrived on time.
In December 2013, the on-time arrival rate dropped substantially compared to November.
We investigate the cause using a Theseus Plot.
First, we create an `on_time` column in the data frame to indicate whether each flight arrived on time.
Next, we extract the flights for November and December into separate data frames to form two comparison groups.
The on-time arrival rate was 83% in November and dropped to 67% in December.
```{r prepare_data}
library(dplyr)
library(nycflights13)
data <- flights |>
filter(!is.na(arr_delay)) |>
mutate(on_time = arr_delay <= 15) |> # Arrived on time
left_join(airlines, by = "carrier") |>
mutate(carrier = name) |> # Convert carrier abbreviations to full names
select(year, month, day, origin, dest, carrier, dep_delay, on_time)
data |> head()
data_Nov <- data |> filter(month == 11)
data_Dec <- data |> filter(month == 12)
data_Nov |> summarise(on_time_rate = mean(on_time)) |> pull(on_time_rate)
data_Dec |> summarise(on_time_rate = mean(on_time)) |> pull(on_time_rate)
```
### 3.2 Basics
Using the two prepared data frames, we first create a `ship` object.
The `ship` object is an instance of the R6 class `ShipOfTheseus`, designed to create Theseus Plots.
```{r create_ship}
library(TheseusPlot)
ship <- create_ship(data_Nov, data_Dec, y = on_time, labels = c("November", "December"))
```
You can create a Theseus Plot by passing column names to the `plot` method of a `ship` object.
For example, to create a Theseus Plot for the airport of origin:
```{r plot_origin}
ship$plot(origin)
```
New York City has three major airports, and Newark Liberty International Airport (EWR) accounted for the largest share of the decline in the on-time arrival rate.
Note that the number of flights at each airport matters, as a larger flight volume is expected to have a greater impact.
To make this clear, the Theseus Plot displays the sample size for each group within each subgroup as a bar chart.
From this, we see that the number of flights is similar across airports, allowing for direct comparison of contributions.
In summary, a Theseus Plot consists of two components:
- A waterfall plot showing how much each subgroup contributed to the change in the metric.
- A bar chart representing the sample size for each group within each subgroup.
A `ship` object also provides the `table` method to inspect the exact values used in the Theseus Plot.
```{r table_origin}
ship$table(origin)
```
### 3.3 Flipping the Plot
When there are many subgroups, a Theseus Plot can become hard to read.
In such cases, you can swap the x- and y-axes for better visualization.
```{r plot_carrier}
ship$plot_flip(carrier)
```
When the number of subgroups is large, those with small contributions are automatically grouped together.
By default, this happens when there are more than 10 subgroups, but the threshold can be adjusted with the `n` argument.
```{r plot_carrier_n}
ship$plot_flip(carrier, n = 6)
```
From this plot, JetBlue Airways and United Air Lines appear to have the largest contributions to the decline in on-time arrival rate.
### 3.4 Automatic Discretization of Continuous Values
Theseus Plots are primarily designed for categorical variables.
When a continuous column is provided, it is automatically discretized.
For example, we can create a Theseus Plot for departure delays.
```{r plot_dep_delay}
ship$plot_flip(dep_delay)
```
By default, continuous variables are discretized so that each subgroup has roughly equal sample sizes, with the number of bins set to 10.
You can modify these settings by passing the return value of `continuous_config()` to the `continuous` argument.
```{r plot_dep_delay_n}
ship$plot_flip(dep_delay, continuous = continuous_config(n = 3))
```
This result shows that both a decrease in on-time departures and an increase in delayed departures contributed to the decline in on-time arrival rate.
### 3.5 Controlling Category Order with Factors
By default, character columns are ordered by contribution size in `table()`,
`plot()`, and `plot_flip()`. If you want to use a specific order instead,
convert the column to a factor. For factor columns, TheseusPlot respects the
order of the factor levels.
This is useful when the categories have a natural order, such as `"Low"`,
`"Medium"`, and `"High"`, or when you want to define the order manually.
For example, suppose we classify departure delays into three categories:
`"Early"`, `"On-time"`, and `"Delayed"`.
When `departure_type` is a character column, the categories are ordered by
their contributions.
```{r no_factor_column}
to_departure_type <- function(x) {
case_when(x <= -4 ~ "Early", x <= 4 ~ "On-time", x > 4 ~ "Delayed")
}
data_Nov <- data_Nov |> mutate(departure_type = to_departure_type(dep_delay))
data_Dec <- data_Dec |> mutate(departure_type = to_departure_type(dep_delay))
ship <- create_ship(data_Nov, data_Dec, y = on_time, labels = c("November", "December"))
ship$plot_flip(departure_type)
```
To display the categories in a meaningful order, convert `departure_type` to
a factor and specify the level order.
```{r factor_column}
to_departure_type <- function(x) {
types <- case_when(x <= -4 ~ "Early", x <= 4 ~ "On-time", x > 4 ~ "Delayed")
types <- factor(types, levels = c("Early", "On-time", "Delayed"))
types
}
data_Nov <- data_Nov |> mutate(departure_type = to_departure_type(dep_delay))
data_Dec <- data_Dec |> mutate(departure_type = to_departure_type(dep_delay))
ship <- create_ship(data_Nov, data_Dec, y = on_time, labels = c("November", "December"))
ship$plot_flip(departure_type)
```
You can change the factor levels to display the categories in any order you
choose.