---
title: "The weight of Pokémon species - Regression analyses"
author: "Lara Lusa, Sam Manski, Marianne Huebner"
date: "July 2026"
output:
  html_document:
    code_folding: "hide"
    toc: true
    toc_float: TRUE
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, error = FALSE, message = FALSE)
```



```{css, echo=FALSE}
.infobox {
  padding: 1em 1em 1em 4em;
  margin-bottom: 10px;
  border: 2px solid orange;
  border-radius: 10px;
  background: #d3d3d3 5px center/3em no-repeat;
  background-image: url("https://img.pokemondb.net/artwork/large/psyduck.jpg");
  }

.caution {
  background-image: url("https://img.pokemondb.net/artwork/large/psyduck.jpg");
}

.resultbox {
  border-color: #2f855a !important;
  background-image: url("https://img.pokemondb.net/artwork/large/alakazam.jpg") !important;
}

.consequencebox {
  border-color: #6b46c1 !important;
  background-image: url("https://img.pokemondb.net/artwork/large/hypno.jpg") !important;
}

.sapdev {
  padding: 1em 1em 1em 4em;
  margin-bottom: 10px;
  border: 2px solid #2b6cb0;
  border-radius: 10px;
  background: #eaf2fb 5px center/3em no-repeat;
  background-image: url("https://img.pokemondb.net/artwork/large/eevee.jpg");
}
```


<script>
document.addEventListener("DOMContentLoaded", function() {
  document.querySelectorAll('.infobox').forEach(function(box) {
    var txt = box.textContent.trim();
    if (/^RESULT/i.test(txt)) { box.classList.add('resultbox'); }
    else if (/^CONSEQUENCE/i.test(txt)) { box.classList.add('consequencebox'); }
  });
});
</script>

# Introduction


The aim of this analysis project is to study the variability in the weight of Pokémon species. The statistical analysis plan (SAP)  specifies that linear regression models will be used to estimate the association between height and weight, both univariable and multivariable.


Before conducting the regression analysis, an initial data analysis report was created.
Initial Data Analysis (IDA) is a systematic process to provide reliable knowledge about the data to determine the suitability of the data for the main data analysis. Information from the IDA findings was used to updated the statistical analysis plan (SAP v1 to SAP v2). Analyses shown in this document are from SAP v2 unless specifically indicated for comparison purposes.

:::: {.infobox data-latex=""}

**COMMENT: **

In this document we first summarize the dataset with a table that would be suitable for inclusion in a scientific rerport. Then we show results from a naïve linear regression model (SAP version 1) explaining the variation in weight with variation in height, not taking into account results from IDA. We compare this to an IDA-informed linear regression model using log-transformations for weight and height.

Then we conduct multivariable linear regression analyses as outlined in the statistical analysis plan that was updated after IDA.

::::


```{r libraries, include = FALSE}
library(readr)
library(tidyverse)
library(lmtest) #for lrtest
library(lme4)
library(ggrepel) # to add labels to busy graphs
library(scales) # for graphs
library(kableExtra) # for displaying tables 
library(sjPlot) #for model results
library(ggfortify) # for model diagnostics
library(broom)
```



```{r read_data, eval=TRUE, include = FALSE}
# Read Analysis-ready data created in IDA
Pokemon_clean <- readRDS("../Data/Pokemon_afterIDA.Rdata")

```



Data can be read also online - use the code below. 

```{r, eval = FALSE}
# read data online 
pokemon <- read.delim("https://stratosida.github.io/assets/Pokemon_clean.tsv", 
                      strip.white = TRUE, na.string =c(NA, ""), blank.lines.skip = TRUE)

pokemon$PokemonPhase_5cat <- factor(pokemon$PokemonPhase_5cat, levels=c("Baby", "Base", "Phase1", "Phase2", "NotEvolving"))
pokemon$special_status <- factor(pokemon$special_status, levels=c("normal", "sub-legendary", "legendary",  "mythical"))
pokemon <- dplyr::arrange(pokemon, pokedex_number)

pokemon$gender_cat<-factor(pokemon$gender_cat, levels= c("Equal", "Mostly females", "Mostly males", "Genderless"), labels=c("Equal", "Mostly female", "Mostly male","Genderless"))


```



## A0 - Description of the dataset

We summarize the main characteristics of the analysis sample. This table is more concise than the descriptive statistics presented in the IDA report and is intended to accompany the regression results, as would typically appear in a scientific paper.


```{r}

### Table 1. Descriptive statistics of the analysis sample

s <- Hmisc::summaryM(
  weight_kg + height_m + special_status + gender_cat + PokemonPhase_5cat +
  hp + attack + defense + sp_attack + sp_defense + speed + happiness_cat ~ 1,
  data = Pokemon_clean,
  overall = FALSE,
  test = FALSE
)

Hmisc::html(
  s,
  caption = 'Table 1. Descriptive statistics of variables included in the regression models',
  exclude1 = TRUE,
  npct = 'both',
  digits = 2,
  prmsd = TRUE,
  brmsd = TRUE
)

```


## A1 - Univariable linear regression models 

Here weight is the outcome and height is the explanatory variable.


### SAP v1: Naïve linear regression model

Here we ignore that height and weight have skewed distributions.


```{r naiveUni}
naive_first_fit <- lm(weight_kg ~ height_m, data = Pokemon_clean, x=T, y=T)
```

The results are summarized below.

```{r}
summary(naive_first_fit)  %>% tab_model()
#par(mfrow=c(2,2))
#plot(naive_first_fit)
autoplot(naive_first_fit, which = 1:6, ncol = 2) #ggfortify package

