10-decline-and-fall.Rmd

# decline and fall of pokemon empire

## I/O

- input: 
- output: `p_pandoras_aggregate`

## summary
昔は人気なかったやつが人気でたり、逆だったり、の極端なやつらをいくつか経時的に追ってったほうがいい気がしてきた。
そういうやつを見つけてみよう：

relativeなrankをつくって、その変動が大きいものをみつけるか。ずっとRankが低い・高いやつをハイライトするのもよさそう

1. 一番大きなrankから一番小さなRankにいっている（栄枯盛衰のうち栄転）
1. 一番小さなrankから一番大きなRankにいっている（栄枯盛衰のうち転落）
1. 大→小→大　（一時期すごかった、はやり）
1. 小→大→小　（カムバック）
1. ずっとちいさなRank（ずっと栄光）
1. ずっと大きなRank（不人気）
くらいがとれると面白そう
どうやるの
relative_rankが…

1. 
1. 
1.
1.
1. na.omitしたrankが平均して一番小さい
1.na.omitしたrankが平均して一番大きい…？



## no show

COUNT ABSENT


でてくるポケモンではなく、でてこないポケモンに着目してみる。
でてこないポケモンの数もシミュレーションと違う。
prepare all possible entries of pokemons, in that specific era. for example, pokedex 152, gen 2 pokemon cannot appear in series_gen_era == 1 period.

```{r}
# empty_rank_df <-
#   tibble(
#     pokedex_id = map(
#       .x = 1:8,
#       ~ 1:df_game_gen$pokemon_cumulative_n[.x]
#     ) |> 
#       unlist(),
#     series_gen_era = map(
#       .x = 1:8,
#       ~ rep(.x, df_game_gen$pokemon_cumulative_n[.x])
#     ) |> 
#       unlist()
#   ) |> 
#   left_join(df_names, by = "pokedex_id")
```


`df_no_appearance_emp`は名前つき。どの名前/pokedex_idのやつが欠けているのかがわかる。
```{r}
df_no_appearance_emp <-
# df_view <- 
  temporal_change_per_gen_df |> 
  filter(condition == "pokemon name") |> 
  # right_join(empty_rank_df) |> 
  filter(n == 0) |> 
  count(series_gen_era, pokedex_id, pokemon_name, pokemon_name_ja, across(), name = "count_no_shows")
df_no_appearance_emp |> 
  ggplot(aes(x = series_gen_era, pokedex_id)) +
  # geom_point() +
  geom_text(
    aes(label = pokemon_name),
    size = 6 * pt_convert
  )
```



↑たとえばseries_gen_era == 1 のころには151のミュウだけカードが一度も登場してない。アンノーンにいたっては一時期ものすごく多かったのに、ゼロになってる。ほんとかよ？第2世代の時期で最も多く（1位）、第3世代でゼロ枚、第4世代でまた一位…？まじ？

```{r}
df_gene |> 
  filter(pokemon_name == "Unown") |> 
  count(release_date) |> 
  ggplot(aes(x = release_date, n)) +
  geom_col() +
  geom_vline(
    data = df_game_gen,
    aes(xintercept = game_release_date),
    inherit.aes = FALSE
  )
```
たしかにぽっかりあいてますね…。
kadabraニキは？そんなに人気ないの？
```{r}
df_gene |> 
  filter(pokemon_name == "Kadabra") |> 
  count(release_date) |> 
  ggplot(aes(x = release_date, n)) +
  geom_col() +
  geom_vline(
    data = df_game_gen,
    aes(xintercept = game_release_date),
    inherit.aes = FALSE
  )
```

series_gen_era == 8ともなると非常にポケモンが多いので一度も登場していないカードも相当ありそう。→２ひきかな

これもかなりランダムとは違う気がするし、測れる気がする。

## compare voids with random

↓とりあえずシミュレーションで一度も登場しなかったポケモンの名前をrun==1に限定してプロットしてみる。
```{r}
temporal_change_per_gen_df |> 
  filter(condition == "simulations", run == 128) |> 
  filter(n == 0) |> 
  count(series_gen_era, pokedex_id, pokemon_name, pokemon_name_ja, across(), name = "count_no_shows") |> 
  ggplot(aes(x = series_gen_era, pokedex_id)) +
  # geom_point() +
  geom_text(
    aes(label = pokemon_name),
    size = 6 * pt_convert,
    alpha =.5
  ) +
  theme_pokemon
  
```

↑当然といえば当然なんだけどまんべんなく登場しないポケモンがでてくる。さっきのEmpデータとは大違いである。

