Loading the dataset

setwd("C:/Users/Surabhi/Downloads")
stockdata=read.csv("stockdata.csv",header=T)
dataset=stockdata[, -(6:11)]
head(dataset)

##   Allied.Chemical    Du.Pont Union.Carbide     Exxon.     Texaco
## 1       0.0130338 -0.0078431    -0.0031889 -0.0447693  0.0052151
## 2       0.0084862  0.0166886    -0.0062100  0.0119560  0.0134890
## 3      -0.0179153 -0.0086393     0.0100360  0.0000000 -0.0061428
## 4       0.0215589 -0.0034858     0.0174353 -0.0285917 -0.0069534
## 5       0.0108225  0.0037167    -0.0101345  0.0291900  0.0409751
## 6       0.0101713 -0.0121978    -0.0083768  0.0137083  0.0029895

We have stock prices of 5 companies in 103 weeks

Loading Packages

library(psych)
library(GPArotation)
library(Matrix)

How many factors should we consider??

R<-cor(dataset)
S<-cov(dataset)
eigen_value<-eigen(R)
eigen_value$values

## [1] 2.4372731 1.4070127 0.5005127 0.4000316 0.2551699

Since there are only two eigen values greater than 1,we can construct orthogonal factor model with two factors.

Scree Plots

plot(eigen_value$values, type = "l", main = "screeplot")

From the scree plot also it is evident that we must consider two factors in the factor model.

Fitting the factor model without rotation

Principal Component method

lambda<-eigen_value$values
P<-eigen_value$vectors
P%*%Diagonal(5,lambda)%*%t(P)

## 5 x 5 Matrix of class "dgeMatrix"
##           [,1]      [,2]      [,3]      [,4]      [,5]
## [1,] 1.0000000 0.6322878 0.5104973 0.1146019 0.1544628
## [2,] 0.6322878 1.0000000 0.5741424 0.3222921 0.2126747
## [3,] 0.5104973 0.5741424 1.0000000 0.1824992 0.1462067
## [4,] 0.1146019 0.3222921 0.1824992 1.0000000 0.6833777
## [5,] 0.1544628 0.2126747 0.1462067 0.6833777 1.0000000

L=cbind(sqrt(lambda[1])*P[,1],sqrt(lambda[2])*P[,2])
L

##            [,1]       [,2]
## [1,] -0.7323218  0.4365209
## [2,] -0.8311791  0.2804859
## [3,] -0.7262022  0.3738582
## [4,] -0.6047155 -0.6939569
## [5,] -0.5630885 -0.7186401

Hence we have obtained estimated factor loadings using the principal component method.

Principal Factor method/Iterative PC method Using the fa function from the ‘psych’ library

fa(r=R,nfactors=2,rotate="none",scores="regression",fm="pa",max.iter=2)

## maximum iteration exceeded

## Factor Analysis using method =  pa
## Call: fa(r = R, nfactors = 2, rotate = "none", scores = "regression", 
##     max.iter = 2, fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                  PA1   PA2   h2   u2 com
## Allied.Chemical 0.65 -0.37 0.56 0.44 1.6
## Du.Pont         0.78 -0.27 0.68 0.32 1.2
## Union.Carbide   0.62 -0.29 0.47 0.53 1.4
## Exxon.          0.57  0.58 0.67 0.33 2.0
## Texaco          0.52  0.58 0.61 0.39 2.0
## 
##                        PA1  PA2
## SS loadings           2.00 0.98
## Proportion Var        0.40 0.20
## Cumulative Var        0.40 0.60
## Proportion Explained  0.67 0.33
## Cumulative Proportion 0.67 1.00
## 
## Mean item complexity =  1.7
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  10  and the objective function was  1.74
## The degrees of freedom for the model are 1  and the objective function was  0.06 
## 
## The root mean square of the residuals (RMSR) is  0.03 
## The df corrected root mean square of the residuals is  0.09 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    PA1  PA2
## Correlation of (regression) scores with factors   0.91 0.84
## Multiple R square of scores with factors          0.83 0.70
## Minimum correlation of possible factor scores     0.65 0.40

