0% found this document useful (0 votes)
25 views37 pages

Principal Component Analysis Homework

The document outlines a homework assignment focused on statistical analysis, specifically covering topics such as sample covariance matrices, principal component analysis, and confidence intervals. It includes tasks related to interpreting data from fish populations and constructing visual aids like scree plots. The assignment is structured around multiple chapters, with specific questions and data sets to analyze.

Uploaded by

3525171771
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
25 views37 pages

Principal Component Analysis Homework

The document outlines a homework assignment focused on statistical analysis, specifically covering topics such as sample covariance matrices, principal component analysis, and confidence intervals. It includes tasks related to interpreting data from fish populations and constructing visual aids like scree plots. The assignment is structured around multiple chapters, with specific questions and data sets to analyze.

Uploaded by

3525171771
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd

2026/1/10 20:55 Homework3

Homework3
Weedy
2026-01-10
Chapter 8
8.6
8.10
(a) Construct the sample covariance matrix S, and find the sample principal components in
(8-20). (Note that the sample mean vector is displayed in Example 8.5.)
(b) Determine the proportion of the total sample variance explained by the first three
principal components. Interpret these components.
(c) Construct Bonferroni simultaneous 90% confidence intervals for the variances λ1 , λ2
and λ3 of the first three population components Y1 , Y2 and Y3 .
8.16 Fish caught by the same fisherman live alongside of each other, so the data should provide
some evidence on how the fish group. The first four fish belong to the centrarchids, the most
plentiful family. The walleye is the most popular fish to eat.
(a) Comment on the pattern of correlation within the centrarchid family x 1 through x 4 . Does
the walleye appear to group with the other fish?
(b) Perform a principal component analysis using only x 1 through x 4 . Interpret your results.
(c) Perform a principal component analysis using all six variables. Interpret your results.
8.26
(a) Determine the appropriate number of components to effectively summarize the
variability. Construct a scree plot to aid in your determination.
(b) Interpret the sample principal components.
(c) Using the values for the first two principal components, plot the data in a twodimensional
space with along the vertical axis and along the horizontal axis. Can you distinguish groups
representing the two socioeconomic levels and/or the two genders? Are there any outliers?
(d) Construct a 95% confidence interval for λ1 , the variance of the first population principal
component from the covariance matrix.
Chapter 9
9.12
9.19
9.20
Chapter 10
10.18

Chapter 8
8.6
To obtain the eigenvalues of ρ, consider the equation:

2
|ρ − λI | = (1 + 2ρ − λ)(1 − ρ − λ) = 0

⇒ λ1 = 1 + 2ρ, λ2 = λ3 = 1 − ρ.

The results are consistent with (8-16) when p=3. ρei = λi ei , i = 1, . . . , p , which Verifies the eigenvalue–
eigenvector pairs for ρ given in (8-15)

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 1/37
2026/1/10 20:55 Homework3

8.10
data8.10 <- [Link]("[Link]")
data8.10

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 2/37
2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5
## 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
## 7 0.0111288 0.0280044 0.0080721 0.0305433 0.0032290
## 8 0.0484801 -0.0051480 0.0182495 0.0063348 0.0076752
## 9 -0.0344914 -0.0137991 -0.0080468 -0.0299011 -0.0108108
## 10 -0.0046596 0.0209882 -0.0060841 -0.0203940 -0.0126677
## 11 -0.0018205 -0.0055675 -0.0107587 -0.0089898 -0.0183648
## 12 0.0148515 0.0346684 -0.0060004 0.0362855 0.0287032
## 13 -0.0092426 -0.0052029 0.0047161 0.0264916 0.0129547
## 14 -0.0458668 -0.0278243 -0.0142696 0.0374776 0.0332022
## 15 -0.0244432 -0.0182914 0.0059048 -0.0259572 -0.0202333
## 16 -0.0183742 -0.0140289 0.0011361 0.0073284 -0.0097182
## 17 -0.0297788 -0.0284571 -0.0164555 0.0310847 0.0164377
## 18 -0.0225080 -0.0228833 0.0344231 -0.0062006 0.0067584
## 19 0.0119617 -0.0067916 0.0185908 -0.0193632 -0.0153440
## 20 0.0209811 0.0240509 0.0129586 0.0355419 0.0150962
## 21 0.0118669 0.0025328 -0.0036036 0.0021186 0.0028784
## 22 0.0140160 0.0172255 0.0003617 0.0150106 0.0141115
## 23 -0.0149506 0.0031610 -0.0001808 0.0310352 0.0226415
## 24 0.0203322 -0.0148548 -0.0182607 -0.0028283 -0.0161439
## 25 0.0112265 -0.0221613 -0.0051565 -0.0247164 0.0105485
## 26 -0.0327505 -0.0158879 -0.0037023 0.0143332 0.0164695
## 27 -0.0261119 -0.0313390 0.0156076 0.0024575 0.0082154
## 28 0.0182675 0.0156863 -0.0219539 -0.0498468 -0.0110910
## 29 0.0219907 0.0043436 0.0136551 0.0152655 0.0217441
## 30 -0.0331257 -0.0204229 -0.0101495 -0.0186362 -0.0255376
## 31 0.0213763 0.0188864 0.0210664 0.0228744 0.0013793
## 32 0.0484518 0.0440539 0.0087639 0.0160338 0.0073462
## 33 0.0276183 0.0168319 0.0104977 0.0004153 0.0043300
## 34 0.0031932 0.0024943 0.0103887 0.0228311 0.0356251
## 35 -0.0010610 0.0085953 -0.0023046 -0.0040584 0.0065732
## 36 -0.0037175 -0.0060552 0.0035537 0.0114099 0.0211145
## 37 0.0023987 -0.0597924 -0.0118626 -0.0251813 -0.0110851
## 38 0.0148897 0.0163187 0.0265185 0.0200455 0.0219875
## 39 -0.0089075 -0.0068477 0.0047129 0.0129660 0.0196161
## 40 -0.0227333 -0.0140276 -0.0069493 0.0024000 -0.0165494
## 41 -0.0329997 -0.0313480 -0.0362141 0.0055866 -0.0065208
## 42 0.0302098 0.0522778 0.0317662 0.0267857 0.0105865
## 43 0.0195493 0.0395079 0.0381773 0.0216425 0.0238843
## 44 -0.0045273 0.0204825 0.0174547 0.0253452 0.0059341
## 45 -0.0446763 -0.0408118 -0.0163225 -0.0035049 -0.0008137
## 46 0.0070008 0.0060451 0.0154081 0.0320252 0.0252443
## 47 0.0100111 0.0048532 -0.0016675 -0.0050224 -0.0266084
## 48 -0.0112885 0.0057498 0.0100217 -0.0173067 -0.0024480
## 49 0.0236703 0.0155500 -0.0162064 0.0001835 -0.0069530
## 50 0.0165941 0.0457104 0.0065557 0.0284299 0.0434514
## 51 -0.0040139 -0.0118432 -0.0041750 0.0039237 -0.0136175
## 52 -0.0069855 0.0098061 0.0003354 -0.0261148 -0.0286114
## 53 -0.0154221 -0.0233060 -0.0238055 0.0113097 0.0257467
## 54 -0.0252817 0.0088378 -0.0094453 0.0075758 -0.0124498

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 3/37


2026/1/10 20:55 Homework3
## 55 0.0039470 0.0094174 0.0067614 0.0241676 0.0164701
## 56 0.0188149 0.0379692 0.0154985 0.0510400 0.0784157
## 57 -0.0055127 -0.0075251 -0.0111921 -0.0044903 0.0198479
## 58 -0.0260532 -0.0168492 -0.0080604 0.0432676 0.0587486
## 59 0.0128059 -0.0059983 0.0013831 0.0148919 0.0649373
## 60 0.0146108 0.0025862 0.0100138 0.0362891 0.0048395
## 61 -0.0373858 -0.0126827 -0.0114530 -0.0272533 -0.0396532
## 62 -0.0028769 -0.0195950 -0.0070897 -0.0100172 0.0262454
## 63 -0.0300058 -0.0497446 -0.0167189 -0.0507510 -0.0583157
## 64 -0.0193337 0.0021033 0.0178888 0.0154897 0.0262930
## 65 0.0172884 0.0174907 0.0022620 0.0195178 -0.0089331
## 66 -0.0163983 0.0077928 -0.0072917 -0.0358752 -0.0636054
## 67 0.0275841 0.0125085 -0.0078699 0.0196896 0.0573919
## 68 0.0176991 0.0233603 0.0216816 -0.0127639 -0.0401924
## 69 0.0034783 -0.0079017 0.0050035 0.0071275 0.0100215
## 70 -0.0323512 -0.0146018 -0.0084120 -0.0482225 -0.0628987
## 71 0.0465672 0.0410867 0.0349723 0.0152170 0.0056721
## 72 -0.0071306 -0.0107828 -0.0086986 0.0303185 0.0517014
## 73 -0.0071818 0.0058862 0.0091124 -0.0064473 0.0060779
## 74 -0.0031829 0.0017339 -0.0006689 0.0064892 0.0214996
## 75 0.0182874 -0.0038944 0.0046854 0.0619937 0.0431379
## 76 -0.0142531 -0.0106429 -0.0141572 0.0001557 -0.0450225
## 77 -0.0046270 -0.0169045 0.0089542 0.0390661 0.0027938
## 78 -0.0072632 0.0075927 0.0000000 -0.0049431 0.0186314
## 79 0.0301434 -0.0019947 0.0261219 -0.0307090 -0.0208547
## 80 -0.0071023 -0.0430824 -0.0177872 -0.0518714 0.0230447
## 81 -0.0128755 -0.0109074 -0.0066456 0.0167076 -0.0126280
## 82 0.0028986 0.0030502 -0.0073591 0.0443048 -0.0112340
## 83 -0.0265896 -0.0002339 -0.0033698 0.0615551 0.0561091
## 84 0.0068290 0.0124006 0.0076078 -0.0419997 -0.0365773
## 85 -0.0259510 -0.0240351 -0.0303691 -0.0209345 -0.0068717
## 86 0.0136240 0.0182335 0.0086520 0.0568640 0.0387476
## 87 0.0209080 0.0165116 0.0089209 -0.0230172 0.0416320
## 88 0.0049737 0.0187600 0.0023805 0.0123049 0.0078337
## 89 -0.0262009 -0.0044914 -0.0166243 -0.0096353 0.0020622
## 90 -0.0041854 0.0060907 -0.0067276 0.0134710 -0.0045908
## 91 0.0090063 -0.0022422 0.0000000 -0.0429774 -0.0620229
## 92 0.0053555 -0.0083146 0.0069469 -0.0188272 -0.0161072
## 93 0.0307783 -0.0160888 0.0031045 -0.0539478 -0.0556609
## 94 0.0373241 0.0359281 0.0252751 0.0581879 0.0169708
## 95 0.0238029 0.0031125 -0.0068757 0.0122545 0.0281715
## 96 0.0256826 0.0525266 0.0406957 -0.0316623 -0.0188482
## 97 -0.0060622 0.0086334 0.0058413 0.0445584 0.0305941
## 98 0.0217449 0.0229645 0.0291983 0.0084395 0.0319296
## 99 0.0033740 -0.0153061 -0.0238245 -0.0016738 -0.0172270
## 100 0.0033626 0.0029016 -0.0030507 -0.0012193 -0.0097005
## 101 0.0170147 0.0095061 0.0181994 -0.0161758 -0.0075614
## 102 0.0103929 -0.0026612 0.0044290 -0.0024818 -0.0164502
## 103 -0.0127948 -0.0143678 -0.0187402 -0.0049759 -0.0163732