```


:::: {.infobox data-latex=""}
**RESULTS: **

If we compare two Pokémon that differ by 1 m, the one that is higher is on average `r round(as.numeric(naive_first_fit$coef[2]),1)` kg heavier.


The naïve fit violates some assumptions of linear regression. For example, the Residuals vs Fitted and Scale-Location plots show a violation of homogeneous residual variance, with residual variance increasing as fitted values increase. Further, a QQ-plot of residuals shows a violation of normally distributed residuals.

The Pokémon with largest residuals are those with very large height, whose weight is strongly underestimated by the model. 


::::


### SAP v2: Linear regression model with log-transformed variables

We fit a second linear regression model, where weight and height are log2-transformed, and summarize its findings. 

```{r firstUni}
IDA_first_fit <- lm(log2(weight_kg) ~ log2(height_m), data = Pokemon_clean, x=T, y=T)
```




```{r}
summary(IDA_first_fit) %>% tab_model()
#par(mfrow=c(2,2))
#plot(IDA_first_fit)
autoplot(IDA_first_fit, which = 1:6, ncol = 2) #ggfortify package

```

:::: {.infobox data-latex=""}
**RESULTS: **

The model estimates that  if we compare two Pokémon, where one is twice the height of the other, the weight of the taller Pokémon is, on average,  `r round(2^as.numeric(IDA_first_fit$coef[2]),1)` times greater.


When examining the IDA-informed fit, we see that the issues of heteroskedasticity and non-normal residual variance are largely resolved. Further, the regression output shows that the R\^2 for the IDA-informed fit is much higher than that of the naïve fit (0.66 vs 0.40).

We notice that the Pokémon with largest residuals are Cosmoem (ID=790), Gastly and Haunter (ID=92 and 93), which have unusual weight/height combinations (or equivalently, BMI values). 
::::


In the graph shown below (in log2 scale on both axes) we display the estimated values of weight using original data (red),  the log2-transformed weight and height (gray), and the estimated association using a smoothing function (in blue).  


:::: {.infobox data-latex=""}
**RESULTS: **
We observe that the model based on the non-transformed data substantially overestimates weights in the the lower range of heights. The fit of the model with log-transformed data is poor for large heights (after about 2m), where the weight is substantially overestimated, indicating that the relationship between height and weight cannot be captured well with assuming a linear relationship on the log2 scale with a univariable model. 
::::

To address the problem of overestimation of weight for large heights, we fit a model that includes also the height term (shown in yellow in the graph).


```{r secondUni}
IDA_quad_fit <- lm(log2(weight_kg) ~ log2(height_m) +  height_m, data = Pokemon_clean, x=T, y=T)

anova(IDA_first_fit, IDA_quad_fit)
```




```{r}
x.pred <- data.frame(height_m = seq(0.1, 20, by=0.1))
data.plot <- data.frame(x=x.pred[,1],y=2^predict(IDA_quad_fit, x.pred))

# species to label inthe plot
rows_to_label <- c(790, 92, 93, 890, 977)

my.plot <- ggplot(Pokemon_clean, aes(height_m, weight_kg)) + geom_point(pos="jitter", alpha=.7) + scale_x_continuous(trans="log2")+ scale_y_continuous(trans="log2") + labs(x="Height (m), log 2 scale", y="Weight (kg) - log 2 scale")  + 
geom_smooth(aes(col="GAM smoother")) +   
geom_line(aes(height_m, naive_first_fit$fitted.values, col="Weight~Height"), cex=2) + geom_line(aes(height_m, 2^IDA_first_fit$fitted.values, col="log2(Weight)~log2(Height)"), cex=2)+
geom_line(data=data.plot, aes(x,y,col="log2(Weight)~log2(Height)+Height"), cex=2) + 
scale_colour_manual("Regression model",  
  #breaks = c("A", "B", "log Weight ~ log Height + Height ","Loess smoother"),
breaks = c("Weight~Height", "log2(Weight)~log2(Height)", "log2(Weight)~log2(Height)+Height","GAM smoother"), 
  values=c("Weight~Height"="red", "log2(Weight)~log2(Height)"="yellow", "log2(Weight)~log2(Height)+Height"="purple", "GAM smoother"="blue")
) + guides(colour = guide_legend(nrow = 2, byrow = TRUE)) + guides(colour = guide_legend(nrow = 2, byrow = TRUE)) +  
  theme_bw() +  theme(
    legend.position = "bottom",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title = element_text(size = 10),
    axis.text = element_text(size = 9)
  )
  


my.plot + geom_label_repel(data=Pokemon_clean[rows_to_label,], aes(label=name));  


# fig UnivariableModels for the paper or supplement
######## paper figure 

invisible(tiff("pokemon_plot_regression.tiff", width = 6, height = 6, units = "in", res = 600, compression = "lzw"))