using iterative algorithm

Step-1

R_inv<-solve(R)
init_comm_1<-1-(1/R_inv[1,1])
init_comm_2<-1-(1/R_inv[2,2])
init_comm_3<-1-(1/R_inv[3,3])
init_comm_4<-1-(1/R_inv[4,4])
init_comm_5<-1-(1/R_inv[5,5])
R_red<-R
R_red[1,1]<-init_comm_1
R_red[2,2]<-init_comm_2
R_red[3,3]<-init_comm_3
R_red[4,4]<-init_comm_4
R_red[5,5]<-init_comm_5

R_red_eigen<-eigen(R_red)
R_red_eigen$values

## [1]  1.90936967  0.88805502 -0.08498706 -0.12009429 -0.24440604

The R_red matrix is no longer positive semi-definite since we have replaced the diagonal entries with the initial communalities estimate. Hence,we ignore the negative eigen values and proceed with the positive ones only so number of factors is equal to 2

lambda_1<-R_red_eigen$values
P_1<-R_red_eigen$vectors
P_1%*%Diagonal(5,lambda_1)%*%t(P_1)

## 5 x 5 Matrix of class "dgeMatrix"
##           [,1]      [,2]      [,3]      [,4]      [,5]
## [1,] 0.4517114 0.6322878 0.5104973 0.1146019 0.1544628
## [2,] 0.6322878 0.5343612 0.5741424 0.3222921 0.2126747
## [3,] 0.5104973 0.5741424 0.3663602 0.1824992 0.1462067
## [4,] 0.1146019 0.3222921 0.1824992 0.5172416 0.6833777
## [5,] 0.1544628 0.2126747 0.1462067 0.6833777 0.4782630

L_1=cbind(sqrt(lambda_1[1])*P_1[,1],sqrt(lambda_1[2])*P_1[,2])
L_1

##            [,1]       [,2]
## [1,] -0.6369753 -0.3571000
## [2,] -0.7546711 -0.2556707
## [3,] -0.6054727 -0.2811806
## [4,] -0.5560281  0.5539234
## [5,] -0.5082708  0.5561236

Step-2

sec_comm_1<-L_1[1,1]^2+L_1[1,2]^2
sec_comm_2<-L_1[2,1]^2+L_1[2,2]^2
sec_comm_3<-L_1[3,1]^2+L_1[3,2]^2
sec_comm_4<-L_1[4,1]^2+L_1[4,2]^2
sec_comm_5<-L_1[5,1]^2+L_1[5,2]^2

R_red_2<-R_red
R_red_2[1,1]<-sec_comm_1
R_red_2[2,2]<-sec_comm_2
R_red_2[3,3]<-sec_comm_3
R_red_2[4,4]<-sec_comm_4
R_red_2[5,5]<-sec_comm_5

R_red_2_eigen<-eigen(R_red_2)
R_red_2_eigen$values

## [1]  2.00003668  0.97949144  0.00121605 -0.03255045 -0.15076903

lambda_2<-R_red_2_eigen$values
P_2<-R_red_2_eigen$vectors
P_2%*%Diagonal(5,lambda_2)%*%t(P_2)

## 5 x 5 Matrix of class "dgeMatrix"
##           [,1]      [,2]      [,3]      [,4]      [,5]
## [1,] 0.5332580 0.6322878 0.5104973 0.1146019 0.1544628
## [2,] 0.6322878 0.6348959 0.5741424 0.3222921 0.2126747
## [3,] 0.5104973 0.5741424 0.4456597 0.1824992 0.1462067
## [4,] 0.1146019 0.3222921 0.1824992 0.6159983 0.6833777
## [5,] 0.1544628 0.2126747 0.1462067 0.6833777 0.5676127

