library(keras)
# Utility functions -------------------------------------------------------
# Util function to open, resize, and format pictures into tensors that Inception V3 can process
preprocess_image <- function(image_path) {
image_load(image_path) %>%
image_to_array() %>%
array_reshape(dim = c(1, dim(.))) %>%
inception_v3_preprocess_input()
}
# Util function to convert a tensor into a valid image
deprocess_image <- function(img) {
img <- array_reshape(img, dim = c(dim(img)[[2]], dim(img)[[3]], 3))
# Undoes preprocessing that was performed by `imagenet_preprocess_input`
img <- img / 2
img <- img + 0.5
img <- img * 255
dims <- dim(img)
img <- pmax(0, pmin(img, 255))
dim(img) <- dims
img
}
resize_img <- function(img, size) {
image_array_resize(img, size[[1]], size[[2]])
}
save_img <- function(img, fname) {
img <- deprocess_image(img)
image_array_save(img, fname)
}
# Model ----------------------------------------------
# You won't be training the model, so this command disables all training-specific operations.
k_set_learning_phase(0)
# Builds the Inception V3 network, without its convolutional base. The model will be loaded with pretrained ImageNet weights.
model <- application_inception_v3(weights = "imagenet",
include_top = FALSE)
# Named list mapping layer names to a coefficient quantifying how much the layer's activation contributes to the loss you'll seek to maximize. Note that the layer names are hardcoded in the built-in Inception V3 application. You can list all layer names using `summary(model)`.
layer_contributions <- list(
mixed2 = 0.2,
mixed3 = 3,
mixed4 = 2,
mixed5 = 1.5
)
# You'll define the loss by adding layer contributions to this scalar variable
loss <- k_variable(0)
for (layer_name in names(layer_contributions)) {
coeff <- layer_contributions[[layer_name]]
# Retrieves the layer's output
activation <- get_layer(model, layer_name)$output
scaling <- k_prod(k_cast(k_shape(activation), "float32"))
# Retrieves the layer's output
loss <- loss + (coeff * k_sum(k_square(activation)) / scaling)
}
# Retrieves the layer's output
dream <- model$input
# Computes the gradients of the dream with regard to the loss
grads <- k_gradients(loss, dream)[[1]]
# Normalizes the gradients (important trick)
grads <- grads / k_maximum(k_mean(k_abs(grads)), 1e-7)
outputs <- list(loss, grads)
# Sets up a Keras function to retrieve the value of the loss and gradients, given an input image
fetch_loss_and_grads <- k_function(list(dream), outputs)
eval_loss_and_grads <- function(x) {
outs <- fetch_loss_and_grads(list(x))
loss_value <- outs[[1]]
grad_values <- outs[[2]]
list(loss_value, grad_values)
}
# Run gradient ascent -----------------------------------------------------
# This function runs gradient ascent for a number of iterations.
gradient_ascent <-
function(x, iterations, step, max_loss = NULL) {
for (i in 1:iterations) {
c(loss_value, grad_values) %<-% eval_loss_and_grads(x)
if (!is.null(max_loss) && loss_value > max_loss)
break
cat("...Loss value at", i, ":", loss_value, "\n")
x <- x + (step * grad_values)
}
x
}
# Playing with these hyperparameters will let you achieve new effects.
# Gradient ascent step size
step <- 0.01
# Number of scales at which to run gradient ascent
num_octave <- 3
# Size ratio between scales
octave_scale <- 1.4
# Number of ascent steps to run at each scale
iterations <- 20
# If the loss grows larger than 10, we will interrupt the gradient-ascent process to avoid ugly artifacts.
max_loss <- 10
# Fill this with the path to the image you want to use.
base_image_path <- "/tmp/mypic.jpg"
# Loads the base image into an array
img <-
preprocess_image(base_image_path)
# Prepares a list of shape tuples defining the different scales at which to run gradient ascent
original_shape <- dim(img)[-1]
successive_shapes <-
list(original_shape)
for (i in 1:num_octave) {
shape <- as.integer(original_shape / (octave_scale ^ i))
successive_shapes[[length(successive_shapes) + 1]] <-
shape
}
# Reverses the list of shapes so they're in increasing order
successive_shapes <-
rev(successive_shapes)
original_img <- img
# Resizes the array of the image to the smallest scale
shrunk_original_img <-
resize_img(img, successive_shapes[[1]])
for (shape in successive_shapes) {
cat("Processing image shape", shape, "\n")
# Scales up the dream image
img <- resize_img(img, shape)
# Runs gradient ascent, altering the dream
img <- gradient_ascent(img,
iterations = iterations,
step = step,
max_loss = max_loss)
# Scales up the smaller version of the original image: it will be pixellated
upscaled_shrunk_original_img <-
resize_img(shrunk_original_img, shape)
# Computes the high-quality version of the original image at this size
same_size_original <-
resize_img(original_img, shape)
# The difference between the two is the detail that was lost when scaling up
lost_detail <-
same_size_original - upscaled_shrunk_original_img
# Reinjects lost detail into the dream
img <- img + lost_detail
shrunk_original_img <-
resize_img(original_img, shape)
save_img(img, fname = sprintf("dream_at_scale_%s.png",
paste(shape, collapse = "x")))
}