(a) Construct the sample covariance matrix S, and find the


sample principal components in (8-20). (Note that the sample

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 4/37


2026/1/10 20:55 Homework3

mean vector is displayed in Example 8.5.)


# Construct the sample covariance matrix
ColMeans <- round(colMeans(data8.10),4)
S <- round(cov(data8.10),4)
stderrs <- sqrt(diag(S))
std_data <- sweep(data8.10, 2, ColMeans, "-")
std_data <- sweep(std_data, 2, stderrs, "/")
std_data

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 5/37
2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5
## 1 0.596690 -0.427155 -0.33862637 -1.843306277 0.04296027
## 2 0.369310 0.799430 -0.55225040 0.300708535 0.33548681
## 3 -0.950765 -0.466965 0.59651528 -0.151185789 -0.35860213
## 4 1.022945 -0.209290 1.11972480 -1.231850471 -0.38726117
## 5 0.486125 0.150835 -0.82975445 0.952092508 1.30726720
## 6 0.453565 -0.644890 -0.70546629 0.366939249 -0.03572657
## 7 0.501440 1.365220 0.45764658 1.003242440 -0.02725897
## 8 2.369005 -0.292400 1.17729744 0.088247145 0.12993794
## 9 -1.779570 -0.724955 -0.68213177 -1.281341140 -0.52364086
## 10 -0.287980 1.014410 -0.54334792 -0.922006535 -0.58929218
## 11 -0.146025 -0.313375 -0.87389206 -0.490968291 -0.79071509
## 12 0.687575 1.698420 -0.53742944 1.220277199 0.87339001
## 13 -0.517130 -0.295145 0.22034154 0.850102574 0.31659645
## 14 -2.348340 -1.426215 -1.12215018 1.265334344 1.03245368
## 15 -1.277160 -0.949570 0.30439533 -1.132275731 -0.85677654
## 16 -0.973710 -0.736445 -0.03280268 0.125801695 -0.48501161
## 17 -1.543940 -1.457855 -1.27671665 1.023705436 0.43973910
## 18 -1.180400 -1.179165 2.32094366 -0.385546440 0.09752417
## 19 0.543085 -0.374580 1.20143099 -0.883045958 -0.68391368
## 20 0.994055 1.167545 0.80317431 1.192171761 0.39230991
## 21 0.538345 0.091640 -0.36795008 -0.071110236 -0.03965455
## 22 0.645800 0.826275 -0.08756103 0.416161563 0.35749551
## 23 -0.802530 0.123050 -0.12592158 1.021834512 0.65907655
## 24 0.961610 -0.777740 -1.40436356 -0.258085481 -0.71219441
## 25 0.506325 -1.143065 -0.47775670 -1.085377899 0.23152444
## 26 -1.692525 -0.829395 -0.37492923 0.390558249 0.44086340
## 27 -1.360595 -1.601950 0.99048689 -0.058301020 0.14903690
## 28 0.858375 0.749315 -1.66551224 -2.035217739 -0.53354742
## 29 1.044535 0.182180 0.85242430 0.425795877 0.62734867
## 30 -1.711285 -1.056145 -0.83081511 -0.855567940 -1.04431186
## 31 1.013815 0.909320 1.37648234 0.713385265 -0.09265574
## 32 2.367590 2.167695 0.50656423 0.454834888 0.11830604
## 33 1.325915 0.806595 0.62916240 -0.135488925 0.01166726
## 34 0.104660 0.089715 0.62145494 0.711748679 1.11811613
## 35 -0.108050 0.394765 -0.27609691 -0.304578891 0.09097636
## 36 -0.240875 -0.337760 0.13814745 0.280067895 0.60508895
## 37 0.064935 -3.024620 -0.95194958 -1.102949468 -0.53333883
## 38 0.689485 0.780935 1.76200403 0.606462895 0.63595416
## 39 -0.500375 -0.377385 0.22011527 0.338882947 0.55211251
## 40 -1.191665 -0.736380 -0.60452680 -0.060474316 -0.72653100
## 41 -1.704985 -1.602400 -2.67386065 0.059967843 -0.37196645
## 42 1.455490 2.578890 2.13307246 0.861218509 0.23286794
## 43 0.922465 1.940395 2.58640569 0.666823822 0.70301617
## 44 -0.281365 0.989125 1.12109659 0.806772727 0.06838076
## 45 -2.288815 -2.075590 -1.26731213 -0.283658557 -0.17019000
## 46 0.295040 0.267255 0.97638011 1.059252995 0.75109943
## 47 0.445555 0.207660 -0.23104714 -0.341014666 -1.08217036
## 48 -0.619425 0.252490 0.59550412 -0.805317564 -0.22797123
## 49 1.128515 0.742500 -1.25910262 -0.144250141 -0.38724703
## 50 0.774705 2.250520 0.35042091 0.923363428 1.39481762
## 51 -0.255695 -0.627160 -0.40835417 -0.002883869 -0.62287269
## 52 -0.404275 0.455305 -0.08942072 -1.138232451 -1.15298710
## 53 -0.826105 -1.200300 -1.79644013 0.276280691 0.76886195
## 54 -1.319085 0.406890 -0.78102065 0.135152536 -0.58158826

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 6/37


2026/1/10 20:55 Homework3
## 55 0.142350 0.435870 0.36496609 0.762263631 0.44088461
## 56 0.885745 1.863460 0.98277236 1.777944881 2.63099230
## 57 -0.330635 -0.411255 -0.90453807 -0.320903177 0.56030788
## 58 -1.357660 -0.877460 -0.68309343 1.484175774 1.93565532
## 59 0.585295 -0.334915 -0.01533715 0.411675124 2.15445890
## 60 0.675540 0.094310 0.59494550 1.220413267 0.02968081
## 61 -1.924290 -0.669135 -0.92298648 -1.181263706 -1.54337369
## 62 -0.198845 -1.014750 -0.61445458 -0.529800361 0.78649366
## 63 -1.555290 -2.522230 -1.29534184 -2.069393286 -2.20319270
## 64 -1.021685 0.070165 1.15179209 0.434269841 0.78817657
## 65 0.809420 0.839535 0.04681047 0.586517710 -0.45725414
## 66 -0.874915 0.354640 -0.62873814 -1.507140895 -2.39021184
## 67 1.324205 0.590425 -0.66962305 0.593011140 1.88768873
## 68 0.829955 1.133015 1.41998355 -0.633615863 -1.56243729
## 69 0.118915 -0.430085 0.24066379 0.118208389 0.21289217
## 70 -1.672560 -0.765090 -0.70795531 -1.973824969 -2.36522622
## 71 2.273360 2.019335 2.35977796 0.423962749 0.05911766
## 72 -0.411530 -0.574140 -0.72822099 0.994745798 1.68649917
## 73 -0.414090 0.259310 0.53120690 -0.394870824 0.07346486
## 74 -0.214145 0.051695 -0.16043546 0.094082917 0.61870429
## 75 0.859370 -0.229720 0.21817073 2.191955826 1.38373372
## 76 -0.767655 -0.567145 -1.11420230 -0.145300882 -1.73320711
## 77 -0.286350 -0.880225 0.52002047 1.325374001 -0.04264561
## 78 -0.418160 0.344635 -0.11313708 -0.338017408 0.51729811
## 79 1.452170 -0.134735 1.73396018 -1.311876889 -0.87874635
## 80 -0.410115 -2.189120 -1.37088206 -2.111740426 0.67333183
## 81 -0.698775 -0.580370 -0.58305197 0.480302134 -0.58788858
## 82 0.089930 0.117510 -0.63350404 1.523378249 -0.53860324
## 83 -1.384480 -0.046695 -0.35141793 2.175378304 1.84233490
## 84 0.286450 0.585030 0.42481561 -1.738625237 -1.43462420
## 85 -1.352550 -1.236755 -2.26055674 -0.942435515 -0.38437264
## 86 0.626200 0.876675 0.49865170 1.998071390 1.22851318
## 87 0.990400 0.790580 0.51766580 -1.021154176 1.33049212
## 88 0.193685 0.903000 0.05518968 0.313895715 0.13554176
## 89 -1.365045 -0.259570 -1.28865261 -0.515365898 -0.06851158
## 90 -0.264270 0.269535 -0.58885024 0.357970152 -0.30373065
## 91 0.395315 -0.147110 -0.11313708 -1.775578823 -2.33426202
## 92 0.212775 -0.450730 0.37808292 -0.862787062 -0.71089687
## 93 1.483915 -0.839440 0.10638422 -2.190220969 -2.10933135
## 94 1.811205 1.761405 1.67408238 2.048110107 0.45858703
## 95 1.135145 0.120625 -0.59932249 0.311990774 0.85459158
## 96 1.229130 2.591330 2.76448346 -1.347908243 -0.80780586
## 97 -0.358110 0.396670 0.29990520 1.532963428 0.94024342
## 98 1.032245 1.113225 1.95149451 0.167797328 0.98746048
## 99 0.113700 -0.800305 -1.79778364 -0.214449483 -0.75048778
## 100 0.113130 0.110080 -0.32885415 -0.197270997 -0.48438582
## 101 0.795735 0.440305 1.17375483 -0.762573561 -0.40875722
## 102 0.464645 -0.168060 0.20004051 -0.244989012 -0.72302375
## 103 -0.694740 -0.753390 -1.43826934 -0.339257131 -0.72030139