L_2=cbind(sqrt(lambda_2[1])*P_2[,1],sqrt(lambda_2[2])*P_2[,2])
L_2

##           [,1]       [,2]
## [1,] 0.6481703 -0.3745163
## [2,] 0.7755047 -0.2740968
## [3,] 0.6155841 -0.2945254
## [4,] 0.5727250  0.5830570
## [5,] 0.5211016  0.5808609

Step3

third_comm_1<-L_2[1,1]^2+L_2[1,2]^2
third_comm_2<-L_2[2,1]^2+L_2[2,2]^2
third_comm_3<-L_2[3,1]^2+L_2[3,2]^2
third_comm_4<-L_2[4,1]^2+L_2[4,2]^2
third_comm_5<-L_2[5,1]^2+L_2[5,2]^2

R_red_3<-R_red_2
R_red_3[1,1]<-third_comm_1
R_red_3[2,2]<-third_comm_2
R_red_3[3,3]<-third_comm_3
R_red_3[4,4]<-third_comm_4
R_red_3[5,5]<-third_comm_5

R_red_3_eigen<-eigen(R_red_3)
R_red_3_eigen$values

## [1]  2.036275115  1.020605670  0.036823099 -0.005567677 -0.108608086

lambda_3<-R_red_3_eigen$values
P_3<-R_red_3_eigen$vectors
P_3%*%Diagonal(5,lambda_3)%*%t(P_3)

## 5 x 5 Matrix of class "dgeMatrix"
##           [,1]      [,2]      [,3]      [,4]      [,5]
## [1,] 0.5603872 0.6322878 0.5104973 0.1146019 0.1544628
## [2,] 0.6322878 0.6765365 0.5741424 0.3222921 0.2126747
## [3,] 0.5104973 0.5741424 0.4656889 0.1824992 0.1462067
## [4,] 0.1146019 0.3222921 0.1824992 0.6679693 0.6833777
## [5,] 0.1544628 0.2126747 0.1462067 0.6833777 0.6089462

L_3=cbind(sqrt(lambda_3[1])*P_3[,1],sqrt(lambda_3[2])*P_3[,2])
L_3

##           [,1]       [,2]
## [1,] 0.6490308 -0.3842949
## [2,] 0.7830614 -0.2880439
## [3,] 0.6146206 -0.3010571
## [4,] 0.5856011  0.5949307
## [5,] 0.5302469  0.5876869

Hence we have obtained the estimated loadings using the iterative PC method by doing two iterations.

Maximum Likelhood solution

ml<-fa(r=R,nfactors=2,rotate="none",scores="regression",fm="ml")
ml

## Factor Analysis using method =  ml
## Call: fa(r = R, nfactors = 2, rotate = "none", scores = "regression", 
##     fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                  ML1   ML2   h2    u2 com
## Allied.Chemical 0.12  0.75 0.58 0.417 1.1
## Du.Pont         0.33  0.79 0.73 0.275 1.3
## Union.Carbide   0.19  0.65 0.46 0.542 1.2
## Exxon.          1.00 -0.01 1.00 0.005 1.0
## Texaco          0.69  0.03 0.47 0.530 1.0
## 
##                        ML1  ML2
## SS loadings           1.62 1.61
## Proportion Var        0.32 0.32
## Cumulative Var        0.32 0.65
## Proportion Explained  0.50 0.50
## Cumulative Proportion 0.50 1.00
## 
## Mean item complexity =  1.1
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  10  and the objective function was  1.74
## The degrees of freedom for the model are 1  and the objective function was  0.02 
## 
## The root mean square of the residuals (RMSR) is  0.02 
## The df corrected root mean square of the residuals is  0.06 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    ML1  ML2
## Correlation of (regression) scores with factors   1.00 0.90
## Multiple R square of scores with factors          1.00 0.81
## Minimum correlation of possible factor scores     0.99 0.63

