Multiple Linear Regression & Factor Analysis in R
By: Jay Narayan
Tags: Feature Engineering, Predictive Modeling, Data Science, Data Visualization, Machine Learning

#Plot a Scree plot using base plot:

Factor = c(1,2,3,4,5,6,7,8,9,10,11)

Eigen_Values <-ev$values

Scree <- data.frame(Factor, Eigen_Values)

plot(Scree, main = "Scree Plot", col= "Blue",ylim=c(0,4))

lines(Scree,col='Red')

abline(h = 1, col="Green") #Plotting Scree plot using ggplot

library(ggplot2)

ggplot(data = Scree,mapping = aes(x=Factor,y=Eigen_Values))+

geom_point()+

geom_line()+

scale_y_continuous(name="Eigen Values",limits = c(0,4))+

theme(panel.background = element_blank())+

theme(plot.background = element_blank())+

theme(panel.grid.major.y = element_line(colour = "skyblue"))+

ggtitle("Scree Plot")

So as per the elbow or Kaiser-Guttman normalization rule, we are good to go ahead with 4 factors.

Let’s use 4 factors to perform the factor analysis. Also, let’s use orthogonal rotation (varimax) because in orthogonal rotation the rotated factors will remain uncorrelated whereas in oblique rotation the resulting factors will be correlated.

There are different method to calculate factor some of which are :

1. Factor analysis using the factanal method:

#Using factanal command:

nfactors <- 4

fit <- factanal(data2, nfactors, scores = c( "regression" ),rotation = "none" )

print(fit) #Varimax Rotation

fit1 <-factanal(data2,nfactors,scores = c( "regression" ),rotation = "varimax" )

print(fit1)

2.Factor analysis using fa method:

#If fm=pa, factor analysis using principal axis method:

fanone <- fa(r=data2, nfactors = 4 , rotate= "none" ,fm= "pa" )

print(fanone)

Graph Factor Loading Matrices

Factor analysis results are typically interpreted in terms of the major loadings on each factor. These structures may be represented as a table of loadings or graphically, where all loadings with an absolute value > some cut point are represented as an edge (path).

fa.diagram(fanone)

rotate= "none" Factor Graph

fanone$loadings

The first 4 factors have an Eigenvalue >1 and which explains almost 69% of the variance. We can effectively reduce dimensionality from 11 to 4 while only losing about 31% of the variance.

Factor 1 accounts for 29.20% of the variance; Factor 2 accounts for 20.20% of the variance; Factor 3 accounts for 13.60% of the variance; Factor 4 accounts for 6% of the variance. All the 4 factors together explain for 69% of the variance in performance.

#Rotated:

fa1<- fa(r=data2, nfactors = 4 , rotate= "varimax" ,fm= "pa" )

print(fa1)

fa1$loadings

#Print the factors diagram

fa.diagram(fa1)

Rotate= "varimax" FA Graph

The red dotted line means that Competitive Pricing marginally falls under the PA4 bucket and the loading are negative.

Labeling and interpretation of the factors

#Scores for all the rows:

head(fa1$scores)

Regression analysis using the factors scores as the independent variable:

Let’s combine the dependent variable and the factor scores into a dataset and label them.

regdata <- cbind(data1[12], fa1$scores)

#Labeling the data



names(regdata) <- c("Satisfaction", "Purchase", "Marketing",

"Post_purchase", "Prod_positioning")

head(regdata)

Let’s split the dataset into training and testing dataset (70:30)

#Splitting the data 70:30

#Random number generator, every time I run this coomand I come

#up with different random numbers. set.seed(100)

indices= sample(1:nrow(regdata), 0.7*nrow(regdata))

train=regdata[indices,]

test = regdata[-indices,]

Let’s train the regression model.

#Regression Model using train data

model1 = lm(Satisfaction~., train)

summary(model1)

The factors Purchase, Marketing, Prod_positioning are highly significant and Post_purchase is not significant in the model.

Let’s check the VIF scores.

As per the VIF values, we don’t have multicollinearity in the model1.

Now let’s check prediction of the model in the test dataset.

#Model Performance metrics:

library(Metrics)

#Model 1:

pred_test1 <- predict(model1, newdata = test, type = "response")

pred_test1

#Find MSE and MAPE scores:

#MSE/ MAPE of Model1

test$Satisfaction_Predicted <- pred_test1

head(test[c(1,6)], 10)

test_r2 <- cor(test$Satisfaction, test$Satisfaction_Predicted) ^2