# Caculate the eigenvector-eigenvalue pair for S


E <- eigen(S)$vectors
E

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 7/37


2026/1/10 20:55 Homework3

## [,1] [,2] [,3] [,4] [,5]


## [1,] -0.2593005 0.5962929 0.2638667 0.7103878 -0.05405177
## [2,] -0.3069226 0.5604719 -0.1788401 -0.5542870 -0.50244597
## [3,] -0.2001969 0.3432888 0.1296875 -0.3454715 0.84018128
## [4,] -0.6175361 -0.2123816 -0.7084212 0.2268222 0.14224709
## [5,] -0.6458576 -0.4090880 0.6162070 -0.1315913 -0.13596923

lambda <- eigen(S)$values


# Cumulative percentage of total variance
CumVar <- round(cumsum(lambda)/sum(lambda)*100, 1)
CumVar

## [1] 55.9 83.6 94.0 97.3 100.0

# Scree Plot
plot(lambda*1000, type = "o", pch = 19, xlab = "i",
ylab = expression(hat(lambda)[i]%*%10^(3)),
xaxt = "n",
main = "A Scree Plot for Stock Data")
axis(1, at = c(1:5))

# The Principle Component


hat_y1 <- c(t(E[, 1])%*%t(scale(data8.10, center = TRUE, scale = TRUE)))
hat_y1

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 8/37


2026/1/10 20:55 Homework3

## [1] 1.13393077 -0.62482606 0.59078338 0.60034194 -1.44883751 0.01125782


## [7] -1.20216869 -0.86541713 1.91069483 0.82798700 1.11525117 -1.88445544
## [13] -0.55082436 -0.23412244 1.79403661 0.70961687 0.14214704 0.37182223
## [19] 0.73670453 -1.72416611 -0.02070882 -0.87419711 -0.86725474 0.88233835
## [25] 0.80738570 0.20849922 0.55939498 1.47221827 -1.14661087 2.10380061
## [31] -1.15067936 -1.67429707 -0.60984134 -1.33945957 0.08979897 -0.43557627
## [37] 2.07411064 -1.52119991 -0.37559346 1.14473174 1.61061654 -2.19791103
## [43] -2.15596841 -0.96614212 1.70432481 -1.47500132 0.79481288 0.60894620
## [49] 0.08402548 -2.39968549 0.73897880 1.43851253 0.22318179 0.66021391
## [55] -0.98538709 -3.76909142 0.20044259 -1.45412323 -1.71606485 -1.06865449
## [61] 2.58832876 0.26724879 4.08535929 -0.76695216 -0.50994096 2.72832606
## [67] -1.98167908 0.61042539 -0.16024866 3.53737536 -1.90009149 -1.30821873
## [73] 0.11946350 -0.39582463 -2.43267593 1.80205953 -0.54527691 -0.11019757
## [79] 0.72846198 1.84343837 0.55190891 -0.50614148 -2.11219390 1.68199609
## [85] 1.95495857 -2.53156675 -0.83277122 -0.60235508 1.01970985 0.08243639
## [91] 2.58759007 1.00257746 2.58128408 -2.83058825 -0.95734908 -0.23477364
## [97] -1.63503446 -1.70524320 1.17338859 0.44271882 0.18529744 0.52314572
## [103] 1.34898168

hat_y2 <- c(t(E[, 2])%*%t(scale(data8.10, center = TRUE, scale = TRUE)))


hat_y3 <- c(t(E[, 3])%*%t(scale(data8.10, center = TRUE, scale = TRUE)))
hat_y4 <- c(t(E[, 4])%*%t(scale(data8.10, center = TRUE, scale = TRUE)))
hat_y5 <- c(t(E[, 5])%*%t(scale(data8.10, center = TRUE, scale = TRUE)))
qqnorm(hat_y4, pch = 19)

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 9/37
2026/1/10 20:55 Homework3

(b) Determine the proportion of the total sample variance


explained by the first three principal components. Interpret these
components.
CumVar[1:3]

## [1] 55.9 83.6 94.0

(c) Construct Bonferroni simultaneous 90% confidence intervals


for the variances λ1 , λ2 and λ3 of the first three population
components Y1 , Y2 and Y3 .
lambda1 <- lambda[1]
lambda2 <- lambda[2]
lambda3 <- lambda[3]
n <- nrow(data8.10)
alpha <- 0.1
[Link].l <- lambda1/(1+qnorm(1-alpha/2)*sqrt(2/n))
[Link].u <- lambda1/(1-qnorm(1-alpha/2)*sqrt(2/n))
c([Link].l, [Link].u)

## [1] 0.001136297 0.001812079

[Link].l <- lambda2/(1+qnorm(1-alpha/2)*sqrt(2/n))


[Link].u <- lambda2/(1-qnorm(1-alpha/2)*sqrt(2/n))
c([Link].l, [Link].u)

## [1] 0.0005636953 0.0008989378

[Link].l <- lambda3/(1+qnorm(1-alpha/2)*sqrt(2/n))


[Link].u <- lambda3/(1-qnorm(1-alpha/2)*sqrt(2/n))
c([Link].l, [Link].u)

## [1] 0.0002115355 0.0003373404

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 10/37
2026/1/10 20:55 Homework3

8.16 Fish caught by the same fisherman live


alongside of each other, so the data should provide
some evidence on how the fish group. The first four
fish belong to the centrarchids, the most plentiful
family. The walleye is the most popular fish to eat.
(a) Comment on the pattern of correlation within the centrarchid
family x1 through x4 . Does the walleye appear to group with the
other fish?
The correlations are positive(x 1 to x 4 ), which means when one type of fish is caught, the other type of fish is
likely to be caught at the same time. The correlations between Walleye and other kind of fishes are negative,
which means when one Walleye fish is caught, the other type of fish is less likely to caught, this suggests that
the Walleye fish is not the same type as other types of fish.

(b) Perform a principal component analysis using only x1


through x4 . Interpret your results.
R <- matrix(c(1, 0.4919, 0.2635, 0.4653, -0.2277, 0.0652,
0.4919, 1, 0.3127, 0.3506, -0.1917, 0.2045,
0.2636, 0.3127, 1, 0.4108, 0.0647, 0.2493,
0.4653, 0.3506, 0.4108, 1, -0.2249, 0.2293,
-0.2277, -0.1917, 0.0647, -0.2249, 1, -0.2144,
0.0652, 0.2045, 0.2493, 0.2293, -0.2144, 1), ncol = 6, nrow = 6)
R_14 <- R[1:4, 1:4]
eigen(R_14)

## eigen() decomposition
## $values
## [1] 2.1539189 0.7875498 0.6156590 0.4428723
##
## $vectors
## [,1] [,2] [,3] [,4]
## [1,] -0.5265384 -0.4571582 0.2491110 -0.6719808
## [2,] -0.5033080 -0.4119833 -0.6142538 0.4467865
## [3,] -0.4427711 0.7584337 -0.3680028 -0.3056057
## [4,] -0.5228691 0.2146031 0.6520812 0.5053996

round(cumsum(eigen(R_14)$values)/sum(eigen(R_14)$values)*100, 1)

## [1] 53.8 73.5 88.9 100.0

(c) Perform a principal component analysis using all six

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 11/37


2026/1/10 20:55 Homework3

variables. Interpret your results.


eigen(R)

## eigen() decomposition
## $values
## [1] 2.3549250 1.0718567 0.9842486 0.6643858 0.5003897 0.4241942
##
## $vectors
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.4753543 0.02188910 0.47987482 0.04564932 0.3578888 -0.6425051
## [2,] -0.4719328 -0.01924243 0.20906455 0.70296351 -0.1771358 0.4556533
## [3,] -0.3931540 -0.56061775 -0.26440849 -0.17551515 -0.5973982 -0.2713733
## [4,] -0.4963538 -0.07723024 0.03226116 -0.60426514 0.3238962 0.5260914
## [5,] 0.2563177 -0.80502150 0.01294351 0.21817123 0.4823355 0.0768220
## [6,] -0.2910014 0.17559671 -0.80925398 0.24539324 0.3822272 -0.1524794

round(cumsum(eigen(R)$values)/sum(eigen(R)$values)*100, 1)

## [1] 39.2 57.1 73.5 84.6 92.9 100.0

