-
Notifications
You must be signed in to change notification settings - Fork 2
/
vgg.R
245 lines (164 loc) · 7.89 KB
/
vgg.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
library(keras)
library(tensortree)
library(ggplot2)
library(tidyr)
library(dplyr)
# build a dataframe with one column listing the filenames, recursive = TRUE lists everything in all subfolders,
# include.dirs = FALSE says not to include the directories themselves in the listing
image_metadata <- data.frame(filename = list.files("datasets/PlantVillage/Tomato",
recursive = TRUE,
include.dirs = FALSE),
stringsAsFactors = FALSE)
# lets only keep 4k images to make it tougher
random_indices <- sample(1:nrow(image_metadata), size = 4000)
image_metadata <- image_metadata[random_indices,, drop = FALSE]
# extract a "class" column using tidyr's extract() function; class is everything up to the first / (ie the subfolder name)
library(tidyr)
image_metadata <- extract(image_metadata, "filename", "class", regex = "([^/]+)", remove = FALSE)
{}
# training and validation data frames
train_indices <- sample(1:nrow(image_metadata), size = nrow(image_metadata) * 0.8)
train_metadata <- image_metadata[train_indices, ]
validate_metadata <- image_metadata[-train_indices, ]
# data generators; one for validation...
validate_datagen <- image_data_generator(rescale = 1/255)
{}
# and one for training, with augmentation
train_datagen <- image_data_generator(
rescale = 1/255,
rotation_range = 40,
width_shift_range = 0.2,
height_shift_range = 0.2,
shear_range = 0.2,
zoom_range = 0.2,
horizontal_flip = TRUE
)
train_generator <- flow_images_from_dataframe(train_metadata,
directory = "datasets/PlantVillage/Tomato",
x_col = "filename",
y_col = "class",
generator = train_datagen,
target_size = c(100, 100),
batch_size = 64,
class_mode = "categorical")
validate_generator <- flow_images_from_dataframe(validate_metadata,
directory = "datasets/PlantVillage/Tomato",
x_col = "filename",
y_col = "class",
generator = validate_datagen,
target_size = c(100, 100),
batch_size = 64,
class_mode = "categorical")
{}
## let's inspect what this augmentation looks like...
batch <- generator_next(train_generator)
batch[[1]] %>% tt() %>% print(end_n = 4)
first4 <- batch[[1]][1:4, , , ]
library(dplyr)
library(ggplot2)
first4 %>% tt() %>%
set_ranknames(c("image", "row", "col", "channel")) %>%
set_dimnames_for_rank("channel", c("R", "G", "B")) %>%
as.data.frame() %>%
spread(channel, value) %>%
mutate(color = rgb(R, G, B)) %>%
ggplot() +
geom_tile(aes(x = col, y = -1*row, fill = color)) +
scale_fill_identity() +
coord_equal() +
facet_wrap(~ image)
# train a basic CNN on it
basicnet <- keras_model_sequential() %>%
layer_conv_2d(input_shape = c(100, 100, 3),
filters = 16, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_flatten() %>%
layer_dense(units = 256, activation = "relu") %>%
layer_dense(units = 10, activation = "softmax")
compile(basicnet,
loss = "categorical_crossentropy",
optimizer = "rmsprop",
metrics = c("accuracy"))
history <- fit_generator(basicnet,
train_generator,
steps_per_epoch = 50, # ~ 3200 (# training examples) / 64 (batch size)
epochs = 10,
validation_data = validate_generator,
validation_steps = 12) # ~ 800 / 64
# build a model based on a predefined architecture ("VGG16"), set the weights according to a predefined
# weight set ("imagenet")
# data are stored to ~/.keras/, which I don't think is configurable in the installed version
vgg16_full <- application_vgg16(weights = "imagenet")
# inspect the architecture
print(vgg16_full)
# or we can download without the flattened, dense layers on top -
# if we do so, we can alter the input shape (not sure why we can't otherwise, must be some weight interpolation
# being done for the new network architecture that would be too costly or intractable with the dense layers)
vgg16_topless <- application_vgg16(weights = "imagenet",
include_top = FALSE,
input_shape = c(100, 100, 3))
# inspect the architecture
print(vgg16_topless)
# put some new class prediction stuff on top
my_vgg16 <- keras_model_sequential() %>%
vgg16_topless %>%
layer_flatten() %>%
layer_dense(units = 256, activation = "relu") %>%
layer_dense(units = 10, activation = "softmax")
# freeze the weights for the convolutional base - we don't want to mess up what's already there!
freeze_weights(vgg16_topless)
compile(my_vgg16,
loss = "categorical_crossentropy",
optimizer = "rmsprop",
metrics = c("accuracy"))
history <- fit_generator(my_vgg16,
train_generator,
steps_per_epoch = 50, # ~ 3200 (# training examples) / 64 (batch size)
epochs = 20,
validation_data = validate_generator,
validation_steps = 12) # ~ 800 / 64
#save_model_hdf5(my_vgg16, "my_vgg16_20epochs_80acc.h5")
# my_vgg16 <- load_model_hdf5("my_vgg16_20epochs_80acc.h5")
filters <- get_layer(vgg16_full, name = "block5_conv1")$output
loss <- k_mean(filters[,,,87])
#loss <- 2*vgg16_full$output[, 636] - k_sum(vgg16_full$output)
#target <- rep(0, 1000)
#target[636] <- 1
#loss <- -1*k_categorical_crossentropy(target, vgg16_full$output)
# k_gradients always returns a list...
grads <- k_gradients(loss, vgg16_full$input)[[1]] # k_gradients(loss, my_vgg16$input)[[1]]
# normalize to the l2 norm
grads <- grads / (k_sqrt(k_mean(k_square(grads))) + 1e-5)
# function that takes an input (for the model$input placeholder),
# and returns a list of two tensors: the loss, and the gradients
iterate <- k_function(list(vgg16_full$input), list(loss, grads))
input_img_data <- array_reshape(runif(224 * 224 * 3, min = 0, max = 1), dim = c(1, 224, 224, 3)) * 20 + 128
#input_img_data <- array_reshape(rep(0, 224 * 224 * 3), dim = c(1, 224, 224, 3)) + 128
step_size <- 15
for(i in 1:100) {
grads_value <- iterate(list(input_img_data))[[2]]
input_img_data <- input_img_data + grads_value * step_size
}
input_img_data <- (input_img_data - min(input_img_data))/(max(input_img_data) - min(input_img_data))
input_img_data %>% tt() %>%
set_ranknames(c("image", "y", "x", "channel")) %>%
set_dimnames_for_rank("channel", c("R", "G", "B")) %>%
as.data.frame() %>%
spread(channel, value) %>%
ggplot() +
geom_tile(aes(x = x, y = y, fill = rgb(R, G, B))) +
#facet_wrap(~ channel) +
coord_equal() +
scale_fill_identity()
imagenet_decode_predictions(predict(vgg16_full, input_img_data),
top = 5)
# graph surgery: extracting a model from a set of layers in an existing model
input_vgg16 <- get_layer(vgg16_full, index = 1)$input
output_features <- get_layer(vgg16_full, index = 19)$output
vgg16_topless <- keras_model(input_vgg16, output_features)