Home / Predictive Modeling & Machine Learning / 203.5.9 Building a Neural Network in R

# 203.5.9 Building a Neural Network in R

### Building the Neural Network

The good news is…

• We don’t need to write the code for weights calculation and updating
• 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

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]]
``````##                                                    [,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)``````

#### R Code Options

• neuralnet(Productivity~Age+Experience,data=Emp_Productivity_raw, hidden=2, stepmax = 1e+07, threshold=0.00001, linear.output = FALSE)
• The number of hidden layers in the neural network. It is actually the number of nodes. We can input a vector to add more hidden layers
• Stepmax: The number of steps while executing algorithm. Sometimes we may need more than 100,000 steps for the algorithm to converge. Some times we may get an error “Alogorithm didn’t converge with the default step max”; We need to increase the stepmax parameter value in such cases.
• Threshold is connected to error function calculation. It can be used as a stopping criteria. If the partial derivative of error function reaches this threshold then the algorithm will stop. A lower threshold value will force the algorithm for more iterations and accuracy.
• The output is expected to be linear by default. We need to specifically mention linear.output = FALSE for classification problems

### 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’.