Checking Assumptions of Orthogonal factor model.

Regression Method

Maximum Likelihood method

fit <- factanal(dataset, 
                2,                
                scores=c("regression"),
                rotation="none")
F<-fit$scores
F<-as.data.frame(F)
F

##         Factor1     Factor2
## 1   -1.80116560  0.38432667
## 2    0.29777596  0.33420663
## 3   -0.15458204 -0.37937911
## 4   -1.20353818  0.77526656
## 5    0.93538203 -0.17356516
## 6    0.35160124 -0.42131797
## 7    0.98549896  0.68930066
## 8    0.08862623  0.84196254
## 9   -1.26241634 -0.75387933
## 10  -0.90029446  0.54079231
## 11  -0.48916160 -0.26725112
## 12   1.20358192  0.66120618
## 13   0.82721463 -0.48457654
## 14   1.22570111 -2.02793082
## 15  -1.11821992 -0.54044394
## 16   0.11210939 -0.72779101
## 17   0.98686777 -1.76044319
## 18  -0.38167869 -0.38661666
## 19  -0.86681772  0.46136782
## 20   1.17260755  0.77551296
## 21  -0.07074478  0.16226984
## 22   0.41179291  0.50457582
## 23   0.99834115 -0.47895387
## 24  -0.26351614 -0.31613330
## 25  -1.06524760 -0.23005823
## 26   0.37428751 -1.13771829
## 27  -0.06703588 -1.02150824
## 28  -1.98721397  0.82903919
## 29   0.42138434  0.50463007
## 30  -0.85266841 -1.04550105
## 31   0.70203168  0.89094437
## 32   0.45888515  1.84908593
## 33  -0.12642476  1.00337106
## 34   0.70125364  0.03752833
## 35  -0.29657816  0.18826994
## 36   0.27324794 -0.28422563
## 37  -1.09945266 -1.42508763
## 38   0.60199966  0.83702541
## 39   0.32980338 -0.38630964
## 40  -0.07235160 -0.87190502
## 41   0.03844349 -1.93663902
## 42   0.85963392  2.00033771
## 43   0.66953624  1.65587891
## 44   0.79240364  0.43812691
## 45  -0.29652309 -1.97790179
## 46   1.03955805  0.16961683
## 47  -0.34003220  0.27978369
## 48  -0.78706257  0.26112023
## 49  -0.14128991  0.50991723
## 50   0.92216365  1.23619225
## 51  -0.01328110 -0.48819284
## 52  -1.11744031  0.36666516
## 53   0.26178814 -1.31173874
## 54   0.12538485 -0.42144012
## 55   0.74766594  0.15136470
## 56   1.76260531  0.99946823
## 57  -0.31531473 -0.41388078
## 58   1.45022572 -1.38775560
## 59   0.41266278 -0.06852185
## 60   1.19090266  0.07623171
## 61  -1.17179462 -0.85824581
## 62  -0.52030414 -0.55941922
## 63  -2.05278479 -1.53043241
## 64   0.42770003 -0.15501120
## 65   0.57308625  0.54040064
## 66  -1.48739824  0.13500103
## 67   0.59294598  0.45031346
## 68  -0.62005365  1.28863066
## 69   0.11297686 -0.15536619
## 70  -1.94989934 -0.58326198
## 71   0.43043035  2.13989572
## 72   0.97427838 -0.81507638
## 73  -0.38462056  0.21381726
## 74   0.09373524 -0.09318484
## 75   2.14499118 -0.34601247
## 76  -0.16096034 -0.74429443
## 77   1.28580322 -0.76944545
## 78  -0.32683510  0.10994344
## 79  -1.28278844  1.09603155
## 80  -2.07184896 -0.97131518
## 81   0.45749482 -0.76850730
## 82   1.47993462 -0.44193401
## 83   2.12884895 -1.08670883
## 84  -1.70223447  0.91512321
## 85  -0.93589575 -1.29248544
## 86   1.96131402  0.24557865
## 87  -0.98215582  1.10542454
## 88   0.31065419  0.45212211
## 89  -0.51026470 -0.70637148
## 90   0.34547887 -0.16602986
## 91  -1.74905006  0.46846208
## 92  -0.84946489  0.13837364
## 93  -2.15397559  0.62446069
## 94   2.01361822  1.30049688
## 95   0.30931762  0.22978738
## 96  -1.30063456  2.62798035
## 97   1.50146918 -0.23790804
## 98   0.17920972  1.27182862
## 99  -0.22315437 -0.69465302
## 100 -0.19710860  0.07137066
## 101 -0.74260843  0.92011234
## 102 -0.24543966  0.16500183
## 103 -0.34492874 -0.82321258

