knitr::opts_chunk$set(echo = TRUE)
options(repos = c(CRAN = "https://cloud.r-project.org/"))
library(imager)
## Loading required package: magrittr
##
## Attaching package: 'imager'
## The following object is masked from 'package:magrittr':
##
## add
## 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
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:imager':
##
## where
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ ggplot2 3.5.1 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ imager::add() masks magrittr::add()
## ✖ stringr::boundary() masks imager::boundary()
## ✖ tidyr::extract() masks magrittr::extract()
## ✖ tidyr::fill() masks imager::fill()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::set_names() masks magrittr::set_names()
## ✖ dplyr::where() masks imager::where()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
install.packages("BiocManager")
## Installing package into 'C:/Users/sanan/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)
## package 'BiocManager' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\sanan\AppData\Local\Temp\RtmpCUqCbl\downloaded_packages
BiocManager::install("EBImage")
## 'getOption("repos")' replaces Bioconductor standard repositories, see
## 'help("repositories", package = "BiocManager")' for details.
## Replacement repositories:
## CRAN: https://cloud.r-project.org/
## Bioconductor version 3.19 (BiocManager 1.30.25), R 4.4.1 (2024-06-14 ucrt)
## Warning: package(s) not installed when version(s) same as or greater than current; use
## `force = TRUE` to re-install: 'EBImage'
## Installation paths not writeable, unable to update packages
## path: C:/Program Files/R/R-4.4.1/library
## packages:
## boot, foreign, MASS, Matrix, nlme, survival
## Old packages: 'bitops', 'corrplot', 'data.table', 'dendextend', 'digest',
## 'doBy', 'emmeans', 'evaluate', 'glue', 'gtable', 'igraph', 'quantreg',
## 'renv', 'rstudioapi', 'slider'
# Set the path to your dataset
imagepath <- "C:\\Users\\sanan\\Desktop\\image dataset"
# Get a list of all categories (folders)
categories <- list.dirs(imagepath, recursive = FALSE)
labels <- basename(categories) # Use folder names as labels
# Function to resize images
resize_image <- function(img_path, img_size = 128) {
img <- load.image(img_path) # Load the image
img <- resize(img, img_size, img_size) # Resize to specified dimensions
as.numeric(img) # Convert to a numeric vector
}
# Function to load all images and create a dataset
load_images <- function(imagepath, categories) {
imagedata <- data.frame() # Initialize an empty data frame
for (category in categories) {
label <- basename(category) # Get the label from the folder name
imagefiles <- list.files(category, full.names = TRUE) # List all image files in the category
for (image_file in imagefiles) {
img_vector <- resize_image(image_file) # Resize the image and convert to a vector
imagedata <- rbind(imagedata, data.frame(label = label, img_vector = I(list(img_vector)))) # Add to data frame
}
}
return(imagedata) # Return the populated data frame
}
# Load the images into a data frame
imagedata <- load_images(imagepath, categories)
# Check the dimensions of the image data
dim(imagepath)
## NULL
library(caret)
## Loading required package: lattice
##
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
##
## lift
library(nnet)
img_matrix <- do.call(rbind, lapply(imagedata$img_vector, as.vector))
## Warning in (function (..., deparse.level = 1) : number of columns of result is
## not a multiple of vector length (arg 1)
# Create a new data frame with flattened image data
imagedata_flat <- data.frame(label = imagedata$label, img_matrix)
# Check the new dimensions
print(dim(imagedata_flat))
## [1] 259 65537
imagedata_flat$label <- as.factor(imagedata_flat$label)
# Normalize the features
imagedata_scaled <- scale(imagedata_flat[, -which(names(imagedata_flat) == "label")])
# Perform PCA
pca_result <- prcomp(imagedata_scaled, center = TRUE, scale. = TRUE)
# Decide the number of components to keep (e.g., 95% variance)
explained_variance <- summary(pca_result)$importance[3,]
num_components <- min(which(cumsum(explained_variance) >= 0.95))
# Create a new dataset with the PCA components
imagedata_pca <- data.frame(pca_result$x[, 1:num_components])
imagedata_pca$label <- imagedata_flat$label
# Fit the multinomial model with PCA components
multinom_model <- multinom(label ~ ., data = imagedata_pca)
## # weights: 30 (20 variable)
## initial value 464.065703
## iter 10 value 401.843831
## iter 20 value 314.886786
## iter 30 value 282.027179
## final value 282.018162
## converged
# Check the summary of the model
summary(multinom_model)
## Call:
## multinom(formula = label ~ ., data = imagedata_pca)
##
## Coefficients:
## (Intercept) PC1 PC2 PC3
## fav 1.7391427 0.000336040 0.006672798 -0.010624844
## flowers -0.9577405 -0.007425074 0.006374766 -0.008682955
## fruits 3.4144943 0.008575872 0.013838970 -0.028732620
## insects 1.2381604 0.003087030 -0.008416775 -0.008400788
## veg 2.0910415 0.004699424 -0.002527482 -0.024650846
##
## Std. Errors:
## (Intercept) PC1 PC2 PC3
## fav 0.6068912 0.002506983 0.007898035 0.007698353
## flowers 1.0050659 0.004108049 0.010304786 0.010603809
## fruits 0.5713848 0.002410337 0.007658824 0.007524069
## insects 0.6342175 0.002501073 0.008343159 0.007842088
## veg 0.5949782 0.002508797 0.007981659 0.007842175
##
## Residual Deviance: 564.0363
## AIC: 604.0363
# Predict the probabilities for the dataset
predicted_probs <- predict(multinom_model, type = "prob")
# Predict the class labels
predicted_classes <- predict(multinom_model)
# View the predicted probabilities and class labels
head(predicted_probs)
## birds fav flowers fruits insects veg
## 1 0.10125061 0.34171277 0.33860334 0.05719536 0.09280294 0.06843498
## 2 0.04392922 0.16057662 0.01083926 0.46304899 0.13983910 0.18176681
## 3 0.06608361 0.35479231 0.28551419 0.13667044 0.06599329 0.09094615
## 4 0.01035250 0.07654912 0.00369888 0.77018247 0.03295196 0.10626507
## 5 0.10247658 0.27516282 0.03017150 0.29029023 0.17622127 0.12567760
## 6 0.04879649 0.26397876 0.05129406 0.42041435 0.08007342 0.13544293
head(predicted_classes)
## [1] fav fruits fav fruits fruits fruits
## Levels: birds fav flowers fruits insects veg
# Create a confusion matrix
confusion_matrix <- table(Actual = imagedata_pca$label, Predicted = predicted_classes)
# View the confusion matrix
print(confusion_matrix)
## Predicted
## Actual birds fav flowers fruits insects veg
## birds 0 3 0 5 2 0
## fav 0 13 1 19 2 0
## flowers 1 3 1 4 0 0
## fruits 0 13 0 120 2 6
## insects 0 1 1 16 6 1
## veg 0 6 0 28 1 4
# Calculate accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Accuracy:", accuracy))
## [1] "Accuracy: 0.555984555984556"
##CLUSTERING
##HEIRARCHIAL CLUSTERING WITH DENDROGRAM:
# Compute the distance matrix
dist_matrix <- dist(imagedata_pca[, -which(names(imagedata_pca) == "label")])
# Perform hierarchical clustering
hclust_result <- hclust(dist_matrix)
# Plot the dendrogram
plot(hclust_result, labels = FALSE, main = "Hierarchical Clustering Dendrogram")
# Cut the dendrogram to create clusters
imagedata_pca$hclust_cluster <- cutree(hclust_result, k = 3) # Use the same number of clusters as above
# View the first few rows with cluster assignments
head(imagedata_pca)
## PC1 PC2 PC3 label hclust_cluster
## 1 -337.001691 -2.837558 36.761987 birds 1
## 2 8.189413 -18.029738 30.625803 birds 2
## 3 -318.068643 21.607894 9.019637 birds 1
## 4 40.552208 29.326328 -4.917352 birds 2
## 5 -45.570080 -1.945369 68.059312 birds 2
## 6 -133.424589 23.820498 15.533943 birds 1
##K-MEANS CLUSTERING:
# Set the number of clusters (k)
set.seed(123) # For reproducibility
k <- 7 # You can also specify a different number of clusters
# Perform K-means clustering
kmeans_result <- kmeans(imagedata_pca[, -which(names(imagedata_pca) == "label")], centers = k)
# Add the cluster assignments to the original PCA data
imagedata_pca$cluster <- as.factor(kmeans_result$cluster)
# View the first few rows with cluster assignments
head(imagedata_pca)
## PC1 PC2 PC3 label hclust_cluster cluster
## 1 -337.001691 -2.837558 36.761987 birds 1 7
## 2 8.189413 -18.029738 30.625803 birds 2 2
## 3 -318.068643 21.607894 9.019637 birds 1 7
## 4 40.552208 29.326328 -4.917352 birds 2 2
## 5 -45.570080 -1.945369 68.059312 birds 2 2
## 6 -133.424589 23.820498 15.533943 birds 1 5
# Optional: Visualize the clusters in a 2D plot (using the first two PCA components)
library(ggplot2)
ggplot(imagedata_pca, aes(x = PC1, y = PC2, color = cluster)) +
geom_point(alpha = 0.6) +
labs(title = "K-means Clustering of Image Data",
x = "Principal Component 1",
y = "Principal Component 2") +
theme_minimal()
##NEURAL NETWORKS
# Load necessary libraries
library(nnet)
library(caret)
# Set seed for reproducibility
set.seed(123)
# Function to fit a neural network model and return the accuracy
fit_nn_model <- function(hidden_neurons, train_data) {
# Fit the neural network model
nn_model <- nnet(label ~ ., data = train_data, size = hidden_neurons, maxit = 100, trace = FALSE)
# Predict the class labels
predicted_classes <- predict(nn_model, train_data, type = "class")
# Create a confusion matrix
confusion_matrix <- table(Actual = train_data$label, Predicted = predicted_classes)
# Calculate accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
return(accuracy)
}
# Fit models with different hidden layer sizes
neurons_list <- c(5, 10, 20)
accuracy_results <- data.frame(Hidden_Neurons = neurons_list, Accuracy = NA)
for (neurons in neurons_list) {
accuracy <- fit_nn_model(neurons, imagedata_pca)
accuracy_results[accuracy_results$Hidden_Neurons == neurons, "Accuracy"] <- accuracy
}
# Print the results
print(accuracy_results)
## Hidden_Neurons Accuracy
## 1 5 0.05405405
## 2 10 0.12741313
## 3 20 0.69884170