Apr19_21_homework.Rmd

---
title: "041921-homework"
author: "Julin Maloof"
date: "4/17/2021"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r}
library(tidyverse) # metapackage of all tidyverse packages
library(keras)
use_condaenv("r-reticulate")
```

## 1) Repeat the activation visualization (5.4.1) but for a dog image.  Compare to the cat activations.  Any interesting differences, especially in the last layer?


Load our model

```{r}
model <- load_model_hdf5("cats_and_dogs_small_2.h5")
summary(model)
```

Get input image:

```{r}
img_path <- "cats_and_dogs_small/test/dogs/dog.1516.jpg"
img <- image_load(img_path, target_size = c(150, 150))                 
img_tensor <- image_to_array(img)
img_tensor <- array_reshape(img_tensor, c(1, 150, 150, 3))
img_tensor <- img_tensor / 255                                         
dim(img_tensor)                                                        
```

take a look at the image
```{r}
plot(as.raster(img_tensor[1,,,]))
```

now create the model.  Using `keras_model` instead of `keras_sequential_model` allows us to access multiple output layers

```{r}
layer_outputs <- lapply(model$layers[1:8], function(layer) layer$output)      
activation_model <- keras_model(inputs = model$input, outputs = layer_outputs)
```

```{r}
activations <- activation_model %>% predict(img_tensor)         
```

define plotting function
```{r}
plot_channel <- function(channel) {
  rotate <- function(x) t(apply(x, 2, rev))
  image(rotate(channel), axes = FALSE, asp = 1,
        col = topo.colors(12))
}
```

```{r}
first_layer_activation <- activations[[1]]
dim(first_layer_activation)
plot_channel(first_layer_activation[1,,,2])
plot_channel(first_layer_activation[1,,,7])
```
plot them all

```{r}
image_size <- 58
images_per_row <- 16

for (i in 1:8) {

  layer_activation <- activations[[i]]
  layer_name <- model$layers[[i]]$name

  n_features <- dim(layer_activation)[[4]]
  n_cols <- n_features %/% images_per_row

  #png(paste0("cat_activations_", i, "_", layer_name, ".png"),
   #   width = image_size * images_per_row,
  #    height = image_size * n_cols)
  op <- par(mfrow = c(n_cols, images_per_row), mai = rep_len(0.02, 4))

  for (col in 0:(n_cols-1)) {
    for (row in 0:(images_per_row-1)) {
      channel_image <- layer_activation[1,,,(col*images_per_row) + row + 1]
      plot_channel(channel_image)
    }
  }

  par(op)
  #dev.off()
}
```

surprisingly, spot glance seems that many of the same final filters are activated by both.

## 2) Visualize the filters (using the methods from 5.4.2) for the cat/dog model

```{r}
model <- load_model_hdf5("cats_and_dogs_small_2.h5" )
model
```
```{r}
for(i in 1:4) pop_layer(model)
model
```


visualizing the filters

set up the loss function
```{r}
library(tensorflow)
tf$compat$v1$disable_eager_execution()
layer_name <- "conv2d_10"
filter_index <- 1
layer_output <- get_layer(model, layer_name)$output %>%
  layer_reshape(input_shape = list(150,150,3), target_shape = list(148, 148, 32))
loss <- k_mean(layer_output[,,,filter_index]) # average output as a tensor
```


get the gradient associated with the above loss and normalize (RMS)
```{r}
grads <- k_gradients(loss, model$input)[[1]]  
grads <- grads / (k_sqrt(k_mean(k_square(grads))) + 1e-5) # as a tensor
```

now we need to be able to calculate loss and gradient for a given input.  We use iterate for this:
```{r}
iterate <- k_function(list(model$input), list(loss, grads))
c(loss_value, grads_value) %<-%
    iterate(list(array(0, dim = c(1, 150, 150, 3))))
```

put it together into a loop
```{r}
input_img_data <-                                                     
  array(runif(150 * 150 * 3), dim = c(1, 150, 150, 3)) * 20 + 128    # input random image, near grey 
