Campus Placement Analysis

This project was developed by DJS Manasa , Akshara Priya Chikoti , G.Hari Prasad

About The Project

Campus Placement Analysis is a data science project conducted using the R programming language, aimed at gaining comprehensive insights into college placement trends spanning over ten years. The project utilizes a rich data set encompassing attributes such as company names, offered salaries (CTC), the number of placements made, and placement dates, segmented by branches of study.

The core objective of this study is to leverage a combination of exploratory data analysis, statistical modeling, and predictive analytics to unravel the intricate patterns and factors influencing placement outcomes across various branches of study.

Libraries Required

library(readxl)
library(ggplot2)
library(tidyr)
library(stats)
library(cluster)  
library(fpc)    
library(dplyr)

Dataset Description

The data set used in this project is downloaded from CBIT college website. The data set contains branch wise intake from the year 2009 to 2020 and eligibility criteria of the recruiting companies

excel_files_dir <- "E:/AP/SEM 6/MINOR PROJECT"
excel_files <- list.files(excel_files_dir, pattern = "\\.xlsx$", full.names = TRUE)
data_frames <- list()
for (file in excel_files) {
    file_name <- tools::file_path_sans_ext(basename(file))
    data_frames[[file_name]] <- read_excel(file)
  }
print(names(data_frames))

##  [1] "2009-10-Placements"   "2010-11_placements-1" "2011-12_placements-1"
##  [4] "2012-13_placements-1" "2013-14_placements-1" "2014-15_placements"  
##  [7] "2015-16_placements"   "2016-17-placements"   "2017-18-placements"  
## [10] "2018-19-placements"   "2019-20-Placements"   "2020-21-Placements"  
## [13] "2021-22-Placements"   "2022-2023-Placements"

Preprocessing

1.Dealing with NA values in Branch Wise Data Set :

For all the columns string ‘NA’ in columns starting from the 5th column, and replacing it with the NA missing value indicator. It ensures that missing data is properly handled across all data frames in the list.

data_clean <- lapply(data_frames, function(df) {
  for (col in 5:ncol(df)) {
    df[[col]][df[[col]] == 'NA'] <- NA
  }
  return(df)
})

NA values are replaced with 0 across all the columns

# Replace NA values with 0 for every element starting from the 5th column
data_frames_clean <- lapply(data_clean, function(df) {

  for (col in 5:ncol(df)) {
    # Replace NA values with 0 for each column
    df[[col]][is.na(df[[col]])] <- 0
  }
  return(df)
})

2.Dealing with NA values in Eligibility Criteria Data set

excel_files_dir <- "E:/AP/SEM 6/MINOR PROJECT/filtered"
excel_files <- list.files(excel_files_dir, pattern = "\\.xlsx$", full.names = TRUE)
e_frames <- list()
for (file in excel_files) {
  file_name <- tools::file_path_sans_ext(basename(file))
  e_frames[[file_name]] <- read_excel(file)
}

Columns of E-SSC, E-Inter, E-Ug, E-Pg NA values are replaced with its mean value and the remaining columns with zeros

# Load the necessary library
library(dplyr)

# Assuming e_frames is a list of data frames
# Initialize e_frames as an example
# e_frames <- list(df1, df2, ...)

# First step: Clean NA and 'N.A' values
data_e_clean <- lapply(e_frames, function(df) {
  for (col in 3:ncol(df)) {
    df[[col]][df[[col]] %in% c('NA', 'N.A')] <- NA
  }
  return(df)
})

# Second step: Remove duplicates and replace empty or NA values in specific columns
cleaned_e_frames <- lapply(data_e_clean, function(df) {
  # Remove duplicates
  df <- distinct(df)
  
  # Columns to replace empty or NA values
  columns_to_replace <- c(5, 6, 7, 8)
  
  for (col in columns_to_replace) {
    # Ensure the column exists in the data frame
    if (col <= ncol(df)) {
      empty_cells <- df[[col]] == "" | is.na(df[[col]]) | df[[col]] == " "
      
      if (sum(empty_cells, na.rm = TRUE) > 0) {
        non_empty_values <- as.numeric(df[[col]][!empty_cells])
        
        if (length(non_empty_values) > 0) {
          column_mean <- mean(non_empty_values, na.rm = TRUE)
          column_mean <- round(column_mean, 2)
          df[[col]][empty_cells] <- column_mean
        }
      }
    }
  }
  
  return(df)
})


