library(dplyr)
X<-matrix(data = c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,216,283,237,203,259,374,342,301,365,
384,404,426,432,409,553,572,506,528,501,
628,677,602,630,652),
nrow = 24, ncol = 2, byrow = FALSE)
colnames(X) <-c("cte","x")
Y<-matrix(data = c(6.1,9.1,7.2,7.5,6.9,11.5,10.3,9.5,9.2,
10.6,12.5,12.9,13.6,12.8,16.5,17.1,15,
16.2,15.8,19,19.4,19.1,18,20.2),
nrow = 24)
print(X)
## cte x
## [1,] 1 216
## [2,] 1 283
## [3,] 1 237
## [4,] 1 203
## [5,] 1 259
## [6,] 1 374
## [7,] 1 342
## [8,] 1 301
## [9,] 1 365
## [10,] 1 384
## [11,] 1 404
## [12,] 1 426
## [13,] 1 432
## [14,] 1 409
## [15,] 1 553
## [16,] 1 572
## [17,] 1 506
## [18,] 1 528
## [19,] 1 501
## [20,] 1 628
## [21,] 1 677
## [22,] 1 602
## [23,] 1 630
## [24,] 1 652
print(Y)
## [,1]
## [1,] 6.1
## [2,] 9.1
## [3,] 7.2
## [4,] 7.5
## [5,] 6.9
## [6,] 11.5
## [7,] 10.3
## [8,] 9.5
## [9,] 9.2
## [10,] 10.6
## [11,] 12.5
## [12,] 12.9
## [13,] 13.6
## [14,] 12.8
## [15,] 16.5
## [16,] 17.1
## [17,] 15.0
## [18,] 16.2
## [19,] 15.8
## [20,] 19.0
## [21,] 19.4
## [22,] 19.1
## [23,] 18.0
## [24,] 20.2
txx<-solve(t(X)%*%(X))
A<-txx%*%t(X)
P<-X%*%A
Iden<-diag(x=1,24,24)
M<-Iden-P
ui<-(M%*%Y)
print(ui)
## [,1]
## [1,] -0.50716765
## [2,] 0.50270510
## [3,] -0.03093888
## [4,] 1.27897644
## [5,] -0.98441350
## [6,] 0.19969645
## [7,] -0.04979501
## [8,] 0.36804405
## [9,] -1.83297302
## [10,] -0.99733747
## [11,] 0.30859470
## [12,] 0.05512008
## [13,] 0.57689973
## [14,] 0.46007774
## [15,] -0.11721068
## [16,] -0.08157512
## [17,] -0.22115126
## [18,] 0.32537412
## [19,] 0.72736569
## [20,] 0.15503494
## [21,] -0.90043126
## [22,] 1.02732313
## [23,] -0.90437184
## [24,] 0.64215354
Varianza
n<-nrow(P)
varJB<-sqrt((1/n)*(sum(ui^2)))
print(varJB)
## [1] 0.7105005
Encontrar la asimetria \(\mu_3\) y curtosis \(\mu_4\)
#asimetria = As
As<-(1/n)*(sum(ui^3))
#curtosis = Ct
Ct<-(1/n)*(sum(ui^4))
Asimetria
print(As)
## [1] -0.2229066
Curtosis
print(Ct)
## [1] 0.7963161
Encontrando \(\alpha\) de asimetria y curtosis
#alpha de asimetria = Aas
Aas<-(As/varJB^3)
#alpha de curtosis = Act
Act<-(Ct/varJB^4)
Alpha de asimetria
print(Aas)
## [1] -0.6214835
Alpha de curtosis
print(Act)
## [1] 3.124841
Calcular estadistico de prueba \(JB\)
JB<-(n/6)*(Aas^2)+(n/24)*(Act-3)^2
Estadistico de Jarque Bera
(JB)
## [1] 1.560552
JB es menor que el V.C 5.9915 Hay evidencia de que le modelo sigue una distribucion normal.
Varianza
i<-1:n
varKS <- sqrt((1/n)*(sum(ui^2)))
print(varKS)
## [1] 0.7105005
Calculo de \(Z_{i}\): \[Z_{i}=\frac{u_{i}}{\sigma}\] Valor \(Z_{i}\)
zi <- ((ui-(ui/n))/varKS)
print(zi)
## [,1]
## [1,] -0.68407501
## [2,] 0.67805586
## [3,] -0.04173080
## [4,] 1.72510180
## [5,] -1.32779106
## [6,] 0.26935344
## [7,] -0.06716423
## [8,] 0.49642310
## [9,] -2.47234034
## [10,] -1.34522310
## [11,] 0.41623696
## [12,] 0.07434675
## [13,] 0.77813064
## [14,] 0.62055946
## [15,] -0.15809545
## [16,] -0.11002970
## [17,] -0.29829200
## [18,] 0.43886928
## [19,] 0.98108130
## [20,] 0.20911335
## [21,] -1.21451461
## [22,] 1.38566819
## [23,] -1.21982973
## [24,] 0.86614591
Valor \(P_{i}\)
pi <- pnorm(-abs(zi))
print(pi)
## [,1]
## [1,] 0.246963900
## [2,] 0.248868138
## [3,] 0.483356650
## [4,] 0.042254564
## [5,] 0.092123570
## [6,] 0.393828856
## [7,] 0.473225481
## [8,] 0.309797965
## [9,] 0.006711583
## [10,] 0.089276599
## [11,] 0.338618309
## [12,] 0.470367238
## [13,] 0.218246001
## [14,] 0.267444760
## [15,] 0.437190795
## [16,] 0.456192912
## [17,] 0.382740154
## [18,] 0.330378128
## [19,] 0.163276327
## [20,] 0.417179876
## [21,] 0.112275636
## [22,] 0.082924123
## [23,] 0.111264714
## [24,] 0.193205075
Valor \(D^{+}\)
Dmas <- abs((i/n)-pi)
print(Dmas)
## [,1]
## [1,] 0.20529723
## [2,] 0.16553480
## [3,] 0.35835665
## [4,] 0.12441210
## [5,] 0.11620976
## [6,] 0.14382886
## [7,] 0.18155881
## [8,] 0.02353537
## [9,] 0.36828842
## [10,] 0.32739007
## [11,] 0.11971502
## [12,] 0.02963276
## [13,] 0.32342067
## [14,] 0.31588857
## [15,] 0.18780921
## [16,] 0.21047375
## [17,] 0.32559318
## [18,] 0.41962187
## [19,] 0.62839034
## [20,] 0.41615346
## [21,] 0.76272436
## [22,] 0.83374254
## [23,] 0.84706862
## [24,] 0.80679493
Valor \(D^{-}\)
Dmenos <- abs(pi - ((i-1)/n))
print(Dmenos)
## [,1]
## [1,] 0.24696390
## [2,] 0.20720147
## [3,] 0.40002332
## [4,] 0.08274544
## [5,] 0.07454310
## [6,] 0.18549552
## [7,] 0.22322548
## [8,] 0.01813130
## [9,] 0.32662175
## [10,] 0.28572340
## [11,] 0.07804836
## [12,] 0.01203391
## [13,] 0.28175400
## [14,] 0.27422191
## [15,] 0.14614254
## [16,] 0.16880709
## [17,] 0.28392651
## [18,] 0.37795521
## [19,] 0.58672367
## [20,] 0.37448679
## [21,] 0.72105770
## [22,] 0.79207588
## [23,] 0.80540195
## [24,] 0.76512826
Cuadro completo
Tab<-cbind(i,i/n,zi,pi,Dmas,Dmenos)
colnames(Tab)<-c("i","i/n","zi","P(i)","Dmas","Dmenos")
print(Tab)
## i i/n zi P(i) Dmas Dmenos
## [1,] 1 0.04166667 -0.68407501 0.246963900 0.20529723 0.24696390
## [2,] 2 0.08333333 0.67805586 0.248868138 0.16553480 0.20720147
## [3,] 3 0.12500000 -0.04173080 0.483356650 0.35835665 0.40002332
## [4,] 4 0.16666667 1.72510180 0.042254564 0.12441210 0.08274544
## [5,] 5 0.20833333 -1.32779106 0.092123570 0.11620976 0.07454310
## [6,] 6 0.25000000 0.26935344 0.393828856 0.14382886 0.18549552
## [7,] 7 0.29166667 -0.06716423 0.473225481 0.18155881 0.22322548
## [8,] 8 0.33333333 0.49642310 0.309797965 0.02353537 0.01813130
## [9,] 9 0.37500000 -2.47234034 0.006711583 0.36828842 0.32662175
## [10,] 10 0.41666667 -1.34522310 0.089276599 0.32739007 0.28572340
## [11,] 11 0.45833333 0.41623696 0.338618309 0.11971502 0.07804836
## [12,] 12 0.50000000 0.07434675 0.470367238 0.02963276 0.01203391
## [13,] 13 0.54166667 0.77813064 0.218246001 0.32342067 0.28175400
## [14,] 14 0.58333333 0.62055946 0.267444760 0.31588857 0.27422191
## [15,] 15 0.62500000 -0.15809545 0.437190795 0.18780921 0.14614254
## [16,] 16 0.66666667 -0.11002970 0.456192912 0.21047375 0.16880709
## [17,] 17 0.70833333 -0.29829200 0.382740154 0.32559318 0.28392651
## [18,] 18 0.75000000 0.43886928 0.330378128 0.41962187 0.37795521
## [19,] 19 0.79166667 0.98108130 0.163276327 0.62839034 0.58672367
## [20,] 20 0.83333333 0.20911335 0.417179876 0.41615346 0.37448679
## [21,] 21 0.87500000 -1.21451461 0.112275636 0.76272436 0.72105770
## [22,] 22 0.91666667 1.38566819 0.082924123 0.83374254 0.79207588
## [23,] 23 0.95833333 -1.21982973 0.111264714 0.84706862 0.80540195
## [24,] 24 1.00000000 0.86614591 0.193205075 0.80679493 0.76512826
Valor D \[D=max(D^{+},D^{-})\]
D1 <- max(Dmas)
D2 <- max(Dmenos)
maxD<-max(Dmas, Dmenos)
print(maxD)
## [1] 0.8470686
V.C en tabla es igual a 0.1788 Es estadistico D es mayor que V.C No hay evidencia que el modelo sigue una distribución normal.
**Identificar p(i) y mi
p_i <- (i-0.375)/(n+0.25)
m_i <- qnorm(mean=0, sd=1, lower.tail = FALSE, p_i)*-1
matriz_m <- matrix(m_i)
m <- (sum(m_i^2))
xSW <- matriz_m[12,1]
print(xSW)
## [1] -0.05170609
calculo de ai paso a paso
ted <- 1/sqrt(n)
print(ted)
## [1] 0.2041241
an <- (((ted)^5)*-2.706050)+(4.434685*(ted)^4)-(2.071190*(ted)^3)-(0.147981*(ted)^2)+(0.2211570*(ted))+(matriz_m[n,1]/sqrt(m))
an_1 <- (((ted)^5)*-3.582633)+(5.682633*(ted)^4)-(1.752461*(ted)^3)-(0.293762*(ted)^2)+(0.042981*(ted))+(matriz_m[(n-1),1]/sqrt(m))
w <- (m-(2*(matriz_m[n,1])^2)-(2*(matriz_m[n-1,1])^2))/(1-(2*(an)^2)-2*(an_1)^2)
print(w)
## [1] 23.48625
a_i <- matriz_m/sqrt(w)
print(a_i)
## [,1]
## [1,] -0.40173288
## [2,] -0.30919370
## [3,] -0.25502179
## [4,] -0.21431914
## [5,] -0.18060106
## [6,] -0.15112913
## [7,] -0.12446207
## [8,] -0.09973122
## [9,] -0.07635921
## [10,] -0.05393035
## [11,] -0.03212284
## [12,] -0.01066927
## [13,] 0.01066927
## [14,] 0.03212284
## [15,] 0.05393035
## [16,] 0.07635921
## [17,] 0.09973122
## [18,] 0.12446207
## [19,] 0.15112913
## [20,] 0.18060106
## [21,] 0.21431914
## [22,] 0.25502179
## [23,] 0.30919370
## [24,] 0.40173288
Encontrando El producto de los residuos y W
au_i<- a_i*ui
print(au_i)
## [,1]
## [1,] 0.2037459209
## [2,] -0.1554332489
## [3,] 0.0078900878
## [4,] -0.2741091362
## [5,] 0.1777861242
## [6,] -0.0301799511
## [7,] 0.0061975904
## [8,] -0.0367054814
## [9,] 0.1399643782
## [10,] 0.0537867593
## [11,] -0.0099129376
## [12,] -0.0005880911
## [13,] 0.0061551002
## [14,] 0.0147790029
## [15,] -0.0063212129
## [16,] -0.0062290121
## [17,] -0.0220556850
## [18,] 0.0404967356
## [19,] 0.1099261459
## [20,] 0.0279994749
## [21,] -0.1929796562
## [22,] 0.2619897822
## [23,] -0.2796260743
## [24,] 0.2579741901
uu_i<- (ui)^2
print(uu_i)
## [,1]
## [1,] 0.2572190250
## [2,] 0.2527124189
## [3,] 0.0009572141
## [4,] 1.6357807424
## [5,] 0.9690699314
## [6,] 0.0398786721
## [7,] 0.0024795434
## [8,] 0.1354564223
## [9,] 3.3597901075
## [10,] 0.9946820249
## [11,] 0.0952306868
## [12,] 0.0030382229
## [13,] 0.3328132949
## [14,] 0.2116715247
## [15,] 0.0137383430
## [16,] 0.0066545004
## [17,] 0.0489078817
## [18,] 0.1058683157
## [19,] 0.5290608535
## [20,] 0.0240358324
## [21,] 0.8107764500
## [22,] 1.0553928037
## [23,] 0.8178884330
## [24,] 0.4123611645
W <- sum(au_i)^2/sum(uu_i)
print(W)
## [1] 0.00716111
Construir matriz
tabla<-cbind(i,p_i,matriz_m,a_i,ui,au_i,uu_i)
colnames(tabla)<-c("i", "p(i)", "mi", "ai", "ui", "ai*ui", "ui^2")
round(tabla,6)
## i p(i) mi ai ui ai*ui ui^2
## [1,] 1 0.025773 -1.946903 -0.401733 -0.507168 0.203746 0.257219
## [2,] 2 0.067010 -1.498434 -0.309194 0.502705 -0.155433 0.252712
## [3,] 3 0.108247 -1.235902 -0.255022 -0.030939 0.007890 0.000957
## [4,] 4 0.149485 -1.038647 -0.214319 1.278976 -0.274109 1.635781
## [5,] 5 0.190722 -0.875240 -0.180601 -0.984413 0.177786 0.969070
## [6,] 6 0.231959 -0.732411 -0.151129 0.199696 -0.030180 0.039879
## [7,] 7 0.273196 -0.603176 -0.124462 -0.049795 0.006198 0.002480
## [8,] 8 0.314433 -0.483324 -0.099731 0.368044 -0.036705 0.135456
## [9,] 9 0.355670 -0.370057 -0.076359 -1.832973 0.139964 3.359790
## [10,] 10 0.396907 -0.261361 -0.053930 -0.997337 0.053787 0.994682
## [11,] 11 0.438144 -0.155676 -0.032123 0.308595 -0.009913 0.095231
## [12,] 12 0.479381 -0.051706 -0.010669 0.055120 -0.000588 0.003038
## [13,] 13 0.520619 0.051706 0.010669 0.576900 0.006155 0.332813
## [14,] 14 0.561856 0.155676 0.032123 0.460078 0.014779 0.211672
## [15,] 15 0.603093 0.261361 0.053930 -0.117211 -0.006321 0.013738
## [16,] 16 0.644330 0.370057 0.076359 -0.081575 -0.006229 0.006655
## [17,] 17 0.685567 0.483324 0.099731 -0.221151 -0.022056 0.048908
## [18,] 18 0.726804 0.603176 0.124462 0.325374 0.040497 0.105868
## [19,] 19 0.768041 0.732411 0.151129 0.727366 0.109926 0.529061
## [20,] 20 0.809278 0.875240 0.180601 0.155035 0.027999 0.024036
## [21,] 21 0.850515 1.038647 0.214319 -0.900431 -0.192980 0.810776
## [22,] 22 0.891753 1.235902 0.255022 1.027323 0.261990 1.055393
## [23,] 23 0.932990 1.498434 0.309194 -0.904372 -0.279626 0.817888
## [24,] 24 0.974227 1.946903 0.401733 0.642154 0.257974 0.412361
Calcular \(W_n\) usando las siguientes formulas:
mu<- 0.0038915*(log(n)^3)-0.083751*(log(n)^2)-0.31082*(log(n))-1.5861
var<- 2.718281828^{(0.0030302*log(n)^2)-0.082676*(log(n))-0.4803}
Wn<-(log(1-W)-mu)/var
print(Wn)
## [1] 6.703498
V.C. = 1.644854 El estadistico Wn es mayor que el V.C Por lo que no hay evidencia que el modelo siga una distribución normal.