### compare numerically, then visually

Game-gen-eraごとに集計して、その数がどれくらいシミュレーションと違うかみてみよう
ただしrunすべてについて行うので、right_joinが全部に起きないといけないので難しそう
まずはシミュレーションについて。
```{r}
df_no_appearance_sim <-
# df_view <- 
  temporal_change_per_gen_df |> 
  filter(condition == "simulations") |> 
  filter(n == 0) |> 
  count(run, series_gen_era, pokemon_gen, name = "count_no_shows") |> 
  complete(
    run = 1:1000, 
    series_gen_era = 1:8, 
    pokemon_gen = 1:8, 
    fill = list(count_no_shows = 0)
  ) |> # create all combinations
  filter(series_gen_era >= pokemon_gen) |> # filter out impossible, excessive combos
  mutate(condition = "simulations") 
```

`df_no_appearance_emp2`は`df_no_appearance_emp`をもとにしているが、名前の情報をなくしている。とにかくどの世代のポケモンがそれぞれの時期に何人登場していないかがわかる。すべてのありうる組み合わせについて集計したいので、completeと直後のfilterでなんとかした。もっと集計すれば、それぞれの時期に（世代関係なく）何人登場していないかデータになるだろうけど、一旦ここで止めている。
```{r}
# align emp data to match with sim df
df_no_appearance_emp2 <-
# df_view <- 
  df_no_appearance_emp |> 
  count(series_gen_era, pokemon_gen, name = "count_no_shows") |> 
  complete(
    series_gen_era = 1:8, 
    pokemon_gen = 1:8, 
    fill = list(
      count_no_shows = 0
    )
  ) |> # create all combinations
  filter(series_gen_era >= pokemon_gen) |> # filter out impossible, excessive combos
  mutate(condition = "pokemon name")
```

いくら第３世代登場直後でも確率的には、ランダムにとれば少しは登場しない奴らがいてもおかしくないのに、全然「一回も登場しないようなポケモンがいない」ということで、正の新奇バイアス…というか、Positive Debutant Biasの傍証といえましょう。第５世代がでるころともなるとその御利益もなくなり、かなりの数が未登場。
ちょっとポケモンじたいの世代は忘れて、時期ごとのAbsenteeの数だけでみてみましょう：

```{r}
# summarise by pokemon_gen & series_gen_era
df_no_appearance_summary <- bind_rows(
  df_no_appearance_emp2, df_no_appearance_sim
  ) |> 
  group_by(series_gen_era, pokemon_gen, condition) |> 
  summarise(mean_count_no_shows = mean(count_no_shows))
# note that `mean_count_no_shows` is 
# exactly the same as the count_no_shows. 
# using the same name just for plotting purposes.

# summarise by series_gen_era only
df_no_appearance2 <- bind_rows(
  df_no_appearance_emp2, df_no_appearance_sim
  ) |> 
  group_by(series_gen_era, condition, run) |> 
  summarise(sum = sum(count_no_shows)) |>
  ungroup() |> 
  complete(series_gen_era, condition, fill = list(sum = 0))
```
<!-- ### ちょっとしたらここ消す -->
<!-- Era１においてsimパンドラ数が偶数だけ？ってのはおかしい気がするんですが。実際empでは１だし。 -->

<!-- ```{r} -->
<!-- df_view <- df_no_appearance2 |>  -->
<!--   filter( -->
<!--     condition == "simulations", -->
<!--     series_gen_era == 1 -->
<!--   ) -->
<!-- ``` -->
<!-- 偶数だけですね…。 -->

<!-- ```{r} -->
<!-- df_no_appearance_sim　|> filter( -->
<!--     condition == "simulations", -->
<!--     series_gen_era == 1 -->
<!--   ) -->

<!-- temporal_change_per_gen_df |>  -->
<!--   filter( -->
<!--     condition == "simulations", -->
<!--     run == 125,  -->
<!--     series_gen_era == 1, -->
<!--   n == 0)  -->
<!-- ``` -->
<!-- 全部みごとに重複してますね。ほかのseries_gen_eraならないのだろうか： -->
<!-- ```{r} -->
<!-- df_view <- temporal_change_per_gen_df |>  -->
<!--   filter( -->
<!--     condition == "simulations", -->
<!--     run == 125,  -->
<!--     series_gen_era == 2, -->
<!--   n == 0)  -->
<!-- ``` -->
<!-- 重複ないですね。 -->
<!-- もう一度`temporal_change_per_gen_df`を計算し直したらうまくいった。後でここまでの部分は消す。 -->

