rstudio / keras3

R Interface to Keras
https://keras3.posit.co/
Other
831 stars 282 forks source link

Visualization of Class Activation Maps (CAM) #182

Closed saanasum closed 6 years ago

saanasum commented 6 years ago

Is there a way in R when using R-Keras to visualize CAMs (after global average pooling) as it has been shown for (Python-)Keras? It is described in detail in this post: https://jacobgil.github.io/deeplearning/class-activation-maps

(and relies on in this paper: https://arxiv.org/pdf/1512.04150.pdf)

jjallaire commented 6 years ago

Here's a complete example (with no comments or explanation). I'm actually working on adapting a publication which will have a much more in depth explanation / commentary, but for now at least this might get you going. I'll post a link to the publication here when it's ready.

library(keras)
K <- backend()

model <- application_vgg16(weights = "imagenet") 

image <- get_file("elephant.jpg", "https://goo.gl/zCTWXW") %>% 
  image_load(target_size = c(224, 224)) %>% 
  image_to_array() %>% 
  array_reshape(dim = c(1, 224, 224, 3)) %>% 
  imagenet_preprocess_input()

preds <- model %>% predict(image)
imagenet_decode_predictions(preds, top = 3)[[1]]

# class_name class_description      score
# 1  n02504458  African_elephant 0.78988522
# 2  n01871265            tusker 0.19872670
# 3  n02504013   Indian_elephant 0.01114247

which.max(preds[1,])

# [1] 387

african_elephant_output <- model$output[, 387]
last_conv_layer <- model %>% get_layer("block5_conv3")
grads <- K$gradients(african_elephant_output, last_conv_layer$output)[[1]]
pooled_grads <- K$mean(grads, axis = c(0L, 1L, 2L))
iterate <- K$`function`(list(model$input), 
                        list(pooled_grads, last_conv_layer$output[1,,,])) 

c(pooled_grads_value, conv_layer_output_value) %<-% iterate(list(x))

for (i in 1:512) {
    conv_layer_output_value[,,i] <- 
      conv_layer_output_value[,,i] * pooled_grads_value[[i]] 
}

heatmap <- apply(conv_layer_output_value, c(1,2), mean)

heatmap <- pmax(heatmap, 0) 
heatmap <- heatmap / max(heatmap)

write_heatmap <- function(heatmap, filename, width = 224, height = 224,
                            bg = "white", col = terrain.colors(12)) {
  png(filename, width = width, height = height, bg = bg)
  op = par(mar = c(0,0,0,0))
  on.exit({par(op); dev.off()}, add = TRUE)
  rotate <- function(x) t(apply(x, 2, rev))
  image(rotate(heatmap), axes = FALSE, asp = 1, col = col)
}

write_heatmap(heatmap, "elephant_heatmap.png") 

library(magick) 
library(viridis) 

image <- image_read(img_path) 
info <- image_info(image) 
geometry <- sprintf("%dx%d!", info$width, info$height) 

pal <- col2rgb(viridis(20), alpha = TRUE)
alpha <- floor(seq(0, 255, length = ncol(pal))) 
pal_col <- rgb(t(pal), alpha = alpha, maxColorValue = 255)
write_heatmap(heatmap, "elephant_overlay.png", 
              width = 14, height = 14, bg = NA, col = pal_col) 

image_read("elephant_overlay.png") %>% 
  image_resize(geometry, filter = "quadratic") %>% 
  image_composite(image, operator = "blend", compose_args = "20") %>%
  plot() 
saanasum commented 6 years ago

Wow! Thank you!

I will try it and I will let you know how it works on my example (as post in this issue). Looking forward to your publication.

saanasum commented 6 years ago

I am trying to copy your example and getting an error:

array_reshape(dim = c(1, 224, 224, 3))

The function cannot be found. It is also not listed here: https://keras.rstudio.com/reference/index.html

jjallaire commented 6 years ago

You need to update to the latest version of the keras package with:

devtools::install_github("rstudio/keras")
saanasum commented 6 years ago

> c(pooled_grads_value, conv_layer_output_value) %<-% iterate(list(x)) error in py_resolve_dots(list(...)) : object 'x' not found

I am just a beginner in R. That´s why I cannot fix problems by my own (so far).

uwesterr commented 6 years ago

change to c(pooled_grads_value, conv_layer_output_value) %<-% iterate(list(image)) should fix the problem

saanasum commented 6 years ago

Thank you. Everything Works! If it is okay I would like the issue to remain open because now I want to transfer it to my model and my examples and I guess there will be some difficulties.

rajatrohan commented 4 years ago

Hi , I have copied your code but getting error at this line grads <- k_gradients(african_elephant_output, last_conv_layer$output)[[1]]

Error in py_call_impl(callable, dots$args, dots$keywords) : RuntimeError: tf.gradients is not supported when eager execution is enabled. Use tf.GradientTape instead.

Please help