ec_frame_clean <- lapply(cleaned_e_frames, function(df) {
  for (col in 3:ncol(df)) {
    df[[col]][is.na(df[[col]])] <- 0
  }
  return(df)
})
ec_frames_clean <- lapply(ec_frame_clean, function(df) {
  for (col in 10:ncol(df)) {
    df[[col]][df[[col]] == 'Yes'] <- 1
    df[[col]][df[[col]] == 'No'] <- 0
  }
  return(df)
})
e_final <- ec_frames_clean

3.Feature Engineering

In Branch Wise Data Set new row_sum and column_sum columns are created row_sum is the number of students recruited by that particular company , column_sum indicates number of students recruited from a particular branch

row_sums <- lapply(data_frames_clean, function(df) {
  numeric_cols <- sapply(df[, 5:ncol(df)], is.numeric)  # Identify numeric columns from column 5 onwards
  df$Row_Sum <- rowSums(df[, 5:ncol(df)][, numeric_cols])  # Compute row sums for numeric columns starting from column 5
  return(df)
})
branch_wise_totals <- list()

# Iterate over each element (data frame) in data_frames_clean
for (i in seq_along(data_frames_clean)) {
  # Extract the file name from the element index
  file_name <- names(data_frames_clean)[i]
  
  # Initialize a list to store branch-wise total intake for the current file
  file_branch_wise_totals <- list()
  
  # Iterate over each branch
  for (branch in names(data_frames_clean[[i]])[5:length(data_frames_clean[[i]])]) {  
    # Convert the column to numeric
    branch_values <- as.numeric(data_frames_clean[[i]][[branch]])
    
    # Compute total intake for the current branch
    total_intake <- sum(branch_values, na.rm = TRUE)
    
    # Store the total intake for the current branch in the file's branch-wise totals list
    file_branch_wise_totals[[branch]] <- total_intake
  }
  
  # Assign the branch-wise total intake for the current file under its file name
  branch_wise_totals[[file_name]] <- file_branch_wise_totals
}

Label Encoding

In Eligibility Criteria Data set GD,Technical,HR,Training period,Service agreement columns Yes and No are converted into 1 and 0 respectively.

ec_frames_clean <- lapply(ec_frame_clean, function(df) {
  for (col in 10:ncol(df)) {
    df[[col]][df[[col]] == 'Yes'] <- 1
    df[[col]][df[[col]] == 'No'] <- 0
  }
  return(df)
})

Analysis

Plotting year-wise intake from Branch Wise Data Set

# Assuming you want to plot the intake for the "Ece" branch
branch_name <- "TOTAL"

# Extract the branch-wise totals for the specified branch
branch_totals <- lapply(branch_wise_totals, `[[`, branch_name)

# Convert the list to a data frame
branch_df <- data.frame(
  Year = (names(branch_totals)),
  Intake = unlist(branch_totals)
)

# Load the ggplot2 package
library(ggplot2)

# Plot the year-wise intake
ggplot(data = branch_df, aes(x = factor(Year), y = Intake)) +
  geom_bar(stat = "identity", fill = "orange") + # Bar plot
  labs(title = paste("Year-wise Intake for", branch_name), x = "Year", y = "Intake") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))  # Rotate x-axis labels if needed

Plotting frequency of the companies coming for recruiting

