Relatório Modelo BxMxS

# Função para VIP score por classe
vip_por_classe <- function(modelo, ncomp) {
  X <- modelo$X
  Tcomp <- modelo$variates$X[, 1:ncomp, drop = FALSE]   # scores
  W <- modelo$loadings$X[, 1:ncomp, drop = FALSE]       # loadings X
  Q <- modelo$loadings$Y[, 1:ncomp, drop = FALSE]       # loadings Y
  p <- ncol(X)
  G <- nrow(Q)                                          # nº de classes
  
  VIP <- matrix(0, nrow = p, ncol = G)
  rownames(VIP) <- colnames(X)
  colnames(VIP) <- rownames(Q)                          # nomes das classes
  
  for (g in 1:G) {
    SSg <- rep(0, ncomp)
    for (h in 1:ncomp) {
      th <- Tcomp[, h]
      qhg <- Q[g, h]
      SSg[h] <- sum(th^2) * (qhg^2)
    }
    
    for (j in 1:p) {
      soma_val <- 0
      for (h in 1:ncomp) {
        whj <- W[j, h]
        soma_val <- soma_val + (whj^2) * SSg[h]
      }
      VIP[j, g] <- sqrt(p * soma_val / sum(SSg))
    }
  }
  return(VIP)
}

# Calcular VIP por classe
vip_class <- vip_por_classe(Modelo_final, opt_comp)

vip_df <- as.data.frame(vip_class)
vip_df$Variavel <- rownames(vip_df)

# Formato longo
vip_long <- vip_df %>%
  pivot_longer(-Variavel, names_to = "Classe", values_to = "VIP")

# Top 5 por classe
top5_por_classe <- vip_long %>%
  group_by(Classe) %>%
  slice_max(order_by = VIP, n = 5) %>%
  arrange(Classe, desc(VIP))

# Mostrar tabela interativa dentro do relatório
tabela_vip <- datatable(top5_por_classe,
                        caption = "Top 5 VIP Scores por Classe")

tabela_vip