Closed saanasum closed 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()
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.
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
You need to update to the latest version of the keras package with:
devtools::install_github("rstudio/keras")
> 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).
change to
c(pooled_grads_value, conv_layer_output_value) %<-% iterate(list(image))
should fix the problem
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.
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
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)