gerador.qmd

---
params:
  clube: "time1"
format:
  html:
    css: www/pages-styles.css
execute: 
  echo: false
  warning: false
  error: false
editor_options: 
  chunk_output_type: console
---

<!-- Conecta com a fonte "Comfortaa" do Google Fonts -->
<link rel="preconnect" href="https://fonts.googleapis.com">
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
<link href="https://fonts.googleapis.com/css2?family=Comfortaa:wght@500;700&display=swap" rel="stylesheet">

```{r}

# Carrega bibliotecas
library(brasileirao)
library(dplyr)
library(forcats)
library(ggplot2)
library(ggiraph)
library(ggnewscale)
library(ggpath)
library(ggtext)
library(glue)
library(purrr)
library(readr)
library(stringi)
library(stringr)
library(tidyr)

# Carrega o banco de dados de partidas
matches <- readr::read_csv("https://raw.githubusercontent.com/williamorim/brasileirao/master/data-raw/csv/matches.csv")

# "Hackeando" o {ggiraph} para adicionar uma versão interativa do ggpath::geom_from_path
geom_from_path_interactive <- function(...)
{ggiraph:::layer_interactive(ggpath::geom_from_path, ...)}

GeomInteractiveFromPath <- ggplot2::ggproto(
  "GeomInteractiveFromPath",
  GeomFromPath,
  default_aes = ggiraph:::add_default_interactive_aes(GeomFromPath),
  parameters = ggiraph:::interactive_geom_parameters,
  draw_key = ggiraph:::interactive_geom_draw_key,
  draw_panel = function(data, panel_params, coord, ..., .ipar = ggiraph:::IPAR_NAMES) {
    zz <- GeomFromPath$draw_panel(data, panel_params, coord, ...)
    coords <- coord$transform(data, panel_params)
    ggiraph:::add_interactive_attrs(zz, coords, ipar = .ipar)
  }
)

# Define time
selected_team <- params$clube

# Define temporadas
selected_seasons <- 2006:2023

```

```{r}

# Operações extras para construção do placeholder com intruções
if (selected_team == "time1") {
  
  ## Sorteia algumas temporadas
  temp <- sort(sample(x = selected_seasons, size = 7))
  
  ## Constrói um toy data para representar as partidas
  matches <- temp |> 
    purrr::map_dfr(function (year) {
      
      time = dplyr::tibble(
        season = rep(year, 380),
        date = seq(as.Date(glue::glue("{year}/4/1")),
                   as.Date(glue::glue("{year}/12/1")),
                   length.out = 380)
      )
      
      team = expand.grid(
        home = glue::glue("time{1:20}"),
        away = glue::glue("time{1:20}")
      ) |> 
        dplyr::filter(home != away) |> 
        dplyr::slice_sample(n = 380)
      
      dplyr::bind_cols(time, team)
      
      
    }) |> 
    dplyr::rowwise() |> 
    dplyr::mutate(score = glue::glue("{sample(1:3, 1)}x{sample(1:3, 1)}"), .before = "away") |> 
    dplyr::ungroup() |> 
    dplyr::mutate(id_match = 1:n(), .before = "season")
  
  ## Define coordenadas dos itens extras para o gráfico
  extras_df <- dplyr::tibble(
    x = c(-30, 0, -18.3),
    y = c(26.5, 20.1, -16.4),
    path = glue::glue("www/mouse_{c('click','hover','hover')}.png"),
    hjust = 0,
    vjust = 0.5,
    label = c(
      "Lista de rivais contra<br>os quais o clube jogou.<br>
      Clique para destacar partidas<br>contra um clube específico",
      
      "Bolhas maiores indicam a pontuação<br>total do clube ao fim da temporada.<br>
      Sobreponha o mouse para ver os valores.<br><br>
      Cores indicam a pontuação<br>
      de 1 <span style='color:#A82A00;'>(vermelho)</span> a 100 <span style='color:#00A81C;'>(verde)</span>.<br>
      Anos em que o clube esteve<br>fora da série A estão em <span style='color:#636363;'>(cinza)</span>.<br><br>
      Punições com perdas de<br>
      pontos estão inclusas:<br>
      <sub>Barueri (-3pts em 2010); Flamengo (-4pts em 2013);<br>
      Portuguesa (-4pts em 2013); Santa Cruz (-3pts em 2016)</sub>",
    
      "Bolhas menores indicam o resultado de uma partida em uma rodada:<br>
      vitórias <span style='color:#00CC22;'>(verde)</span>, empates <span style='color:white;'>(branco)</span> e derrotas <span style='color:#EB3B00;'>(vermelho)</span>.<br>
      Em <span style='color:#636363;'>cinza</span> estão as partidas em que o clube esteve fora da série A.<br><br>
      Sobreponha o mouse para ver uma tooltip que mostra<br>
      informações sobre a partida, confrontos passados entre os clubes<br>
      e desempenho histórico na mesma rodada em temporadas passadas.<br><br>
      <img src='www/Vtip.png' width='70' /><img src='www/Etip.png' width='70' /><img src='www/Dtip.png' width='70' />"
    )
  )
  
  ## Gera o itens extras para o gráfico
  extras_img <- 
    ggpath::geom_from_path(
      aes(x = x, y = y, path = path),
      width = 0.07, height = 0.07, data = extras_df
    )
  extras_lbl <- 
    ggtext::geom_richtext(
      aes(x = x, y = y, label = label),
      hjust = 0, vjust = 0.5, nudge_x = 2, lineheight = 1.3,
      label.colour = NA, fill = "#000000c7", color = "white",
      label.padding = unit(c(0.45, 0.45, 0.45, 0.45), "lines"),
      size = 2, family = "Comfortaa", data = extras_df
    )
  
} else {
  extras_img <- NULL
  extras_lbl <- NULL
}

```

