Meus 2 Centavos: análise das notas

Como extrair as notas dos vídeos

O código para extrair as notas é pra lá de esotérico e usa um monte de funções auxiliares de pacotes do linux. Como o amigo Caio Lente adora falar, meus códigos costumam ter muitas partes móveis…

A obtenção das notas dos filmes passa pelo seguinte fluxo:

1. Baixar os vídeos do youtube
2. Extrair os frames dos vídeos
3. Encontrar a imagem que tem a nota
4. Limpar a imagem que tem a nota
5. Passar um algoritmo de OCR (Optical Character Recognition) na imagem
6. Cruzar com uma base de metadados do YouTube, usando o pacote tuber

Vou explicar brevemente como cada um desses passos foi executado. O código não é totalmente reprodutível pois o código completo com os loops ficaria pouco legível.

Passo 1: Baixar os vídeos

Os vídeos foram baixados usando um pacote chamado youtube-dl. Para instalá-lo num Ubuntu 16.04 podemos rodar

sudo apt install youtube-dl

O download da lista de reprodução do Tiago Belotti de 2015 pode ser realizada rodando, por exemplo:

youtube-dl -f 160 https://www.youtube.com/playlist?list=PLy-phHpv7EKaioTZ39lNd_nvitGNtQadl

Realizei o download numa resolução bem ruim e sem áudio, para ocupar pouco espaço em disco. Faça isso para todos os anos (2013 até 2017) e pronto! Temos os vídeos.

Passo 2: Extrair os frames dos vídeos

Os arquivos de vídeo foram transformados utilizando ffmpeg, também baixado como pacote do linux. Para instalá-lo num Ubuntu 16.04 podemos rodar

sudo apt install ffmpeg

A função tirar_screenshots() recebe o nome de um arquivo de vídeo, cria uma pasta com esse nome e salva os screenshots na pasta.

tirar_screenshots <- function(vfile) {
  # folder and file names
  file_name <- tools::file_path_sans_ext(basename(vfile))
  folder_name <- glue("imgs/{file_name}")
  if (!file.exists(folder_name)) {
    dir.create(folder_name, showWarnings = FALSE, recursive = TRUE)
    out <- glue("{folder_name}/out_")
    # take screenshots
    take_shots <- glue("ffmpeg -y -i '{vfile}' -vf fps=1 '{out}%04d.png'")
    system(take_shots)
  }
}

Basta fazer um loop (com purrr, não for, rs) para processar todos os arquivos de vídeo. Resultado:

Passo 3: Encontrar a imagem que tem a nota

A nota geralmente aparece no canto superior direito da imagem:

Então, vamos recortar esse pedaço e pegar qual imagem tem maior concentração de vermelho. A função cortar_canto() utiliza o magick para pegar o canto da imagem e salva num arquivo temporário.

cortar_canto <- function(img_file) {
  img_file %>% 
    magick::image_read() %>% 
    magick::image_crop("x60+180") %>% 
    magick::image_write(tempfile())
}

A função somar_vermelho() pega a imagem e calcula a quantidade de vermelhos, tirando os casos em que há vermelho conjuntamente com outras cores (como branco, por exemplo).

somar_vermelho <- function(img_file) {
  p <- png::readPNG(img_file)
  if (length(dim(png_img)) != 3) return(0)
  sum(p[,,1] == 1.0 & p[,,2] < 0.1 & p[,,3] < 0.1)
}

Assim, a soma de vermelhos de um arquivo fica

"out_0277.png" %>%
  cortar_canto() %>% 
  somar_vermelho()
# [1] 758

Basta rodar isso para todos os arquivos e depois selecionar a imagem que tem a maior contagem.

Passo 4: Limpar a imagem que tem a nota

A função limpar_imagem() recebe a imagem cortada e faz a limpeza, soltando apenas os números, prontos para receber o algoritmo de OCR.

limpar_imagem <- function(img_cut) {
  tmp <- tempfile()
  # filtros a serem aplicados em cada cor
  parms <- c(red = .9, green = .2, blue = .2)
  png::readPNG(img_cut) %>% 
    purrr::array_branch(3) %>% 
    purrr::map2(parms, ~.x > .y) %>% 
    purrr::map_at(2:3, magrittr::not) %>% 
    purrr::reduce(magrittr::and) %>% 
    magrittr::multiply_by(-1) %>% 
    magrittr::add(1) %>% 
    png::writePNG(tmp)
  tmp
}

"out_0277.png" %>%
  cortar_canto() %>% 
  limpar_imagem()

Passo 5: Passar um algoritmo de OCR

Finalmente, a função pegar_nota() utiliza tesseract para transformar as imagens em números

pegar_nota <- function(img_filtered) {
  # whitelist de numeros
  engine <- tesseract::tesseract(options = list(
    tessedit_char_whitelist = "1234567890."))
  # apply tesseract
  img <- img_filtered %>% 
    magick::image_read() %>% 
    magick::image_trim() %>% 
    tesseract::ocr(engine = engine) %>% 
    readr::parse_number()
}

A utilização final do algoritmo fica assim:

"out_0277.png" %>%
  cortar_canto() %>% 
  limpar_imagem() %>% 
  pegar_nota()
# [1] 8.3

Pronto! Agora é só loopar em todos os arquivos e teremos as notas de todos os filmes.

Infelizmente, o algoritmo de OCR do tesseract não é lá essas coisas, e precisei arrumar muitos desses dados na mão.

Passo 6: Cruzar com uma base de metadados do YouTube

Agora, vamos cruzar com os metadados do youtube. Os nomes dos arquivos baixados pelo youtube-dl vêm com um código no final, por exemplo com UVN6ljuRzp8. É possível utilizar esses códigos no tuber para obter metadados de um vídeo, dessa forma:

## código para obter um token de acesso
# tuber::yt_oauth(
#   "998136489867-5t3tq1g7hbovoj46dreqd6k5kd35ctjn.apps.googleusercontent.com",
#   "MbOSt6cQhhFkwETXKur-L9rN")
detalhes <- tuber::get_video_details("UVN6ljuRzp8")

## pegar nome do filme
purrr::pluck(detalhes, 4, 1, "snippet", "title")
# [1] "JOGO PERIGOSO (Gerald's Game, Netflix, 2017) - Crítica"

## pegar data de disponibilização
purrr::pluck(detalhes, 4, 1, "snippet", "publishedAt")
# [1] "2017-10-07T14:39:54.000Z"

Usei esses metadados para extrair a data de disponibilização dos vídeos. No final, fiquei com a seguinte base de dados com 386 filmes classificados (mostrando apenas 20 linhas):

Análises

Agora que temos uma base de dados, podemos fazer algumas análises!

Primeiro, é claro, vamos fazer os top 20 e os top -20

notas_2cents %>%
  dplyr::select(nm, nota) %>% 
  dplyr::arrange(desc(nota)) %>% 
  utils::head(20) %>% 
  knitr::kable()

Não assistiu a algum desses filmes? Tá na hora de ver!

notas_2cents %>%
  dplyr::select(nm, nota) %>% 
  dplyr::arrange(nota) %>% 
  utils::head(20) %>% 
  knitr::kable()

Já assistiu a algum desses filmes? Meus pêsames!

p <- notas_2cents %>% 
  ggplot(aes(x = data, y = nota, group = nm)) +
  geom_point() +
  geom_smooth(aes(group = 1), method = "lm", se = FALSE) +
  theme_minimal(16)
plotly::ggplotly(p)
## `geom_smooth()` using formula 'y ~ x'
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.