# Build the plot
my.plot <- ggplot(Pokemon_clean, aes(x = height_m, y = weight_kg)) + 
  geom_point(position = position_jitter(width = 0.1, height = 0.1), alpha = 0.7, size = 1) +
  
  scale_x_continuous(trans = "log2") +
  scale_y_continuous(trans = "log2") +
  labs(
    x = "Height (m), log2 scale",
    y = "Weight (kg), log2 scale"
  ) +

  geom_smooth(aes(col = "GAM smoother"), method = "gam", se = FALSE, size = 0.8) +

  geom_line(aes(y = naive_first_fit$fitted.values, col = "Weight~Height"), size = 0.8) +
  geom_line(aes(y = 2^IDA_first_fit$fitted.values, col = "log2(Weight)~log2(Height)"), size = 0.8) +
  geom_line(data = data.plot, aes(x = x, y = y, col = "log2(Weight)~log2(Height)+Height"), size = 0.8) +

  scale_colour_manual(
    name = "Regression model",
    breaks = c(
      "Weight~Height",
      "log2(Weight)~log2(Height)",
      "log2(Weight)~log2(Height)+Height",
      "GAM smoother"
    ),
    values = c(
      "Weight~Height" = "red",
      "log2(Weight)~log2(Height)" = "orange",
      "log2(Weight)~log2(Height)+Height" = "purple",
      "GAM smoother" = "blue"
    )
  ) + guides(colour = guide_legend(nrow = 2, byrow = TRUE)) + 
  theme_bw(base_size = 11) +
  theme(
    legend.position = "bottom",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title = element_text(size = 10),
    axis.text = element_text(size = 9)
  ) +

  geom_label_repel(
    data = Pokemon_clean[rows_to_label,], 
    aes(label = name),
    size = 2.5,
    max.overlaps = 10,
    box.padding = 0.3,
    point.padding = 0.2,
    segment.size = 0.3
  )

# Render the plot
print(my.plot);
# Close TIFF device
invisible(dev.off())

```
#### Diagnostic plots 
We present the diagnostic plots from the model. 

```{r}
#regression diagnostics
autoplot(IDA_quad_fit, which = 1:6, ncol = 2)
```


:::: {.infobox data-latex=""}
**RESULTS: **
The diagnostic plots suggest that a few species (Cosmoem, Gastly, Haunter, Dondozo, Eternatus) may be influential in this univariable model, either due to unusual weight-for-height (BMI) combinations or extreme height values. We do not formally exclude them at this stage; their influence is assessed systematically in the multivariable model below (SA3, SA4).
::::


Now we limit the estimation to the Pokémon with height within 5 meters (removing `r sum(Pokemon_clean$height_m>=5) ` Pokémon).  As a preview of SA2 (formally conducted on the multivariable model below), we limit the estimation to the Pokémon with height within 5 meters (removing `r sum(Pokemon_clean$height_m>=5) ` Pokémon).
  


```{r sensHighH}
IDA_quad_fit_sens2 <- lm(log2(weight_kg) ~ log2(height_m) + height_m, data = Pokemon_clean[Pokemon_clean$height_m<5,], x=T, y=T)
#x.pred <- data.frame(height_m = seq(0.1, 20, by=0.1))
#data.plot.sens1 <- data.frame(x=x.pred[,1],y=2^predict(IDA_first_fit_sens1, x.pred))

summary(IDA_quad_fit_sens2) %>% tab_model()

```


:::: {.infobox data-latex=""}
**RESULTS: **

In the range from 0.4 to 5 m the estimated relationship between height and weight remains similar to the one obtained using all data (in green in the graph). The standard error of the regression coefficients increase substantially. 
::::


```{r}

my.plot.quad <- ggplot(Pokemon_clean, aes(height_m, weight_kg)) + geom_point(pos="jitter", alpha=.7) + scale_x_continuous(trans="log2")+ scale_y_continuous(trans="log2") + labs(x="Height (m), log 2 scale", y="Weight (kg) - log 2 scale")  + 
geom_smooth(aes(col="GAM smoother")) +   
geom_line(data=data.plot, aes(x,y,col="log2(Weight)~log2(Height)+Height"), cex=2) + 
scale_colour_manual("Regression model",  
  #breaks = c("A", "B", "log Weight ~ log Height + Height ","Loess smoother"),
breaks = c("Weight~Height", "log2(Weight)~log2(Height)", "log2(Weight)~log2(Height)+Height","GAM smoother", "Excluding taller than 5 m"), 
  values=c("Weight~Height"="red", "log2(Weight)~log2(Height)"="yellow", "log2(Weight)~log2(Height)+Height"="purple", "GAM smoother"="blue", "Excluding taller than 5 m"="green")
) + theme_bw() +  guides(colour = guide_legend(nrow = 2, byrow = TRUE)) +   theme(
    legend.position = "bottom",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title = element_text(size = 10),
    axis.text = element_text(size = 9)
  ) 
  

data.plot.sens2 <- data.frame(x=IDA_quad_fit_sens2$x[,2], y=IDA_quad_fit_sens2$fitted)

my.plot.quad + geom_label_repel(data=Pokemon_clean %>% filter(BMI<0.1 | BMI>1000), aes(label=name)) + geom_line(data=data.plot.sens2, aes(2^x, 2^y, col="Excluding taller than 5 m"), cex=1) +
geom_label_repel(data=Pokemon_clean[rows_to_label,], aes(label=name))


```



## A2 - Multivariable linear regression models

Log2-transformed weight is the outcome variable. Height is the key explanatory variable, modeled using both log2-transformed height and untransformed height (linear term), as motivated by the univariable analysis above. For simplicity, we refer to these as 'weight' and 'height' below.


**Inclusion of covariates**

Based on the initial data analysis, we include the categorical gender variable, base statistics, categorical happiness, special status, and evolutionary phase as covariates in addition to height.

Evolutionary stage is strongly associated with the other covariates. We nonetheless retain it in the model, since it was regarded as a key explanatory variable in the study plan; its association with the other covariates suggests that its independent contribution to explaining the outcome may be limited, a question addressed through variable selection below.

We include all six base statistics rather than their total, since IDA suggested that they carry some information not captured by the total. As the base stats are correlated, some may be redundant in explaining the outcome; this is also addressed through variable selection.

Catch rate is excluded, given its strong correlation with the base stats observed during IDA.


:::: {.infobox data-latex=""}
**COMMENT: **
To take the expected correlations between explanatory variables into account, we amended the SAP and decided to use a backward variable selection method based on AIC to eliminate possible explanatory variables that do not contribute to the explanation of the outcome. 
::::


Gender is defined as four categories (genderless, equal male and female, mostly male, and mostly female). The reference level is 'Equal' to understand the difference in estimated weight compared to categories mostly female, mostly male, or genderless. Happiness is defined as a categorical variable with normal level as reference.

### Full model with all variables


```{r}
Pokemon_clean$gender_cat <- factor(Pokemon_clean$gender_cat )
Pokemon_clean$gender_cat <-relevel(Pokemon_clean$gender_cat, ref = "Equal")
Pokemon_clean$PokemonPhase_5cat <-relevel(Pokemon_clean$PokemonPhase_5cat, ref = "Base")

