203.5.9 Building a Neural Network in R

Building the Neural Network

In previous section, we studied about Neural Network Algorithm-Demo

The good news is…

• We don’t need to write the code for weights calculation and updating
• There readymade codes, libraries and packages available in R
• The gradient descent method is not very easy to understand for a non mathematics students
• Neural network tools don’t expect the user to write the code for the full length back propagation algorithm

Building the Neural Network in R

• We have a couple of packages available in R
• We need to mention the dataset, input, output & number of hidden layers as input.
• Neural network calculations are very complex. The algorithm may take sometime to produce the results
• One need to be careful while setting the parameters. The runtime changed based on the input parameter values

LAB: Building the neural network in R

• Build a neural network for XOR data
• Dataset: Emp_Productivity/Emp_Productivity.csv
• Draw a 2D graph between age, experience and productivity
• Build neural network algorithm to predict the productivity based on age and experience
• Plot the neural network with final weights

#Build a neural network for XOR data
xor_data <- read.csv("C:\\Amrita\\Datavedi\\Gates\\xor.csv")

library(neuralnet)
xor_nn_model<-neuralnet(output~input1+input2,data=xor_data,hidden=2, linear.output = FALSE, threshold = 0.0000001)
plot(xor_nn_model)
xor_nn_model

## $call
## neuralnet(formula = output ~ input1 + input2, data = xor_data, 
##     hidden = 2, threshold = 0.0000001, linear.output = FALSE)
## 
## $response
##   output
## 1      0
## 2      1
## 3      1
## 4      0
## 
## $covariate
##      [,1] [,2]
## [1,]    1    1
## [2,]    1    0
## [3,]    0    1
## [4,]    0    0
## 
## $model.list
## $model.list$response
## [1] "output"
## 
## $model.list$variables
## [1] "input1" "input2"
## 
## 
## $err.fct
## function (x, y) 
## {
##     1/2 * (y - x)^2
## }
## <environment: 0x0000000016553c10>
## attr(,"type")
## [1] "sse"
## 
## $act.fct
## function (x) 
## {
##     1/(1 + exp(-x))
## }
## <environment: 0x0000000016553c10>
## attr(,"type")
## [1] "logistic"
## 
## $linear.output
## [1] FALSE
## 
## $data
##   input1 input2 output
## 1      1      1      0
## 2      1      0      1
## 3      0      1      1
## 4      0      0      0
## 
## $net.result
## $net.result[[1]]
##              [,1]
## 1 0.0003185101884
## 2 0.9996257314867
## 3 0.9996630653497
## 4 0.0003185325238
## 
## 
## $weights
## $weights[[1]]
## $weights[[1]][[1]]
##              [,1]         [,2]
## [1,]  12.35701619  14.52331515
## [2,]  27.92334230 -29.82025809
## [3,] -25.13123326  30.97532827
## 
## $weights[[1]][[2]]
##              [,1]
## [1,]  23.93704062
## [2,] -16.04687427
## [3,] -15.94171059
## 
## 
## 
## $startweights
## $startweights[[1]]
## $startweights[[1]][[1]]
##               [,1]           [,2]
## [1,] -0.7988483694  1.47000823414
## [2,]  0.6305789956 -0.02025809359
## [3,]  0.0349316111  1.96285115316
## 
## $startweights[[1]][[2]]
##               [,1]
## [1,]  0.6396722330
## [2,] -1.1034476353
## [3,] -0.4925817729
## 
## 
## 
## $generalized.weights
## $generalized.weights[[1]]
##                [,1]              [,2]
## 1 -0.00004428782727  0.00002962249121
## 2  0.00010806080751 -0.00011224647941
## 3 -0.00126935589219  0.00114243053961
## 4 -0.00169227096813  0.00149056306649
## 
## 
## $result.matrix
##                                          1
## error                   0.0000002282567938
## reached.threshold       0.0000000893602715
## steps                 299.0000000000000000
## Intercept.to.1layhid1  12.3570161856417933
## input1.to.1layhid1     27.9233423046044855
## input2.to.1layhid1    -25.1312332602235671
## Intercept.to.1layhid2  14.5233151451645366
## input1.to.1layhid2    -29.8202580935878032
## input2.to.1layhid2     30.9753282731611250
## Intercept.to.output    23.9370406200377168
## 1layhid.1.to.output   -16.0468742667940738
## 1layhid.2.to.output   -15.9417105903462328
## 
## attr(,"class")
## [1] "nn"