mse_test1 <- mse(test$Satisfaction, pred_test1)

rmse_test1 <- sqrt(mse(test$Satisfaction, pred_test1))

mape_test1 <- mape(test$Satisfaction, pred_test1) model1_metrics <- cbind(mse_test1,rmse_test1,mape_test1,test_r2)

print(model1_metrics, 3) ## mse_test1 rmse_test1 mape_test1 test_r2

## [1,] 0.438 0.662 0.0864 0.64

As the feature “Post_purchase” is not significant so we will drop this feature and then let’s run the regression model again.

##Regression model without post_purchase:

model2 <- lm(Satisfaction ~ Purchase+ Marketing+

Prod_positioning, data= train)

summary(model2)

Using the model2 to predict the test dataset.

pred_test2 <- predict(model2, newdata = test, type = "response")

pred_test2

test$Satisfaction_Predicted2 <- pred_test2

head(test[c(1,7)], 10)

test_r22 <- cor(test$Satisfaction, test$Satisfaction_Predicted2) ^2

mse_test2 <- mse(test$Satisfaction, pred_test2)

rmse_test2 <- sqrt(mse(test$Satisfaction, pred_test2))

mape_test2 <- mape(test$Satisfaction, pred_test2)



model2_metrics <- cbind(mse_test2,rmse_test2,mape_test2,test_r22)

model2_metrics ## mse_test2 rmse_test2 mape_test2 test_r22

## [1,] 0.4224132 0.6499332 0.08447357 0.6515163 Overall <- rbind(model1_metrics,model2_metrics)

row.names(Overall) <- c("Test1", "Test2")

colnames(Overall) <- c("MSE", "RMSE", "MAPE", "R-squared")

print(Overall,3)

Test1 Model matrix is with all 4 Factored features.

Test2 Model matrix is without the factored feature “Post_purchase”.

##Model with Interaction:

names(regdata)

## [1] "Satisfaction" "Purchase" "Marketing"

## [4] "Post_purchase" "Prod_positioning" model3 <- lm(lm(Satisfaction ~ Purchase+ Marketing+ Post_purchase+

Prod_positioning+ Purchase*Post_purchase+

Marketing*Prod_positioning+ Purchase* Marketing+

Purchase* Prod_positioning*Marketing,data=train ))

summary(model3)

##Predict with Interactions:

pred_int_train = predict(model3, data = train, type = "response")

pred_int_test = predict(model3, newdata = test, type = "response")



mse_train_int <- mse(train$Satisfaction, pred_int_train)

mse_test_int <- mse(test$Satisfaction, pred_int_test)



rmse_train_int <- sqrt(mse(train$Satisfaction, pred_int_train))

rmse_test_int <- sqrt(mse(test$Satisfaction, pred_int_test))



mape_train_int <- mape(train$Satisfaction, pred_int_train)

mape_test_int <- mape(test$Satisfaction, pred_int_test)



r2_train <- cor(train$Satisfaction, pred_int_train) ^2

r2_test <- cor(test$Satisfaction, pred_int_test) ^2



model3_metrics_train <- cbind(mse_train_int,rmse_train_int,mape_train_int,r2_train)

model3_metrics_test <- cbind(mse_test_int,rmse_test_int,mape_test_int,r2_test)



interact_train_test <- rbind(model3_metrics_train,model3_metrics_test)



row.names(interact_train_test) <- c("Train","Test")

colnames(interact_train_test) <- c("MSE","RMSE","MAPE","R-squared")



print(interact_train_test,digits = 3)

Including Interaction model, we are able to make a better prediction. Even though the Interaction didn't give a significant increase compared to the individual variables. But with the interaction model, we are able to make much closer predictions. In some cases when I include interaction mode, I am able to increase the model performance measures. So we can infer that overall the model is valid and also not overfit.

Conclusion

In this article, we saw how Factor Analysis can be used to reduce the dimensionality of a dataset and then we used multiple linear regression on the dimensionally reduced columns/Features for further analysis/predictions. Topics Covered in this article are:

1. Checked for Multicollinearity

2. Run Factor Analysis

3. Naming the Factors

4. Perform Multiple Linear Regression with Y(dependent) and X(independent) variables.

I hope you guys have enjoyed reading this article. Please let me know if you have any feedback/suggestions.

You can also reach me out in LinkedIn.

If you found this article useful give it a clap and share it with others.

See you until next time!

Thank You!!