test_LRP.R
In innsight: Get the Insights of Your Neural Network

test_that("LRP: General errors", {
  library(keras)
  library(torch)

  data <- matrix(rnorm(4 * 10), nrow = 10)
  model <- keras_model_sequential()
  model %>%
    layer_dense(units = 16, activation = "relu", input_shape = c(4)) %>%
    layer_dense(units = 8, activation = "relu") %>%
    layer_dense(units = 3, activation = "softmax")

  converter <- Converter$new(model)

  expect_error(LRP$new(model, data))
  expect_error(LRP$new(converter, model))
  expect_error(LRP$new(converter, data, channels_first = NULL))
  expect_error(LRP$new(converter, data, rule_name = "asdf"))
  expect_error(LRP$new(converter, data, rule_param = "asdf"))
  expect_error(LRP$new(converter, data, dtype = NULL))
})


test_that("LRP: Plot and Boxplot", {
  library(neuralnet)
  library(torch)

  data(iris)
  data <- iris[sample.int(150, size = 10), -5]
  nn <- neuralnet(Species ~ .,
                  iris,
                  linear.output = FALSE,
                  hidden = c(10, 8), act.fct = "tanh", rep = 1, threshold = 0.5
  )
  # create an converter for this model
  converter <- Converter$new(nn)

  # Rescale Rule
  lrp <- LRP$new(converter, data, dtype = "double",
  )

  # ggplot2

  # Non-existing data points
  expect_error(plot(lrp, data_idx = c(1,11)))
  expect_error(boxplot(lrp, data_idx = 1:11))
  # Non-existing class
  expect_error(plot(lrp, output_idx = c(5)))
  expect_error(boxplot(lrp, output_idx = c(5)))

  p <- plot(lrp)
  boxp <- boxplot(lrp)
  expect_s4_class(p, "innsight_ggplot2")
  expect_s4_class(boxp, "innsight_ggplot2")
  p <- plot(lrp, data_idx = 1:3)
  boxp <- boxplot(lrp, data_idx = 1:4)
  expect_s4_class(p, "innsight_ggplot2")
  expect_s4_class(boxp, "innsight_ggplot2")
  p <- plot(lrp, data_idx = 1:3, output_idx = 1:3)
  boxp <- boxplot(lrp, data_idx = 1:5, output_idx = 1:3)
  expect_s4_class(p, "innsight_ggplot2")
  expect_s4_class(boxp, "innsight_ggplot2")

  # plotly
  library(plotly)

  p <- plot(lrp, as_plotly = TRUE)
  boxp <- boxplot(lrp, as_plotly = TRUE)
  expect_s4_class(p, "innsight_plotly")
  expect_s4_class(boxp, "innsight_plotly")
  p <- plot(lrp, data_idx = 1:3, as_plotly = TRUE)
  boxp <- boxplot(lrp, data_idx = 1:4, as_plotly = TRUE)
  expect_s4_class(p, "innsight_plotly")
  expect_s4_class(boxp, "innsight_plotly")
  p <- plot(lrp, data_idx = 1:3, output_idx = 1:3, as_plotly = TRUE)
  boxp <- boxplot(lrp, data_idx = 1:5, output_idx = 1:3, as_plotly = TRUE)
  expect_s4_class(p, "innsight_plotly")
  expect_s4_class(boxp, "innsight_plotly")
})



