Outlier removal for IFSA elections

Understanding why removing outliers with the 1.5 interquantile range is a probably a bad idea …

Case 1 - strategic voters

Once upon a time there was the elections in the IFSA Forest there are two candidates: Ash annd Fagus

The job to do is to expand the a nearby abandoned farmland, and cleraly Ash is better at it than Fagus. Let’s consider that that Ash real score should be 9 while Fagus 6.

As we all know Fagus is extremely arrogant and cannot tolerate other trees, so asks their supporters to give him 10 and 0 to Ash.

This doesn’t look good so outliers are removed…

Let’s consider n_F the number of Fagus supporters (hence strategic voters) and see what happens for different numbers of n_F. To simply calculations there are 100 voters in the forest election.

# Define voting system
no_outlier <- function(votes) mean(votes)

remove_outliers <-  function(votes) {
  low <- quantile(votes, .25) - 1.5 * IQR(votes)
  high <- quantile(votes, .75) + 1.5 * IQR(votes)

  ifelse(between(votes, low, high), votes, NA)
}

outlier_simple <- function(votes){
  remove_outliers(votes) %>%
    mean(na.rm = TRUE)
}

outlier_mean <- function(votes){
  votes <- remove_outliers(votes)
  votes %>%
    replace_na(mean(votes, na.rm = TRUE)) %>%
    mean()
}

outlier_median <- function(votes){
  votes <- remove_outliers(votes)
  votes %>%
    replace_na(median(votes, na.rm = TRUE)) %>%
    mean()
}

calc_elections <- function(votes){
    votes %>%
    pivot_longer(everything(), names_to = "Tree", values_to = "votes") %>%
    group_by(Tree) %>%
    summarize(
      no_outlier = no_outlier(votes),
      outlier_simple = outlier_simple(votes),
      outlier_mean = outlier_mean(votes),
      outlier_median = outlier_median(votes),
      n_out = remove_outliers(votes) %>% is.na() %>%  sum()
    )
}
# Compare voting systems
voting_outcome_strategic <- function(n_F) {
  tibble(Ash = c(rep(9, (100 - n_F)), rep(0, n_F)),
         Fagus = c(rep(6, (100 - n_F)), rep(10, n_F))) %>%
         calc_elections()
}

voting_outcome_strategic(5)

scenarios_forest <- tibble(
  n_F = seq(1, 100),
  outcome = map(n_F, voting_outcome_strategic)
)

The three different outliers replacement methods basic provide the same results so for simplicy are omitted in the plot

And actually we can see that the outlier removal has an effect only when there is a small number of strategic votes

scenarios_forest %>%
  unnest(outcome) %>%
  select(-outlier_mean, -outlier_median) %>%
  pivot_longer(c(-n_F, -Tree, -n_out), names_to = "type", values_to = "score") %>%
  ggplot(aes(n_F, score, colour = type, linetype = Tree)) +
  geom_line() +
  ggthemes::scale_color_colorblind() +
  labs(x = "Number of strategic votes (only for beech)")

If the number of strategic votes removing outliers first has no impact and then it actually help the Fagus!

scenarios_forest %>%
    unnest(outcome) %>%
    filter(Tree == "Ash") %>%
    mutate(outlier_effect = outlier_simple - no_outlier ) %>%
    ggplot(aes(n_F, outlier_effect)) +
        geom_line()

Case 2 - Honest voting

let’s now imagine that everyone got annoyed by the Fagus behaviour (we can dream right …) and the Fagus is replaced the Birch, which actually is as good as the Ash.

Now the inhabitants of the forest are all very honest and just give the candidate the score that they deserve depending on the benefit they receive from each Tree. So everyone gives 9 to the Ash and 9 to the Birch.

Now imagine that there is the mushroom that lives at the edge of the forest and he is allergic to the pollen of the Ash, poor mushroom for him having a new ash would be big problem (that’s honest voting that’s not strategy), but they understand that the ash is also a good tree so decided at the end of giving a score of 7 to the ash.

Let’s see what happens with the outliers vs no_outliers voting system…

votes <- tibble(
  Ash = c(rep(9, 99), 7),
  Birch = rep(9, 100)
)

calc_elections(votes)

Poor mushroom! He had an honest concern and now their completely valid vote was removed (will there be a mushroom revolution)