8.26
(a) Determine the appropriate number of components to
effectively summarize the variability. Construct a scree plot to aid
in your determination.
data8.26 <- [Link]("[Link]")
data8.26

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 12/37


2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5 V6 V7
## 1 27 13 14 20 11 2 1
## 2 12 13 24 25 6 2 1
## 3 14 20 15 16 7 2 1
## 4 18 20 17 12 6 2 1
## 5 9 22 22 21 6 2 1
## 6 18 15 17 25 9 2 1
## 7 12 18 29 18 4 2 1
## 8 10 19 21 10 16 2 1
## 9 8 23 23 19 9 2 1
## 10 21 11 17 9 16 2 1
## 11 15 16 16 12 19 2 1
## 12 9 20 29 14 7 2 1
## 13 16 22 24 17 4 2 1
## 14 14 19 17 18 15 2 1
## 15 13 26 23 17 5 2 1
## 16 13 20 22 18 5 2 1
## 17 18 17 11 23 14 2 1
## 18 15 24 15 8 15 2 1
## 19 18 22 24 11 6 2 1
## 20 18 18 17 24 7 2 1
## 21 9 16 27 18 9 2 1
## 22 25 17 15 14 14 2 1
## 23 9 21 21 18 4 2 1
## 24 28 17 19 12 7 2 1
## 25 18 18 26 14 6 2 1
## 26 25 13 11 20 6 2 1
## 27 6 16 22 23 15 2 1
## 28 25 13 18 9 15 2 1
## 29 4 23 27 16 8 2 1
## 30 17 7 19 22 12 2 1
## 31 13 14 16 20 16 2 1
## 32 14 16 21 19 10 2 1
## 33 17 12 22 19 12 2 1
## 34 14 16 19 18 13 2 1
## 35 10 19 23 23 3 2 1
## 36 8 21 16 20 10 1 1
## 37 15 12 15 23 11 1 1
## 38 8 22 18 15 9 1 1
## 39 9 17 29 20 10 1 1
## 40 9 14 23 21 12 1 1
## 41 21 16 22 11 11 1 1
## 42 12 18 19 18 8 1 1
## 43 18 20 13 13 17 1 1
## 44 10 14 28 20 10 1 1
## 45 15 11 22 25 9 1 1
## 46 20 14 14 9 17 1 1
## 47 7 14 23 17 23 1 1
## 48 22 17 11 15 11 1 1
## 49 18 21 15 8 15 1 1
## 50 7 14 24 24 14 1 1
## 51 13 17 19 24 8 1 1
## 52 15 20 17 19 10 1 1
## 53 15 19 29 17 2 1 1
## 54 7 21 21 25 8 1 1

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 13/37


2026/1/10 20:55 Homework3
## 55 29 16 8 12 18 1 1
## 56 14 16 23 22 9 1 1
## 57 15 19 12 15 14 1 1
## 58 19 17 21 18 5 1 1
## 59 9 14 21 18 17 1 1
## 60 25 6 19 11 25 1 1
## 61 10 18 22 18 12 1 1
## 62 16 18 19 21 10 1 1
## 63 12 14 21 27 9 1 1
## 64 12 21 19 17 10 1 1
## 65 18 22 14 8 23 1 1
## 66 15 12 15 19 17 1 1
## 67 8 15 25 17 16 1 1
## 68 7 23 29 14 8 1 1
## 69 15 16 14 18 15 1 1
## 70 10 19 22 15 14 1 1
## 71 10 11 28 18 9 1 1
## 72 20 10 14 27 13 1 1
## 73 27 13 19 4 17 1 2
## 74 29 21 11 4 13 1 2
## 75 16 13 9 16 22 1 2
## 76 3 20 25 20 8 1 2
## 77 12 17 9 14 21 1 2
## 78 19 27 12 6 7 2 2
## 79 22 17 21 11 9 2 2
## 80 20 11 23 18 7 2 2
## 81 15 21 21 14 8 2 2
## 82 12 12 28 25 5 2 2
## 83 26 18 9 1 19 2 2
## 84 26 22 16 5 14 1 2
## 85 12 17 10 15 20 1 2
## 86 22 12 18 14 14 1 2
## 87 19 20 17 15 11 1 2
## 88 22 24 9 11 10 1 2
## 89 23 15 14 14 11 1 2
## 90 9 19 18 21 6 1 2
## 91 15 12 12 17 21 1 2
## 92 15 20 20 10 11 1 2
## 93 16 19 19 16 7 1 2
## 94 11 20 22 13 11 1 2
## 95 14 7 20 14 19 1 2
## 96 13 11 26 9 22 1 2
## 97 21 13 18 19 14 1 2
## 98 12 19 20 7 14 2 2
## 99 22 22 14 13 4 2 2
## 100 21 21 21 5 9 2 2
## 101 17 19 25 10 14 2 2
## 102 14 18 12 12 17 2 2
## 103 16 19 14 12 15 2 2
## 104 24 9 2 20 23 2 2
## 105 21 18 18 8 8 2 2
## 106 11 11 24 27 9 2 2
## 107 28 23 11 6 10 2 2
## 108 13 19 24 19 4 2 2
## 109 17 19 20 8 6 2 2
## 110 14 20 21 13 7 2 2

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 14/37


2026/1/10 20:55 Homework3
## 111 31 10 6 7 21 2 2
## 112 19 20 12 4 18 2 2
## 113 10 19 22 11 11 2 2
## 114 10 22 26 9 10 2 2
## 115 18 15 19 17 9 2 2
## 116 18 20 8 6 17 2 2
## 117 13 19 24 17 12 2 2
## 118 18 24 16 12 10 2 2
## 119 20 13 18 23 7 2 2
## 120 16 21 19 12 13 2 2
## 121 9 19 19 19 12 2 2
## 122 10 15 20 22 10 1 2
## 123 13 22 14 12 9 1 2
## 124 22 10 17 14 18 1 2
## 125 16 18 16 8 16 1 2
## 126 10 11 26 17 10 1 2
## 127 14 12 14 11 29 1 2
## 128 19 11 23 18 13 2 2
## 129 27 19 22 7 9 2 2
## 130 10 17 22 22 8 2 2

ColMeans8.26 <- round(colMeans(data8.26),4)


S8.26 <- round(cov(data8.26),4)
stderrs8.26 <- sqrt(diag(S))
std_data8.26 <- sweep(data8.26, 2, ColMeans, "-")

## Warning in sweep(data8.26, 2, ColMeans, "-"): STATS does not recycle exactly


## across MARGIN

std_data8.26 <- sweep(std_data, 2, stderrs, "/")


std_data8.26

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 15/37


2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5
## 1 29.83450 -21.35775 -23.9445 -69.670429 1.518875
## 2 18.46550 39.97150 -39.0500 11.365714 11.861250
## 3 -47.53825 -23.34825 42.1800 -5.714286 -12.678500
## 4 51.14725 -10.46450 79.1765 -46.559571 -13.691750
## 5 24.30625 7.54175 -58.6725 35.985714 46.218875
## 6 22.67825 -32.24450 -49.8840 13.869000 -1.263125
## 7 25.07200 68.26100 32.3605 37.919000 -0.963750
## 8 118.45025 -14.62000 83.2475 3.335429 4.594000
## 9 -88.97850 -36.24775 -48.2340 -48.430143 -18.513500
## 10 -14.39900 50.72050 -38.4205 -34.848571 -20.834625
## 11 -7.30125 -15.66875 -61.7935 -18.556857 -27.956000
## 12 34.37875 84.92100 -38.0020 46.122143 30.879000
## 13 -25.85650 -14.75725 15.5805 32.130857 11.193375
## 14 -117.41700 -71.31075 -79.3480 47.825143 36.502750
## 15 -63.85800 -47.47850 21.5240 -42.796000 -30.291625
## 16 -48.68550 -36.82225 -2.3195 4.754857 -17.147750
## 17 -77.19700 -72.89275 -90.2775 38.692429 15.547125
## 18 -59.02000 -58.95825 164.1155 -14.572286 3.448000
## 19 27.15425 -18.72900 84.9540 -33.376000 -24.180000
## 20 49.70275 58.37725 56.7930 45.059857 13.870250
## 21 26.91725 4.58200 -26.0180 -2.687714 -1.402000
## 22 32.29000 41.31375 -6.1915 15.729429 12.639375
## 23 -40.12650 6.15250 -8.9040 38.621714 23.301875
## 24 48.08050 -38.88700 -99.3035 -9.754714 -25.179875
## 25 25.31625 -57.15325 -33.7825 -41.023429 8.185625
## 26 -84.62625 -41.46975 -26.5115 14.761714 15.586875
## 27 -68.02975 -80.09750 70.0380 -2.203571 5.269250
## 28 42.91875 37.46575 -117.7695 -76.924000 -18.863750
## 29 52.22675 9.10900 60.2755 16.093571 22.180125
## 30 -85.56425 -52.80725 -58.7475 -32.337429 -36.922000
## 31 50.69075 45.46600 97.3320 26.963429 -3.275875
## 32 118.37950 108.38475 35.8195 17.191143 4.182750
## 33 66.29575 40.32975 44.4885 -5.121000 0.412500
## 34 5.23300 4.48575 43.9435 26.901571 39.531375
## 35 -5.40250 19.73825 -19.5230 -11.512000 3.216500
## 36 -12.04375 -16.88800 9.7685 10.585571 21.393125
## 37 3.24675 -151.23100 -67.3130 -41.687571 -18.856375
## 38 34.47425 39.04675 124.5925 22.922143 22.484375
## 39 -25.01875 -18.86925 15.5645 12.808571 19.520125
## 40 -59.58325 -36.81900 -42.7465 -2.285714 -25.686750
## 41 -85.24925 -80.12000 -189.0705 2.266571 -13.151000
## 42 72.77450 128.94450 150.8310 32.551000 8.233125
## 43 46.12325 97.01975 182.8865 25.203571 24.855375
## 44 -14.06825 49.45625 79.2735 30.493143 2.417625
## 45 -114.44075 -103.77950 -89.6125 -10.721286 -6.017125
## 46 14.75200 13.36275 69.0405 40.036000 26.555375
## 47 22.27775 10.38300 -16.3375 -12.889143 -38.260500
## 48 -30.97125 12.62450 42.1085 -30.438143 -8.060000
## 49 56.42575 37.12500 -89.0320 -5.452143 -13.691250
## 50 38.73525 112.52600 24.7785 34.899857 49.314250
## 51 -12.78475 -31.35800 -28.8750 -0.109000 -22.021875
## 52 -20.21375 22.76525 -6.3230 -43.021143 -40.764250
## 53 -41.30525 -60.01500 -127.0275 10.442429 27.183375
## 54 -65.95425 20.34450 -55.2265 5.108286 -20.562250

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 16/37