test_that("LRP: Dense-Net (Neuralnet)", {
  library(neuralnet)
  library(torch)

  data(iris)
  data <- iris[sample.int(150, size = 10), -5]
  nn <- neuralnet(Species ~ .,
                  iris,
                  linear.output = FALSE,
                  hidden = c(10, 8), act.fct = "tanh", rep = 1, threshold = 0.5
  )
  # create an converter for this model
  converter <- Converter$new(nn)

  expect_error(LRP$new(converter, array(rnorm(4 * 2 * 3), dim = c(2, 3, 4))))

  # Simple Rule
  lrp_simple <- LRP$new(converter, data)
  expect_equal(dim(lrp_simple$get_result()), c(10, 4, 3))
  expect_true(
    lrp_simple$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Epsilon Rule
  lrp_eps_default <-
    LRP$new(converter, data, rule_name = "epsilon", dtype = "double")
  expect_equal(dim(lrp_eps_default$get_result()), c(10, 4, 3))
  expect_true(
    lrp_eps_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_eps_1 <- LRP$new(converter, data,
                       rule_name = "epsilon",
                       rule_param = 1,
                       ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_eps_1$get_result()), c(10, 4, 3))
  expect_true(
    lrp_eps_1$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Alpha-Beta Rule
  lrp_ab_default <- LRP$new(converter, data,
                            rule_name = "epsilon",
                            dtype = "double",
                            ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_ab_default$get_result()), c(10, 4, 3))
  expect_true(
    lrp_ab_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_ab_2 <- LRP$new(converter, data, rule_name = "epsilon", rule_param = 2)
  expect_equal(dim(lrp_ab_2$get_result()), c(10, 4, 3))
  expect_true(
    lrp_ab_2$get_result(type = "torch.tensor")$dtype == torch_float()
  )
})



test_that("LRP: Dense-Net (keras)", {
  library(keras)
  library(torch)

  data <- matrix(rnorm(4 * 10), nrow = 10)

  model <- keras_model_sequential()
  model %>%
    layer_dense(units = 16, activation = "relu", input_shape = c(4)) %>%
    layer_dense(units = 8, activation = "tanh") %>%
    layer_dense(units = 3, activation = "softmax")

  converter <- Converter$new(model)

  expect_error(LRP$new(converter, array(rnorm(4 * 2 * 3), dim = c(2, 3, 4))))

  # Simple Rule
  lrp_simple <- LRP$new(converter, data)
  expect_equal(dim(lrp_simple$get_result()), c(10, 4, 3))
  expect_true(
    lrp_simple$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Epsilon Rule
  lrp_eps_default <-
    LRP$new(converter, data, rule_name = "epsilon", dtype = "double")
  expect_equal(dim(lrp_eps_default$get_result()), c(10, 4, 3))
  expect_true(
    lrp_eps_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_eps_1 <- LRP$new(converter, data,
    rule_name = "epsilon",
    rule_param = 1,
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_eps_1$get_result()), c(10, 4, 3))
  expect_true(
    lrp_eps_1$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Alpha-Beta Rule
  lrp_ab_default <- LRP$new(converter, data,
    rule_name = "epsilon",
    dtype = "double",
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_ab_default$get_result()), c(10, 4, 3))
  expect_true(
    lrp_ab_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_ab_2 <- LRP$new(converter, data, rule_name = "epsilon", rule_param = 2)
  expect_equal(dim(lrp_ab_2$get_result()), c(10, 4, 3))
  expect_true(
    lrp_ab_2$get_result(type = "torch.tensor")$dtype == torch_float()
  )
})

test_that("LRP: Conv1D-Net", {
  library(keras)
  library(torch)

  data <- array(rnorm(4 * 64 * 3), dim = c(4, 64, 3))

  model <- keras_model_sequential()
  model %>%
    layer_conv_1d(
      input_shape = c(64, 3), kernel_size = 16, filters = 8,
      activation = "softplus"
    ) %>%
    layer_conv_1d(kernel_size = 16, filters = 4, activation = "tanh") %>%
    layer_conv_1d(kernel_size = 16, filters = 2, activation = "relu") %>%
    layer_flatten() %>%
    layer_dense(units = 64, activation = "relu") %>%
    layer_dense(units = 16, activation = "relu") %>%
    layer_dense(units = 1, activation = "sigmoid")

  # test non-fitted model
  converter <- Converter$new(model)

  expect_error(LRP$new(converter, array(rnorm(4 * 2 * 3), dim = c(2, 3, 4))))

  # Simple Rule
  lrp_simple <- LRP$new(converter, data, channels_first = FALSE)
  expect_equal(dim(lrp_simple$get_result()), c(4, 64, 3, 1))
  expect_true(
    lrp_simple$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Epsilon Rule
  lrp_eps_default <- LRP$new(converter, data,
    rule_name = "epsilon",
    dtype = "double", channels_first = FALSE
  )
  expect_equal(dim(lrp_eps_default$get_result()), c(4, 64, 3, 1))
  expect_true(
    lrp_eps_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_eps_1 <- LRP$new(converter, data,
    rule_name = "epsilon",
    rule_param = 1,
    channels_first = FALSE,
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_eps_1$get_result()), c(4, 64, 3, 1))
  expect_true(
    lrp_eps_1$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Alpha-Beta Rule
  lrp_ab_default <- LRP$new(converter, data,
    rule_name = "epsilon",
    dtype = "double",
    channels_first = FALSE,
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_ab_default$get_result()), c(4, 64, 3, 1))
  expect_true(
    lrp_ab_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_ab_2 <- LRP$new(converter, data,
    rule_name = "epsilon",
    rule_param = 2,
    channels_first = FALSE
  )
  expect_equal(dim(lrp_ab_2$get_result()), c(4, 64, 3, 1))
  expect_true(
    lrp_ab_2$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Different rules
  lrp_mixed_rules <- LRP$new(converter, data,
                             rule_name = list(Dense_Layer = "alpha_beta"),
                             rule_param = list(Dense_Layer = 2),
                             channels_first = FALSE)
  expect_equal(dim(lrp_mixed_rules$get_result()), c(4, 64, 3, 1))

  lrp_mixed_rules <- LRP$new(converter, data,
                             rule_name = list(Dense_Layer = "alpha_beta",
                                              Conv1D_Layer = "epsilon"),
                             rule_param = list(Dense_Layer = 2),
                             channels_first = FALSE)
  expect_equal(dim(lrp_mixed_rules$get_result()), c(4, 64, 3, 1))
  expect_error(LRP$new(converter, data,
                       rule_name = list(Flatten = "alpha_beta",
                                        Conv1D_Layer = "epsilon"),
                       rule_param = list(Dense_Layer = 2),
                       channels_first = FALSE))
})

test_that("LRP: Conv2D-Net", {
  library(keras)
  library(torch)

  data <- array(rnorm(4 * 32 * 32 * 3), dim = c(4, 32, 32, 3))

  model <- keras_model_sequential()
  model %>%
    layer_conv_2d(
      input_shape = c(32, 32, 3), kernel_size = 8, filters = 8,
      activation = "softplus", padding = "same"
    ) %>%
    layer_conv_2d(
      kernel_size = 8, filters = 4, activation = "tanh",
      padding = "same"
    ) %>%
    layer_conv_2d(
      kernel_size = 4, filters = 2, activation = "relu",
      padding = "same"
    ) %>%
    layer_flatten() %>%
    layer_dense(units = 64, activation = "relu") %>%
    layer_dense(units = 16, activation = "relu") %>%
    layer_dense(units = 2, activation = "sigmoid")

  # test non-fitted model
  converter <- Converter$new(model)

  expect_error(LRP$new(converter,
    array(rnorm(4 * 32 * 31, 3), dim = c(4, 32, 31, 3)),
    channels_first = FALSE
  ))

  # Simple Rule
  lrp_simple <-
    LRP$new(converter, data, channels_first = FALSE, ignore_last_act = FALSE)
  expect_equal(dim(lrp_simple$get_result()), c(4, 32, 32, 3, 2))
  expect_true(
    lrp_simple$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Epsilon Rule
  lrp_eps_default <- LRP$new(converter, data,
    rule_name = "epsilon",
    dtype = "double",
    channels_first = FALSE
  )
  expect_equal(dim(lrp_eps_default$get_result()), c(4, 32, 32, 3, 2))
  expect_true(
    lrp_eps_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_eps_1 <- LRP$new(converter, data,
    rule_name = "epsilon",
    rule_param = 1,
    channels_first = FALSE,
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_eps_1$get_result()), c(4, 32, 32, 3, 2))
  expect_true(
    lrp_eps_1$get_result(type = "torch.tensor")$dtype == torch_float()
  )

  # Alpha-Beta Rule
  lrp_ab_default <- LRP$new(converter, data,
    rule_name = "epsilon",
    dtype = "double",
    channels_first = FALSE,
    ignore_last_act = FALSE
  )
  expect_equal(dim(lrp_ab_default$get_result()), c(4, 32, 32, 3, 2))
  expect_true(
    lrp_ab_default$get_result(type = "torch.tensor")$dtype == torch_double()
  )

  lrp_ab_2 <- LRP$new(converter, data,
    rule_name = "epsilon",
    rule_param = 2,
    channels_first = FALSE
  )
  expect_equal(dim(lrp_ab_2$get_result()), c(4, 32, 32, 3, 2))
  expect_true(
    lrp_ab_2$get_result(type = "torch.tensor")$dtype == torch_float()
  )
})


test_that("LRP: Keras model with two inputs + two outputs", {
  library(keras)

  main_input <- layer_input(shape = c(10,10,2), name = 'main_input')
  lstm_out <- main_input %>%
    layer_conv_2d(2, c(2,2)) %>%
    layer_flatten() %>%
    layer_dense(units = 4)
  auxiliary_input <- layer_input(shape = c(5), name = 'aux_input')
  auxiliary_output <- layer_concatenate(c(lstm_out, auxiliary_input)) %>%
    layer_dense(units = 2, activation = 'softmax', name = 'aux_output')
  main_output <- layer_concatenate(c(lstm_out, auxiliary_input)) %>%
    layer_dense(units = 5, activation = 'tanh') %>%
    layer_dense(units = 4, activation = 'tanh') %>%
    layer_dense(units = 2, activation = 'tanh') %>%
    layer_dense(units = 3, activation = 'softmax', name = 'main_output')
  model <- keras_model(
    inputs = c(auxiliary_input, main_input),
    outputs = c(auxiliary_output, main_output)
  )

  converter <- Converter$new(model)
  data <- lapply(list(c(5), c(10,10,2)),
                 function(x) array(rnorm(10 * prod(x)), dim = c(10, x)))

  lrp <- LRP$new(converter, data, channels_first = FALSE,
                       output_idx = list(c(2), c(1,3)))
  result <- lrp$get_result()
  expect_equal(length(result), 2)
  expect_equal(length(result[[1]]), 2)
  expect_equal(dim(result[[1]][[1]]), c(10,5,1))
  expect_equal(dim(result[[1]][[2]]), c(10,10,10,2,1))
  expect_equal(length(result[[2]]), 2)
  expect_equal(dim(result[[2]][[1]]), c(10,5,2))
  expect_equal(dim(result[[2]][[2]]), c(10,10,10,2,2))

  lrp_eps <- LRP$new(converter, data, channels_first = FALSE, rule_name = "epsilon",
                         output_idx = list(c(1), c(1,2)))
  result <- lrp_eps$get_result()
  expect_equal(length(result), 2)
  expect_equal(length(result[[1]]), 2)
  expect_equal(dim(result[[1]][[1]]), c(10,5,1))
  expect_equal(dim(result[[1]][[2]]), c(10,10,10,2,1))
  expect_equal(length(result[[2]]), 2)
  expect_equal(dim(result[[2]][[1]]), c(10,5,2))
  expect_equal(dim(result[[2]][[2]]), c(10,10,10,2,2))

  lrp_ab <- LRP$new(converter, data, channels_first = FALSE, rule_name = "alpha_beta",
                    rule_param = 0.5, output_idx = list(c(2), c(2, 3)))
  result <- lrp_ab$get_result()
  expect_equal(length(result), 2)
  expect_equal(length(result[[1]]), 2)
  expect_equal(dim(result[[1]][[1]]), c(10,5,1))
  expect_equal(dim(result[[1]][[2]]), c(10,10,10,2,1))
  expect_equal(length(result[[2]]), 2)
  expect_equal(dim(result[[2]][[1]]), c(10,5,2))
  expect_equal(dim(result[[2]][[2]]), c(10,10,10,2,2))
})


test_that("LRP: Correctness (CNN)", {
  library(keras)
  library(torch)

  data <- torch_tensor(array(rnorm(10 * 32 * 32 * 3), dim = c(10, 32, 32, 3)) * 5,
                       dtype = torch_double())

  model <- keras_model_sequential()
  model %>%
    layer_conv_2d(
      input_shape = c(32, 32, 3), kernel_size = 8, filters = 8,
      activation = "softplus",
      padding = "valid", use_bias = FALSE
    ) %>%
    layer_conv_2d(
      kernel_size = 8, filters = 4, activation = "tanh",
      padding = "valid", use_bias = FALSE
    ) %>%
    layer_conv_2d(
      kernel_size = 4, filters = 2, activation = "relu",
      padding = "valid", use_bias = FALSE
    ) %>%
    layer_flatten() %>%
    layer_dense(units = 64, activation = "relu", use_bias = FALSE) %>%
    layer_dense(units = 16, activation = "relu", use_bias = FALSE) %>%
    layer_dense(units = 1, activation = "sigmoid", use_bias = FALSE)

  # test non-fitted model
  converter <- Converter$new(model, dtype = "double")

  lrp <- LRP$new(converter, data, channels_first = FALSE, dtype = "double")
  res <- converter$model(data, channels_first = FALSE, save_last_layer = TRUE)
  out <- converter$model$modules_list[[7]]$preactivation
  lrp_result_sum <-
    lrp$get_result(type = "torch.tensor")$sum(dim = c(2, 3, 4))
  expect_lt(as.array(mean(abs(lrp_result_sum - out)^2)), 1e-10)

  lrp <-
    LRP$new(converter, data, channels_first = FALSE, ignore_last_act = FALSE,
            dtype = "double")
  res <- converter$model(data, channels_first = FALSE, save_last_layer = TRUE)
  out <- converter$model$modules_list[[7]]$output - 0.5
  lrp_result_no_last_act_sum <-
    lrp$get_result(type = "torch.tensor")$sum(dim = c(2, 3, 4))
  expect_lt(as.array(mean(abs(lrp_result_no_last_act_sum - out)^2)), 1e-10)
})


test_that("LRP: Correctness (mixed model with add layer)", {
  library(keras)
  library(torch)

  data <- lapply(list(c(12,15,3), c(20), c(10)),
                 function(x) torch_randn(c(10,x), dtype = torch_double()))

  input_1 <- layer_input(shape = c(12,15,3))
  part_1 <- input_1 %>%
    layer_conv_2d(3, c(4,4), activation = "relu", use_bias = FALSE) %>%
    layer_conv_2d(2, c(3,3), activation = "relu", use_bias = FALSE) %>%
    layer_flatten() %>%
    layer_dense(12, activation = "relu", use_bias = FALSE)
  input_2 <- layer_input(shape = c(10))
  part_2 <- input_2 %>%
    layer_dense(12, activation = "relu", use_bias = FALSE)
  input_3 <- layer_input(shape = c(20))
  part_3 <- input_3 %>%
    layer_dense(12, activation = "relu", use_bias = FALSE)

  output <- layer_add(c(part_1, part_3, part_2)) %>%
    layer_dense(10, activation = "relu", use_bias = FALSE) %>%
    layer_dense(1, activation = "linear", use_bias = FALSE)

  model <- keras_model(
    inputs = c(input_1, input_3, input_2),
    outputs = output
  )

  conv <- Converter$new(model)

  lrp <- LRP$new(conv, data, channels_first = FALSE, dtype = "double")

  res_total_true <- as.array(model(lapply(data, as.array)))
  res <- lrp$result[[1]]
  res_total <- as.array(
    res[[1]]$sum(c(2,3,4,5)) + res[[2]]$sum(c(2,3)) + res[[3]]$sum(c(2,3)))

  expect_lt(mean((res_total - res_total_true)^2), 1e-12)
})

test_that("LRP: Correctness (mixed model with concat layer)", {
  library(keras)
  library(torch)

  data <- lapply(list(c(12,15,3), c(20), c(10)),
                 function(x) torch_randn(c(10,x)))

  input_1 <- layer_input(shape = c(12,15,3))
  part_1 <- input_1 %>%
    layer_conv_2d(3, c(4,4), activation = "relu", use_bias = FALSE) %>%
    layer_conv_2d(2, c(3,3), activation = "relu", use_bias = FALSE) %>%
    layer_flatten() %>%
    layer_dense(20, activation = "relu", use_bias = FALSE)
  input_2 <- layer_input(shape = c(10))
  part_2 <- input_2 %>%
    layer_dense(50, activation = "tanh", use_bias = FALSE)
  input_3 <- layer_input(shape = c(20))
  part_3 <- input_3 %>%
    layer_dense(40, activation = "relu", use_bias = FALSE)

  output <- layer_concatenate(c(part_1, part_3, part_2)) %>%
    layer_dense(100, activation = "relu", use_bias = FALSE) %>%
    layer_dense(1, activation = "linear", use_bias = FALSE)

  model <- keras_model(
    inputs = c(input_1, input_3, input_2),
    outputs = output
  )

  conv <- Converter$new(model)

  lrp <- LRP$new(conv, data, channels_first = FALSE)

  res_total_true <- as.array(model(lapply(data, as.array)))
  res <- lrp$result[[1]]
  res_total <- as.array(
    res[[1]]$sum(c(2,3,4,5)) + res[[2]]$sum(c(2,3)) + res[[3]]$sum(c(2,3)))

  expect_lt(mean((res_total - res_total_true)^2), 1e-10)
})