torch_perdas.R

# carregando dados do exemplo ---------------------------------------------

# exemplo daqui: https://mlverse.github.io/luz/articles/examples/mnist-cnn.html

library(torch)
library(torchvision)
library(luz)

dir <- "./mnist" 

# bases de treino e teste
train_ds <- mnist_dataset(
  dir,
  download = TRUE,
  transform = transform_to_tensor,
  # modifiquei aqui para que seja um problema binário, não multiclass
  target_transform = function(x) ifelse(x == 3, 0, 1)
)

test_ds <- mnist_dataset(
  dir,
  train = FALSE,
  transform = transform_to_tensor,
  target_transform = function(x) ifelse(x == 3, 0, 1)
)

train_dl <- dataloader(train_ds, batch_size = 128, shuffle = TRUE)
test_dl <- dataloader(test_ds, batch_size = 128)

# saída logit, perda bce --------------------------------------------------

set.seed(1)
torch_manual_seed(1)

# pegando um batch para exemplo
batch <- train_dl$.iter()$.next()
x <- batch[[1]]
y <- batch[[2]]


set.seed(1)
torch_manual_seed(1)

net_logit <- nn_module(
  "Net Logit",
  initialize = function() {
    self$conv1 <- nn_conv2d(1, 32, 3, 1)
    self$conv2 <- nn_conv2d(32, 64, 3, 1)
    self$dropout1 <- nn_dropout(0.25)
    self$dropout2 <- nn_dropout(0.5)
    self$fc1 <- nn_linear(9216, 128)
    self$fc2 <- nn_linear(128, 1)
  },
  forward = function(x) {
    res <- x %>% 
      self$conv1() %>% 
      nnf_relu() %>% 
      self$conv2() %>% 
      nnf_relu() %>% 
      nnf_max_pool2d(2) %>% 
      self$dropout1() %>% 
      torch_flatten(start_dim = 2) %>% 
      self$fc1() %>% 
      nnf_relu() %>% 
      self$dropout2() %>% 
      # veja que o último passo é apenas uma camada linear, então
      # o intervalo de variação aqui é de -Inf a Inf
      self$fc2()
    
    res[,1]
  }
)

# exemplo numérico

(res_logit <- net_logit()(x))

nnf_binary_cross_entropy_with_logits(
  res_logit,
  batch[[2]]
)

# torch_tensor
# 0.684815
# [ CPUFloatType{} ][ grad_fn = <BinaryCrossEntropyWithLogitsBackward0> ]

# saída probabilidade, perda bce ------------------------------------------

set.seed(1)
torch_manual_seed(1)

net_prob <- nn_module(
  "Net Logit",
  initialize = function() {
    self$conv1 <- nn_conv2d(1, 32, 3, 1)
    self$conv2 <- nn_conv2d(32, 64, 3, 1)
    self$dropout1 <- nn_dropout(0.25)
    self$dropout2 <- nn_dropout(0.5)
    self$fc1 <- nn_linear(9216, 128)
    self$fc2 <- nn_linear(128, 1)
  },
  forward = function(x) {
    res <- x %>% 
      self$conv1() %>% 
      nnf_relu() %>% 
      self$conv2() %>% 
      nnf_relu() %>% 
      nnf_max_pool2d(2) %>% 
      self$dropout1() %>% 
      torch_flatten(start_dim = 2) %>% 
      self$fc1() %>% 
      nnf_relu() %>% 
      self$dropout2() %>% 
      self$fc2() %>%
      # agora colocamos uma sigmoide
      nnf_sigmoid()
    
    res[,1]
  }
)

# exemplo numerico
(res_prob <- net_prob()(x))

# veja que a perda é a mesma que antes (se o set seed foi colocado corretamente)
nnf_binary_cross_entropy(
  res_prob,
  batch[[2]]
)

# torch_tensor
# 0.684815
# [ CPUFloatType{} ][ grad_fn = <BinaryCrossEntropyBackward0> ]

# saída chance, perda bce modificada --------------------------------------

set.seed(1)
torch_manual_seed(1)