```{r}

# Mantém apenas os anos com 38 partidas, ordena por id da partida
# e converte os anos a factor
matches <- matches |> 
  dplyr::filter(season %in% selected_seasons) |>
  dplyr::mutate(season = factor(season, levels = selected_seasons)) |> 
  dplyr::arrange(id_match)

# Unifica os nomes dos clubes que mudaram ao longo do tempo
matches <- matches |> 
  dplyr::mutate(across(.cols = c("home","away"),
                       .fns = brasileirao::fix_names))

# Filtra apenas partidas do time selecionado
matches <- matches |> 
  dplyr::filter(if_any(.cols = c("home","away"),
                       .fns = ~. == selected_team))

# Adiciona a ordem das partidas
matches <- matches |> 
  dplyr::group_by(season) |> 
  dplyr::mutate(order_match = 1:n(),
                order_match = factor(order_match)) |> 
  dplyr::ungroup()

# Identifica rivais e status do clube na partida
matches <- matches |> 
  dplyr::mutate(rival = ifelse(home == selected_team, away, home),
                team = ifelse(home == selected_team, "home", "away")) 

# Extrai os gols do time e seus rivais
matches <- matches |> 
  dplyr::mutate(home = stringr::str_split_i(score, "x", 1),
                away = stringr::str_split_i(score, "x", 2)) |> 
  dplyr::mutate(goals_for = ifelse(team == "home", home, away),
                goals_against = ifelse(team == "home", away, home)) |> 
  dplyr::mutate(across(.cols = starts_with("goals"),
                       .fns = ~ifelse(stringr::str_length(.) == 0, NA, .)))

# Calcula os pontos com base nos resultados
matches <- matches |>
  dplyr::mutate(points = case_when(goals_for > goals_against ~ 3,
                                   goals_for == goals_against ~ 1,
                                   goals_for < goals_against ~ 0))

# Gera o cumulativo de pontos a cada temporada
matches <- matches |>
  dplyr::group_by(season) |> 
  dplyr::mutate(cumpoints = cumsum(points)) |> 
  dplyr::ungroup()

# Altera vazios para hífens na pontuação cumulativa
matches <- matches |>
  dplyr::mutate(cumpoints = ifelse(is.na(cumpoints), "—", cumpoints))

# Preenche vazios em temporadas que o clube não jogou a série A
matches <- matches |>
  tidyr::complete(season, order_match)

# Calcula a pontuação total por temporada
scoring <- matches |> 
  dplyr::group_by(season) |> 
  dplyr::summarise(points = sum(points, na.rm = TRUE)) |> 
  dplyr::ungroup()

# Desconta punições listadas
## Prudente/Barueri -3pts em 2010
## Flamengo -4pts em 2013
## Portuguesa -4pts em 2013
## Santa Cruz -3pts em 2016
if (selected_team %in% c("Barueri", "Flamengo", "Portuguesa", "Santa Cruz")) {
  
  loss <- switch(selected_team,
                 `Barueri` = -3,
                 `Flamengo` = -4,
                 `Portuguesa` = -4,
                 `Santa Cruz` = -3)
  
  occasion <- switch(selected_team,
                     `Barueri` = 2010,
                     `Flamengo` = 2013,
                     `Portuguesa` = 2013,
                     `Santa Cruz` = 2016)
  
  scoring <- scoring |> 
    dplyr::mutate(points = ifelse(season == occasion, points+loss, points))
  
}

# Altera "zeros" para hífens na pontuação total
scoring <- scoring |>
  dplyr::mutate(label = ifelse(points == 0, "—", points))

# Compõe a tooltip dos pontos de resumo
scoring <- scoring |>
  dplyr::mutate(tooltip = glue::glue(
    "<div class='tip-container'><span class='tip-pts'>{label}</span>PTS
    <span class='tip-ssn'>{season}</span></div>"
  ))

# Converte a pontuação em factor
matches <- matches |>
  dplyr::mutate(points = factor(points))

# Converte o nome do clube ao formato adequado para obter as imagens
logo_team <- stringi::stri_trans_general(selected_team, "latin-ascii; lower") |>
  stringr::str_replace_all("[:space:]", "-")

# Converte o nome dos clubes ao formato adequado para obter as imagens
# e as põe em colunas que indicam o mandante e visitante
matches <- matches |>
  dplyr::mutate(rival_logo = stringi::stri_trans_general(rival, "latin-ascii; lower"),
                rival_logo = stringr::str_replace_all(rival_logo, "[:space:]", "-"),
                home_logo = ifelse(team == "home", logo_team, rival_logo),
                away_logo = ifelse(team == "away", logo_team, rival_logo))

# Adiciona espaços entre os gols na variável "score"
matches <- matches |>
  dplyr::mutate(score = stringr::str_replace(score, "x", " x "))

# Lista os confrontos com rivais
rivals <- matches |>
  dplyr::rename("pastdate" = "date") |> 
  dplyr::filter(!is.na(points)) |> 
  dplyr::group_by(rival) |> 
  tidyr::nest() |> 
  dplyr::ungroup()

# Acrescenta a lista de confrontos
matches <- matches |>
  dplyr::left_join(rivals)

# Pega os três últimos confrontos para cada linha
matches <- matches |>
  dplyr::mutate(data = purrr::map2(
    .x = data,
    .y = date,
    .f = function(df, refdate) {
      if (!is.null(df)) {
        df |> 
          dplyr::filter(refdate > pastdate) |> 
          dplyr::mutate(tip = glue::glue(
            "<div class='card-past-games'>
              <img src='www/badges/{home_logo}.svg'>
              {score}
              <img src='www/badges/{away_logo}.svg'>
            </div>"
          )) |> 
          dplyr::slice_max(order_by = pastdate, n = 3) |> 
          dplyr::summarise(tip = glue::glue_collapse(tip)) |> 
          dplyr::pull(tip)
      } else {
        ""
      }
    })) |> 
  tidyr::unnest(cols = data, keep_empty = TRUE) |> 
  dplyr::mutate(data = ifelse(is.na(data), "", data)) |> 
  dplyr::rename("past" = "data")

# Lista o desempenho histórico por rodada em diferentes temporadas
history <- matches |> 
  dplyr::rename("pastdate" = "date") |> 
  dplyr::filter(!is.na(points)) |> 
  dplyr::group_by(order_match) |> 
  tidyr::nest() |> 
  dplyr::ungroup()

# Acrescenta a lista de desempenho histórico
matches <- matches |>
  dplyr::left_join(history)

# Pega os três últimos confrontos para cada linha
matches <- matches |>
  dplyr::mutate(data = purrr::map2(
    .x = data,
    .y = date,
    .f = function(df, refdate) {
      if (!is.null(df)) {
        df = df |> 
          dplyr::filter(refdate > pastdate) |> 
          dplyr::mutate(points = forcats::fct_recode(points, "v" = "3", "e" = "1", "d" = "0"))
        
        forcats::fct_count(df$points) |> 
          tidyr::pivot_wider(names_from = f, values_from = n) |> 
          dplyr::mutate(tip = glue::glue(
            "<div>
              <span class='card-history-abrv'>V</span><br>{v}
            </div>
            <div>
              <span class='card-history-abrv'>E</span><br>{e}
            </div>
            <div>
              <span class='card-history-abrv'>D</span><br>{d}
            </div>"
          )) |> 
          dplyr::pull(tip)
      } else {
        ""
      }
    })) |> 
  tidyr::unnest(cols = data, keep_empty = TRUE) |> 
  dplyr::mutate(data = ifelse(is.na(data), "", data)) |> 
  dplyr::rename("history" = "data")

# Gera um label que indica o nº da rodada
matches <- matches |>
  dplyr::mutate(turn = glue::glue("{order_match}ª RODADA"))

# Compõe a tooltip dos pontos de resumo
matches <- matches |>
  dplyr::mutate(tooltip = glue::glue(
    "<div class='card-container'>
    
      <div class='card-turn'>
        <div>
          <div class='card-turn-date'>{date}</div>
          {turn}
        </div>
        <div class='card-turn-cumulative'>
          <div class='card-turn-points'>{cumpoints}</div>
          <div class='card-turn-text'>PONTOS NA<br>TEMPORADA</div>
        </div>
      </div>
    
      <div class='card-main'>
        <div class='card-nowgame'>
          <img src='www/badges/{home_logo}.svg'>
          {score}
          <img src='www/badges/{away_logo}.svg'>
        </div>
        <div class='card-past'>
          <div class='card-past-title'>ÚLTIMOS CONFRONTOS</div>
          <div class='card-past-content'>{past}</div>
        </div>
      </div>
    
      <div class='card-history'>
        <div class='card-history-values'>{history}</div>
        <div class='card-history-title'>HISTÓRICO NESSA RODADA</div>
      </div>
    
    </div>"
  )) |> 
  dplyr::mutate(tooltip = ifelse(is.na(date),
                                 "<div class='card-out'>Fora da<br>Série A</div>",
                                 tooltip))

# Mantém apenas os dados de interesse
matches <- matches |>
  dplyr::select(season, date, order_match,
                rival, team, points, score,
                goals_for, goals_against,
                tooltip, home_logo, away_logo)

```

