• No products in the cart.

203.5.9 Building a Neural Network in R

Using package neuraolab

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)

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.

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’.
The next post is about Local vs Global minimum.

Statinfer

Statinfer derived from Statistical inference. We provide training in various Data Analytics and Data Science courses and assist candidates in securing placements.

Contact Us

info@statinfer.com

+91- 9676098897

+91- 9494762485

 

Our Social Links

top
© 2020. All Rights Reserved.