Pokemon_clean$happiness_cat <-relevel(factor(Pokemon_clean$happiness_cat), ref = "Normal")



mv_fit <- lm(log2(weight_kg) ~ log2(height_m)+ height_m + gender_cat + 
               I(hp/10) + I(attack/10) + I(defense/10) + I(sp_attack/10) + I(sp_defense/10) + I(speed/10)  + special_status + happiness_cat + PokemonPhase_5cat , data = Pokemon_clean, x=T, y=T)
summary(mv_fit) %>% tab_model()

anova(mv_fit)
#par(mfrow=c(2,2))
#plot(mv_fit)
autoplot(mv_fit, which = 1:6, ncol = 2) #ggfortify package

```


:::: {.infobox data-latex=""}
**RESULTS: **
The use of additional explanatory variables increases the adjusted determination coefficient of the model from 0.66 to 0.71.

::::



### Backward selection of variables from the full model

Since we observed large associations between the potential explanatory variables in the IDA report, we decided to use backward variable selection based on AIC to eliminate variables that might not contribute to the explanation of variation in the outcome or inflate the standard errors. 
 
 
```{r, warnings=FALSE, message=FALSE}
mv_fit_step <- step(mv_fit, trace = FALSE)
summary(mv_fit_step) %>% tab_model()
```
 
:::: {.infobox data-latex=""}
**RESULTS: **
The backward elimination based on AIC removed evolutionary stage, attack and special defense, selecting a model with the same adjusted determination coefficient as the full model.
The estimated association between height and weight is similar in the full and the selected models. 
::::


#### Residuals vs. height (linearity check)

```{r residVsHeight}
ggplot(data.frame(height_m = mv_fit_step$model$height_m, resid = residuals(mv_fit_step)), 
       aes(x = height_m, y = resid)) +
  geom_point(alpha = 0.5) +
  geom_smooth(se = FALSE) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  labs(x = "Height (m)", y = "Residuals", title = "Residuals vs. Height (selected multivariable model)") +
  theme_bw()
```


```{r}
x.pred <- data.frame(height_m = seq(0.1, 20, by=0.1), gender_cat="Equal", hp =100, 
attack=100, defense=100, sp_attack=100, sp_defense=100, speed=100, PokemonPhase_5cat="Base", special_status = "normal", happiness_cat="Normal"
)

tmp <- predict(mv_fit, newdata=x.pred)
data.plot2 <- data.frame(x=x.pred[,1], y=2^tmp)

tmp <- predict(mv_fit_step, newdata=x.pred)
data.plot <- data.frame(x=x.pred[,1], y=2^tmp)

ggplot(Pokemon_clean, aes(height_m, weight_kg)) + geom_point(pos="jitter") + 
#geom_line(aes(height_m, 2^IDA_quad_fit$fitted.values), col="red", cex=2) +
scale_x_continuous(trans="log2")+ scale_y_continuous(trans="log2") + labs(x="Height (m), log 2 scale", y="Weight (kg) - log 2 scale") + 
scale_colour_manual("Regression model",  
  breaks = c("Selected multivariable model","GAM smoother", "Excluding taller than 5 m","Full model"), 
  values=c("Selected multivariable model"="purple", "GAM smoother"="blue", "Excluding taller than 5 m"="green",  "Full model"="red")
) + theme_bw()+ guides(colour = guide_legend(nrow = 2, byrow = TRUE)) +   theme(
    legend.position = "bottom",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title = element_text(size = 10),
    axis.text = element_text(size = 9)
  ) + geom_line(data=data.plot, aes(x, y, col="Selected multivariable model"), cex=2) + #mult
geom_line(data=data.plot2, aes(x, y, col="Full model"), cex=2) + #atypical bmi
geom_smooth(aes(col="GAM smoother"))


```


### Sensitivity analyses



#### Correlation within evolutionary family (SA1)


Observations may not be fully independent, as species within the same evolutionary family are expected to be more similar. This is partially addressed by including evolutionary phase as a covariate; the residual correlation within evolutionary family is assessed directly below (SA1), using cluster-robust standard errors rather than mixed-effects models or GEE, since evolutionary families are typically small (see IDA additional report), with many families including a single species, making reliable estimation of a random-effects variance impractical.

To take into account the correlation within Pokemon evolutionary family, we fit a model that includes the variables selected with the backward procedure and derive the robust standard errors of the estimated regression coefficients.

```{r}


library(sandwich)

# Cluster-robust standard errors and P-values (evolutionary family), 
# using the same format as for the previous models
tab_model(mv_fit_step, 
          vcov.fun = "vcovCL", 
          vcov.args = list(cluster = ~PokemonID))

# alternative coding
# Cluster-robust standard errors by cluster ID
# cluster_se <- vcovCL(mv_fit_step, cluster = ~PokemonID)

# Robust inference
# ct <- coeftest(mv_fit_step, vcov = cluster_se)

# Display results
#kable(as.table(ct), digits = 3, caption = "Cluster-robust standard errors and P-values") 