mean_F<-c(0,0)
mean_F[1]<-mean(F[,1])
mean_F[2]<-mean(F[,2])
mean_F

## [1]  1.330937e-17 -5.816797e-18

correlation1<-cor(F)
correlation1

##               Factor1       Factor2
## Factor1  1.000000e+00 -1.773637e-15
## Factor2 -1.773637e-15  1.000000e+00

library(MVN)

## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2

## sROC 0.1-2 loaded

mvn(data = F, mvnTest = "mardia")

## $multivariateNormality
##              Test           Statistic           p value Result
## 1 Mardia Skewness   0.745285405187538 0.945629116871012    YES
## 2 Mardia Kurtosis -0.0196531043318575 0.984320100867419    YES
## 3             MVN                <NA>              <NA>    YES
## 
## $univariateNormality
##           Test  Variable Statistic   p value Normality
## 1 Shapiro-Wilk  Factor1     0.9867    0.3965    YES   
## 2 Shapiro-Wilk  Factor2     0.9926    0.8481    YES   
## 
## $Descriptives
##           n          Mean   Std.Dev     Median       Min      Max       25th
## Factor1 103  1.330937e-17 0.9975139 0.08862623 -2.153976 2.144991 -0.6813310
## Factor2 103 -5.816797e-18 0.9027633 0.07137066 -2.027931 2.627980 -0.5713406
##              75th       Skew    Kurtosis
## Factor1 0.6853949 -0.1267137 -0.43604361
## Factor2 0.5251589  0.1587395  0.08258797

Principal factor method

F_1<-factor.scores(dataset,L_3,method="Thurstone")
F_1a<-as.data.frame(F_1$scores)
mean_F_1<-c(0,0)
mean_F_1[1]<-mean(F_1a[,1])
mean_F_1[2]<-mean(F_1a[,2])
mean_F_1

## [1] -1.015571e-17 -1.034992e-17

correlation2<-cor(F_1a)
correlation2

##            V1         V2
## V1 1.00000000 0.01240676
## V2 0.01240676 1.00000000

library(MVN)
mvn(data = F_1a, mvnTest = "mardia")

## $multivariateNormality
##              Test         Statistic           p value Result
## 1 Mardia Skewness 0.971725445561096 0.914052598934592    YES
## 2 Mardia Kurtosis 0.348838400680582 0.727210632550703    YES
## 3             MVN              <NA>              <NA>    YES
## 
## $univariateNormality
##           Test  Variable Statistic   p value Normality
## 1 Shapiro-Wilk    V1        0.9925    0.8441    YES   
## 2 Shapiro-Wilk    V2        0.9877    0.4658    YES   
## 
## $Descriptives
##      n          Mean   Std.Dev     Median       Min      Max       25th
## V1 103 -1.015571e-17 0.9172090 0.01307782 -2.530660 2.088689 -0.5821234
## V2 103 -1.034992e-17 0.8548972 0.04619179 -2.356089 2.127663 -0.4903723
##         75th        Skew   Kurtosis
## V1 0.5961013  0.02503477 -0.1674982
## V2 0.4741064 -0.06880125  0.3260323

