Monday, August 2, 2021

Ordinal Logistic Regression (OLR) in Neural Network (NN) using R

 library(neuralnet)

library("ISLR")


#load data

data<- read.csv(file.choose())

colnames(data)


smp_size <- floor(0.75 * nrow(data))

train_ind <- sample(seq_len(nrow(data)), size = smp_size)


train <- mtcars[train_ind, ]

test <- mtcars[-train_ind, ]


#divide training and testing data

mean_data <- apply(data[2:11], 2, mean)


sd_data <- apply(data[2:11], 2, sd)


data_scaled <- as.data.frame(scale(data[,2:11],center = mean_data, scale = sd_data))


head(data_scaled, n=20)


index = sample(1:nrow(data),round(0.70*nrow(data)))


train_data <- as.data.frame(data_scaled[index,])


test_data <- as.data.frame(data_scaled[-index,])



# Custom activation function

softplus <- function(x) 1 / (1 + exp(-x))

nn <- neuralnet((KABCO=="2") ~ Covid + Speed+ Volume+ Drug_Alco+

                  Lighting+ Road_Surface+ Speeding+ Work_Zone_Related+

                  Weather_Condition, train_data,

                linear.output = FALSE, hidden = c(9,9), act.fct = softplus,

                likelihood=TRUE, threshold=0.01)

print(nn)

plot(nn)

summary(nn)

predict_olr <- predict(nn,test_data)

plot(test_data$KABCO,predict_olr$nn,col='black',main='Real vs predicted for neural network',pch=18,cex=4)

abline(1,2,3,4,5, lwd=5)


#Check the data - actual and predicted

final_output=cbind (Input, Output,

                    as.data.frame(model$net.result) )

colnames(final_output) = c("Input", "Expected Output",

                           "Neural Net Output" )

print(final_output)


#for 2 row and 2 column

par(mfrow=c(2,2))


gwplot(net.infert, selected.covariate="parity")

gwplot(net.infert, selected.covariate="induced")

gwplot(net.infert, selected.covariate="spontaneous")


#mse

predict_net_test <- compute(nn,test_data)


MSE.net <- sum((test_data$KABCO - predict_net_test$net.result)^2)/nrow(test_data)

MSE.net



#####################################################################

#Confusion matrix

library(caret)

library(e1071)


# training


p<- predict(nn, train_data)


tab<- table(p, train_data$KABCO)


tab


1-sum(diag(tab))/sum(tab)






#testing


p1<- predict(nn, test_data)


tab1<- table(p1, test_data$KABCO)


tab1


1-sum(diag(tab1))/sum(tab1)




#end




#data


confusionMatrix(data$KABCO, sample(data$KABCO))


newPrior <- c(.05, .8, .15, 0.5, 0.9)


names(newPrior) <- levels(data$KABCO)




cm <-confusionMatrix(data$KABCO, sample(data$KABCO))




#2


# extract the confusion matrix values as data.frame


cm_d <- as.data.frame(cm$table)


# confusion matrix statistics as data.frame


cm_st <-data.frame(cm$overall)


# round the values


cm_st$cm.overall <- round(cm_st$cm.overall,2)




# here we also have the rounded percentage values


cm_p <- as.data.frame(prop.table(cm$table))


cm_d$Perc <- round(cm_p$Freq*100,2)




#3


library(ggplot2)     # to plot


library(gridExtra)   # to put more


library(grid)        # plot together




# plotting the matrix


cm_d_p <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+

  

  geom_tile() +

  

  geom_text(aes(label = paste("",Freq,",",Perc,"%")), color = 'red', size = 8) +

  

  theme_light() +

  

  guides(fill=FALSE) 




# plotting the stats


cm_st_p <-  tableGrob(cm_st)




# all together


grid.arrange(cm_d_p, cm_st_p,nrow = 1, ncol = 2, 

             

             top=textGrob("Confusion Matrix and Statistics",gp=gpar(fontsize=25,font=1)))


#search confusion matrix plot




###########################################################################

#Creates vectors having data points


expected_value <- factor(train_data[c("KABCO"))

predicted_value <- factor(test_data[c("KABCO"))


#Creating confusion matrix

example <- confusionMatrix(data=predicted_value, reference = expected_value)


#Display results 

example


table(expected_value,predicted_value)


#install required packages

install.packages('gmodels')

#import required library 

library(gmodels)


#Computes the crosstable calculations

CrossTable(expected_value,predicted_value)





0 comments:

Post a Comment