```


:::: {.infobox data-latex=""}
**RESULTS: **
As expected, taking into account the correlation within evolutionary family increased the standard errors of most of the estimated regression coefficients. 

In terms of statistical significance, two of the three special status levels (sub-legendary, mythical) and the "Mostly female" level of gender_cat move from p<0.05 to p>0.05 after this correction. Happiness_cat remains non-significant, as it already was in the non-robust model. All other predictors remain significant.
::::



#### Extreme height  (SA2)

We refit the selected model limited to Pokémon shorter than 5 m. 

```{r sensitivityMult1}
# sensitivity to large heights
mv_fit_step_sens1 <- update(mv_fit_step, data=Pokemon_clean[Pokemon_clean$height_m<5,])
summary(mv_fit_step_sens1) %>% tab_model()

```


:::: {.infobox data-latex=""}
**RESULTS: **
The estimated association between height and weight is similar as with the full model. See picture below.

::::




#### Identification of species with large influence (SA3)

Below we display the measures of influence (leverage, Cook's distance and studentized residuals) obtained based on the selected multivariable model, for the species that have the value of at least one of the measures among the top 40 species; threshold values are also displayed graphically ($n$ is the sample size, $p$ is the number of variables in the model; 2p/n for leverage, 4/n for Cook's distance, 2 for absolute value of studentized residuals)



```{r}

# ----------------------------
# 1. Compute diagnostic measures and define cut-off values
# ----------------------------
lev   <- hatvalues(mv_fit_step)           # leverage
cooks <- cooks.distance(mv_fit_step)      # Cook's distance
stud  <- rstudent(mv_fit_step)            # studentized residuals


n <- nrow(mv_fit_step$model)
p <- length(coef(mv_fit_step))

cutoff_lev   <- 2 * p / n
mean_lev     <- p / n
cutoff_cooks <- 4 / n           # common Cook’s distance rule-of-thumb
cutoff_resid <- 2               # studentized residual threshold

# Align rows with model frame
idx <- as.numeric(rownames(mv_fit_step$model))


# ----------------------------
# 2. Combine into a data frame
# ----------------------------
diag_tbl <- Pokemon_clean %>%
  mutate(
    lev = lev,
    cooks = cooks,
    stud_res = stud
  ) %>%
  select(name, special_status, type1, type2, lev, cooks, stud_res)



# ----------------------------
# Select top N influential Pokémon
# ----------------------------
top_n <- 40
top_diag <- diag_tbl %>% 
  arrange(desc(lev)) %>% 
  slice(1:top_n)

# Pivot into long format for plotting
top_diag_long <- top_diag %>%
  pivot_longer(cols = c("lev", "cooks", "stud_res"),
               names_to = "measure", values_to = "value")

# Order Pokémon names by leverage (highest first)
top_diag_long$name <- factor(top_diag_long$name, levels = top_diag$name)



# Thresholds as a data frame (so we can facet with them)
thresholds <- data.frame(
  measure = c("lev", "lev", "cooks", "stud_res", "stud_res"),
  value   = c(mean_lev, cutoff_lev, cutoff_cooks, -cutoff_resid, cutoff_resid),
  type    = c("mean leverage", "cutoff leverage", "Cook's threshold", "±2 resid", "±2 resid")
)

# ----------------------------
# Plot: vertical alignment (Pokémon names on Y-axis, facets for measures)
# ----------------------------
ggplot(top_diag_long, aes(x = value, y = fct_rev(name), color = special_status)) +
  geom_point(size = 3) +
  geom_vline(data = thresholds, aes(xintercept = value, linetype = type),
             color = "black", inherit.aes = FALSE) +
  facet_wrap(~measure, scales = "free_x") +
  scale_linetype_manual(values = c("dotted", "dashed", "dashed", "dashed", "dashed")) +
  theme_minimal() +
  labs(
    x = "Influence / Residual",
    y = NULL,
    title = "Top 40 large leverage Pokémon in Weight Regression",
    color = "Special Status",
    linetype = "Threshold"
  )



# ----------------------------
# Select top N Cook distance Pokémon
# ----------------------------
top_n <- 40
top_diag <- diag_tbl %>% 
  arrange(desc(cooks)) %>% 
  slice(1:top_n)

# Pivot into long format for plotting
top_diag_long <- top_diag %>%
  pivot_longer(cols = c("lev", "cooks", "stud_res"),
               names_to = "measure", values_to = "value")

# Order Pokémon names by leverage (highest first)
top_diag_long$name <- factor(top_diag_long$name, levels = top_diag$name)

# ----------------------------
# Define thresholds
# ----------------------------
n <- nrow(mv_fit_step$model)
p <- length(coef(mv_fit_step))

cutoff_lev   <- 2 * p / n
mean_lev     <- p / n
cutoff_cooks <- 4 / n           # common Cook’s distance rule-of-thumb
cutoff_resid <- 2               # studentized residual threshold

# Thresholds as a data frame (so we can facet with them)
thresholds <- data.frame(
  measure = c("lev", "lev", "cooks", "stud_res", "stud_res"),
  value   = c(mean_lev, cutoff_lev, cutoff_cooks, -cutoff_resid, cutoff_resid),
  type    = c("mean leverage", "cutoff leverage", "Cook's threshold", "±2 resid", "±2 resid")
)

# ----------------------------
# Plot: vertical alignment (Pokémon names on Y-axis, facets for measures)
# ----------------------------
ggplot(top_diag_long, aes(x = value, y = fct_rev(name), color = special_status)) +
  geom_point(size = 3) +
  geom_vline(data = thresholds, aes(xintercept = value, linetype = type),
             color = "black", inherit.aes = FALSE) +
  facet_wrap(~measure, scales = "free_x") +
  scale_linetype_manual(values = c("dotted", "dashed", "dashed", "dashed", "dashed")) +
  theme_minimal() +
  labs(
    x = "Influence / Residual",
    y = NULL,
    title = "Top 40 large Cook's distance Pokémon in Weight Regression",
    color = "Special Status",
    linetype = "Threshold"
  )