2026/1/10 20:55 Homework3
## 55 7.11750 21.79350 25.8070 28.810857 15.587625
## 56 44.28725 93.17300 69.4925 67.200000 93.019625
## 57 -16.53175 -20.56275 -63.9605 -12.129000 19.809875
## 58 -67.88300 -43.87300 -48.3020 56.096571 68.435750
## 59 29.26475 -16.74575 -1.0845 15.559857 76.171625
## 60 33.77700 4.71550 42.0690 46.127286 1.049375
## 61 -96.21450 -33.45675 -65.2650 -44.647571 -54.566500
## 62 -9.94225 -50.73750 -43.4485 -20.024571 27.806750
## 63 -77.76450 -126.11150 -91.5945 -78.215714 -77.894625
## 64 -51.08425 3.50825 81.4440 16.413857 27.866250
## 65 40.47100 41.97675 3.3100 22.168286 -16.166375
## 66 -43.74575 17.73200 -44.4585 -56.964571 -84.506750
## 67 66.21025 29.52125 -47.3495 22.413714 66.739875
## 68 41.49775 56.65075 100.4080 -23.948429 -55.240500
## 69 5.94575 -21.50425 17.0175 4.467857 7.526875
## 70 -83.62800 -38.25450 -50.0600 -74.603571 -83.623375
## 71 113.66800 100.96675 166.8615 16.024286 2.090125
## 72 -20.57650 -28.70700 -51.4930 37.597857 59.626750
## 73 -20.70450 12.96550 37.5620 -14.924714 2.597375
## 74 -10.70725 2.58475 -11.3445 3.556000 21.874500
## 75 42.96850 -11.48600 15.4270 82.848143 48.922375
## 76 -38.38275 -28.35725 -78.7860 -5.491857 -61.278125
## 77 -14.31750 -44.01125 36.7710 50.094429 -1.507750
## 78 -20.90800 17.23175 -8.0000 -12.775857 18.289250
## 79 72.60850 -6.73675 122.6095 -49.584286 -31.068375
## 80 -20.50575 -109.45600 -96.9360 -79.816286 23.805875
## 81 -34.93875 -29.01850 -41.2280 18.153714 -20.785000
## 82 4.49650 5.87550 -44.7955 57.578286 -19.042500
## 83 -69.22400 -2.33475 -24.8490 82.221571 65.136375
## 84 14.32250 29.25150 30.0390 -65.713857 -50.721625
## 85 -67.62750 -61.83775 -159.8455 -35.620714 -13.589625
## 86 31.31000 43.83375 35.2600 75.520000 43.434500
## 87 49.52000 39.52900 36.6045 -38.596000 47.040000
## 88 9.68425 45.15000 3.9025 11.864143 4.792125
## 89 -68.25225 -12.97850 -91.1215 -19.479000 -2.422250
## 90 -13.21350 13.47675 -41.6380 13.530000 -10.738500
## 91 19.76575 -7.35550 -8.0000 -67.110571 -82.528625
## 92 10.63875 -22.53650 26.7345 -32.610286 -25.134000
## 93 74.19575 -41.97200 7.5225 -82.782571 -74.576125
## 94 90.56025 88.07025 118.3755 77.411286 16.213500
## 95 56.75725 6.03125 -42.3785 11.792143 30.214375
## 96 61.45650 129.56650 195.4785 -50.946143 -28.560250
## 97 -17.90550 19.83350 21.2065 57.940571 33.242625
## 98 51.61225 55.66125 137.9915 6.342143 34.912000
## 99 5.68500 -40.01525 -127.1225 -8.105429 -26.533750
## 100 5.65650 5.50400 -23.2535 -7.456143 -17.125625
## 101 39.78675 22.01525 82.9970 -28.822571 -14.451750
## 102 23.23225 -8.40300 14.1450 -9.259714 -25.562750
## 103 -34.73700 -37.66950 -101.7010 -12.822714 -25.466500

# Caculate the eigenvector-eigenvalue pair for S


E8.26 <- eigen(S8.26)$vectors
E8.26

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 17/37


2026/1/10 20:55 Homework3

## [,1] [,2] [,3] [,4] [,5]


## [1,] 0.5792591568 -0.07969788 0.642760950 -0.309153266 0.38547023
## [2,] -0.0415704794 -0.61133553 -0.140890775 0.514928461 0.58062739
## [3,] -0.5241064549 -0.21895181 -0.119721477 -0.733981081 0.35106069
## [4,] -0.4931937255 0.57130146 0.422874589 0.303973344 0.39412775
## [5,] 0.3800023012 0.49474171 -0.610938644 -0.089783583 0.47642511
## [6,] -0.0005922969 -0.02562941 0.022536255 -0.003973172 -0.01933568
## [7,] 0.0200249309 -0.01286992 -0.009904095 -0.008248598 -0.09137549
## [,6] [,7]
## [1,] 0.0009661936 0.02831011
## [2,] 0.0195317230 0.04505079
## [3,] 0.0131294553 0.02991783
## [4,] 0.0357218817 0.05038996
## [5,] 0.0465423364 0.01935696
## [6,] 0.9227781796 -0.38330885
## [7,] 0.3801097013 0.92001868

lambda8.26 <- eigen(S8.26)$values


lambda8.26

## [1] 68.7799394 31.5346901 23.1148496 16.3555412 2.4116876 0.2230248 0.1895673

# Cumulative percentage of total variance


CumVar8.26 <- round(cumsum(lambda8.26)/sum(lambda8.26)*100, 1)
CumVar8.26

## [1] 48.2 70.3 86.6 98.0 99.7 99.9 100.0

# Scree Plot
plot(lambda8.26*1000, type = "o", pch = 19, xlab = "i",
ylab = expression(hat(lamdda)[i]%*%10^(3)),
xaxt = "n",
main = "A Scree Plot for Data8.26")
axis(1, at = c(1:7))

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 18/37


2026/1/10 20:55 Homework3

X_prcomp8.26 <- prcomp(data8.26[,1:5], center = TRUE,


scale. = TRUE, # 基于样本相关系数矩阵R
retx = TRUE)
X_prcomp8.26

## Standard deviations (1, .., p=5):


## [1] 1.4821014 1.1697220 0.8694038 0.7673239 0.3007939
##
## Rotation (n x k) = (5 x 5):
## PC1 PC2 PC3 PC4 PC5
## V1 -0.5209626 -0.086521361 -0.6674512 -0.253099293 0.4599582
## V2 0.1213677 -0.788216689 0.1870605 0.350892684 0.4537257
## V3 0.5482732 0.007941356 0.1150943 -0.732694760 0.3863226
## V4 0.4391410 0.490952547 -0.2949415 0.525281896 0.4507873
## V5 -0.4694885 0.360736798 0.6475184 0.007238184 0.4797052

(b) Interpret the sample principal components.


Under the R condition, the first component contracts independence and leadership with benevolence and
conformity. The second component contracts support with conformity and benevolence.

Under the S condition, the first component contracts independence and leadership with benevolence and
conformity. The second component contracts conformity and leadership with support.

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 19/37


2026/1/10 20:55 Homework3

(c) Using the values for the first two principal components, plot
the data in a twodimensional space with along the vertical axis
and along the horizontal axis. Can you distinguish groups
representing the two socioeconomic levels and/or the two
genders? Are there any outliers?
biplot(X_prcomp8.26)

(d) Construct a 95% confidence interval for λ1 , the variance of


the first population principal component from the covariance
matrix.
lambda <- eigen(cov(data8.26))$value
lambda1 <- lambda[1]
n <- nrow(data8.26)
alpha <- 0.05
[Link].l <- lambda1/(1+qnorm(1-alpha/2)*sqrt(2/n))
[Link].u <- lambda1/(1-qnorm(1-alpha/2)*sqrt(2/n))
c([Link].l, [Link].u)

## [1] 55.32918 90.87096

Chapter 9
盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 20/37
2026/1/10 20:55 Homework3

9.12
data6.9 <- [Link]("[Link]", header = FALSE)
data6.9

## V1 V2 V3 V4
## 1 98 81 38 female
## 2 103 84 38 female
## 3 103 86 42 female
## 4 105 86 42 female
## 5 109 88 44 female
## 6 123 92 50 female
## 7 123 95 46 female
## 8 133 99 51 female
## 9 133 102 51 female
## 10 133 102 51 female
## 11 134 100 48 female
## 12 136 102 49 female
## 13 138 98 51 female
## 14 138 99 51 female
## 15 141 105 53 female
## 16 147 108 57 female
## 17 149 107 55 female
## 18 153 107 56 female
## 19 155 115 63 female
## 20 155 117 60 female
## 21 158 115 62 female
## 22 159 118 63 female
## 23 162 124 61 female
## 24 177 132 67 female
## 25 93 74 37 male
## 26 94 78 35 male
## 27 96 80 35 male
## 28 101 84 39 male
## 29 102 85 38 male
## 30 103 81 37 male
## 31 104 83 39 male
## 32 106 83 39 male
## 33 107 82 38 male
## 34 112 89 40 male
## 35 113 88 40 male
## 36 114 86 40 male
## 37 116 90 43 male
## 38 117 90 41 male
## 39 117 91 41 male
## 40 119 93 41 male
## 41 120 89 40 male
## 42 120 93 44 male
## 43 121 95 42 male
## 44 125 93 45 male
## 45 127 96 45 male
## 46 128 95 45 male
## 47 131 95 46 male
## 48 135 106 47 male

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 21/37