Weighted least squares method of finding factor scores

Maximum Likelihood method

fit <- factanal(dataset, 
                2,                
                scores=c("Bartlett"),
                rotation="none")
F<-fit$scores
F<-as.data.frame(F)
F

##         Factor1     Factor2
## 1   -1.81015485  0.47157713
## 2    0.29926209  0.41007876
## 3   -0.15535353 -0.46550636
## 4   -1.20954479  0.95126882
## 5    0.94005033 -0.21296820
## 6    0.35335600 -0.51696625
## 7    0.99041738  0.84578680
## 8    0.08906855  1.03310622
## 9   -1.26871680 -0.92502622
## 10  -0.90478765  0.66356384
## 11  -0.49160291 -0.32792290
## 12   1.20958875  0.81131426
## 13   0.83134309 -0.59458588
## 14   1.23181833 -2.48831492
## 15  -1.12380072 -0.66313639
## 16   0.11266891 -0.89301528
## 17   0.99179302 -2.16010181
## 18  -0.38358357 -0.47438699
## 19  -0.87114383  0.56610828
## 20   1.17845980  0.95157115
## 21  -0.07109786  0.19910860
## 22   0.41384808  0.61912543
## 23   1.00332367 -0.58768675
## 24  -0.26483129 -0.38790239
## 25  -1.07056403 -0.28228641
## 26   0.37615550 -1.39600492
## 27  -0.06737044 -1.25341267
## 28  -1.99713174  1.01724899
## 29   0.42348738  0.61919199
## 30  -0.85692391 -1.28285237
## 31   0.70553538  1.09320798
## 32   0.46117536  2.26886837
## 33  -0.12705572  1.23115796
## 34   0.70475345  0.04604807
## 35  -0.29805832  0.23101129
## 36   0.27461166 -0.34875098
## 37  -1.10493980 -1.74861330
## 38   0.60500412  1.02704826
## 39   0.33144936 -0.47401027
## 40  -0.07271269 -1.06984629
## 41   0.03863536 -2.37629790
## 42   0.86392417  2.45445757
## 43   0.67287776  2.03179918
## 44   0.79635836  0.53759118
## 45  -0.29800298 -2.42692822
## 46   1.04474627  0.20812352
## 47  -0.34172923  0.34330063
## 48  -0.79099064  0.32040016
## 49  -0.14199506  0.62567946
## 50   0.92676597  1.51683459
## 51  -0.01334738 -0.59902316
## 52  -1.12301723  0.44990606
## 53   0.26309467 -1.60953176
## 54   0.12601062 -0.51711613
## 55   0.75139739  0.18572776
## 56   1.77140211  1.22636910
## 57  -0.31688840 -0.50784066
## 58   1.45746350 -1.70280609
## 59   0.41472230 -0.08407779
## 60   1.19684621  0.09353796
## 61  -1.17764281 -1.05308615
## 62  -0.52290087 -0.68641947
## 63  -2.06302981 -1.87787363
## 64   0.42983459 -0.19020210
## 65   0.57594640  0.66308326
## 66  -1.49482154  0.16564917
## 67   0.59590525  0.55254434
## 68  -0.62314821  1.58117765
## 69   0.11354071 -0.19063767
## 70  -1.95963088 -0.71567504
## 71   0.43257854  2.62569827
## 72   0.97914080 -1.00011633
## 73  -0.38654012  0.26235840
## 74   0.09420306 -0.11433981
## 75   2.15569638 -0.42456477
## 76  -0.16176366 -0.91326535
## 77   1.29222040 -0.94412618
## 78  -0.32846626  0.13490297
## 79  -1.28919058  1.34485438
## 80  -2.08218913 -1.19182470
## 81   0.45977808 -0.94297505
## 82   1.48732067 -0.54226258
## 83   2.13947360 -1.33341520
## 84  -1.71072997  1.12287594
## 85  -0.94056662 -1.58590755
## 86   1.97110254  0.30133030
## 87  -0.98705755  1.35637979
## 88   0.31220460  0.55476359
## 89  -0.51281133 -0.86673306
## 90   0.34720309 -0.20372222
## 91  -1.75777921  0.57481309
## 92  -0.85370440  0.16978744
## 93  -2.16472564  0.76622676
## 94   2.02366777  1.59573776
## 95   0.31086136  0.28195408
## 96  -1.30712576  3.22458864
## 97   1.50896270 -0.29191830
## 98   0.18010412  1.56056119
## 99  -0.22426808 -0.85235425
## 100 -0.19809233  0.08757334
## 101 -0.74631464  1.12899771
## 102 -0.24666460  0.20246081
## 103 -0.34665021 -1.01009961