company_freq <- data.frame(Company = character(), Frequency = numeric(), stringsAsFactors = FALSE)
for (df in e_final) {
  company_names <- df[, 2]
  company_counts <- table(company_names)
  for (company_name in names(company_counts)) {
    if (company_name %in% company_freq$Company) {
      company_freq$Frequency[company_freq$Company == company_name] <- 
        company_freq$Frequency[company_freq$Company == company_name] + company_counts[company_name]
    } else {
      company_freq <- rbind(company_freq, data.frame(Company = company_name, Frequency = company_counts[company_name]))
    }
  }
}

company_freq_df <- data.frame(Company = company_freq$Company, Frequency = company_freq$Frequency)

ggplot(data = company_freq, aes(x = reorder(Company, -Frequency), y = Frequency)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  labs(title = "Frequency of Each Company", x = "Company", y = "Frequency") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size=5))

ggplot(data = company_freq, aes(x = "", y = Company, fill = Frequency)) +
  geom_tile() +
  scale_fill_gradient(low = "skyblue", high = "red") +
  labs(title = "Frequency of Each Company", fill = "Frequency") +
  theme(axis.text.x = element_blank(),  
        axis.text.y = element_text(size = 2), 
        axis.title.x = element_blank())

Preference of the companies between UG and PG over the years

counts <- vector("list", length(e_final))
for (i in seq_along(e_final)) {
  ug_count <- 0
  pg_count <- 0
  ug_columns <- grep("^UG$|^U\\.G$", names(e_final[[i]]), value = TRUE)
  if (length(ug_columns) > 0) {
    ug_count <- sum(sapply(ug_columns, function(col) e_final[[i]][[col]]) != 0)
  }
  
  pg_columns <- grep("^PG$|^P\\.G$", names(e_final[[i]]), value = TRUE)
  if (length(pg_columns) > 0) {
    pg_count <- sum(sapply(pg_columns, function(col) e_final[[i]][[col]]) != 0)
  }
  counts[[i]] <- c(ug_count = ug_count, pg_count = pg_count)
}
counts_df <- do.call(rbind, counts)
rownames(counts_df) <- c("2015", "2016", "2017", "2018", "2019", "2020")
counts_df

##      ug_count pg_count
## 2015       29       13
## 2016       35       11
## 2017       56       16
## 2018       26       11
## 2019       30       11
## 2020       32       16

library(ggplot2)
library(tidyr)
if (!is.data.frame(counts_df)) {
  counts_df <- as.data.frame(counts_df)
}

counts_df$Year <- rownames(counts_df)
counts_long <- pivot_longer(counts_df, cols = c(ug_count, pg_count),
                            names_to = "Variable", values_to = "Count")

# Plotting
ggplot(counts_long, aes(x = Year, y = Count, fill = Variable)) +
  geom_bar(stat = "identity", position = "dodge", color = "black") +
  labs(title = "Count of companies prefering between UG and PG ",
       x = "Year",
       y = "Count") +
  scale_fill_manual(values = c("ug_count" = "skyblue", "pg_count" = "salmon")) +
  theme_minimal() +
  theme(legend.title = element_blank())

Model Building

K-MEANS

K-means clustering is an unsupervised machine learning algorithm used for grouping similar data points together. It partitions a dataset into a predefined number of clusters (k) such that data points within a cluster are more similar to each other than those in different clusters. 1. Elbow Method The elbow method is a heuristic technique used to determine the optimal number of clusters in a dataset for clustering algorithms By using elbow method we found out the number of clusters to be made

# Load required packages
library(stats)
# Select common columns across all data frames in e_final
common_columns <- Reduce(intersect, lapply(e_final, colnames))
# Concatenate data frames for each year, considering only common columns
combined_data <- do.call(rbind, lapply(e_final, function(df) df[, common_columns]))
# Select relevant features for clustering
features <- combined_data[, c(  'S-UG', 'S-PG', 'Technical', 'HR', 'Training period',
                               'Service Agreement')]