```

As an illustrative sensitivity analysis, we refit the selected model after removing all species with Cook's distance above a commonly used threshold (4/n), rather than examining each flagged species individually; this mechanical removal is a simplification for teaching purposes and is not a general recommendation for handling influential points in practice. Overall, `r length(which(cooks > cutoff_cooks))` species are removed from the analysis. The excluded species are highlighted in the height-weight scatterplot. 

```{r plotExcluded}

idx_infl <- which(cooks > cutoff_cooks) 

Pokemon_clean$excluded <- ifelse(1:nrow(Pokemon_clean) %in% idx_infl,
                                 "Excluded (Cook's D > cutoff)", 
                                 "Included")

# ----------------------------
# 1. Scatterplot with jitter, original scales on axes
# ----------------------------
p1 <- ggplot(Pokemon_clean, aes(x = log2(height_m), y = log2(weight_kg), color = excluded)) +
  geom_jitter(size = 3, alpha = 0.8, width = 0.05, height = 0.05) +
  scale_x_continuous(name = "Height (m)", labels = function(x) round(2^x, 2)) +
  scale_y_continuous(name = "Weight (kg)", labels = function(y) round(2^y, 1)) +
  theme_minimal(base_size = 12) +
  labs(
    title = "Height vs. Weight with Jitter",
    subtitle = "Points colored by inclusion/exclusion based on Cook's Distance",
    color = "Status"
  )

p1

```

We provide a list of the names of the removed species. 



```{r influence1}

# ----------------------------
# 1. Influence measures
# ----------------------------
#cooks <- cooks.distance(mv_fit_step)
#n <- nrow(mv_fit_step$model)
#cutoff_cooks <- 4 / n   # standard cutoff

# ----------------------------
# 2. Identify influential Pokémon
# ----------------------------
#idx_infl <- which(cooks > cutoff_cooks)
cat("Influential Pokémon removed (Cook's D > cutoff):\n")
print(Pokemon_clean$name[idx_infl])
```

The figure below shows the impact of the removal of the influential species on the fitted regression coefficients. 

```{r influence2}
# ----------------------------
# 3. Refit model without influential Pokémon
# ----------------------------
Pokemon_no_infl <- Pokemon_clean[-idx_infl, ]

mv_fit_clean <- lm(
  log2(weight_kg) ~ log2(height_m) + height_m + gender_cat + I(hp/10) +
    I(defense/10) + I(sp_attack/10) + I(speed/10) + special_status +
    happiness_cat,
  data = Pokemon_no_infl
)

# ----------------------------
# 4. Extract coefficients (with 95% CI) from both models
# ----------------------------
coef_orig <- tidy(mv_fit_step, conf.int = TRUE) %>%
  mutate(model = "Original")

coef_clean <- tidy(mv_fit_clean, conf.int = TRUE) %>%
  mutate(model = "Without influential points")

coef_compare <- bind_rows(coef_orig, coef_clean)

# ----------------------------
# 5. Plot coefficient comparison
# ----------------------------
ggplot(coef_compare, aes(x = estimate, y = term, color = model)) +
  geom_point(position = position_dodge(width = 0.6)) +
  geom_errorbar(aes(xmin = conf.low, xmax = conf.high),
                width = 0.2,
                position = position_dodge(width = 0.6)) +
  geom_vline(xintercept = 0, linetype = "dotted", color = "grey50") +
  theme_minimal(base_size = 12) +
  labs(
    title = "Comparison of Regression Coefficients",
    subtitle = "Original model vs. model without influential Pokémon (Cook's D > cutoff)",
    x = "Coefficient estimate (with 95% CI)",
    y = "Predictor",
    color = "Model"
  )


```


:::: {.infobox data-latex=""}
**RESULTS: **
The estimated coefficients with and without influential points are similar. The estimated coefficients for happiness are closer to 0, while the coefficients estimated for special statuses and for genderless species are larger. 
The adjusted determination coefficient increases substantially from `r round(summary(mv_fit_step)$adj.r.squared,2)` to `r round(summary(mv_fit_clean)$adj.r.squared,2)` and the residual standard error decreases.  

Overall, the estimated  association between height and weight is similar to the one obtained using all data; the most marked difference is in the large range of heights  (see picture below).

::::


```{r fitWithWithout}


# ----------------------------
# 1. Mark excluded vs included Pokémon
# ----------------------------
Pokemon_clean$excluded <- ifelse(1:nrow(Pokemon_clean) %in% idx_infl,
                                 "Excluded", 
                                 "Included")

# ----------------------------
# 2. Prepare prediction dataset (typical values for other covariates)
# ----------------------------
num_medians <- sapply(Pokemon_clean %>% select(hp, defense, sp_attack, speed), median)
cat_refs <- sapply(Pokemon_clean %>% select(gender_cat, special_status, happiness_cat), function(x) levels(x)[1])

height_seq <- seq(min(Pokemon_clean$height_m), max(Pokemon_clean$height_m), length.out = 100)

pred_df_clean <- data.frame(
  height_m = height_seq,
  log2.height_m = log2(height_seq),
  hp = num_medians["hp"],
  defense = num_medians["defense"],
  sp_attack = num_medians["sp_attack"],
  speed = num_medians["speed"],
  gender_cat = cat_refs["gender_cat"],
  special_status = cat_refs["special_status"],
  happiness_cat = cat_refs["happiness_cat"]
)