2026/1/10 20:55 Homework3

n <- 24
S <- 10 ^ (-3) * matrix(c(11.072, 8.019, 8.160, 8.019, 6.417, 6.005, 8.160, 6.005, 6.773), ncol
= 3, nrow = 3)
L_hat <- c(0.1022, 0.0752, 0.0765)
L_hat %*% t(L_hat)

## [,1] [,2] [,3]


## [1,] 0.01044484 0.00768544 0.00781830
## [2,] 0.00768544 0.00565504 0.00575280
## [3,] 0.00781830 0.00575280 0.00585225

diag(L_hat %*% t(L_hat))

## [1] 0.01044484 0.00565504 0.00585225

Sn <- (n - 1) / n * S
Sn

## [,1] [,2] [,3]


## [1,] 0.010610667 0.007684875 0.007820000
## [2,] 0.007684875 0.006149625 0.005754792
## [3,] 0.007820000 0.005754792 0.006490792

diag(Sn) - diag(L_hat %*% t(L_hat))

## [1] 0.0001658267 0.0004945850 0.0006385417

sum(diag(L_hat %*% t(L_hat))) / sum(diag(Sn)) * 100

## [1] 94.41336

residual <- Sn - L_hat %*% t(L_hat)


diag(residual) <- c(0, 0, 0)
residual

## [,1] [,2] [,3]


## [1,] 0.00e+00 -5.650000e-07 1.700000e-06
## [2,] -5.65e-07 0.000000e+00 1.991667e-06
## [3,] 1.70e-06 1.991667e-06 0.000000e+00

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 22/37
2026/1/10 20:55 Homework3

9.19
library(psych)
data9.19 <- [Link]("[Link]")
data9.19_scale <- scale(data9.19, center = TRUE, scale = TRUE)
fac.ml2 <- fa(r = data9.19_scale, nfactors = 2, fm = "mle", rotate = "none")
print(fac.ml2, digits = 3)

## Factor Analysis using method = ml


## Call: fa(r = data9.19_scale, nfactors = 2, rotate = "none", fm = "mle")
## Standardized loadings (pattern matrix) based upon correlation matrix
## ML1 ML2 h2 u2 com
## V1 0.695 0.669 0.931 0.06919 2.00
## V2 0.669 0.695 0.930 0.07038 2.00
## V3 0.795 0.494 0.877 0.12331 1.67
## V4 0.983 -0.167 0.995 0.00499 1.06
## V5 0.655 0.312 0.526 0.47359 1.43
## V6 0.250 0.569 0.386 0.61364 1.37
## V7 0.558 0.812 0.971 0.02882 1.77
##
## ML1 ML2
## SS loadings 3.333 2.283
## Proportion Var 0.476 0.326
## Cumulative Var 0.476 0.802
## Proportion Explained 0.593 0.407
## Cumulative Proportion 0.593 1.000
##
## Mean item complexity = 1.6
## Test of the hypothesis that 2 factors are sufficient.
##
## df null model = 21 with the objective function = 10.902 with Chi Square = 499.661
## df of the model are 8 and the objective function was 2.634
##
## The root mean square of the residuals (RMSR) is 0.057
## The df corrected root mean square of the residuals is 0.092
##
## The harmonic [Link] is 50 with the empirical chi square 6.79 with prob < 0.559
## The total [Link] was 50 with Likelihood Chi Square = 117.2 with prob < 1.25e-21
##
## Tucker Lewis Index of factoring reliability = 0.3824
## RMSEA index = 0.5221 and the 90 % confidence intervals are 0.4456 0.6145
## BIC = 85.904
## Fit based upon off diagonal values = 0.993
## Measures of factor score adequacy
## ML1 ML2
## Correlation of (regression) scores with factors 0.998 0.989
## Multiple R square of scores with factors 0.996 0.978
## Minimum correlation of possible factor scores 0.991 0.956

fac.ml2_rotated <- fa(r = data9.19_scale, nfactors = 2, fm = "mle", rotate = "varimax")


