library(torch)
library(torchvision)
library(luz)
library(EBImage)
library(magrittr)CNN using torch in R
Load Packages
Load Image Directories
train_dir <- ".../Train"
test_dir <- ".../Test"
train_files <- list.files(train_dir,
pattern = "\\.jpg$",
full.names = TRUE,
recursive = TRUE)
test_files <- list.files(test_dir,
pattern = "\\.jpg$",
full.names = TRUE,
recursive = TRUE)
train_list <- lapply(train_files, readImage)
test_list <- lapply(test_files, readImage)Display the sample image
train_list[[1]] %>% EBImage::display()
Resize and Combine
train_list <- lapply(train_list, resize, w = 64, h = 64)
test_list <- lapply(test_list, resize, w = 64, h = 64)
# for (i in 1:length(train_files)){
# train_list[[i]] <- resize(train_list[[i]], 64, 64)
# }
# for (i in 1:length(test_files)){
# test_list[[i]] <- resize(test_list[[i]], 64, 64)
# }
train <- EBImage::combine(train_list)
test <- EBImage::combine(test_list)Display a concatenated images
train %>%
tile(132) %>%
display()
test %>%
tile(5) %>%
display()
Reorder Dimension
image_dim <- c(4, 1, 2, 3)
train %<>% aperm(image_dim)
test %<>% aperm(image_dim) One-hot Encoding (For labels)
class_name <- c("ALBATROSS","ANTBIRD","APOSTLEBIRD")Train
bird_name_response_train <- rep(class_name, c(132, 150, 153)) %>% as.factor()
bird_response_target_train <- as.integer(bird_name_response_train) Test
bird_name_response_test <- rep(class_name, c(5, 5, 5)) %>% as.factor()
bird_response_target_test <- as.integer(bird_name_response_test)CNN Model
Conversion to torch tensor
train_images_tr <- torch_tensor(train) %>%
torch_reshape(c(-1, 3, 64, 64))
test_images_tr <- torch_tensor(test) %>%
torch_reshape(c(-1, 3, 64, 64))
train_label_y_tr <- bird_response_target_train %>%
torch_tensor()
test_label_y_tr <- bird_response_target_test %>%
torch_tensor()Architecture
convnet <- nn_sequential(
nn_conv2d(in_channels = 3, out_channels = 16, kernel_size = 3, stride = 1, padding = 1),
nn_relu(),
nn_max_pool2d(kernel_size = 2, stride = 2),
nn_conv2d(in_channels = 16, out_channels = 32, kernel_size = 3, stride = 1, padding = 1),
nn_relu(),
nn_max_pool2d(kernel_size = 2, stride = 2),
nn_flatten(),
nn_linear(in_features = 32 * 16 * 16, out_features = 3) # Adjust the out_features to match your number of classes
)
model <- convnet
criterion <- nn_cross_entropy_loss()
optimizer <- optim_adam(model$parameters, lr = 0.01)Train
train_cnn <- function(n) {
f <- glue::glue
for (rep in 1:n) {
suffix1 <- ifelse(rep %% 10 %in% 1:3 & rep %% 100 %/% 10 != 1,
ifelse(rep %% 10 == 1 & rep %% 100 != 11, "st",
ifelse(rep %% 10 == 2 & rep %% 100 != 12, "nd",
ifelse(rep %% 10 == 3 & rep %% 100 != 13, "rd", "th")
)
), "th")
cat("「",f(rep, suffix1), "result", "」", "\n")
for (epoch in 1:50) {
optimizer$zero_grad()
outputs <- model(train_images_tr)
loss <- criterion(outputs, train_label_y_tr)
loss$backward()
optimizer$step()
if (epoch %% 5 == 0) {
cat("Epoch:", epoch, "Loss:", as.numeric(loss), "\n")
}
}
}
res = outputs
return(res)
}
outputs <- train_cnn(5)「 1st result 」
Epoch: 5 Loss: 1.742386
Epoch: 10 Loss: 1.094477
Epoch: 15 Loss: 1.024726
Epoch: 20 Loss: 0.8683809
Epoch: 25 Loss: 0.7784934
Epoch: 30 Loss: 0.9643698
Epoch: 35 Loss: 0.8142969
Epoch: 40 Loss: 0.728441
Epoch: 45 Loss: 0.6589504
Epoch: 50 Loss: 0.6390849
「 2nd result 」
Epoch: 5 Loss: 0.5949203
Epoch: 10 Loss: 0.5617996
Epoch: 15 Loss: 0.538302
Epoch: 20 Loss: 0.5045453
Epoch: 25 Loss: 0.4743917
Epoch: 30 Loss: 0.4463897
Epoch: 35 Loss: 0.4201474
Epoch: 40 Loss: 0.3918261
Epoch: 45 Loss: 0.3646121
Epoch: 50 Loss: 0.3412166
「 3rd result 」
Epoch: 5 Loss: 0.3234368
Epoch: 10 Loss: 0.285052
Epoch: 15 Loss: 0.2796574
Epoch: 20 Loss: 0.2361809
Epoch: 25 Loss: 0.2255808
Epoch: 30 Loss: 0.2041594
Epoch: 35 Loss: 0.1642962
Epoch: 40 Loss: 0.1343487
Epoch: 45 Loss: 0.1072725
Epoch: 50 Loss: 0.08070982
「 4th result 」
Epoch: 5 Loss: 0.05824423
Epoch: 10 Loss: 0.04241421
Epoch: 15 Loss: 0.03032013
Epoch: 20 Loss: 0.02184391
Epoch: 25 Loss: 0.01606583
Epoch: 30 Loss: 0.01208414
Epoch: 35 Loss: 0.009362903
Epoch: 40 Loss: 0.007495954
Epoch: 45 Loss: 0.006197718
Epoch: 50 Loss: 0.005253006
「 5th result 」
Epoch: 5 Loss: 0.004542025
Epoch: 10 Loss: 0.003985927
Epoch: 15 Loss: 0.003542636
Epoch: 20 Loss: 0.003185462
Epoch: 25 Loss: 0.002890209
Epoch: 30 Loss: 0.002642544
Epoch: 35 Loss: 0.002429743
Epoch: 40 Loss: 0.002245838
Epoch: 45 Loss: 0.002085447
Epoch: 50 Loss: 0.001943499 Test
test_cnn <- function(n) {
f <- glue::glue
for (rep in 1:n) {
suffix2 <- ifelse(rep %% 10 %in% 1:3 & rep %% 100 %/% 10 != 1,
ifelse(rep %% 10 == 1 & rep %% 100 != 11, "st",
ifelse(rep %% 10 == 2 & rep %% 100 != 12, "nd",
ifelse(rep %% 10 == 3 & rep %% 100 != 13, "rd", "th")
)
), "th")
cat("「",f(rep, suffix2), "result", "」", "\n")
for (epoch in 1:50) {
optimizer$zero_grad()
outputs_2 <- model(test_images_tr)
loss_2 <- criterion(outputs_2, test_label_y_tr)
loss_2$backward()
optimizer$step()
if (epoch %% 5 == 0) {
cat("Epoch:", epoch, "Loss:", as.numeric(loss_2), "\n")
}
}
}
res <- outputs_2
return(res)
}
outputs_2 <- test_cnn(5)「 1st result 」
Epoch: 5 Loss: 3.512259
Epoch: 10 Loss: 0.01318069
Epoch: 15 Loss: 0.03483154
Epoch: 20 Loss: 0.037995
Epoch: 25 Loss: 0.01144956
Epoch: 30 Loss: 0.00598612
Epoch: 35 Loss: 0.001919644
Epoch: 40 Loss: 0.0001756011
Epoch: 45 Loss: 0.0002821077
Epoch: 50 Loss: 0.0001979958
「 2nd result 」
Epoch: 5 Loss: 8.772144e-05
Epoch: 10 Loss: 4.715504e-05
Epoch: 15 Loss: 3.509271e-05
Epoch: 20 Loss: 3.158811e-05
Epoch: 25 Loss: 3.019729e-05
Epoch: 30 Loss: 2.897349e-05
Epoch: 35 Loss: 2.757498e-05
Epoch: 40 Loss: 2.609706e-05
Epoch: 45 Loss: 2.474627e-05
Epoch: 50 Loss: 2.359412e-05
「 3rd result 」
Epoch: 5 Loss: 2.263266e-05
Epoch: 10 Loss: 2.179832e-05
Epoch: 15 Loss: 2.109906e-05
Epoch: 20 Loss: 2.048719e-05
Epoch: 25 Loss: 1.991505e-05
Epoch: 30 Loss: 1.940648e-05
Epoch: 35 Loss: 1.892968e-05
Epoch: 40 Loss: 1.846878e-05
Epoch: 45 Loss: 1.802377e-05
Epoch: 50 Loss: 1.760259e-05
「 4th result 」
Epoch: 5 Loss: 1.718936e-05
Epoch: 10 Loss: 1.679997e-05
Epoch: 15 Loss: 1.642647e-05
Epoch: 20 Loss: 1.606887e-05
Epoch: 25 Loss: 1.571127e-05
Epoch: 30 Loss: 1.538545e-05
Epoch: 35 Loss: 1.505168e-05
Epoch: 40 Loss: 1.474176e-05
Epoch: 45 Loss: 1.444772e-05
Epoch: 50 Loss: 1.416164e-05
「 5th result 」
Epoch: 5 Loss: 1.38835e-05
Epoch: 10 Loss: 1.362125e-05
Epoch: 15 Loss: 1.335106e-05
Epoch: 20 Loss: 1.311266e-05
Epoch: 25 Loss: 1.287425e-05
Epoch: 30 Loss: 1.264379e-05
Epoch: 35 Loss: 1.242128e-05
Epoch: 40 Loss: 1.219082e-05
Epoch: 45 Loss: 1.197625e-05
Epoch: 50 Loss: 1.178553e-05 Model Evaluation
Train
predicted_train <- apply(as.array(outputs), 1, which.max)
predicted_train_class <- factor(
class_name[predicted_train],
levels = class_name
)
train_cfm <- table(
actual = bird_name_response_train,
predicted = predicted_train_class
)Confusion Matrix and Statistics
predicted
actual ALBATROSS ANTBIRD APOSTLEBIRD
ALBATROSS 132 0 0
ANTBIRD 0 150 0
APOSTLEBIRD 0 0 153
Overall Statistics
Accuracy : 1
95% CI : (0.9916, 1)
No Information Rate : 0.3517
P-Value [Acc > NIR] : < 2.2e-16
Kappa : 1
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: ALBATROSS Class: ANTBIRD Class: APOSTLEBIRD
Sensitivity 1.0000 1.0000 1.0000
Specificity 1.0000 1.0000 1.0000
Pos Pred Value 1.0000 1.0000 1.0000
Neg Pred Value 1.0000 1.0000 1.0000
Precision 1.0000 1.0000 1.0000
Recall 1.0000 1.0000 1.0000
F1 1.0000 1.0000 1.0000
Prevalence 0.3034 0.3448 0.3517
Detection Rate 0.3034 0.3448 0.3517
Detection Prevalence 0.3034 0.3448 0.3517
Balanced Accuracy 1.0000 1.0000 1.0000Test
predicted_test <- apply(as.array(outputs_2), 1, which.max)
predicted_test_class <- factor(
class_name[predicted_test],
levels = class_name
)
test_cfm <- table(
actual = bird_name_response_test,
predicted = predicted_test_class
)
caret::confusionMatrix(test_cfm, mode = "everything")Confusion Matrix and Statistics
predicted
actual ALBATROSS ANTBIRD APOSTLEBIRD
ALBATROSS 5 0 0
ANTBIRD 0 5 0
APOSTLEBIRD 0 0 5
Overall Statistics
Accuracy : 1
95% CI : (0.782, 1)
No Information Rate : 0.3333
P-Value [Acc > NIR] : 6.969e-08
Kappa : 1
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: ALBATROSS Class: ANTBIRD Class: APOSTLEBIRD
Sensitivity 1.0000 1.0000 1.0000
Specificity 1.0000 1.0000 1.0000
Pos Pred Value 1.0000 1.0000 1.0000
Neg Pred Value 1.0000 1.0000 1.0000
Precision 1.0000 1.0000 1.0000
Recall 1.0000 1.0000 1.0000
F1 1.0000 1.0000 1.0000
Prevalence 0.3333 0.3333 0.3333
Detection Rate 0.3333 0.3333 0.3333
Detection Prevalence 0.3333 0.3333 0.3333
Balanced Accuracy 1.0000 1.0000 1.0000Confusion Matrix and Statistics
predicted
actual ALBATROSS ANTBIRD APOSTLEBIRD
ALBATROSS 5 0 0
ANTBIRD 0 5 0
APOSTLEBIRD 0 0 5
Overall Statistics
Accuracy : 1
95% CI : (0.782, 1)
No Information Rate : 0.3333
P-Value [Acc > NIR] : 6.969e-08
Kappa : 1
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: ALBATROSS Class: ANTBIRD Class: APOSTLEBIRD
Sensitivity 1.0000 1.0000 1.0000
Specificity 1.0000 1.0000 1.0000
Pos Pred Value 1.0000 1.0000 1.0000
Neg Pred Value 1.0000 1.0000 1.0000
Precision 1.0000 1.0000 1.0000
Recall 1.0000 1.0000 1.0000
F1 1.0000 1.0000 1.0000
Prevalence 0.3333 0.3333 0.3333
Detection Rate 0.3333 0.3333 0.3333
Detection Prevalence 0.3333 0.3333 0.3333
Balanced Accuracy 1.0000 1.0000 1.0000New Images
new_birds_dir <- ".../New Images"
new_birds_files <- list.files(new_birds_dir,
pattern = "\\.jpg$",
full.names = TRUE,
recursive = TRUE)Pre-processing
new_birds_list <- lapply(new_birds_files, readImage) %>%
lapply(resize, w = 64, h = 64)Combine and Reorder Dimension
new_data <- EBImage::combine(new_birds_list)
image_dim <- c(4, 1, 2, 3)
new_data %<>% aperm(image_dim) One-hot Encoding
new_bird_name_response <- rep(class_name, c(5, 4, 3)) %>% as.factor()
new_bird_response_target <- as.integer(new_bird_name_response)Torch Tensor
new_data_tr <- torch_tensor(new_data) %>%
torch_reshape(c(-1, 3, 64, 64))
new_data_y_tr <- new_bird_response_target %>%
torch_tensor()CNN Model
new_cnn <- function(n) {
f <- glue::glue
for (rep in 1:n) {
suffix <- ifelse(rep %% 10 %in% 1:3 & rep %% 100 %/% 10 != 1,
ifelse(rep %% 10 == 1 & rep %% 100 != 11, "st",
ifelse(rep %% 10 == 2 & rep %% 100 != 12, "nd",
ifelse(rep %% 10 == 3 & rep %% 100 != 13, "rd", "th")
)
), "th")
cat("「",f(rep, suffix), "result", "」", "\n")
for (epoch in 1:50) {
optimizer$zero_grad()
outputs <- model(new_data_tr)
loss <- criterion(outputs, new_data_y_tr)
loss$backward()
optimizer$step()
if (epoch %% 5 == 0) {
cat("Epoch:", epoch, "Loss:", as.numeric(loss), "\n")
}
}
}
res <- outputs
return(res)
}
new_output <- new_cnn(5)「 1st result 」
Epoch: 5 Loss: 0.02298064
Epoch: 10 Loss: 0.02293617
Epoch: 15 Loss: 0.009672205
Epoch: 20 Loss: 0.0007471149
Epoch: 25 Loss: 0.0003766804
Epoch: 30 Loss: 0.0001323497
Epoch: 35 Loss: 4.59898e-05
Epoch: 40 Loss: 2.017519e-05
Epoch: 45 Loss: 1.154311e-05
Epoch: 50 Loss: 7.947138e-06
「 2nd result 」
Epoch: 5 Loss: 6.228594e-06
Epoch: 10 Loss: 5.294815e-06
Epoch: 15 Loss: 4.748452e-06
Epoch: 20 Loss: 4.390832e-06
Epoch: 25 Loss: 4.132551e-06
Epoch: 30 Loss: 3.943806e-06
Epoch: 35 Loss: 3.794798e-06
Epoch: 40 Loss: 3.655722e-06
Epoch: 45 Loss: 3.526581e-06
Epoch: 50 Loss: 3.44711e-06
「 3rd result 」
Epoch: 5 Loss: 3.337836e-06
Epoch: 10 Loss: 3.258365e-06
Epoch: 15 Loss: 3.188827e-06
Epoch: 20 Loss: 3.099422e-06
Epoch: 25 Loss: 3.039818e-06
Epoch: 30 Loss: 2.97028e-06
Epoch: 35 Loss: 2.910676e-06
Epoch: 40 Loss: 2.851072e-06
Epoch: 45 Loss: 2.791468e-06
Epoch: 50 Loss: 2.731864e-06
「 4th result 」
Epoch: 5 Loss: 2.672261e-06
Epoch: 10 Loss: 2.632525e-06
Epoch: 15 Loss: 2.582855e-06
Epoch: 20 Loss: 2.523251e-06
Epoch: 25 Loss: 2.483515e-06
Epoch: 30 Loss: 2.423911e-06
Epoch: 35 Loss: 2.374241e-06
Epoch: 40 Loss: 2.354373e-06
Epoch: 45 Loss: 2.304703e-06
Epoch: 50 Loss: 2.274901e-06
「 5th result 」
Epoch: 5 Loss: 2.235165e-06
Epoch: 10 Loss: 2.215297e-06
Epoch: 15 Loss: 2.175561e-06
Epoch: 20 Loss: 2.135825e-06
Epoch: 25 Loss: 2.106023e-06
Epoch: 30 Loss: 2.076221e-06
Epoch: 35 Loss: 2.036484e-06
Epoch: 40 Loss: 2.016616e-06
Epoch: 45 Loss: 1.97688e-06
Epoch: 50 Loss: 1.957013e-06 Model Evaluation
predicted_new <- apply(as.array(new_output), 1, which.max)
predicted_new_class <- factor(
class_name[predicted_new],
levels = class_name
)
new_cfm <- table(
actual = new_bird_name_response,
predicted = predicted_new_class
)Confusion Matrix and Statistics
predicted
actual ALBATROSS ANTBIRD APOSTLEBIRD
ALBATROSS 5 0 0
ANTBIRD 0 4 0
APOSTLEBIRD 0 0 3
Overall Statistics
Accuracy : 1
95% CI : (0.7354, 1)
No Information Rate : 0.4167
P-Value [Acc > NIR] : 2.738e-05
Kappa : 1
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: ALBATROSS Class: ANTBIRD Class: APOSTLEBIRD
Sensitivity 1.0000 1.0000 1.00
Specificity 1.0000 1.0000 1.00
Pos Pred Value 1.0000 1.0000 1.00
Neg Pred Value 1.0000 1.0000 1.00
Precision 1.0000 1.0000 1.00
Recall 1.0000 1.0000 1.00
F1 1.0000 1.0000 1.00
Prevalence 0.4167 0.3333 0.25
Detection Rate 0.4167 0.3333 0.25
Detection Prevalence 0.4167 0.3333 0.25
Balanced Accuracy 1.0000 1.0000 1.00