mean_F<-c(0,0)
mean_F[1]<-mean(F[,1])
mean_F[2]<-mean(F[,2])
mean_F

## [1]  1.168675e-18 -1.271253e-17

correlation1<-cor(F)
correlation1

##             Factor1     Factor2
## Factor1 1.00000e+00 1.82636e-15
## Factor2 1.82636e-15 1.00000e+00

library(MVN)
mvn(data = F, mvnTest = "mardia")

## $multivariateNormality
##              Test           Statistic           p value Result
## 1 Mardia Skewness   0.745285405187498 0.945629116871017    YES
## 2 Mardia Kurtosis -0.0196531043318744 0.984320100867406    YES
## 3             MVN                <NA>              <NA>    YES
## 
## $univariateNormality
##           Test  Variable Statistic   p value Normality
## 1 Shapiro-Wilk  Factor1     0.9867    0.3965    YES   
## 2 Shapiro-Wilk  Factor2     0.9926    0.8481    YES   
## 
## $Descriptives
##           n          Mean  Std.Dev     Median       Min      Max       25th
## Factor1 103  1.168675e-18 1.002492 0.08906855 -2.164726 2.155696 -0.6847314
## Factor2 103 -1.271253e-17 1.107710 0.08757334 -2.488315 3.224589 -0.7010473
##              75th       Skew    Kurtosis
## Factor1 0.6888156 -0.1267137 -0.43604361
## Factor2 0.6443814  0.1587395  0.08258797

Principal factor method

F_1<-factor.scores(dataset,L_3,method="Bartlett")
F_1a<-as.data.frame(F_1$scores)
mean_F_1<-c(0,0)
mean_F_1[1]<-mean(F_1a[,1])
mean_F_1[2]<-mean(F_1a[,2])
mean_F_1

## [1] -1.382726e-17 -9.591242e-18

correlation2<-cor(F_1a)
correlation2

##             V1          V2
## V1  1.00000000 -0.01246409
## V2 -0.01246409  1.00000000

library(MVN)
mvn(data = F_1a, mvnTest = "mardia")

## $multivariateNormality
##              Test         Statistic           p value Result
## 1 Mardia Skewness 0.947911080885658 0.917588808573216    YES
## 2 Mardia Kurtosis  0.34291841956547 0.731659834235337    YES
## 3             MVN              <NA>              <NA>    YES
## 
## $univariateNormality
##           Test  Variable Statistic   p value Normality
## 1 Shapiro-Wilk    V1        0.9917    0.7817    YES   
## 2 Shapiro-Wilk    V2        0.9879    0.4769    YES   
## 
## $Descriptives
##      n          Mean  Std.Dev      Median       Min      Max       25th
## V1 103 -1.382726e-17 1.090438 -0.02600633 -2.996864 2.453040 -0.6927153
## V2 103 -9.591242e-18 1.169882  0.06060514 -3.218802 2.912096 -0.6715958
##         75th        Skew   Kurtosis
## V1 0.7135607  0.03216636 -0.1597351
## V2 0.6572158 -0.06391506  0.3320292

