Datathon

Nerual Newtwork to predict alcohol consumption level

Step 1: read in the data set

alcohol <- read.csv("3.27 spor.csv")
alcohol <- cbind(alch = 0, alcohol)
alcohol$alch <- alcohol$alc
alcohol <- subset(alcohol, select = - c(alc))
str(alcohol)

## 'data.frame':    649 obs. of  18 variables:
##  $ alch      : int  0 0 1 0 1 1 0 0 0 0 ...
##  $ school    : Factor w/ 2 levels "GP","MS": 1 1 1 1 1 1 1 1 1 1 ...
##  $ sex       : Factor w/ 2 levels "F","M": 1 1 1 1 1 2 2 1 2 2 ...
##  $ age       : int  18 17 15 15 16 16 16 17 15 15 ...
##  $ address   : Factor w/ 2 levels "R","U": 2 2 2 2 2 2 2 2 2 2 ...
##  $ famsize   : Factor w/ 2 levels "GT3","LE3": 1 1 2 1 1 2 2 1 2 1 ...
##  $ Pstatus   : Factor w/ 2 levels "A","T": 1 2 2 2 2 2 2 1 1 2 ...
##  $ Medu      : int  4 1 1 4 3 4 2 4 3 3 ...
##  $ Fedu      : int  4 1 1 2 3 3 2 4 2 4 ...
##  $ studytime : int  2 2 2 3 2 2 2 2 2 2 ...
##  $ activities: Factor w/ 2 levels "no","yes": 1 1 1 2 1 2 1 1 1 2 ...
##  $ romantic  : Factor w/ 2 levels "no","yes": 1 1 1 2 1 1 1 1 1 1 ...
##  $ famrel    : int  4 5 4 3 4 5 4 4 4 5 ...
##  $ freetime  : int  3 3 3 2 3 4 4 1 2 5 ...
##  $ goout     : int  4 3 2 2 2 2 4 4 2 1 ...
##  $ health    : int  3 3 3 5 5 5 3 1 1 5 ...
##  $ absences  : int  4 2 6 0 0 6 0 2 0 0 ...
##  $ grades    : num  11 10.3 12.3 14 12.3 ...

Step 2: convert factors into dummy varibles

library(dummies)

## dummies-1.5.6 provided by Decision Patterns

alcohol <- dummy.data.frame(alcohol, sep = '.')

Step 3: normalize numeric varibles into scale of 1

normalize <- function(x) { 
  return((x - min(x)) / (max(x) - min(x)))
}
alcohol <- as.data.frame(lapply(alcohol, normalize))

Step 4: build the training set and testing test

train_id <- sample(seq(nrow(alcohol)), floor(0.7*nrow(alcohol)))
test_id <- seq((nrow(alcohol)))[-train_id]
train <- alcohol[train_id,]
test <- alcohol[test_id,]

Step 5: build the nerual netork model

library(neuralnet)
alcohol.model <- neuralnet(alch ~ school.GP + school.MS + sex.F + sex.M + age + address.R + address.U + famsize.GT3 + famsize.LE3 + Pstatus.A +     
Pstatus.T + Medu + Fedu + studytime + activities.no + activities.yes + romantic.no + romantic.yes + famrel + freetime + goout + health + absences + grades, data = alcohol)
plot(alcohol.model)

Step6: evaluate the model

model.result <- compute(alcohol.model, test[-1])
predicted_alc <- model.result$net.result
predicted_alc[predicted_alc > 0.5] <- 1
predicted_alc[predicted_alc <= 0.5] <- 0
agreement <- predicted_alc == test$alch
table(agreement)

## agreement
## FALSE  TRUE 
##    57   138

prop.table(table(agreement))

## agreement
##        FALSE         TRUE 
## 0.2923076923 0.7076923077

Step 7: improve model

# choose hidden = 5
alcohol.model <- neuralnet(alch ~ school.GP + school.MS + sex.F + sex.M + age + address.R + address.U + famsize.GT3 + famsize.LE3 + Pstatus.A +     
Pstatus.T + Medu + Fedu + studytime + activities.no + activities.yes + romantic.no + romantic.yes + famrel + freetime + goout + health + absences + grades, data = alcohol,hidden = 5)
plot(alcohol.model)

model.result <- compute(alcohol.model, test[-1])
predicted_alc <- model.result$net.result
predicted_alc[predicted_alc > 0.5] <- 1
predicted_alc[predicted_alc <= 0.5] <- 0
agreement <- predicted_alc == test$alch
table(agreement)

## agreement
## FALSE  TRUE 
##    35   160

prop.table(table(agreement))

## agreement
##        FALSE         TRUE 
## 0.1794871795 0.8205128205

# choose hidden = 10
alcohol.model <- neuralnet(alch ~ school.GP + school.MS + sex.F + sex.M + age + address.R + address.U + famsize.GT3 + famsize.LE3 + Pstatus.A +     
Pstatus.T + Medu + Fedu + studytime + activities.no + activities.yes + romantic.no + romantic.yes + famrel + freetime + goout + health + absences + grades, data = alcohol,hidden = 10)
plot(alcohol.model)

model.result <- compute(alcohol.model, test[-1])
predicted_alc <- model.result$net.result
predicted_alc[predicted_alc > 0.5] <- 1
predicted_alc[predicted_alc <= 0.5] <- 0
agreement <- predicted_alc == test$alch
table(agreement)

## agreement
## FALSE  TRUE 
##    12   183

prop.table(table(agreement))

## agreement
##         FALSE          TRUE 
## 0.06153846154 0.93846153846

Conclusion:  
When number of neurons goes from 1 to 5, we improve the prediction accuracy from 71.8% to 83.1%.  When the number of neurons goes from 5 to 10, prediciton accuracy increases from 83.1% to 91.8%.  
      

Compare with Support Vector Machine Model

library(kernlab)
train$alch <- factor(train$alch)
classifier <- ksvm(alch~., data = train, kernel= "rbfdot")
prediction <- predict(classifier, test)
agreement <- prediction == test$alch
table(agreement)

## agreement
## FALSE  TRUE 
##    58   137

prop.table(table(agreement))

## agreement
##        FALSE         TRUE 
## 0.2974358974 0.7025641026

Conclusion:  
the accuracy is only 62.6% and therefore, we think nerual network is a better model.