#Decision Boundaries
m1_slope <- xor_nn_model$weights[[1]][[1]][2]/(-xor_nn_model$weights[[1]][[1]][3])
m1_intercept <- xor_nn_model$weights[[1]][[1]][1]/(-xor_nn_model$weights[[1]][[1]][3])

m2_slope <- xor_nn_model$weights[[1]][[1]][5]/(-xor_nn_model$weights[[1]][[1]][6])
m2_intercept <- xor_nn_model$weights[[1]][[1]][4]/(-xor_nn_model$weights[[1]][[1]][6])

####Drawing the Decision boundary

library(ggplot2)
base<-ggplot(xor_data)+geom_point(aes(x=input1,y=input2,color=factor(output),shape=factor(output)),size=5)
base+geom_abline(intercept = m1_intercept , slope = m1_slope, colour = "blue", size = 2) +geom_abline(intercept = m2_intercept , slope = m2_slope, colour = "blue", size = 2) 

#Build neural network algorithm to predict the productivity based on age and experience
library(neuralnet)
Emp_Productivity_nn_model1<-neuralnet(Productivity~Age+Experience,data=Emp_Productivity_raw )
plot(Emp_Productivity_nn_model1)

#Including the option Linear.output
Emp_Productivity_nn_model1<-neuralnet(Productivity~Age+Experience,data=Emp_Productivity_raw, linear.output = FALSE)
plot(Emp_Productivity_nn_model1)

#Including the option Hidden layers
Emp_Productivity_nn_model1<-neuralnet(Productivity~Age+Experience,data=Emp_Productivity_raw, hidden=2,linear.output = FALSE)
plot(Emp_Productivity_nn_model1)

####Results and Intime validation
actual_values<-Emp_Productivity_raw$Productivity
Predicted<-Emp_Productivity_nn_model1$net.result[[1]]
head(Predicted)

##                                                    [,1]
## 1 0.000000000000000000000119533394902859312351924014894
## 2 0.000000000000000000000000000000000000000001603279924
## 3 0.000000000000000000000000044343283346655628096577573
## 4 0.000000000000000000000000000000000000000446140716678
## 5 0.000000000000000000000000031580168948958869472830313
## 6 0.000000000000000000000000000000000000002386761799388

#The root mean square error
sqr_err<-(actual_values-Predicted)^2
sum(sqr_err)

## [1] 23.49729814

mean(sqr_err)

## [1] 0.1974562869

sqrt(mean(sqr_err))

## [1] 0.444360537

#Plottig Actual and Predicted
plot(actual_values)
points(Predicted, col=2)

#Plottig Actual and Predicted using ggplot
library(ggplot2)
library(reshape2)
act_pred_df<-data.frame(actual_values,Predicted)
act_pred_df$id<-rownames(act_pred_df)
act_pred_df_melt = melt(act_pred_df, id.vars ="id")
ggplot(act_pred_df_melt,aes(id, value, colour = variable)) + geom_point() 


##Plotting Actual and Predicted using ggplot on classification graph
Emp_Productivity_pred_act<-data.frame(Emp_Productivity_raw,Predicted=round(Predicted,0))
library(ggplot2)
#Graph without predictions
ggplot(Emp_Productivity_pred_act)+geom_point(aes(x=Age,y=Experience,color=factor(Productivity)),size=5)

#Graph with predictions
ggplot(Emp_Productivity_pred_act)+geom_point(aes(x=Age,y=Experience,color=factor(Productivity),shape=factor(Predicted)),size=5)

Output: Building the neural network in R

Code- Prediction using NN

new_data<-data.frame(Age=40, Experience=12)
compute(Emp_Productivity_nn_model1, new_data)

## $neurons
## $neurons[[1]]
##      1 Age Experience
## [1,] 1  40         12
## 
## $neurons[[2]]
##      [,1]                        [,2]
## [1,]    1 0.0000000000000000968980272
##                                                                                                                 [,3]
## [1,] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005100784947
## 
## 
## $net.result
##             [,1]
## [1,] 0.476638241

There can be many solutions

With the threshold 0.5 the above output will be ‘0’.