### plot

```{r}
p_pandoras_aggregate <-
df_no_appearance2 |> 
  filter(condition == "simulations") |> 
  ggplot(aes(x = series_gen_era, y = sum, fill = series_gen_era)) +
  geom_quasirandom(
    size = .1, 
    pch = 21,
    colour = "transparent",
    stroke = 0
  ) +
  geom_line(
    data = df_no_appearance2 |> filter(condition == "pokemon name"),
    colour = pokemon_blue,
    size = .2,
    linetype = "dotted"
  ) +
  geom_point(
    data = df_no_appearance2 |> filter(condition == "pokemon name"),
    fill = pokemon_blue,
    pch = 21,
    colour = "black",
    stroke = .1
  ) +
  scale_fill_viridis_c() +
  theme_pokemon
ggsave("./output/p_pandoras_aggregate.png", width = 100, height = 100, units = "mm", dpi = 600)
```
第４世代までは全部登場させるようなバイアスがかかっていて、５世代以降はかなり「もう諦めようぜ、もう多すぎだから全部作ろうと思わないでいいよ」みたいになってることが一目瞭然である。もちろん５世代目以降はランダムでも多いのであれだけど、ランダムの値からのハズレをみても。
変になった〜〜〜〜

### plot simVSemp, zansa

紀要載せたいなー
[rbind trick](https://stackoverflow.com/questions/25961897/how-to-merge-2-vectors-alternating-indexes)
```{r}
p_no_appearance <- 
  df_no_appearance_summary |> 
  ggplot(aes(x = series_gen_era, y = mean_count_no_shows, colour = condition)) +
  geom_violin(
    data = df_no_appearance_sim,
    aes(group = series_gen_era, y = count_no_shows),
    scale = "count",
    fill = pokemon_yellow |> lighten(0.6),
    colour = "transparent",
    bw = .5,
    trim = FALSE
  ) +
  geom_line(
    size = .5
  ) +
  geom_point(
    size = .5,
    # stroke = .05
  ) +
  scale_colour_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  scale_x_continuous(
    breaks = 1:8,
    labels = rbind("", 1:4 * 2) |> c()
  ) +
  # scale_y_continuous(trans = "log10")
  facet_wrap(
     vars(pokemon_gen),
     nrow = 1,
     scales = "free",
     labeller = pokemon_gen_labeller
  ) +
  theme_pokemon +
  theme(
    # aspect.ratio = 1,
    # legend.position = "none"
  )
ggsave("./output/p_count_absent.png", width = 166, height = 166/4, unit = "mm", dpi = 600)
ggsave("./output/p_count_absent.pdf", width = 166, height = 166/4, unit = "mm", dpi = 600)

```

## 残差
```{r}
df_no_appearance_residual <- full_join(
  df_no_appearance_emp2 |> 
    select(-condition), 
  df_no_appearance_sim |>
    select(-condition),
  by = c("series_gen_era", "pokemon_gen")
  ) |> 
  mutate(count_no_shows.x = replace_na(count_no_shows.x, 0)) |> 
  rename(empirical = "count_no_shows.x", simulations = "count_no_shows.y") |> 
  mutate(residual = empirical - simulations)

df_no_appearance_residual |> 
  # filter(condition == "simulations") |>
  ggplot(aes(x = series_gen_era, y = residual, colour = pokemon_gen - series_gen_era)) +
  geom_hline(yintercept = 1, colour = "blue", alpha = .4) +
  geom_jitter(size = .1, alpha = .1) +
  scale_colour_viridis_c() +
  theme_pokemon
```




これはプロットが難しいな…ggridgesするときがきた？
```{r}
p_pandoras_ridges <-
df_no_appearance_residual |> 
  # mutate(series_gen_era = )) |> 
  ggplot(aes(
    y =fct_rev(as.factor(series_gen_era)),
    # y = paste0("Gen", series_gen_era,"Era, Gen", pokemon_gen, "pokemons"),
    x = residual, 
    fill = (pokemon_gen - series_gen_era) |> as.factor()
    # group = pokemon_gen
  )) +
  geom_vline(xintercept = 0) +
  geom_density_ridges(
    rel_min_height = .01,
    bandwidth = .8,
    alpha = .8,
    size = .2
    ) +
  scale_y_discrete(
    "Era",
    labels =  8:1 |> as.roman()
  ) +
  scale_fill_viridis_d("Gens Past Release", option = "B") +
  theme_pokemon +
  theme(legend.position = c(0.2, 0.8))
```
第４世代までは新しく登場したばかりのポケモンも昔からのポケモンも大した差はなく平等にとられていた（し、ランダムよりもずっとあますところなくとられていた）が、第５世代では明らかに第５世代が優遇されており、そのアオリを昔の世代たちがくっている

## 微妙だけど一応のせたやつ

`average_relative_rank`全Eraつうじてのランクの高さ。数値が低いほど上位を維持している。人気どあい。0.5以上であれば中央以上に人気といっていい。多分。
`rank()`関数じたいは少ないほうから順にランク１位！としてしまう。nが多いほどランクが上位（小さい）になってほしいので、[ここ](https://stats.stackexchange.com/questions/3321/rank-in-r-descending-order)を参考に逆にする。
```{r}
decline_and_fall_of_pokemon_empire_df <- temporal_change_per_gen_df |>
  filter(run == 1 | is.na(run)) |>
  filter(condition %in% c("pokemon name", "simulations")) |>
  # right_join(empty_rank_df) |>
  group_by(condition, run, series_gen_era) |>
  # arrange(desc(n)) |>
  # mutate(n = replace_na(n, 0)) |> # NAを放置すると次のrank()でNAのやつらの順位が一緒にならん
  mutate(rank = rank(-n, ties.method = "min")) |>  # higher n -> smaller rank with -n
  # mutate(rank = rank(-n, ties.method = "random")) |>  # higher n -> smaller rank with -n
  ungroup() |>
  select(condition, run, series_gen_era, pokemon_gen,  pokedex_id,n, rank, ecdf, ) |>
  group_by(condition, run, series_gen_era) |>
  mutate(relative_rank = rank/max(rank, na.rm = TRUE)) |>
  filter(!is.na(relative_rank)) |>
  ungroup() |>
  group_by(condition, run, pokedex_id) |>
  mutate(
    average_relative_rank = ave(relative_rank, na.rm = TRUE), # 5., 6.
    # delta =
  ) # 30 sec
decline_and_fall_of_pokemon_empire_df # 8731 x 10
```
```{r}
decline_and_fall_of_pokemon_empire_df |>
  ggplot(aes(y = relative_rank, x = pokedex_id, colour = condition)) +
  geom_point()
```
なんでPokedex_idによって変な線が見えるんじゃー！面白いけど絶対なんかの都合なので取り除く。→鳥のアゾけましたね
minでもrandomでも取り除けた。randomとminで違いすぎやろ。まあminがよかろう。
### ポケモンそれぞれの人気の入れ替わり
```{r}
decline_and_fall_of_pokemon_empire_df |>
  ggplot(aes(x = series_gen_era,  y = relative_rank, group = pokedex_id, colour = pokedex_id)) +
  geom_line() +
  geom_point() +
  facet_grid(
    cols = vars(pokemon_gen),
    rows = vars(condition),
    scales = "free"
    ) +
  theme_pokemon
  # scale_y_continuous(trans = "log10")
# ggsave("./output/p_emp_decline_journey.svg", width = 166, height = 90, unit = "mm", dpi = 1200)
```
## 栄枯盛衰をなんとかデルタ的な感じで数値にする
まずは平均的な、全期をつうじての人気、`average_relative_rank`でやってみるか…
Aveでいいのかわからんし、relativeでいいのかもわからん、なんもわからん
Gen8のものはあまりにサンプルサイズが少ないので（Averageの意味がないので）除く。
 setting `pch = 21` points `colour = "transparent"` is better better than setting `stroke = 0`, [source](https://stackoverflow.com/questions/38081159/slight-point-strokes-in-ggplot-points)
```{r}

# p_average_relative_rank <-
  decline_and_fall_of_pokemon_empire_df |>
  filter(pokemon_gen < 8) |>
  select(average_relative_rank, pokedex_id) |>
  distinct() |>
  left_join(df_names, by = "pokedex_id") |>
  ggplot(aes(x = pokemon_gen, y = average_relative_rank, colour = condition)) +
  geom_quasirandom(
    dodge.width = .8,
    alpha = .7,
    colour = "transparent",
    stroke = 0,
    pch = 21, aes(fill = condition)) +
  geom_smooth(se = FALSE) +
  scale_colour_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  geom_text()
  scale_fill_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  labs(
    x = "Pokémon Generation",
    y = "Average Relative Rank",
  ) +
  facet_grid(
    cols = vars(condition)
  ) +
  theme_pokemon +
  theme(
    legend.position = "none"
  )
```