# ----------------------------
# 3. Predictions for cleaned model
# ----------------------------
pred_clean <- predict(mv_fit_clean, newdata = pred_df_clean, se.fit = TRUE)
pred_df_clean$log2_weight_kg <- pred_clean$fit
pred_df_clean$se <- pred_clean$se.fit
pred_df_clean$lower <- pred_df_clean$log2_weight_kg - 1.96 * pred_df_clean$se
pred_df_clean$upper <- pred_df_clean$log2_weight_kg + 1.96 * pred_df_clean$se
pred_df_clean$model <- "Cleaned model"

# ----------------------------
# 4. Predictions for original model
# ----------------------------
pred_orig <- predict(mv_fit_step, newdata = pred_df_clean, se.fit = TRUE)
pred_df_orig <- pred_df_clean
pred_df_orig$log2_weight_kg <- pred_orig$fit
pred_df_orig$se <- pred_orig$se.fit
pred_df_orig$lower <- pred_df_orig$log2_weight_kg - 1.96 * pred_df_orig$se
pred_df_orig$upper <- pred_df_orig$log2_weight_kg + 1.96 * pred_df_orig$se
pred_df_orig$model <- "Original model"

# Combine for plotting
pred_df <- bind_rows(pred_df_clean, pred_df_orig)

# ----------------------------
# 5. Plot on log2 axes, tick labels in original scale
# ----------------------------
ggplot() +
  # Model fits
  geom_line(data = pred_df, aes(x = log2(height_m), y = log2_weight_kg, color = model), size = 1.2) +
  geom_ribbon(data = pred_df, aes(x = log2(height_m), ymin = lower, ymax = upper, fill = model), alpha = 0.2, color = NA) +
  # Actual points
  geom_point(data = Pokemon_clean, aes(x = log2(height_m), y = log2(weight_kg), color = excluded),
             size = 2, alpha = 0.8) +
  scale_color_manual(values = c("Included" = "gray50", "Excluded" = "red", "Original model" = "blue", "Cleaned model" = "green")) +
  scale_fill_manual(values = c("Original model" = "blue", "Cleaned model" = "green")) +
  # Tick labels in original scale
  scale_x_continuous(name = "Height (m)", labels = function(x) round(2^x, 2)) +
  scale_y_continuous(name = "Weight (kg)", labels = function(y) round(2^y, 1)) +
  theme_minimal(base_size = 12) +
  labs(
    title = "Estimated Weight vs. Height (log2 scale)",
    subtitle = "Other covariates at median/reference; comparison of original vs. cleaned model",
    color = "Points / Model",
    fill = "Model Fit"
  )


```



#### Comparison of IDA profile imbalance index to MDA influence diagnostics (continuation of SA3)

During IDA, a profile imbalance index was defined to identify Pokémon species with unusual combinations of base-stat values, using only the predictor distributions and without reference to the outcome. Here we compare the ten species with the highest profile imbalance index to the species identified as influential by Cook's distance in the fitted model, to assess whether these influential points could have been anticipated from the predictor distributions alone, before model fitting

```{r}
base_stats <- c("hp","attack","defense","sp_attack","sp_defense","speed")

z_stats <- scale(Pokemon_clean[, base_stats])
Pokemon_clean$profile_imbalance <- apply(z_stats, 1, sd)

top10_imbalance <- Pokemon_clean %>%
  arrange(desc(profile_imbalance)) %>%
  slice(1:10) %>%
  pull(name)

influential_cooks <- diag_tbl %>%
  filter(cooks > cutoff_cooks) %>%
  pull(name)

overlap <- intersect(top10_imbalance, influential_cooks)

data.frame(species = union(top10_imbalance, influential_cooks)) %>%
  mutate(
    flagged_by_IDA_index = species %in% top10_imbalance,
    flagged_by_cooks_distance = species %in% influential_cooks
  ) %>%
  arrange(desc(flagged_by_IDA_index), desc(flagged_by_cooks_distance)) %>%
  kbl(booktabs = TRUE,
      caption = "Comparison: species flagged by the IDA profile imbalance index (top 10) vs. species exceeding the Cook's distance threshold (4/n) in the selected model") %>%
  kable_styling()

cat("Overlap:", length(overlap), "of", length(top10_imbalance), "IDA-flagged species were also flagged by Cook's distance.\n")



```


:::: {.infobox data-latex=""}
**RESULTS: **
TOUPDATE:4 of the 10 species with the highest profile imbalance index (Blissey, Chansey, Wobbuffet, Regieleki) are also among those with Cook's distance above the 4/n threshold. This overlap is well above what would be expected by chance (about 0.6 species, given that 62 of 1025 species, roughly 6%, exceed the Cook's distance threshold).
::::



:::: {.infobox data-latex=""}
**CONSEQUENCES: **
This indicates that species with unbalanced predictor profiles were, to some extent, anticipated as influential before model fitting, supporting the usefulness of IDA-stage screening. At the same time, most Cook's-distance-flagged species (58 of 62) were not among the top 10 by profile imbalance, showing that predictor-based screening alone cannot anticipate most outcome-dependent influential points; the two approaches capture different, complementary aspects of the data.
::::


#### BMI of Pokémon (SA4)

We remove the 5 Pokémon with the most extreme BMI values or identified as influential (same 5 species as in the univariable analysis). 

```{r sensitivityMult2}
# sensitivity to Pokémon with atypical BMI
mv_fit_step_sens2 <- update(mv_fit_step, data=Pokemon_clean[-c(790,92,93,890,977 ),])
summary(mv_fit_step_sens2) %>% tab_model()