step <- 1
for (i in 1:40) {                                                     
  c(loss_value, grads_value) %<-% iterate(list(input_img_data)) # calculate gradient and loss
  cat("loss: ", loss_value, "\n")
  cat("grads_value: ", grads_value[1,1:5,1,1], "\n")
  input_img_data <- input_img_data + (grads_value * step) # update image     
}

```
gradient ascent because we are increasing the loss?

post process the tensor so that we can dispaly it as an image:

```{r}
deprocess_image <- function(x) {
  dms <- dim(x)
  x <- x - mean(x)                        
  x <- x / (sd(x) + 1e-5)                 
  x <- x * 0.1                            
  x <- x + 0.5                            
  x <- pmax(0, pmin(x, 1))                
  array(x, dim = dms)                     
}
```

put it all together in a function
```{r}
generate_pattern <- function(layer_name, filter_index, size = 150) {
  print(layer_name)
  layer_output <- model$get_layer(layer_name)$output %>%
    layer_reshape(input_shape=list(150,150,3),
                  target_shape = list(148,148,32))
  loss <- k_mean(layer_output[,,,filter_index])                           
  grads <- k_gradients(loss, model$input)[[1]]                            
  grads <- grads / (k_sqrt(k_mean(k_square(grads))) + 1e-5)               
  iterate <- k_function(list(model$input), list(loss, grads))             
  input_img_data <-                                                       
    array(runif(size * size * 3), dim = c(1, size, size, 3)) * 20 + 128   
  step <- 1                                                               
  for (i in 1:40) {                                                       
    c(loss_value, grads_value) %<-% iterate(list(input_img_data))         
    input_img_data <- input_img_data + (grads_value * step)               
  }                                                                       
  img <- input_img_data[1,,,]
  deprocess_image(img)
}
```

```{r}
library(grid)
grid.raster(generate_pattern("conv2d_10", 1))
```

```{r, eval=FALSE}
library(grid)
library(gridExtra)
dir.create("catdog_filters")
for (layer_name in c("conv2d_10", "conv2d_9",
                     "conv2d_8", "conv2d_7")) {
  size <- 150

  png(paste0("catdog_filters/", layer_name, ".png"),
      width = 5 * size, height = 5 * size)

  grobs <- list()
  for (i in 0:4) {
    for (j in 0:4) {
      print(i+j*5+1)
      pattern <- generate_pattern(layer_name, i + (j*5) + 1, size = size)
      grob <- rasterGrob(pattern,
                         width = unit(0.9, "npc"),
                         height = unit(0.9, "npc"))
      grobs[[length(grobs)+1]] <- grob
    }
  }

  grid.arrange(grobs = grobs, ncol = 8)
  dev.off()
}
```


## 3) Run the attached image through the cat/dog categorization.  Does it categorize correctly?  Make a heatmap showing which areas of the image contributed (5.4.3)


```{r}
model <- load_model_hdf5("cats_and_dogs_small_2.h5") 
model
```

```{r}
img_path <- "_MG_2350.jpg"              
img <- image_load(img_path, target_size = c(150, 150)) %>%           
  image_to_array() %>%                                               
  array_reshape(dim = c(1, 150, 150, 3)) %>%                         
  imagenet_preprocess_input()                                        
```

```{r}
 preds <- model %>% predict(img)
preds
```

```{r}
summary(model)
```


```{r}
dog_output <- model$output                             
last_conv_layer <- model %>% get_layer("conv2d_7")      

grads <- k_gradients(dog_output, last_conv_layer$output)[[1]] 

pooled_grads <- k_mean(grads, axis = c(1, 2, 3))                           
iterate <- k_function(list(model$input),                                   
                      list(pooled_grads, last_conv_layer$output[1,,,]))

c(pooled_grads_value, conv_layer_output_value) %<-% iterate(list(img))     
for (i in 1:128) {       # 128 channels                                             
  conv_layer_output_value[,,i] <-
    conv_layer_output_value[,,i] * pooled_grads_value[[i]]
}
heatmap <- apply(conv_layer_output_value, c(1,2), mean)                    
```



```{r}
heatmap <- pmax(heatmap, 0)
heatmap <- heatmap / max(heatmap)                                          
write_heatmap <- function(heatmap, filename, width = 150, height = 150,    
                          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, "dog_heatmap.png")                             
```

```{r}
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()
```