library(clustertend)
## Package `clustertend` is deprecated. Use package `hopkins` instead.
library(nnet)
library(cluster)
library(glmnet)
## Warning: package 'glmnet' was built under R version 4.3.3
## Loading required package: Matrix
## Loaded glmnet 4.1-8
library(neuralnet)
## Warning: package 'neuralnet' was built under R version 4.3.3
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:neuralnet':
##
## compute
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
library(tidyr)
##
## Attaching package: 'tidyr'
## The following objects are masked from 'package:Matrix':
##
## expand, pack, unpack
library(imager)
## Warning: package 'imager' was built under R version 4.3.3
## Loading required package: magrittr
##
## Attaching package: 'magrittr'
## 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:tidyr':
##
## fill
## The following object is masked from 'package:dplyr':
##
## where
## 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(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.94 loaded
library(ggfortify)
## Warning: package 'ggfortify' was built under R version 4.3.3
library(mclust)
## Warning: package 'mclust' was built under R version 4.3.3
## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.
library(caret)
## Warning: package 'caret' was built under R version 4.3.3
## Loading required package: lattice
df <-"D:/ml image"
# Get a list of all categories (folders)
categories <- list.dirs(df, recursive = FALSE)
labels <- basename(categories) # Use folder names as labels
# Function to resize images
resize_image <- function(img_path, img_size = 32) {
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(df, categories) {
df <- data.frame() # Initialize an empty data frame
for (category in categories) {
label <- basename(category) # Get the label from the folder name
image_files <- list.files(category, full.names = TRUE) # List all image files in the category
for (image_file in image_files) {
img_vector <- resize_image(image_file) # Resize the image and convert to a vector
df <- rbind(df, data.frame(label = label, img_vector = I(list(img_vector)))) # Add to data frame
}
}
return(df) # Return the populated data frame
}
# Load the images into a data frame
df <- load_images(image_path, categories)
# Check the dimensions of the image data
dim(df)
## [1] 342 2
colSums(is.na(df))
## label img_vector
## 0 0
load_image_features <- function(image_path) {
img <- readImage(image_path)
img_resized <- resize(img, 64, 64)
img_gray <- channel(img_resized, "gray")
as.vector(img_gray)
}
image_features <- t(sapply(df$image_path, load_image_features))
image_features <- as.data.frame(image_features)
dataset_combined <- cbind(image_features, label = df$label)
dataset_combined$label <- as.factor(dataset_combined$label)
summary(df)
## label img_vector.Length img_vector.Class img_vector.Mode
## Length:342 3072 -none- numeric
## Class :character 3072 -none- numeric
## Mode :character 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
## 3072 -none- numeric
ggplot(df, aes(x = label)) +
geom_bar(fill = "skyblue") +
theme_minimal() +
labs(title = "Distribution of Labels", x = "Class Labels", y = "Frequency")
# Flatten the img_vector column into multiple pixel columns
img_matrix <- do.call(rbind, lapply(df$img_vector, as.vector))
# Create a new data frame with flattened image data
image_data_flat <- data.frame(label = df$label, img_matrix)
# Check the new dimensions
print(dim(image_data_flat)) # Should show the number of loaded images and the number of pixel columns
## [1] 342 3073
# Convert labels to a factor if they are not already
image_data_flat$label <- as.factor(image_data_flat$label)
# Normalize the features
image_data_scaled <- scale(image_data_flat[, -which(names(image_data_flat) == "label")])
# Perform PCA
pca_result <- prcomp(image_data_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
image_data_pca <- data.frame(pca_result$x[, 1:num_components])
image_data_pca$label <- image_data_flat$label
# Split the data into training and testing sets
set.seed(123) # For reproducibility
train_index <- createDataPartition(image_data_pca$label, p = 0.7, list = FALSE)
train_data <- image_data_pca[train_index, ]
test_data <- image_data_pca[-train_index, ]
# Fit the logistic regression model on training data
logistic_model <- multinom(label ~ ., data = train_data) # Using multinom for logistic regression in multi-class case
## # weights: 15 (8 variable)
## initial value 264.765562
## iter 10 value 72.259851
## iter 20 value 67.830088
## iter 30 value 67.400965
## iter 40 value 67.340324
## iter 50 value 67.339917
## final value 67.339395
## converged
# Check the summary of the model
summary(logistic_model)
## Call:
## multinom(formula = label ~ ., data = train_data)
##
## Coefficients:
## (Intercept) PC1 PC2 PC3
## fruits -18.2414630 1.4961986 2.52751626 -1.32231203
## plants -0.9146149 0.0611278 -0.03160788 -0.08441199
##
## Std. Errors:
## (Intercept) PC1 PC2 PC3
## fruits 69.8731073 10.27823324 28.51069350 6.41683862
## plants 0.4663954 0.01739484 0.02223387 0.02210762
##
## Residual Deviance: 134.6788
## AIC: 150.6788
# Predict the probabilities for the test dataset
predicted_probs <- predict(logistic_model, newdata = test_data, type = "prob")
# Predict the class labels for the test dataset
predicted_classes <- predict(logistic_model, newdata = test_data)
# View the predicted probabilities and class labels
head(predicted_probs)
## animal fruits plants
## 1 0.9696964 6.054155e-47 0.03030357
## 2 0.9860903 4.074730e-51 0.01390965
## 3 0.9860023 1.317922e-48 0.01399770
## 9 0.9260470 7.904765e-41 0.07395301
## 10 0.8999209 9.569893e-61 0.10007908
## 15 0.9891875 1.207717e-57 0.01081245
head(predicted_classes)
## [1] animal animal animal animal animal animal
## Levels: animal fruits plants
# Create a confusion matrix for the test set
confusion_matrix <- table(Actual = test_data$label, Predicted = predicted_classes)
# View the confusion matrix
print(confusion_matrix)
## Predicted
## Actual animal fruits plants
## animal 43 0 5
## fruits 0 36 0
## plants 5 0 12
# Calculate accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Test Accuracy:", accuracy))
## [1] "Test Accuracy: 0.900990099009901"
##HEIRARCHIAL CLUSTERING WITH DENDROGRAM:
# Compute the distance matrix
dist_matrix <- dist(image_data_pca[, -which(names(image_data_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
image_data_pca$hclust_cluster <- cutree(hclust_result, k = 3)
image_data_pca$hclust_cluster
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 3 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1
## [38] 1 1 1 1 1 3 3 3 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 3 1 2 1 2 2 3 3 1 1 1
## [75] 1 1 1 1 3 3 3 3 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 3 1 1 1 3
## [112] 3 3 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1
## [149] 1 1 1 1 1 3 1 1 3 1 3 2 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 2 2 1 2 2
## [186] 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 1 1 1 2 2 1 2 2 1 1 2 2 1 1 2 2 1 1
## [223] 1 1 1 2 2 2 2 1 1 1 1 2 2 2 2 2 2 2 2 2 2 1 1 1 2 1 1 2 1 1 2 1 2 1 1 1 1
## [260] 2 2 1 1 1 2 1 1 1 1 1 2 1 2 2 2 1 2 2 1 2 2 2 2 2 3 3 3 3 3 3 1 3 3 3 3 1
## [297] 3 3 3 1 3 1 3 3 3 3 3 3 3 1 3 3 3 3 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 1 1
## [334] 3 1 1 3 3 1 1 3 3
# View the first few rows with cluster assignments
head(image_data_pca)
## PC1 PC2 PC3 label hclust_cluster
## 1 -58.20563 -5.569308 -9.8427471 animal 1
## 2 -57.48360 -4.759187 -0.1998293 animal 1
## 3 -57.76196 -2.830820 -1.1992944 animal 1
## 4 -23.58001 -1.416570 -5.0465293 animal 1
## 5 -30.73151 -11.803826 -13.0189800 animal 1
## 6 -30.28423 -15.128324 -8.2502567 animal 1
set.seed(123) # For reproducibility
k <- 4 # You can also specify a different number of clusters
str(image_data_pca)# Assuming kmeans has been applied, e.g., using kmeans_result$cluster
## 'data.frame': 342 obs. of 5 variables:
## $ PC1 : num -58.2 -57.5 -57.8 -23.6 -30.7 ...
## $ PC2 : num -5.57 -4.76 -2.83 -1.42 -11.8 ...
## $ PC3 : num -9.84 -0.2 -1.2 -5.05 -13.02 ...
## $ label : Factor w/ 3 levels "animal","fruits",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ hclust_cluster: int 1 1 1 1 1 1 1 1 1 1 ...
kmeans_result <- kmeans(image_data_pca[,1:2], centers = 3) # Example with 3 clusters
image_data_pca$cluster <- as.factor(kmeans_result$cluster)
image_data_pca$cluster
## [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 3 3 2 2 2 2 2
## [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 3 2 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 3 3 1 3 3
## [186] 1 3 3 3 3 3 3 3 3 3 3 3 3 1 3 3 1 3 3 1 1 1 3 3 1 3 3 1 1 3 3 1 1 3 3 1 1
## [223] 1 1 1 3 3 3 3 1 1 1 1 3 3 3 3 3 3 3 3 3 3 1 1 1 3 1 1 3 1 1 3 1 3 1 1 1 1
## [260] 3 3 1 1 1 3 1 1 1 1 1 3 1 3 3 3 1 3 3 1 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2
## [297] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 3 2 2 2 2 2 2 2 2 2 2
## [334] 2 2 2 2 2 2 2 2 2
## Levels: 1 2 3
# 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)
accuracy
## [1] 0.9009901
# 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, image_data_pca)
accuracy_results[accuracy_results$Hidden_Neurons == neurons_list, "Accuracy"] <- accuracy
}
## Warning in x[[jj]][iseq] <- vjj: number of items to replace is not a multiple
## of replacement length
## Warning in x[[jj]][iseq] <- vjj: number of items to replace is not a multiple
## of replacement length
## Warning in x[[jj]][iseq] <- vjj: number of items to replace is not a multiple
## of replacement length
# Print the results
print(accuracy_results)
## Hidden_Neurons Accuracy
## 1 5 158
## 2 10 0
## 3 20 3
print(neurons_list)
## [1] 5 10 20