Hence the assumptions of orthogonal factor model have been satisfied. 1) Zero Mean 2)Normality 3)Pairwise Independence.

Interpretations without rotation

The first factor has positive large values so it can be considered as general ‘economic’ factor which has an impact on all kinds of establishments,irrespective of the category of company. For the second factor,the estimated loadings are positve for the first three companies and negative or negligible for the other two.This may be considered as an industry factor since the first three companies are chemical industries and the last two companies are oil industries.

Rotation

Maximum likelihood estimation with varimax rotation

fa(r=R,nfactors=2,rotate="varimax",scores="regression",fm="ml")

## Factor Analysis using method =  ml
## Call: fa(r = R, nfactors = 2, rotate = "varimax", scores = "regression", 
##     fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                  ML2  ML1   h2    u2 com
## Allied.Chemical 0.76 0.03 0.58 0.417 1.0
## Du.Pont         0.82 0.23 0.73 0.275 1.2
## Union.Carbide   0.67 0.11 0.46 0.542 1.1
## Exxon.          0.11 0.99 1.00 0.005 1.0
## Texaco          0.11 0.68 0.47 0.530 1.1
## 
##                        ML2  ML1
## SS loadings           1.72 1.51
## Proportion Var        0.34 0.30
## Cumulative Var        0.34 0.65
## Proportion Explained  0.53 0.47
## Cumulative Proportion 0.53 1.00
## 
## Mean item complexity =  1.1
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  10  and the objective function was  1.74
## The degrees of freedom for the model are 1  and the objective function was  0.02 
## 
## The root mean square of the residuals (RMSR) is  0.02 
## The df corrected root mean square of the residuals is  0.06 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    ML2  ML1
## Correlation of (regression) scores with factors   0.90 1.00
## Multiple R square of scores with factors          0.82 0.99
## Minimum correlation of possible factor scores     0.64 0.98

Principal factor solution with varimax rotation

fa(r=R,nfactors=2,rotate="varimax",scores="regression",fm="pa",max.iter=2)

## maximum iteration exceeded

## Factor Analysis using method =  pa
## Call: fa(r = R, nfactors = 2, rotate = "varimax", scores = "regression", 
##     max.iter = 2, fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                  PA1  PA2   h2   u2 com
## Allied.Chemical 0.75 0.06 0.56 0.44 1.0
## Du.Pont         0.79 0.22 0.68 0.32 1.1
## Union.Carbide   0.67 0.11 0.47 0.53 1.1
## Exxon.          0.14 0.81 0.67 0.33 1.1
## Texaco          0.10 0.77 0.61 0.39 1.0
## 
##                        PA1  PA2
## SS loadings           1.67 1.31
## Proportion Var        0.33 0.26
## Cumulative Var        0.33 0.60
## Proportion Explained  0.56 0.44
## Cumulative Proportion 0.56 1.00
## 
## Mean item complexity =  1.1
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  10  and the objective function was  1.74
## The degrees of freedom for the model are 1  and the objective function was  0.06 
## 
## The root mean square of the residuals (RMSR) is  0.03 
## The df corrected root mean square of the residuals is  0.09 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    PA1  PA2
## Correlation of (regression) scores with factors   0.88 0.86
## Multiple R square of scores with factors          0.78 0.75
## Minimum correlation of possible factor scores     0.56 0.49

Interpretation with rotation

Varimax rotated data factor loading interpretation ( Same for MLE and PC methods) The chemical company stocks load highly on the first factor while the oil stocks depend higly on the second factor. Factor 1 can be some economic factor which has high impact on chemical company stocks but doesnt have much impact on oil company stocks Factor 2 represents economic conditions affecting oil stocks. The ‘general’ economic factor which has some impact on all type of industries has been destroyed after rotation.

Stock Price Data - Factor Analysis