Employee Group Classification

library(readxl)

download.file("https://dport96.github.io/Elementary-Business-Analytics-Case-Book/Predicting_MBA_Student_Success/MBAStudents.xlsm", "Employee_data.xlsm", mode = "wb")

trying URL 'https://dport96.github.io/Elementary-Business-Analytics-Case-Book/Predicting_MBA_Student_Success/MBAStudents.xlsm'
Content type 'application/vnd.ms-excel.sheet.macroenabled.12' length 13099 bytes (12 KB)
downloaded 12 KB

Employee_data <- read_excel("Employee_data.xlsm", sheet = "New Applicants")

MBAStudents <- read_excel("Employee_data.xlsm", sheet = "Data")

MBAStudents

Employee_data

Data Legend: Training sample - MBA Students data to determine classifiction models New Candidates - data of new MBA candidates we want to classify Obs: label for an employee’s data Group: categorical, rating: 1 = good, 2 = bad Mechanical: numerical, GPA Verbal: numerical, GMAT Candidate: label to identify candidate application worthiness

library(ggplot2)
ggplot(MBAStudents, aes(x=GMAT, color=factor(Rating))) + geom_density()

NA
NA
NA

ggplot(MBAStudents, aes(x=GPA, color=factor(Rating))) + geom_density()

library("e1071")
mdl_bayes <- naiveBayes(as.factor(Rating) ~ GPA + GMAT, data = MBAStudents)

predict(mdl_bayes, MBAStudents) 

 [1] 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 1 2 1 1 1 1 1 1 1 2 2 2 1 1 1 1 1 1 1 1 1 1 1
[39] 2 1 2 1 1 2 2 2 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2
Levels: 1 2

predict(mdl_bayes, MBAStudents, type="raw") 

                 1           2
 [1,] 0.9159113434 0.084088657
 [2,] 0.6171307093 0.382869291
 [3,] 0.6996038377 0.300396162
 [4,] 0.8645510687 0.135448931
 [5,] 0.8840126747 0.115987325
 [6,] 0.9976787518 0.002321248
 [7,] 0.9651736199 0.034826380
 [8,] 0.9910268431 0.008973157
 [9,] 0.7238444714 0.276155529
[10,] 0.9745311222 0.025468878
[11,] 0.4834339789 0.516566021
[12,] 0.4830877588 0.516912241
[13,] 0.4024052207 0.597594779
[14,] 0.3293759356 0.670624064
[15,] 0.3176000438 0.682399956
[16,] 0.8565016950 0.143498305
[17,] 0.1674744375 0.832525562
[18,] 0.8740541462 0.125945854
[19,] 0.7438348673 0.256165133
[20,] 0.9808622746 0.019137725
[21,] 0.8310979371 0.168902063
[22,] 0.8500090882 0.149990912
[23,] 0.9759815448 0.024018455
[24,] 0.8316514416 0.168348558
[25,] 0.3371462635 0.662853736
[26,] 0.0612498183 0.938750182
[27,] 0.3938566454 0.606143355
[28,] 0.9097135756 0.090286424
[29,] 0.6382607642 0.361739236
[30,] 0.9650820579 0.034917942
[31,] 0.8492406081 0.150759392
[32,] 0.5455267822 0.454473218
[33,] 0.7799450241 0.220054976
[34,] 0.8619003910 0.138099609
[35,] 0.9064901400 0.093509860
[36,] 0.8412858987 0.158714101
[37,] 0.5520961465 0.447903854
[38,] 0.7708834557 0.229116544
[39,] 0.4122735897 0.587726410
[40,] 0.6498318759 0.350168124
[41,] 0.0071923832 0.992807617
[42,] 0.5060932050 0.493906795
[43,] 0.7187741226 0.281225877
[44,] 0.2227099999 0.777290000
[45,] 0.0006022091 0.999397791
[46,] 0.0356016205 0.964398380
[47,] 0.3276040448 0.672395955
[48,] 0.0580782815 0.941921719
[49,] 0.1106438439 0.889356156
[50,] 0.0646751957 0.935324804
[51,] 0.0060385037 0.993961496
[52,] 0.7085174337 0.291482566
[53,] 0.3546824355 0.645317565
[54,] 0.1863561918 0.813643808
[55,] 0.0090260182 0.990973982
[56,] 0.1535016365 0.846498364
[57,] 0.5297031496 0.470296850
[58,] 0.4707600468 0.529239953
[59,] 0.2388813944 0.761118606
[60,] 0.3850750332 0.614924967
[61,] 0.0919710389 0.908028961
[62,] 0.0397188664 0.960281134
[63,] 0.0238758237 0.976124176
[64,] 0.1537573986 0.846242601
[65,] 0.4041512317 0.595848768
[66,] 0.0197229385 0.980277062
[67,] 0.1210541435 0.878945857
[68,] 0.0959857102 0.904014290
[69,] 0.0188980359 0.981101964
[70,] 0.0257789450 0.974221055

decision plot defining:

decisionplotgg <- function(model, model_data, x = NULL, y = NULL, class = NULL, predict_type = "class", cutoff_value=0.5,
                           resolution = 100, main="Decision Plot", ...) {
  data <- as.data.frame(cbind(model_data[x], model_data[y], model_data[class]))
  
  if(!is.null(class)) cl <- as.factor(data[,class]) else cl <- 1
  
  # make grid
  r <- sapply(data[,1:2], range, na.rm = TRUE)
  xs <- seq(r[1,1], r[2,1], length.out = resolution)
  ys <- seq(r[1,2], r[2,2], length.out = resolution)
  g <- cbind(rep(xs, each=resolution), rep(ys, time = resolution))
  colnames(g) <- colnames(r)
  g <- as.data.frame(g)
  
  ### guess how to get class labels from predict
  ### (unfortunately not very consistent between models so best to check)
  p <- predict(model, g, type = predict_type)
  ### If class predictions are not available, try to construct them by 
  ### assuming class liklihoods are returned
  if( length(dim(p)) == 2) p <- ifelse( p[,1] >= p[,2], names(as.data.frame(p))[1], names(as.data.frame(p))[2])
  g <- as.data.frame(cbind(g,p))
  # If predict gives a list then extract the classes
  if(is.list(p)) p <- p$class
  # what if we get responses not classes? Assume these are liklihoods with 0.5 priors
  if(class(p)=="numeric" && is.null(dim(p))) p <- (p >= cutoff_value)*1 + 1
  p <- as.factor(p) # make sure these are factors
  
  dplot <- ggplot() + labs(title = main) + geom_point(data = data, aes_(x = as.name(names(data)[1]), y = as.name(names(data)[2]), color = cl), size = 2, shape=as.numeric(cl)) 
  dplot <- dplot + geom_contour(data = g, aes_(x=as.name(names(g)[1]), y=as.name(names(g)[2]), z = as.numeric(p))) 
  dplot + geom_tile(data = g, aes_(x=as.name(names(g)[1]), y=as.name(names(g)[2]),fill = p), alpha=0.2, show.legend=FALSE)
}

naive bayes plot: - visual of the decision rule showing the boundary between the ratings for the GPA and GMAT numerical values of the independent variables - useful in interpreting classification rule

decisionplotgg(mdl_bayes, MBAStudents, x="GPA", y="GMAT", class = "Rating", main = "Naive Bayes") -> NB_decision_plot
NB_decision_plot