Libraries
# Data wrangling
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
# Image manipulation
library(imager)
## Loading required package: magrittr
##
## Attaching package: 'magrittr'
##
## The following object is masked from 'package:purrr':
##
## set_names
##
## The following object is masked from 'package:tidyr':
##
## extract
##
##
## Attaching package: 'imager'
##
## The following object is masked from 'package:magrittr':
##
## add
##
## The following object is masked from 'package:stringr':
##
## boundary
##
## The following object is masked from 'package:dplyr':
##
## where
##
## The following object is masked from 'package:tidyr':
##
## fill
##
## The following objects are masked from 'package:stats':
##
## convolve, spectrum
##
## The following object is masked from 'package:graphics':
##
## frame
##
## The following object is masked from 'package:base':
##
## save.image
# Deep learning
library(keras)
# Model Evaluation
library(caret)
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(purrr)
options(scipen = 999)
EDA
folder_list <- list.files("/Users/gabrielmedina/Desktop/red neuronal/train")
folder_list
## [1] "Jarra" "Plato" "Vaso"
folder_path <- paste0("/Users/gabrielmedina/Desktop/red neuronal/train/", folder_list, "/")
folder_path
## [1] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/"
## [2] "/Users/gabrielmedina/Desktop/red neuronal/train/Plato/"
## [3] "/Users/gabrielmedina/Desktop/red neuronal/train/Vaso/"
# Get file name
file_name <- map(folder_path,
function(x) paste0(x, list.files(x))
) %>%
unlist()
# first 6 file name
head(file_name)
## [1] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3140.jpg"
## [2] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3141.jpg"
## [3] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3142.jpg"
## [4] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3143.jpg"
## [5] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3144.jpg"
## [6] "/Users/gabrielmedina/Desktop/red neuronal/train/Jarra/IMG_3145.jpg"
length(file_name)
## [1] 80
# Randomly select image
set.seed(123)
sample_image <- sample(file_name, 6)
# Load image into R
img <- map(sample_image, load.image)
# Plot image
par(mfrow = c(2, 3)) # Create 2 x 3 image grid
map(img, plot)
## [[1]]
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
##
## [[2]]
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
##
## [[3]]
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
##
## [[4]]
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
##
## [[5]]
## Image. Width: 4032 pix Height: 3024 pix Depth: 1 Colour channels: 3
##
## [[6]]
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
# Full Image Description
img <- load.image(file_name[1])
img
## Image. Width: 5712 pix Height: 4284 pix Depth: 1 Colour channels: 3
# Image Dimension
dim(img)
## [1] 5712 4284 1 3
# Function for acquiring width and height of an image
get_dim <- function(x){
img <- load.image(x)
df_img <- data.frame(height = height(img),
width = width(img),
filename = x
)
return(df_img)
}
get_dim(file_name[1])
# Randomly get sample images
set.seed(123)
sample_file <- sample(file_name)
# Run the get_dim() function for each image
file_dim <- map_df(sample_file, get_dim)
head(file_dim, 10)
summary(file_dim)
## height width filename
## Min. :3024 Min. :4032 Length:80
## 1st Qu.:3024 1st Qu.:4032 Class :character
## Median :4284 Median :5712 Mode :character
## Mean :3953 Mean :5271
## 3rd Qu.:4284 3rd Qu.:5712
## Max. :4284 Max. :5712
Procesamiento
# Desired height and width of images
target_size <- c(64, 64)
# Batch size for training the model
batch_size <- 32
# Image Generator
train_data_gen <- image_data_generator(rescale = 1/255, # Scaling pixel value
horizontal_flip = T, # Flip image horizontally
vertical_flip = T, # Flip image vertically
rotation_range = 45, # Rotate image from 0 to 45 degrees
zoom_range = 0.25, # Zoom in or zoom out range
validation_split = 0.2 # 20% data as validation data
)
# Training Dataset
train_image_array_gen <- flow_images_from_directory(directory = "/Users/gabrielmedina/Desktop/red neuronal/train/", # Folder of the data
target_size = target_size, # target of the image dimension (64 x 64)
color_mode = "rgb", # use RGB color
batch_size = batch_size ,
seed = 123, # set random seed
subset = "training", # declare that this is for training data
generator = train_data_gen
)
## Found 66 images belonging to 3 classes.
# Validation Dataset
val_image_array_gen <- flow_images_from_directory(directory = "/Users/gabrielmedina/Desktop/red neuronal/train/",
target_size = target_size,
color_mode = "rgb",
batch_size = batch_size ,
seed = 123,
subset = "validation", # declare that this is the validation data
generator = train_data_gen
)
## Found 14 images belonging to 3 classes.
library(dplyr)
# Number of training samples
train_samples <- train_image_array_gen$n
# Number of validation samples
valid_samples <- val_image_array_gen$n
# Number of target classes/categories
output_n <- n_distinct(train_image_array_gen$classes)
# Get the class proportion
table("\nFrequency" = factor(train_image_array_gen$classes)
) %>%
prop.table()
##
## Frequency
## 0 1 2
## 0.3484848 0.3484848 0.3030303
# input shape of the image
c(target_size, 3)
## [1] 64 64 3
library(torch)
# Definir el modelo
model <- nn_module(
"ConvNet",
initialize = function() {
self$conv1 <- nn_conv2d(3, 32, kernel_size = 3, padding = 1)
self$conv2 <- nn_conv2d(32, 64, kernel_size = 3, padding = 1)
self$fc1 <- nn_linear(64 * 16 * 16, 128) # Ajustar el tamaño según la reducción de la dimensionalidad
self$fc2 <- nn_linear(128, 10) # Suponiendo 10 clases
},
forward = function(x) {
x %>%
self$conv1() %>%
nnf_relu() %>%
nnf_max_pool2d(2) %>%
self$conv2() %>%
nnf_relu() %>%
nnf_max_pool2d(2) %>%
torch_flatten(start_dim = 2) %>%
self$fc1() %>%
nnf_relu() %>%
self$fc2()
}
)
# Crear una instancia del modelo
net <- model()
# Ver el modelo
print(net)
## An `nn_module` containing 2,117,962 parameters.
##
## ── Modules ─────────────────────────────────────────────────────────────────────
## • conv1: <nn_conv2d> #896 parameters
## • conv2: <nn_conv2d> #18,496 parameters
## • fc1: <nn_linear> #2,097,280 parameters
## • fc2: <nn_linear> #1,290 parameters
model <- keras_model_sequential(name = "cnn_model") %>%
layer_conv_2d(filters = 32, kernel_size = c(3,3), activation = 'relu', padding = 'same', input_shape = c(64, 64, 3)) %>%
layer_max_pooling_2d(pool_size = c(2,2)) %>%
layer_conv_2d(filters = 64, kernel_size = c(3,3), activation = 'relu', padding = 'same') %>%
layer_max_pooling_2d(pool_size = c(2,2)) %>%
layer_flatten() %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 3, activation = 'softmax') # 3 unidades para Vaso, Plato, Jarra
model %>% compile(
loss = 'categorical_crossentropy',
optimizer = 'adam',
metrics = c('accuracy')
)
model %>% summary()
## Model: "cnn_model"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## conv2d_1 (Conv2D) (None, 64, 64, 32) 896
## max_pooling2d_1 (MaxPooling2D) (None, 32, 32, 32) 0
## conv2d (Conv2D) (None, 32, 32, 64) 18496
## max_pooling2d (MaxPooling2D) (None, 16, 16, 64) 0
## flatten (Flatten) (None, 16384) 0
## dense_1 (Dense) (None, 128) 2097280
## dense (Dense) (None, 3) 387
## ================================================================================
## Total params: 2117059 (8.08 MB)
## Trainable params: 2117059 (8.08 MB)
## Non-trainable params: 0 (0.00 Byte)
## ________________________________________________________________________________
history <- model %>% fit(
x = train_image_array_gen,
steps_per_epoch = ceiling(train_samples / batch_size),
epochs = 10,
validation_data = val_image_array_gen,
validation_steps = ceiling(valid_samples / batch_size)
)
## Epoch 1/10
## 3/3 - 4s - loss: 1.4423 - accuracy: 0.2879 - val_loss: 1.5416 - val_accuracy: 0.3571 - 4s/epoch - 1s/step
## Epoch 2/10
## 3/3 - 3s - loss: 1.3800 - accuracy: 0.3030 - val_loss: 1.3658 - val_accuracy: 0.2857 - 3s/epoch - 1s/step
## Epoch 3/10
## 3/3 - 3s - loss: 1.2043 - accuracy: 0.3030 - val_loss: 1.1049 - val_accuracy: 0.2857 - 3s/epoch - 1s/step
## Epoch 4/10
## 3/3 - 3s - loss: 1.0914 - accuracy: 0.3636 - val_loss: 1.0876 - val_accuracy: 0.4286 - 3s/epoch - 1s/step
## Epoch 5/10
## 3/3 - 3s - loss: 1.1079 - accuracy: 0.3939 - val_loss: 1.0915 - val_accuracy: 0.3571 - 3s/epoch - 1s/step
## Epoch 6/10
## 3/3 - 3s - loss: 1.0907 - accuracy: 0.4091 - val_loss: 1.0775 - val_accuracy: 0.3571 - 3s/epoch - 1s/step
## Epoch 7/10
## 3/3 - 3s - loss: 1.0873 - accuracy: 0.4394 - val_loss: 1.0428 - val_accuracy: 0.4286 - 3s/epoch - 1s/step
## Epoch 8/10
## 3/3 - 3s - loss: 1.0823 - accuracy: 0.3788 - val_loss: 0.9995 - val_accuracy: 0.3571 - 3s/epoch - 1s/step
## Epoch 9/10
## 3/3 - 3s - loss: 1.0690 - accuracy: 0.3485 - val_loss: 0.9543 - val_accuracy: 0.3571 - 3s/epoch - 1s/step
## Epoch 10/10
## 3/3 - 3s - loss: 1.0530 - accuracy: 0.3636 - val_loss: 0.9049 - val_accuracy: 0.5000 - 3s/epoch - 1s/step
Evaluación
# Evaluación del modelo
evaluation_result <- model %>% evaluate(
x = val_image_array_gen,
steps = val_image_array_gen$n
)
## 14/14 - 0s - loss: 0.9011 - accuracy: 0.4286 - 482ms/epoch - 34ms/step
# Hacer algunas predicciones (ejemplo)
predictions <- model %>% predict(
x = val_image_array_gen,
steps = 1
)
## 1/1 - 1s - 514ms/epoch - 514ms/step
predicted_classes <- apply(predictions, 1, which.max) - 1 # Ajusta el índice si es necesario
# Suponiendo que tienes un vector o lista `class_names` que corresponde a los índices de clase:
class_names <- c("Vaso", "Plato", "Jarra") # Asegúrate de que esto coincida con el orden de tus clases
predicted_labels <- class_names[predicted_classes + 1] # +1 en R ya que los índices comienzan en 1
print(evaluation_result)
## loss accuracy
## 0.9010932 0.4285714
print(predicted_labels)
## [1] "Plato" "Vaso" "Plato" "Plato" "Plato" "Plato" "Plato" "Plato" "Vaso"
## [10] "Vaso" "Vaso" "Plato" "Plato" "Plato"