```



:::: {.infobox data-latex=""}
**RESULTS: **
As in the univariable case, the removal of the 5 Pokémon increases the adjusted determination coefficient (from 0.71 to 0.75) and decreases the residual standard error. 
The estimated regression coefficient of the legendary group changes from -0.10 to -0.44. As anticipated in IDA, the effect is due to the large influence of Cosmoem, which is a legendary Pokémon (a rare group, including only 31 Pokémon).

For both sensitivity analyses the estimated association between height and weight is similar as with the full model.
::::






#### Gender coding (SA5)

We compare the coding of gender used in the main model (gender_cat, 3 categories among Pokémon with a defined gender) to a finer-grained coding using percentage_male as a 7-level factor. This analysis is restricted to the 871 Pokémon with a defined gender; it does not evaluate whether genderless Pokémon should be modeled as a separate category, which is a structural feature of the data rather than an alternative coding choice.

```{r sensitivityGender}
Pokemon_gendered <- droplevels(Pokemon_clean[Pokemon_clean$gender_cat != "Genderless", ])

mv_fit_step_gendercat <- update(mv_fit_step, data = Pokemon_gendered)
mv_fit_step_gendernum <- update(mv_fit_step, . ~ . - gender_cat + factor(percentage_male), data = Pokemon_gendered)

tab_model(mv_fit_step_gendercat, mv_fit_step_gendernum, 
          dv.labels = c("Gender as 3-category factor", "Percentage male as 7-level factor"))

AIC(mv_fit_step_gendercat, mv_fit_step_gendernum)
```

:::: {.infobox data-latex=""}
**RESULTS:    **

The AIC values for the two models are nearly identical (2709.65 for the 3-category gender_cat model vs. 2709.59 for the 7-level percentage_male model, ΔAIC = 0.07), far below the threshold typically used to prefer one model over another. R² adjusted is also nearly identical (0.707 vs. 0.709). Estimates for all other covariates (height, base statistics, special status, happiness) are essentially unchanged between the two codings.
::::

:::: {.infobox data-latex=""}
**COMMENT: **

The finer 7-level coding does not improve model fit relative to gender_cat, supporting the 3-category coding as an adequate simplification for the main model. The 7-level coding suggests a possible non-monotonic pattern (percentage_male = 75 has the largest, most significant coefficient), but given the wide confidence intervals and the lack of a consistent monotonic trend across levels, this is not sufficient evidence to prefer the more complex coding.
::::



### Interpretation of the results


Here we first interpret the results of the selected multivariable model.

Compared to the full model, backward selection based on AIC removed evolutionary phase, attack, and special defense. The selected model has the same adjusted R² as the full model, and the estimated height-weight association is nearly identical between the two, both in point estimates and in confidence intervals.  Estimates for the other retained covariates are also similar between the two models, including for the sub-legendary category (-0.46 in the full model vs. -0.51 in the selected model), whose p-value shifts slightly, from 0.052 to 0.025, after removing the collinear variables.

Height remains the strongest predictor of weight. The model retains both the log2-transformed and the linear height terms; together they describe a relationship where weight increases with height, but at a decelerating rate for the tallest Pokémon, consistent with the pattern already observed in the univariable analysis and shown in the graph above.

The coefficient for the genderless category is positive and large, suggesting that Pokémon species who are genderless are heavier than other species, after accounting for height. This follows the expert understanding that many genderless Pokémon species are legendary, and legendary species tend to be larger than species with an equal male/female gender split. The coefficients for mostly male and mostly female are positive and negative, respectively, which follows a real-world interpretation of females of many species being smaller than males. 

After accounting for the other variables, sub-legendary and mythical Pokémon are estimated to be lighter than normal; the legendary category itself is not distinguishable from normal in this model.


When interpreting base statistics, we use increases of 10  to interpret coefficients rather than a 1-point change, since domain knowledge and IDA univariable descriptions show that a 1-point change is not meaningful for these variables.  HP and defense are positively associated to weight, speed and special attack negatively (after accounting for the other variables). 

Unhappy Pokémon are estimated to be heavier than normal, happy lighter (but not statistically significantly different than normal).


#### Robustness of the results across sensitivity analyses

The estimated association between height and weight is consistent across all sensitivity analyses (SA1-SA5): its direction and approximate magnitude do not change materially when accounting for within-family correlation, restricting to shorter Pokémon, removing influential species, or recoding gender.

Some coefficients are less robust than others, however. Taking into account the correlation within evolutionary family (SA1) increases standard errors throughout, and moves the coefficients for sub-legendary and mythical special status, and for the "mostly female" gender category, from p<0.05 to p>0.05; happiness_cat remains non-significant, as it already was without this correction.

Comparing the species removed based on Cook's distance (SA3) to those flagged during IDA by the profile imbalance index (a predictor-only measure, computed before model fitting) shows a modest but above-chance overlap: 4 of the 10 species with the highest profile imbalance were also flagged by Cook's distance, versus about 0.6 expected by chance. Most influential species, however, are not captured by the profile imbalance index, since influence also depends on the relationship with the outcome, which the index does not use; the two diagnostics are complementary rather than interchangeable.

Removing the species with the most extreme height or BMI values (SA2, SA4) increases the adjusted R² substantially and changes the estimated coefficient for the legendary special-status category, driven by the outsized influence of Cosmoem, a legendary species with an extreme weight-for-height ratio; the estimated height-weight association itself is not affected.

The choice of gender coding (SA5) does not materially affect the results: a finer 7-level coding of percentage_male gives essentially the same AIC and R² as the 3-category gender_cat used in the main model (when the analysis is restricted to species with known gender), and the estimates of all other covariates remain stable between the two.