This project aims to classify and analyze animal images using logistic regression, clustering, and neural network models. We will download images, preprocess them, and apply machine learning techniques to classify animals like cats, lions, and bears.
# Set up Unsplash API credentials and animal queries to download images
access_key <- 'oWUiAtzcuJXRjP7mM24BGOeHQXF6PIt2paTTtbvtvh8'
base_url <- 'https://api.unsplash.com/photos/random'
animal_queries <- list(
cat = 50, lion = 20, eagle = 15, beaver = 20, bear = 15, fox = 10,
swan = 10, crab = 15, jellyfish = 15, octopus = 10, ox = 15,
elephant = 20, bull = 10
)
# Function to fetch and save images
download_images <- function(query, count) {
headers <- add_headers(Authorization = paste("Client-ID", access_key))
params <- list(query = query, count = count)
response <- GET(base_url, headers, query = params)
if (status_code(response) == 200) {
data <- content(response, as = "parsed", type = "application/json")
dir.create(file.path("unsplash_images", query), recursive = TRUE, showWarnings = FALSE)
for (i in seq_along(data)) {
tryCatch({
image_url <- data[[i]]$urls$full
photographer <- data[[i]]$user$name
download_url <- data[[i]]$links$download_location
download_response <- GET(download_url, headers)
image_response <- GET(image_url)
img_path <- file.path("unsplash_images", query, paste0("image_", i, ".jpg"))
writeBin(content(image_response, as = "raw"), img_path)
cat("Downloaded", query, "image", i, "Photo by", photographer, "\n")
}, error = function(e) {
cat("Failed to download", query, "image", i, ":", e$message, "\n")
})
}
} else {
cat("Failed to retrieve data for", query, ":", status_code(response), "\n")
}
}
# Download images for each animal query
for (animal in names(animal_queries)) {
download_images(animal, animal_queries[[animal]])
}
# Create a CSV file containing the paths of all downloaded images
get_image_paths <- function(main_directory) {
image_extensions <- c(".jpg", ".jpeg", ".png", ".gif")
image_data <- data.frame(FilePath = character(), FolderName = character(), stringsAsFactors = FALSE)
dirs <- list.dirs(main_directory, recursive = TRUE)
for (dir in dirs) {
files <- list.files(dir, pattern = paste(image_extensions, collapse = "|"), full.names = TRUE)
folder_name <- basename(dir)
if (length(files) > 0) {
image_data <- bind_rows(image_data, data.frame(FilePath = files, FolderName = folder_name))
}
}
return(image_data)
}
main_directory <- file.path(getwd(), "unsplash_images")
image_data <- get_image_paths(main_directory)
write.csv(image_data, "image_paths.csv", row.names = FALSE)
library(httr)
library(jsonlite)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(neuralnet)
##
## Attaching package: 'neuralnet'
## The following object is masked from 'package:dplyr':
##
## compute
library(ggplot2)
library(glmnet)
## Loading required package: Matrix
## Loaded glmnet 4.1-8
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
library(magick)
## Linking to ImageMagick 6.9.12.98
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11
library(png)
library(jpeg)
library(glmnet)
library(EBImage)
library(recolorize)
##
## Attaching package: 'recolorize'
## The following object is masked from 'package:EBImage':
##
## readImage
library(mclust)
## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.
# Load the dataset
df <- read.csv("image_paths.csv")
# Image loading function
load_img <- function(img_path){
img <- readImage(img_path)
img_resized <- resize(img, 64, 64)
img_gray <- channel(img_resized, "gray")
as.vector(img_gray)
}
# Extract features from images
img_features <- t(sapply(df$FilePath, load_img))
img_features <- as.data.frame(img_features)
# Combine features with labels
fdf <- cbind(img_features, label = df$FolderName)
fdf$binary_label <- ifelse(fdf$label == "cat", 1, 0)
# Split the data into training and testing sets
set.seed(42)
fdf <- fdf[sample(nrow(fdf)), ]
train_indices <- 1:round(0.8 * nrow(fdf))
trainData <- fdf[train_indices, ]
testData <- fdf[-train_indices, ]
x_train <- as.matrix(trainData[, -which(names(trainData) %in% c("label", "binary_label"))])
y_train <- trainData$binary_label
x_test <- as.matrix(testData[, -which(names(testData) %in% c("label", "binary_label"))])
y_test <- testData$binary_label
x_train <- scale(x_train)
x_test <- scale(x_test)
# Train the logistic regression model
model <- cv.glmnet(x_train, y_train, family = "binomial", alpha = 1)
# Make predictions and create confusion matrix
predictions <- predict(model, newx = x_test, type = "response")
predicted_classes <- ifelse(predictions > 0.5, 1, 0)
confusionMatrix <- table(y_test, predicted_classes)
print(confusionMatrix)
## predicted_classes
## y_test 0
## 0 34
## 1 9
# Check accuracy, precision, recall, and F1 score
accuracy <- sum(diag(confusionMatrix)) / sum(confusionMatrix)
precision <- diag(confusionMatrix) / colSums(confusionMatrix)
recall <- diag(confusionMatrix) / rowSums(confusionMatrix)
f1_score <- 2 * (precision * recall) / (precision + recall)
cat("Accuracy:", accuracy, "\n")
## Accuracy: 0.7906977
cat("Precision:", precision[1], "\n")
## Precision: 0.7906977
cat("Recall:", recall[1], "\n")
## Recall: 1
cat("F1 Score:", f1_score[1], "\n")
## F1 Score: 0.8831169
The Logistic regression model has a very moderate performance since the accuracy is very low. There is class imbalance and overlapping between features
# K-means clustering on image features
set.seed(42)
scaled_features <- scale(img_features)
kmean_result <- kmeans(scaled_features, centers = length(unique(fdf$label)))
# Visualize clusters
fviz_cluster(kmean_result, data = scaled_features,
ellipse.type = "convex",
palette = "jco",
geom = "point",
ggtheme = theme_minimal(),
main = "K-Means Clustering of Animal Images")
## Warning: This manual palette can handle a maximum of 10 values. You have supplied 13
## This manual palette can handle a maximum of 10 values. You have supplied 13
## Warning: Removed 35 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_point()`).
# Compute Adjusted Rand Index (ARI)
ari <- adjustedRandIndex(kmean_result$cluster, fdf$label)
cat("Adjusted Rand Index:", ari, "\n")
## Adjusted Rand Index: 0.001881496
The clustering results indicate overlap between clusters
# Neural network model for image classification
feature_train <- names(trainData)[-which(names(trainData) %in% c("label", "binary_label"))]
labels_train <- trainData$binary_label
feature_test <- names(testData)[-which(names(testData) %in% c("label", "binary_label"))]
labels_test <- testData$binary_label
scaled_features_train <- scale(trainData[, feature_train])
scaled_features_test <- scale(testData[, feature_test])
scaled_train_data <- data.frame(scaled_features_train)
scaled_train_data$label <- labels_train
scaled_test_data <- data.frame(scaled_features_test)
scaled_test_data$label <- labels_test
# Train neural networks with different numbers of hidden neurons
nnModel5 <- neuralnet(label ~ ., data = scaled_train_data, hidden = 5)
nnModel10 <- neuralnet(label ~ ., data = scaled_train_data, hidden = 10)
nnModel20 <- neuralnet(label ~ ., data = scaled_train_data, hidden = 20)
# Predict using the trained neural networks
nnModel5_pred <- neuralnet::compute(nnModel5, scaled_test_data[,-which(names(scaled_test_data)=="label")])
nnModel10_pred <- neuralnet::compute(nnModel10, scaled_test_data[,-which(names(scaled_test_data)=="label")])
nnModel20_pred <- neuralnet::compute(nnModel20, scaled_test_data[,-which(names(scaled_test_data)=="label")])
# Convert predictions to binary labels (0 or 1)
predicted_5 <- ifelse(nnModel5_pred$net.result > 0.15, 1, 0)
predicted_10 <- ifelse(nnModel10_pred$net.result > 0.15, 1, 0)
predicted_20 <- ifelse(nnModel20_pred$net.result > 0.15, 1, 0)
# Create confusion matrices for each model
cat("Confusion matrix for 5 neurons:\n")
## Confusion matrix for 5 neurons:
print(table(predicted_5, scaled_test_data$label))
##
## predicted_5 0 1
## 0 21 5
## 1 13 4
cat("Confusion matrix for 10 neurons:\n")
## Confusion matrix for 10 neurons:
print(table(predicted_10, scaled_test_data$label))
##
## predicted_10 0 1
## 0 19 5
## 1 15 4
cat("Confusion matrix for 20 neurons:\n")
## Confusion matrix for 20 neurons:
print(table(predicted_20, scaled_test_data$label))
##
## predicted_20 0 1
## 0 21 5
## 1 13 4
The accuracy of the results indicate that the neural network performs better with 10 neurons. When the number of neurons is 5 or 20 the accuracy is lower.