net_odds <- nn_module(
  "Net Logit",
  initialize = function() {
    self$conv1 <- nn_conv2d(1, 32, 3, 1)
    self$conv2 <- nn_conv2d(32, 64, 3, 1)
    self$dropout1 <- nn_dropout(0.25)
    self$dropout2 <- nn_dropout(0.5)
    self$fc1 <- nn_linear(9216, 128)
    self$fc2 <- nn_linear(128, 1)
  },
  forward = function(x) {
    res <- x %>% 
      self$conv1() %>% 
      nnf_relu() %>% 
      self$conv2() %>% 
      nnf_relu() %>% 
      nnf_max_pool2d(2) %>% 
      self$dropout1() %>% 
      torch_flatten(start_dim = 2) %>% 
      self$fc1() %>% 
      nnf_relu() %>% 
      self$dropout2() %>% 
      self$fc2() %>%
      # agora colocamos uma ativação que retorna valores positivos,
      # como a softplus, que você mencionou
      nnf_softplus()
    
    res[,1]
    
  }
)

# exemplo numérico
(res_odds <- net_odds()(x))

# inversa da softplus
nnf_inv_softplus <- function(x) {
  torch_log(torch_exp(x) - 1)
}

# a perda novamente é a mesma
nnf_binary_cross_entropy_with_logits(
  nnf_inv_softplus(res_odds),
  batch[[2]]
)

# torch_tensor
# 0.684815
# [ CPUFloatType{} ][ grad_fn = <BinaryCrossEntropyWithLogitsBackward0> ]

# criando uma perda nova

nnf_binary_cross_entropy_with_odds <- function(input, target, ...) {
  nnf_binary_cross_entropy_with_logits(
    nnf_inv_softplus(input),
    target,
    ...
  )
}

nnf_binary_cross_entropy_with_odds(
  res_odds,
  batch[[2]]
)

# torch_tensor
# 0.684815
# [ CPUFloatType{} ][ grad_fn = <BinaryCrossEntropyWithLogitsBackward0> ]

# fizemos uma perda nova com nnf, mas precisamos criar um módulo
# para usar no luz e ajustar o modelo

# isso será usado na hora de dar fit no modelo
# referência: https://github.com/mlverse/torch/blob/9da75b29ac4a2430c5c91690a77eefaf0e6f5c71/R/nn-loss.R#L449
nn_bce_loss_with_odds <- nn_module(
  "nn_bce_loss_with_odds",
  inherit = torch:::nn_weighted_loss,
  initialize = function(weight = NULL, reduction = "mean") {
    super$initialize(weight, reduction)
  },
  forward = function(input, target) {
    # mudamos apenas aqui da versão original
    nnf_binary_cross_entropy_with_odds(input, target, weight = self$weight, reduction = self$reduction)
  }
)

# ajuste dos modelos ------------------------------------------------------

set.seed(1)
torch_manual_seed(1)

# ajuste do modelo logit
fitted_logit <- net_logit %>%
  setup(
    # veja a perda aqui, com logits
    loss = nn_bce_with_logits_loss(),
    optimizer = optim_adam
  ) %>%
  # coloquei uma epoch só para rodar rápido
  fit(train_dl, epochs = 1, valid_data = test_dl)

# Epoch 1/1
# Train metrics: Loss: 0.0915                                                                                                         
# Valid metrics: Loss: 0.0287

set.seed(1)
torch_manual_seed(1)

# ajuste do modelo prob
fitted_prob <- net_prob %>%
  setup(
    # veja a perda aqui, com probabilidade
    loss = nn_bce_loss(),
    optimizer = optim_adam
  ) %>%
  # coloquei uma epoch só para rodar rápido
  fit(train_dl, epochs = 1, valid_data = test_dl)

## não fica exatamente igual, mas muito parecido
# Epoch 1/1
# Train metrics: Loss: 0.0913                                                                                                         
# Valid metrics: Loss: 0.0283

set.seed(1)
torch_manual_seed(1)

# ajuste do modelo odds / chance
fitted_odds <- net_odds %>%
  setup(
    # veja a perda aqui, com odds
    loss = nn_bce_loss_with_odds(),
    optimizer = optim_adam
  ) %>%
  # coloquei uma epoch só para rodar rápido
  fit(train_dl, epochs = 1, valid_data = test_dl)

## não fica exatamente igual, mas muito parecido
# Epoch 1/1
# Train metrics: Loss: 0.0911                                                                                                         
# Valid metrics: Loss: 0.0284

# conclusões/opinião ------------------------------------------------------

# esses três modelos são, essencialmente, os mesmos
# o que muda é que as redes neurais terão um output diferente
# (logit, probabilidade e odds/chance).

# o motivo é que estamos sempre com a mesma loss, a cross entropy,
# que é a loss derivada da distribuição bernoulli utilizando
# divergência de Kullback-Leibler. O formato da saída do modelo
# não é tão relevante.

# na prática, você poderia usar sempre a bce with logits,
# para garantir estabilidade numérica, a menos que exista alguma
# aplicação muito específica para seu caso