print(fac.ml2_rotated, digits = 3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 23/37


2026/1/10 20:55 Homework3

## Factor Analysis using method = ml


## Call: fa(r = data9.19_scale, nfactors = 2, rotate = "varimax", fm = "mle")
## Standardized loadings (pattern matrix) based upon correlation matrix
## ML2 ML1 h2 u2 com
## V1 0.852 0.452 0.931 0.06919 1.52
## V2 0.868 0.419 0.930 0.07038 1.44
## V3 0.717 0.602 0.877 0.12331 1.94
## V4 0.148 0.987 0.995 0.00499 1.04
## V5 0.501 0.525 0.526 0.47359 2.00
## V6 0.619 0.060 0.386 0.61364 1.02
## V7 0.946 0.277 0.971 0.02882 1.17
##
## ML2 ML1
## SS loadings 3.545 2.071
## Proportion Var 0.506 0.296
## Cumulative Var 0.506 0.802
## Proportion Explained 0.631 0.369
## Cumulative Proportion 0.631 1.000
##
## Mean item complexity = 1.4
## Test of the hypothesis that 2 factors are sufficient.
##
## df null model = 21 with the objective function = 10.902 with Chi Square = 499.661
## df of the model are 8 and the objective function was 2.634
##
## The root mean square of the residuals (RMSR) is 0.057
## The df corrected root mean square of the residuals is 0.092
##
## The harmonic [Link] is 50 with the empirical chi square 6.79 with prob < 0.559
## The total [Link] was 50 with Likelihood Chi Square = 117.2 with prob < 1.25e-21
##
## Tucker Lewis Index of factoring reliability = 0.3824
## RMSEA index = 0.5221 and the 90 % confidence intervals are 0.4456 0.6145
## BIC = 85.904
## Fit based upon off diagonal values = 0.993
## Measures of factor score adequacy
## ML2 ML1
## Correlation of (regression) scores with factors 0.990 0.997
## Multiple R square of scores with factors 0.980 0.994
## Minimum correlation of possible factor scores 0.959 0.988

# Estimated factor loadings


L.ml2 <- fac.ml2$loadings
# Specific variances
Psi.ml2 <- fac.ml2$uniquenesses
# residual matrix
z9.19 <- matrix(data9.19_scale, ncol = 7, nrow = 50)
R9.19 <- cov(z9.19)
L.ml2%*%t(L.ml2)+diag(Psi.ml2)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 24/37


2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5 V6 V7
## V1 1.0000000 0.9295185 0.8834713 0.5720627 0.6642314 0.5543376 0.9311883
## V2 0.9295185 1.0000000 0.8749727 0.5413952 0.6547844 0.5624010 0.9373106
## V3 0.8834713 0.8749727 1.0000000 0.6996404 0.6751659 0.4798313 0.8449575
## V4 0.5720627 0.5413952 0.6996404 1.0000000 0.5918666 0.1504776 0.4126431
## V5 0.6642314 0.6547844 0.6751659 0.5918666 1.0000000 0.3412918 0.6189365
## V6 0.5543376 0.5624010 0.4798313 0.1504776 0.3412918 1.0000000 0.6017606
## V7 0.9311883 0.9373106 0.8449575 0.4126431 0.6189365 0.6017606 1.0000000

round(R9.19-L.ml2%*%t(L.ml2)-diag(Psi.ml2), 3)

## V1 V2 V3 V4 V5 V6 V7
## V1 0.000 -0.003 0.001 0.000 0.044 0.120 -0.004
## V2 -0.003 0.000 -0.032 0.000 0.091 -0.097 0.007
## V3 0.001 -0.032 0.000 0.001 -0.038 0.161 0.008
## V4 0.000 0.000 0.001 0.000 -0.001 -0.004 0.000
## V5 0.044 0.091 -0.038 -0.001 0.000 0.045 -0.044
## V6 0.120 -0.097 0.161 -0.004 0.045 0.000 -0.035
## V7 -0.004 0.007 0.008 0.000 -0.044 -0.035 0.000

fac.ml3 <- fa(r = data9.19_scale, nfactors = 3, fm = "mle", rotate = "none")


print(fac.ml3, digits = 3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 25/37


2026/1/10 20:55 Homework3

## Factor Analysis using method = ml


## Call: fa(r = data9.19_scale, nfactors = 3, rotate = "none", fm = "mle")
## Standardized loadings (pattern matrix) based upon correlation matrix
## ML1 ML3 ML2 h2 u2 com
## V1 0.901 0.381 -0.066 0.961 0.03857 1.36
## V2 0.775 0.600 0.067 0.966 0.03448 1.90
## V3 0.931 0.202 0.060 0.912 0.08812 1.10
## V4 0.733 -0.118 0.666 0.995 0.00496 2.04
## V5 0.689 0.225 0.169 0.553 0.44662 1.34
## V6 0.757 -0.132 -0.636 0.995 0.00497 2.01
## V7 0.762 0.608 -0.110 0.962 0.03751 1.96
##
## ML1 ML3 ML2
## SS loadings 4.445 0.998 0.901
## Proportion Var 0.635 0.143 0.129
## Cumulative Var 0.635 0.778 0.906
## Proportion Explained 0.701 0.157 0.142
## Cumulative Proportion 0.701 0.858 1.000
##
## Mean item complexity = 1.7
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 21 with the objective function = 10.902 with Chi Square = 499.661
## df of the model are 3 and the objective function was 1.418
##
## The root mean square of the residuals (RMSR) is 0.026
## The df corrected root mean square of the residuals is 0.069
##
## The harmonic [Link] is 50 with the empirical chi square 1.426 with prob < 0.699
## The total [Link] was 50 with Likelihood Chi Square = 62.175 with prob < 2.02e-13
##
## Tucker Lewis Index of factoring reliability = 0.0933
## RMSEA index = 0.6278 and the 90 % confidence intervals are 0.5028 0.7764
## BIC = 50.439
## Fit based upon off diagonal values = 0.999
## Measures of factor score adequacy
## ML1 ML3 ML2
## Correlation of (regression) scores with factors 0.998 0.984 0.997
## Multiple R square of scores with factors 0.997 0.969 0.994
## Minimum correlation of possible factor scores 0.993 0.937 0.988

fac.ml3_rotated <- fa(r = data9.19_scale, nfactors = 3, fm = "mle", rotate = "varimax")


print(fac.ml3_rotated, digits = 3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 26/37


2026/1/10 20:55 Homework3

## Factor Analysis using method = ml


## Call: fa(r = data9.19_scale, nfactors = 3, rotate = "varimax", fm = "mle")
## Standardized loadings (pattern matrix) based upon correlation matrix
## ML3 ML1 ML2 h2 u2 com
## V1 0.793 0.374 0.438 0.961 0.03857 2.04
## V2 0.911 0.317 0.185 0.966 0.03448 1.33
## V3 0.651 0.544 0.438 0.912 0.08812 2.73
## V4 0.255 0.964 0.020 0.995 0.00496 1.14
## V5 0.542 0.465 0.207 0.553 0.44662 2.27
## V6 0.299 0.054 0.950 0.995 0.00497 1.20
## V7 0.917 0.180 0.298 0.962 0.03751 1.29
##
## ML3 ML1 ML2
## SS loadings 3.175 1.718 1.453
## Proportion Var 0.454 0.245 0.208
## Cumulative Var 0.454 0.699 0.906
## Proportion Explained 0.500 0.271 0.229
## Cumulative Proportion 0.500 0.771 1.000
##
## Mean item complexity = 1.7
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 21 with the objective function = 10.902 with Chi Square = 499.661
## df of the model are 3 and the objective function was 1.418
##
## The root mean square of the residuals (RMSR) is 0.026
## The df corrected root mean square of the residuals is 0.069
##
## The harmonic [Link] is 50 with the empirical chi square 1.426 with prob < 0.699
## The total [Link] was 50 with Likelihood Chi Square = 62.175 with prob < 2.02e-13
##
## Tucker Lewis Index of factoring reliability = 0.0933
## RMSEA index = 0.6278 and the 90 % confidence intervals are 0.5028 0.7764
## BIC = 50.439
## Fit based upon off diagonal values = 0.999
## Measures of factor score adequacy
## ML3 ML1 ML2
## Correlation of (regression) scores with factors 0.988 0.996 0.996
## Multiple R square of scores with factors 0.976 0.992 0.991
## Minimum correlation of possible factor scores 0.952 0.984 0.982

# Estimated factor loadings


L.ml3 <- fac.ml3$loadings
# Specific variances
Psi.ml3 <- fac.ml3$uniquenesses
# residual matrix
L.ml3%*%t(L.ml3)+diag(Psi.ml3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 27/37


2026/1/10 20:55 Homework3

## V1 V2 V3 V4 V5 V6 V7
## V1 1.0000000 0.9228132 0.9120900 0.5714373 0.6949346 0.6738835 0.9255325
## V2 0.9228132 1.0000000 0.8471023 0.5417814 0.6799445 0.4654561 0.9481931
## V3 0.9120900 0.8471023 1.0000000 0.6991263 0.6969684 0.6402870 0.8255831
## V4 0.5714373 0.5417814 0.6991263 1.0000000 0.5910467 0.1469508 0.4130097
## V5 0.6949346 0.6799445 0.6969684 0.5910467 1.0000000 0.3841949 0.6425632
## V6 0.6738835 0.4654561 0.6402870 0.1469508 0.3841949 1.0000000 0.5669006
## V7 0.9255325 0.9481931 0.8255831 0.4130097 0.6425632 0.5669006 1.0000000

round(R9.19-L.ml3%*%t(L.ml3)-diag(Psi.ml3), 3)

## V1 V2 V3 V4 V5 V6 V7
## V1 0.000 0.003 -0.028 0.001 0.013 0.001 0.002
## V2 0.003 0.000 -0.005 0.000 0.066 0.000 -0.004
## V3 -0.028 -0.005 0.000 0.001 -0.059 0.001 0.027
## V4 0.001 0.000 0.001 0.000 0.000 0.000 0.000
## V5 0.013 0.066 -0.059 0.000 0.000 0.002 -0.068
## V6 0.001 0.000 0.001 0.000 0.002 0.000 -0.001
## V7 0.002 -0.004 0.027 0.000 -0.068 -0.001 0.000

sum(diag(L.ml2%*%t(L.ml2))) / sum(diag(R9.19)) * 100

## [1] 80.22979

sum(diag(L.ml3%*%t(L.ml3))) / sum(diag(R9.19)) * 100

## [1] 90.63956

m = c(2, 3)
p = 7
n = 50
(n - 1 - (2 * p + 4 * m[1] + 5) / 6) * log(det(L.ml2%*%t(L.ml2)+diag(Psi.ml2))/det(R9.19))

## [1] 117.3066

(n - 1 - (2 * p + 4 * m[2] + 5) / 6) * log(det(L.ml3%*%t(L.ml3)+diag(Psi.ml3))/det(R9.19))

## [1] 62.82397

[Link] <- fa(r = z9.19, nfactors = 3, fm = "wls", rotate = "none",


scores = "regression")

## Warning in [Link](r = r, f = f, phi = phi, [Link] = [Link], [Link] = [Link], :


## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 28/37


2026/1/10 20:55 Homework3

print([Link], digits = 3)

## Factor Analysis using method = wls


## Call: fa(r = z9.19, nfactors = 3, rotate = "none", scores = "regression",
## fm = "wls")
## Standardized loadings (pattern matrix) based upon correlation matrix
## WLS1 WLS2 WLS3 h2 u2 com
## 1 0.969 -0.118 -0.020 0.953 0.0472 1.03
## 2 0.931 0.015 -0.153 0.891 0.1095 1.05
## 3 0.935 -0.010 0.231 0.927 0.0725 1.12
## 4 0.607 0.400 0.169 0.557 0.4434 1.91
## 5 0.763 0.341 -0.167 0.726 0.2738 1.50
## 6 0.594 -0.355 0.068 0.484 0.5161 1.66
## 7 0.891 -0.205 -0.078 0.842 0.1583 1.12
##
## WLS1 WLS2 WLS3
## SS loadings 4.777 0.459 0.144
## Proportion Var 0.682 0.066 0.021
## Cumulative Var 0.682 0.748 0.768
## Proportion Explained 0.888 0.085 0.027
## Cumulative Proportion 0.888 0.973 1.000
##
## Mean item complexity = 1.3
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 21 with the objective function = 10.902 with Chi Square = 499.661
## df of the model are 3 and the objective function was 3.071
##
## The root mean square of the residuals (RMSR) is 0.052
## The df corrected root mean square of the residuals is 0.136
##
## The harmonic [Link] is 50 with the empirical chi square 5.578 with prob < 0.134
## The total [Link] was 50 with Likelihood Chi Square = 134.605 with prob < 5.5e-29
##
## Tucker Lewis Index of factoring reliability = -1.0165
## RMSEA index = 0.9365 and the 90 % confidence intervals are 0.8135 1.0859
## BIC = 122.869
## Fit based upon off diagonal values = 0.994

L <- [Link]$loadings
Psi <- diag([Link]$uniquenesses)

z <- c(110, 98, 105, 15, 18, 20, 35)


z_scale <- c((110 - 98.836)/7.73345,(98-106.622)/10.124315,(105-102.810)/4.712218,(15-11.220)/
3.950149,(18-14.180)/3.384780,(12-10.560)/2.139617,(35-29.760)/10.537707)
z_scale

## [1] 1.4435989 -0.8516132 0.4647493 0.9569259 1.1285815 0.6730176 0.4972619

[Link] <- t(L)%*%solve(R9.19)%*%z_scale


round([Link], 3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 29/37


2026/1/10 20:55 Homework3

## [,1]
## WLS1 1.416
## WLS2 -1.491
## WLS3 3.185

9.20
library(psych)
data9.20 <- [Link]("[Link]")
data9.20 <- [Link](
X1 = data9.20$V1,
X2 = data9.20$V2,
X3 = data9.20$V5,
X4 = data9.20$V6
)
data9.20

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 30/37
2026/1/10 20:55 Homework3

## X1 X2 X3 X4
## 1 8 98 12 8
## 2 7 107 9 5
## 3 7 103 5 6
## 4 10 88 8 15
## 5 6 91 8 10
## 6 8 90 12 12
## 7 9 84 12 15
## 8 5 72 21 14
## 9 7 82 11 11
## 10 8 64 13 9
## 11 6 71 10 3
## 12 6 91 12 7
## 13 7 72 18 10
## 14 10 70 11 7
## 15 10 72 8 10
## 16 9 77 9 10
## 17 8 76 7 7
## 18 8 71 16 4
## 19 9 67 13 2
## 20 9 69 9 5
## 21 10 62 14 4
## 22 9 88 7 6
## 23 8 80 13 11
## 24 5 30 5 2
## 25 6 83 10 23
## 26 8 84 7 6
## 27 6 78 11 11
## 28 8 79 7 10
## 29 6 62 9 8
## 30 10 37 7 2
## 31 8 71 10 7
## 32 7 52 12 8
## 33 5 48 8 4
## 34 6 75 10 24
## 35 10 35 6 9
## 36 8 85 9 10
## 37 5 86 6 12
## 38 5 86 13 18
## 39 7 79 9 25
## 40 7 79 8 6
## 41 6 68 11 14
## 42 8 40 6 5

R9.20 <- cov(data9.20)

# Principal component method


fac.pa1 <- principal(R9.20, nfactors = 1, rotate = "varimax")
print(fac.pa1, digits = 3)

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 31/37


2026/1/10 20:55 Homework3

## Principal Components Analysis


## Call: principal(r = R9.20, nfactors = 1, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 h2 u2 com
## X1 -0.564 0.318 0.682 1
## X2 0.645 0.416 0.584 1
## X3 0.477 0.228 0.772 1
## X4 0.771 0.594 0.406 1
##
## PC1
## SS loadings 1.556
## Proportion Var 0.389
##
## Mean item complexity = 1
## Test of the hypothesis that 1 component is sufficient.
##
## The root mean square of the residuals (RMSR) is 0.198
##
## Fit based upon off diagonal values = -0.027

# Principal component method


fac.pa2 <- principal(R9.20, nfactors = 2, rotate = "varimax")
print(fac.pa2, digits = 3)

## Principal Components Analysis


## Call: principal(r = R9.20, nfactors = 2, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 h2 u2 com
## X1 -0.313 -0.528 0.377 0.623 1.63
## X2 0.828 -0.042 0.688 0.312 1.01
## X3 -0.047 0.875 0.768 0.232 1.01
## X4 0.739 0.295 0.633 0.367 1.31
##
## RC1 RC2
## SS loadings 1.332 1.133
## Proportion Var 0.333 0.283
## Cumulative Var 0.333 0.616
## Proportion Explained 0.540 0.460
## Cumulative Proportion 0.540 1.000
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.212
##
## Fit based upon off diagonal values = -0.17

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 32/37


2026/1/10 20:55 Homework3

fac.ml1 <- fa(r = R9.20, nfactors = 1, fm = "mle", rotate = "varimax")


# Estimated factor loadings
L.ml1 <- fac.ml1$loadings
# Specific variances
Psi.ml1 <- fac.ml1$uniquenesses
# residual matrix
round(L.ml1, 3)

##
## Loadings:
## ML1
## X1 -0.324
## X2 0.410
## X3 0.232
## X4 0.771
##
## ML1
## SS loadings 0.921
## Proportion Var 0.230

round(Psi.ml1, 3)

## X1 X2 X3 X4
## 0.895 0.832 0.946 0.405

fac.ml2 <- fa(r = R9.20, nfactors = 2, fm = "mle", rotate = "varimax")


# Estimated factor loadings
L.ml2 <- fac.ml2$loadings
# Specific variances
Psi.ml2 <- fac.ml1$uniquenesses
# residual matrix
round(L.ml2, 3)

##
## Loadings:
## ML1 ML2
## X1 -0.489
## X2 0.559 0.102
## X3 0.172 0.192
## X4 0.493 0.426
##
## ML1 ML2
## SS loadings 0.594 0.468
## Proportion Var 0.148 0.117
## Cumulative Var 0.148 0.265

round(Psi.ml2, 3)

## X1 X2 X3 X4
## 0.895 0.832 0.946 0.405

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 33/37


2026/1/10 20:55 Homework3

Chapter 10

盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 34/37
2026/1/10 20:55 Homework3

10.18
normalize_b <- function
(b, mat22){
return
(b/c(sqrt((t(b)%*%mat22%*%b))))
}
get_canon_var <- function
(mat, p, q){
# 矩阵的分块
mat11 <- mat[1:p, 1:p]
mat12 <- mat[1:p, (p+1):(p+q)]
mat21 <- mat[(p+1):(p+q), 1:p]
mat22 <- mat[(p+1):(p+q), (p+1):(p+q)]

# 求逆
mat11_inv <- solve(mat11)
mat22_inv <- solve(mat22)
mat11_sqrt_inv <- eigen(mat11)$vectors%*%diag(eigen(mat11)$values^(-0.5))%*%t(eigen(mat11)$ve
ctors)
mat22_sqrt_inv <- eigen(mat22)$vectors%*%diag(eigen(mat22)$values^(-0.5))%*%t(eigen(mat22)$ve
ctors)

the_mat <- mat11_sqrt_inv%*%mat12%*%mat22_inv%*%mat21%*%mat11_sqrt_inv


rho_star <- sqrt(eigen(the_mat)$values)
E_mat <- eigen(the_mat)$vectors
A <- c()
B <- c()
for in
(k 1:p){
A <- cbind(A, mat11_sqrt_inv%*%E_mat[, k])
B <- cbind(B, normalize_b(mat22_inv%*%mat21%*%A[, k], mat22))
}
F_mat <- eigen(mat22_sqrt_inv%*%mat21%*%mat11_inv%*%mat12%*%mat22_sqrt_inv)$vectors
if(q > p){
for in
(k (p+1):q){
B <- cbind(B, mat22_sqrt_inv%*%F_mat[, k])
}
}
return (list( # \rho_{11}^{-1/2}:mat11_sqrt_inv = round(mat11_sqrt_inv, 4),
# \rho_{22}^{-1}:mat22_inv = round(mat22_inv, 4),
# the_mat:the_mat = round(the_mat, 4),
# eigenvectors of the_mat:E_mat = round(E_mat, 4),
# canonical correlation
rho_star = rho_star,
A = round(t(A), 4),
B = round(t(B), 4)))
}
get_var_expla <- function
(R, p, q, r){
canon_var <- get_canon_var(R, p, q)
A_inv <- solve(canon_var$A)
B_inv <- solve(canon_var$B)
R2Z1 <- 0
R2Z2 <- 0
for in
(k 1:r){
R2Z1 <- R2Z1 + sum(A_inv[, k]^2)
R2Z2 <- R2Z2 + sum(B_inv[, k]^2)
}
return
(list(R2Z1 = R2Z1/p, R2Z2 = R2Z2/q))
盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link]
[Link] 35/37
2026/1/10 20:55 Homework3
}
cov_test <- function
(mat, p, q, n, alpha){
cannon_var <- get_canon_var(mat, p, q)
k_list <- c()
stat_list <- c()
df_list <- c()
cri_val_list <- c()
k <- 0
flag <- TRUE
while
(flag){
k_list <- c(k_list, k)
stat <- -(n-1-1/2*(p+q+1))*log(prod((1-cannon_var$rho_star^2)[(k+1):p]))
stat_list <- c(stat_list, stat)
cri_val <- qchisq(1-alpha, (p-k)*(q-k))
df_list <- c(df_list, (p-k)*(q-k))
cri_val_list <- c(cri_val_list, cri_val)
flag <- (stat > cri_val)
k <- k + 1
}
return
(list('H_0^(k)' = k_list,
'statistic' = stat_list,
'df' = df_list,
'[Link]' = cri_val_list))
}

data10.18 <- [Link]("[Link]", header = F)


R <- cor(data10.18)
get_canon_var(R, 4, 4)

## $rho_star
## [1] 0.91732930 0.81692694 0.26538537 0.09168402
##
## $A
## [,1] [,2] [,3] [,4]
## [1,] 1.5054 0.2119 -1.9984 -0.6764
## [2,] -3.4956 -1.5431 1.0760 3.7679
## [3,] 5.7015 -3.5252 4.7135 -7.1532
## [4,] 5.0848 0.5867 -6.0694 0.6861
##
## $B
## V5 V6 V7 V8
## [1,] 0.1593 -0.6325 -0.3249 -0.8179
## [2,] 0.6886 1.0029 0.0050 -1.5619
## [3,] 0.5130 -0.0772 1.6631 0.7786
## [4,] -2.3330 2.1803 -0.0222 -0.0891

get_var_expla(R, 4, 4, 1)

## $R2Z1
## [1] 0.8801116
##
## $R2Z2
## [1] 0.6979143

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 36/37


2026/1/10 20:55 Homework3

cov_test(R, 4, 4, nrow(data10.18), 0.05)

## $`H_0^(k)`
## [1] 0 1 2
##
## $statistic
## [1] 170.864715 66.794152 4.603281
##
## $df
## [1] 16 9 4
##
## $[Link]
## [1] 26.296228 16.918978 9.487729

## V1 V2 V3 V4 V5 V6 V7
## V1 1.0000000 0.9138256 0.9838790 0.9875554 0.6477987 0.7350138 -0.5418813
## V2 0.9138256 1.0000000 0.9422199 0.8746665 0.5370190 0.6085413 -0.5559586
## V3 0.9838790 0.9422199 1.0000000 0.9745114 0.6807025 0.7644251 -0.5745904
## V4 0.9875554 0.8746665 0.9745114 1.0000000 0.7063811 0.7962528 -0.5636592
## V5 0.6477987 0.5370190 0.6807025 0.7063811 1.0000000 0.9055912 -0.7334321
## V6 0.7350138 0.6085413 0.7644251 0.7962528 0.9055912 1.0000000 -0.7109855
## V7 -0.5418813 -0.5559586 -0.5745904 -0.5636592 -0.7334321 -0.7109855 1.0000000
## V8 0.8217782 0.8495981 0.8651424 0.8132479 0.7842212 0.7927309 -0.7845570
## V8
## V1 0.8217782
## V2 0.8495981
## V3 0.8651424
## V4 0.8132479
## V5 0.7842212
## V6 0.7927309
## V7 -0.7845570
## V8 1.0000000

[Link] 盘桌面请来这里/Weedy's-(1)/课程日常学习/专业课/多元统计分析/25秋多元统计作业/[Link] 37/37

You might also like