Aviso importante: este documento é autossuficiente e não usa o pacote
recommenderlab. Implementamos UBCF/IBCF comMatrix+proxye código próprio.
Antes de compilar, garanta no Console:install.packages(c("tidyverse","data.table","Matrix","proxy","knitr"))
Nesta seção executamos exatamente o pedido: carregar
os CSVs, juntar quando houver metadados, tratar
ausências (nota -1 → NA), filtrar
densidade e converter em matriz
usuário–item.
O que fazemos e por quê
- Leitura robusta (usa fread; se falhar, cai em
read.csv) para evitar problemas de encoding/aspas.
- Normalizamos nomes de colunas para user_id,
anime_id, rating (há variações nos
datasets).
knitr::opts_chunk$set(message = TRUE, warning = TRUE, error = TRUE)
# Checagem de pacotes (sem instalar durante o knit)
req <- c("tidyverse","data.table","Matrix","proxy","knitr")
missing <- setdiff(req, rownames(installed.packages()))
if (length(missing)) {
stop("Pacotes ausentes: ", paste(missing, collapse=", "),
". Instale no Console: install.packages(c('tidyverse','data.table','Matrix','proxy','knitr'))")
}
library(tidyverse); library(data.table); library(Matrix); library(proxy); library(knitr)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
##
## Attaching package: 'data.table'
##
##
## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year
##
##
## The following objects are masked from 'package:dplyr':
##
## between, first, last
##
##
## The following object is masked from 'package:purrr':
##
## transpose
##
##
##
## Attaching package: 'Matrix'
##
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
##
##
## Attaching package: 'proxy'
##
##
## The following object is masked from 'package:Matrix':
##
## as.matrix
##
##
## The following objects are masked from 'package:stats':
##
## as.dist, dist
##
##
## The following object is masked from 'package:base':
##
## as.matrixset.seed(42)
# Caminhos (ajuste em Knit with Parameters, se preciso)
anime_path <- params$anime_path
rating_path <- params$rating_path
# Leitura robusta
read_csv_safe <- function(path){
tryCatch(
data.table::fread(path, sep = ",", encoding = "UTF-8", quote = ""),
error = function(e){
message("fread falhou → usando read.csv: ", e$message)
read.csv(path, check.names = TRUE)
}
)
}
anime_df <- read_csv_safe(anime_path)
rating_df <- read_csv_safe(rating_path)
# Normalização de nomes comuns
norm_col <- function(x, from, to){ if (from %in% names(x)) names(x)[names(x)==from] <- to; x }
rating_df <- rating_df %>%
as.data.frame() %>%
rename_with(tolower) %>%
{norm_col(., "user", "user_id")} %>%
{norm_col(., "userid", "user_id")} %>%
{norm_col(., "animeid", "anime_id")} %>%
{norm_col(., "itemid", "anime_id")} %>%
{norm_col(., "item_id", "anime_id")} %>%
{norm_col(., "rating_user", "rating")}
list(dims_anime = dim(anime_df), cols_anime = names(anime_df)[1:min(10,length(names(anime_df)))],
dims_rating = dim(rating_df), cols_rating = names(rating_df)[1:min(10,length(names(rating_df)))])## $dims_anime
## [1] 646600 4
##
## $cols_anime
## [1] "\"\"" "\"user_id\"" "\"anime_id\"" "\"rating\""
##
## $dims_rating
## [1] 646600 4
##
## $cols_rating
## [1] "\"\"" "\"user_id\"" "\"anime_id\"" "\"rating\""O que fazemos e por quê
- Em rating.csv, a nota -1 significa
“assistiu, mas não avaliou” → NA.
- Se anime.csv tiver metadados e a chave
anime_id, realizamos left join para trazer
descrições.
# -1 -> NA
if ("rating" %in% names(rating_df)) rating_df$rating <- dplyr::na_if(rating_df$rating, -1)
detail_cols <- c("name","genre","type","episodes","members","producers","studios")
has_details <- ("anime_id" %in% names(anime_df)) && any(detail_cols %in% names(anime_df))
if (has_details) {
anime_info <- anime_df %>% distinct(anime_id, .keep_all = TRUE)
ratings_all <- left_join(rating_df, anime_info, by = "anime_id")
} else {
message("Aviso: 'anime.csv' sem metadados suficientes; seguimos só com ratings.")
ratings_all <- rating_df
}## Aviso: 'anime.csv' sem metadados suficientes; seguimos só com ratings.head(ratings_all)## "" "user_id" "anime_id" "rating"
## 1 "1" 54 1 -1
## 2 "2" 54 5 -1
## 3 "3" 54 7 -1
## 4 "4" 54 15 -1
## 5 "5" 54 16 -1
## 6 "6" 54 20 -1O que fazemos e por quê
- Modelos baseados em vizinhança sofrem com esparsidade
extrema.
- Aplicamos filtros mínimos de quantidade de avaliações por usuário e
por item.
ratings_clean <- ratings_all %>%
filter(!is.na(rating) & is.finite(rating) & rating >= 1) %>%
group_by(user_id) %>% filter(n() >= params$min_user_ratings) %>% ungroup() %>%
group_by(anime_id) %>% filter(n() >= params$min_item_ratings) %>% ungroup()## Error in `filter()`:
## ℹ In argument: `!is.na(rating) & is.finite(rating) & rating >= 1`.
## Caused by error:
## ! objeto 'rating' não encontrado# Amostra opcional para acelerar
if (!is.null(params$sample_max_users)) {
users <- ratings_clean %>% distinct(user_id) %>% pull(user_id)
if (length(users) > params$sample_max_users) {
keep <- sample(users, params$sample_max_users)
ratings_clean <- ratings_clean %>% filter(user_id %in% keep)
}
}## Error: objeto 'ratings_clean' não encontradosummary(list(n_users = n_distinct(ratings_clean$user_id),
n_items = n_distinct(ratings_clean$anime_id),
n_ratings= nrow(ratings_clean)))## Error in h(simpleError(msg, call)): erro na avaliação do argumento 'object' na seleção do método para a função 'summary': 'objeto 'ratings_clean' não encontrado'O que fazemos e por quê
- CF opera sobre uma matriz Usuário × Item.
- Usamos uma matriz esparsa
(Matrix::sparseMatrix) para eficiência de memória.
ui <- ratings_clean %>% select(user_id, anime_id, rating)## Error: objeto 'ratings_clean' não encontradoU <- factor(ui$user_id)## Error: objeto 'ui' não encontradoI <- factor(ui$anime_id)## Error: objeto 'ui' não encontradoR <- sparseMatrix(i = as.integer(U),
j = as.integer(I),
x = ui$rating,
dims = c(nlevels(U), nlevels(I)),
dimnames = list(levels(U), levels(I)))## Error: objeto 'U' não encontradototal <- nrow(R)*ncol(R)## Error: objeto 'R' não encontradosparsity <- 1 - length(R@x)/total## Error: objeto 'R' não encontradolist(dim = dim(R), sparsity = round(sparsity, 4))## Error: objeto 'R' não encontradoO que fazemos e por quê
- Para cada usuário, mantemos
given_per_user itens no treino e
escondemos o restante no teste.
- Predizemos apenas onde existe ground-truth no teste
(itens escondidos).
given <- params$given_per_user
R_train <- R## Error: objeto 'R' não encontradoR_test <- Matrix(0, nrow=nrow(R), ncol=ncol(R), dimnames=dimnames(R))## Error: objeto 'R' não encontradoset.seed(42)
for (u in seq_len(nrow(R))) {
row <- R[u,]
obs <- which(row != 0)
if (length(obs) > given) {
keep <- sample(obs, given)
test_items <- setdiff(obs, keep)
if (length(test_items)) {
R_train[u, test_items] <- 0
R_test[u, test_items] <- R[u, test_items]
}
}
}## Error: objeto 'R' não encontradolist(train_nnz = length(R_train@x), test_nnz = length(R_test@x))## Error: objeto 'R_train' não encontradoO que fazemos e por quê
- Similaridades calculadas com proxy::simil, suportando
NA via use="pairwise.complete.obs".
- Z-score por usuário/por item reduz viés de escala
(usuários que dão notas altas/baixas).
as_dense_na <- function(M){ A <- as.matrix(M); A[A==0] <- NA; A }
row_zscore <- function(M){
mu <- rowMeans(M, na.rm = TRUE)
sdv <- apply(M, 1, sd, na.rm = TRUE)
sdv[sdv == 0 | is.na(sdv)] <- 1
sweep(sweep(M, 1, mu, "-"), 1, sdv, "/")
}
col_zscore <- function(M){
mu <- colMeans(M, na.rm = TRUE)
sdv <- apply(M, 2, sd, na.rm = TRUE)
sdv[sdv == 0 | is.na(sdv)] <- 1
sweep(sweep(M, 2, mu, "-"), 2, sdv, "/")
}
# Similaridade entre usuários (linhas) ou itens (colunas)
sim_matrix <- function(M, by = c("row","col"), method = "cosine"){
by <- match.arg(by)
A <- as_dense_na(M)
if (by == "row") as.matrix(proxy::simil(A, method = method, by_rows = TRUE, use = "pairwise.complete.obs"))
else as.matrix(proxy::simil(A, method = method, by_rows = FALSE, use = "pairwise.complete.obs"))
}O que fazemos e por quê
- UBCF: média ponderada das notas (em escala
z-score) dos k usuários mais
similares.
- IBCF: média ponderada das notas (em escala
z-score) dos k itens mais similares
avaliados pelo usuário.
- Reescalamos para a unidade original (desfazendo o z-score) usando a
média e o desvio padrão do usuário/ item.
predict_ubcf <- function(Rtr, Rte, k = 20, method = "cosine"){
A <- as_dense_na(Rtr)
Z <- row_zscore(A)
Su <- sim_matrix(Rtr, by = "row", method = method); diag(Su) <- 0
users <- rownames(A)
pred <- matrix(NA_real_, nrow=nrow(A), ncol=ncol(A), dimnames=dimnames(A))
mu_u <- rowMeans(A, na.rm = TRUE)
sd_u <- apply(A, 1, sd, na.rm = TRUE); sd_u[sd_u==0 | is.na(sd_u)] <- 1
Tte <- as.matrix(Rte)
for (u in users){
jidx <- which(Tte[u,] != 0) # apenas itens escondidos (test)
if (!length(jidx)) next
neigh <- order(Su[u,], decreasing = TRUE)[1:min(k, nrow(A)-1)]
w <- Su[u, neigh]
if (all(w == 0)) next
Znei <- Z[neigh, jidx, drop = FALSE]
W <- matrix(w, nrow = length(neigh), ncol = length(jidx))
Znei_f <- ifelse(is.na(Znei), 0, Znei)
num <- colSums(Znei_f * W)
den <- colSums((!is.na(Znei)) * abs(W))
zhat <- num / pmax(den, 1e-9)
pred[u, jidx] <- mu_u[u] + sd_u[u] * zhat
}
pred
}
predict_ibcf <- function(Rtr, Rte, k = 20, method = "cosine"){
A <- as_dense_na(Rtr)
Z <- col_zscore(A)
Si <- sim_matrix(Rtr, by = "col", method = method); diag(Si) <- 0
users <- rownames(A)
pred <- matrix(NA_real_, nrow=nrow(A), ncol=ncol(A), dimnames=dimnames(A))
mu_i <- colMeans(A, na.rm = TRUE)
sd_i <- apply(A, 2, sd, na.rm = TRUE); sd_i[sd_i==0 | is.na(sd_i)] <- 1
Tte <- as.matrix(Rte)
for (u in users){
jidx <- which(Tte[u,] != 0)
if (!length(jidx)) next
known <- which(!is.na(A[u,]))
if (!length(known)) next
for (j in jidx){
sims <- Si[known, j]
ord <- order(sims, decreasing = TRUE)
topk <- ord[1:min(k, length(ord))]
w <- sims[topk]
r <- Z[u, known[topk]]
if (all(w == 0) || all(is.na(r))) next
zhat <- sum(w * ifelse(is.na(r), 0, r)) / sum(abs(w) * (!is.na(r)))
pred[u, j] <- mu_i[j] + sd_i[j] * zhat
}
}
pred
}metrics <- function(pred, truth){
idx <- which(truth != 0 & is.finite(pred))
yhat <- pred[idx]; y <- truth[idx]
mse <- mean((yhat - y)^2, na.rm = TRUE)
rmse <- sqrt(mse)
mae <- mean(abs(yhat - y), na.rm = TRUE)
tibble(MSE = mse, RMSE = rmse, MAE = mae)
}ks <- params$ks
sim_method <- params$similarity
Rtr <- R_train; Rte <- as.matrix(R_test)## Error: objeto 'R_train' não encontradoresults <- tibble()
for (k in ks){
# UBCF
pU <- predict_ubcf(Rtr, Rte, k = k, method = sim_method)
mU <- metrics(pU, Rte) %>% mutate(Model = "UBCF", k = k, Similarity = sim_method)
results <- bind_rows(results, mU)
# IBCF
pI <- predict_ibcf(Rtr, Rte, k = k, method = sim_method)
mI <- metrics(pI, Rte) %>% mutate(Model = "IBCF", k = k, Similarity = sim_method)
results <- bind_rows(results, mI)
}## Error: objeto 'Rtr' não encontradoknitr::kable(results %>% arrange(Model, k), digits = 4,
caption = "Desempenho de predição de notas (MSE, RMSE, MAE) por modelo e k")## Error in `arrange()`:
## ℹ In argument: `..1 = Model`.
## Caused by error:
## ! objeto 'Model' não encontradorecommenderlab torna o relatório
portável e fácil de compilar.similarity = "pearson", refinar
k e, se desejar, adicionar reamostragem (cross-validation)
para estimativas mais estáveis.