```{r}

# Define as coordenadas dos pontos
matches <- matches |> 
  dplyr::mutate(phi = (2/39)*(as.numeric(order_match)),
                r = as.numeric(season)+10,
                x = r*sinpi(phi),
                y = r*cospi(phi))

# Define as coordenadas dos pontos de resumo
scoring <- scoring |> 
  dplyr::mutate(r = as.numeric(season)+10) |> 
  dplyr::mutate(phi = (2/39)*(39),
                x = r*sinpi(phi),
                y = r*cospi(phi))

# Define as coordenadas dos escudos dos rivais nos "menus"
posY <- seq(30, -30, length.out = 21)
rivals <- rivals |> 
  dplyr::arrange(rival) |> 
  dplyr::mutate(path = stringi::stri_trans_general(rival, "latin-ascii; lower"),
                path = stringr::str_replace_all(path, "[:space:]", "-"),
                path = glue::glue("www/badges/{path}.svg"),
                x = ifelse(row_number() <= (ceiling(nrow(rivals)/2)), -30, 30)) |> 
  dplyr::group_by(x) |> 
  dplyr::mutate(y = posY[1:n()]) |> 
  dplyr::ungroup()

# Define as coordenadas do escudo do clube escolhido
teamdf <- dplyr::tibble(
  x = 0,
  y = 0,
  path = glue::glue("www/badges/{logo_team}.svg")
)

# Gera versão estática do gráfico
estatico <- matches |> 
  ggplot() +
  
  ## Insere os pontos das partidas
  ggiraph::geom_point_interactive(
    aes(x = x, y = y, color = points,
        tooltip = tooltip, data_id = rival),
    size = 0.5
  ) +
  ## Define mapeamentos para os pontos das partidas
  scale_color_discrete(type = c("0" = "#EB3B00", "1" = "white", "3" = "#00CC22"),
                       na.value = "#636363") +
  ## Permite o uso de uma nova escala
  ggnewscale::new_scale_color() +
  
  ## Insere os pontos de resumo das temporadas
  ggiraph::geom_point_interactive(
    aes(x = x, y = y, color = points, tooltip = tooltip),
    size = 1.5, data = scoring
  ) +
  ## Define mapeamentos para os pontos de resumo das temporadas
  scale_color_gradient(low = "#A82A00", high = "#00A81C",
                       na.value = "#636363", limits = c(1,100)) +
  
  ## Insere o menu de escudos dos rivais
  geom_from_path_interactive(
    aes(x = x, y = y, path = path, data_id = rival),
    width = 0.02, height = 0.02, data = rivals
  ) +
  
  ## Insere o escudo do clube ao centro
  ggpath::geom_from_path(
    aes(x = x, y = y, path = path),
    width = 0.2, height = 0.2, data = teamdf
  ) +
  
  ## Insere os anos inicial e final das temporadas analisadas
  annotate("text", x = 0, y = 29.5, color = "#9e9e9e", size = 2,
           family = "Comfortaa", vjust = 0, label = 2023) +
  annotate("text", x = 0, y = 9.5, color = "#9e9e9e", size = 2,
           family = "Comfortaa", vjust = 1, label = 2006) +
  
  ## Insere o nome do clube
  annotate("text", x = 0, y = -8, color = "white", size = 2.3,
           family = "Comfortaa", label = toupper(selected_team)) +
  
  ## Insere segmentos e texto para identificar os turnos
  annotate("segment", x = 0, xend = 0, y = -10.5, yend = -30,
           color = "#9e9e9e", linetype = "dashed", linewidth = 0.3) +
  annotate("text", x = 0, y = -29.5, color = "#9e9e9e", size = 2,
           family = "Comfortaa", hjust = -0.1, vjust = 0.5,
           label = "1º TURNO") +
  annotate("text", x = 0, y = -29.5, color = "#9e9e9e", size = 2,
           family = "Comfortaa", hjust = 1.1, vjust = 0.5,
           label = "2º TURNO") +
  
  ## Garante que os eixos têm a mesma proporção
  coord_equal(xlim = c(-31,31), ylim = c(-31,31)) +
  
  ## Customiza estética
  theme_void() +
  theme(
    legend.position = "none",
    plot.background = element_rect(fill = "black", color = "black")
  ) +
  
  ## Insere os extras
  extras_lbl + extras_img

# Gera a versão interativa do gráfico
ggiraph::girafe(
  ggobj = estatico,
  bg = "black",
  width_svg = 5,
  height_svg = 5,
  options = list(
    ggiraph::opts_tooltip(css = "border-radius:3vmin;color:white;",
                          use_fill = TRUE, opacity = 1),
    ggiraph::opts_hover(css = "stroke:none;"),
    ggiraph::opts_selection(css = "r:2pt;",
                            type = "single",
                            only_shiny = FALSE),
    ggiraph::opts_selection_inv(css = "opacity:0.1;"),
    ggiraph::opts_toolbar(saveaspng = FALSE)
  )
)

```