# Convert all columns to numeric
features <- sapply(features, as.numeric)
# Replace missing values with column means
imputed_features <- apply(features, 2, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE), x))
# Scale the features
scaled_features <- scale(imputed_features)
# Perform K-means clustering for different values of k
max_k <- 10  # Maximum number of clusters to consider
wcss <- numeric(max_k)
for (k in 1:max_k) {
  kmeans_result <- kmeans(scaled_features, centers = k)
  wcss[k] <- kmeans_result$tot.withinss
}
# Plot the elbow curve
plot(1:max_k, wcss, type = "b", pch = 19, xlab = "Number of Clusters (k)", ylab = "Within-Cluster Sum of Squares (WCSS)",
     main = "Elbow Method for Optimal k")

2.Clustering

we are performing K-means clustering with the optimal number of clusters (assumed to be 3 based on the elbow method) on scaled features. Then, we’re conducting Principal Component Analysis (PCA) on the scaled features and visualizing the data in a two-dimensional space using the first two principal components, with each point colored according to its assigned cluster.

# Load required packages
library(ggplot2)
optimal_k <- 3  # Assuming the elbow method suggested k = 3
kmeans_result <- kmeans(scaled_features, centers = optimal_k)
cluster_assignments <- kmeans_result$cluster

# Perform PCA
pca_result <- prcomp(scaled_features, center = TRUE, scale. = TRUE)

# Extract the principal components
pca_data <- as.data.frame(pca_result$x)

# Add cluster assignments to PCA data
pca_data$Cluster <- as.factor(cluster_assignments)
ggplot(data = pca_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 2) +
  labs(title = "Cluster Visualization (PCA)",
       x = "Principal Component 1",
       y = "Principal Component 2",
       color = "Cluster") +
  theme_minimal()

3.Evaluation

we’re evaluating the performance of the K-means clustering model by computing various clustering evaluation metrics such as Within-cluster Sum of Squares (WCSS) , Average Silhouette Score , Davies-Bouldin Index , and Dunn Index. These metrics provide insights into the compactness, separation, and overall quality of the clusters formed by the algorithm.

# Load required packages
install.packages("cluster")
install.packages("fpc")

library(cluster)  # For silhouette score
library(fpc)      # For cluster.stats function

# Assuming kmeans_result is the result of K-means clustering

# Compute Within-cluster Sum of Squares (WCSS)
wcss <- kmeans_result$tot.withinss

# Compute Silhouette Score
silhouette_score <- silhouette(cluster_assignments, dist(scaled_features))
avg_silhouette_score <- mean(silhouette_score[, 3])

# Compute Davies-Bouldin Index
db_index <- cluster.stats(dist(scaled_features), cluster_assignments)$db

# Compute Dunn Index
dunn_index <- cluster.stats(dist(scaled_features), cluster_assignments)$dunn

# Print the computed metrics
cat("Within-cluster Sum of Squares (WCSS):", wcss, "\n")

## Within-cluster Sum of Squares (WCSS): 965.9789

cat("Average Silhouette Score:", avg_silhouette_score, "\n")

## Average Silhouette Score: 0.3852957

cat("Davies-Bouldin Index:", db_index, "\n")

## Davies-Bouldin Index:

cat("Dunn Index:", dunn_index, "\n")

## Dunn Index: 0.1650203

Conclusion

In our project, we employed K-means clustering and Principal Component Analysis (PCA) to gain insights into the placement patterns of students. By determining the optimal number of clusters using the elbow method, we segmented the dataset into distinct groups, each representing a different placement profile. Visualizing these clusters using PCA allowed us to discern underlying trends and patterns in the placement data.

Furthermore, we evaluated the clustering performance using metrics such as Within-cluster Sum of Squares (WCSS), Average Silhouette Score, Davies-Bouldin Index, and Dunn Index. These metrics provided a comprehensive assessment of the clustering quality, indicating the compactness, separation, and overall effectiveness of the clustering algorithm.

The analysis provides actionable insights for universities, recruiters, and students to optimize placement strategies and decision-making processes. By leveraging data-driven approaches, stakeholders can identify areas for improvement and enhance overall placement effectiveness. This project lays the groundwork for further research and optimization endeavors in campus placement dynamics.