# 5. HARJOITUKSET ################# # 5.1 # (a) S1<-matrix(c(2,1,1,4),nrow=2) S1 [,1] [,2] [1,] 2 1 [2,] 1 4 S2<-matrix(c(4,3,3,6),nrow=2) S2 [,1] [,2] [1,] 4 3 [2,] 3 6 Sp<-0.5*S1+0.5*S2 Sp [,1] [,2] [1,] 3 2 [2,] 2 5 M<-(det(S1)^(5/2)*det(S2)^(5/2))/det(Sp)^5 M # [1] 0.7014712 # (b) S2<-matrix(c(10,15,15,30),nrow=2) Sp<-0.5*S1+0.5*S2 Sp Sp [,1] [,2] [1,] 6 8 [2,] 8 17 M<-(det(S1)^(5/2)*det(S2)^(5/2))/det(Sp)^5 M 0.07970403 # Mitä enemmän matriisit poikkeavat toisistaan, sitä lähemmäksi M # menee nollaa ###### # 5.2 ###### Y<-read.table("C:\\Kurssit\\Mmm\\mmm03\\Datat\\pojat.R.txt", header = T, skip=7) S<-cov(Y) S11<-S[1:2,1:2]; S22<-S[3:4,3:4] det(S) # [1] 1207109 det(S11);det(S22) #[1] 2385.085 #[1] 1341.881 (25-1-5/2)*log(det(S11)*det(S22)/det(S)) # [1] 20.96418 1-pchisq(20.96418, 4) # [1] 0.0003218897 # Testisuureen arvoon liittyvä tn hyvin pieni. 1. ja 2. poikien pään mitat eivät # riippumattomat (H0 hylätään) ###### # 5.3 ###### # (a) Y<-read.table("C:\\Kurssit\\Mmm\\mmm03\\Datat\\luu.txt", header = T, skip=3) S<-cov(Y) -20*log(det(S)/((sum(diag(S))/p)^p)) [1] 151.4895 p<-4 nu<-p*(p+1)/2-1 nu # [1] 9 1-pchisq(151.4895,9) # [1] 0 # H0 hylätään # (b) ######## C<-matrix(c(1,-1,0,0,0),nrow=3,ncol=4, byrow =T) C [,1] [,2] [,3] [,4] [1,] 1 -1 0 0 [2,] 0 1 -1 0 [3,] 0 0 1 -1 S<-C%*%S%*%t(C); p<-p-1 q<- -20*log(det(S)/((sum(diag(S))/p)^p)) q # [1] 8.927699 nu<-p*(p+1)/2-1 nu # [1] 5 1-pchisq(q,nu) # [1] 0.1119830 # H0 jää voimaan # Peräkkäiisten ikäväleillä tarkasteltavan luun kasvumäärät riippumattomat ###### # 5.5 ###### Y<-matrix(c(9,6,9,0,2,3,1,2,3,2,7,4,0,8,9,7),ncol=2) n<-dim(Y)[1] n #[1] 8 # Testataan hypoteesi H0: mu_1=mu_2=mu_3 T<-(n-1)*cov(Y) T [,1] [,2] [1,] 88 -11 [2,] -11 72 n1<-3;n2<-2;n3<-3 E<-(n1-1)*cov(Y[1:3,])+(n2-1)*cov(Y[4:5,])+(n3-1)*cov(Y[6:8,]) E [,1] [,2] [1,] 10 1 [2,] 1 24 H<-T-E H [,1] [,2] [1,] 78 -12 [2,] -12 48 lambda<-det(E)/det(T) lambda # [1] 0.03845535 p<-2 ((n-p-2)/p)*((1-sqrt(lambda))/sqrt(lambda)) # [1] 8.19886 1-pf(8.19886, 2*p,2*(n-p-2)) 0.006234085 # Hypoteesi, että eri ryhmien odotusarvot ovat samat, voidaan hylätä # 1%:n riskitasolla # (b) F1<-(H[1,1]/2)/(E[1,1]/5) F1 # [1] 19.5 F2<-(H[2,2]/2)/(E[2,2]/5) F2 # [1] 5 1-pf(c(19.5,5),2,5) # [1] 0.004353047 0.064150030 # 1. muuttujan suhteen voidaan odotusarvojen yhtäsuushypoteesi hylätä # 1%:n riskitasolla # 2. 1. muuttujan suhteen yhtäsuushypoteesi jää voimaan # (c) Y<-matrix(c(9,6,9,0,2,3,1,2,3,2,7,4,0,8,9,7),ncol=2) Y<-as.data.frame(Y) colnames(Y)<-c("x","y") attach(Y) plot(Y, xlim=c(0,10), ylim=c(0,10)) points(Y[4:5,],pch=16) points(Y[6:8,],pch=2) points(mean(x[1:3]),mean(y[1:3]),pch=3) points(mean(x[4:5]),mean(y[4:5]),pch=3) points(mean(x[6:8]),mean(y[6:8]),pch=3) ###### # 5.6 ###### # (a) Y<-matrix(c(9,6,9,0,2,3,1,2,3,2,7,4,0,8,9,7),ncol=2) n<-dim(Y)[1] n a<-cbind(c(1,1)) Y<-transform(Y,z=Y%*%a) attach(Y) # 1. tapa ######### n1<-3;n2<-2;n3<-3 SST<- (n-1)*var(z) # [1] 138 SSE<- (n1-1)*var(z[1:3])+(n2-1)*var(z[4:5])+(n3-1)*var(z[6:8]) SSE # [1] 36 SSH<- SST-SSE SSH # [1] 102 a<- 3 F<- (SSH/(a-1))/(SSE/(n-a)) F # [1] 7.083333 1-pf(7.083333,2,5) 0.03475830 # z:n keskiarvoerot merkitseviä 5%:n riskitasolla ############# # 2. tapa ############# Y T<-(n-1)*cov(Y) T X1 X2 z X1 88 -11 77 X2 -11 72 61 z 77 61 138 E<-(n1-1)*cov(Y[1:3,])+(n2-1)*cov(Y[4:5,])+(n3-1)*cov(Y[6:8,]) E X1 X2 z X1 10 1 11 X2 1 24 25 z 11 25 36 H<-T-E H X1 X2 z X1 78 -12 66 X2 -12 48 36 z 66 36 102 Fz<-(H[3,3]/2)/(E[3,3]/5) Fz 7.083333 # (b) Y<-matrix(c(9,6,9,0,2,3,1,2,3,2,7,4,0,8,9,7),ncol=2) # Voidaan valita esim. f=(sqrt(2),0), eli 1. muuttuja # Tehtävän 5.5 (b) mukaan # F1 # [1] 19.5, joka on suurempi kuin z-muuttujalla saatu F # Maksimaalinen keskiarvoero saavutetaan, kun kerroinvektoriksi valitaan # matriisin E^{-1}H suurimpaan ominaisarvoon liittyvä ominaisvektori oaa.EH<-eigen(solve(E)%*%H) p1<-oaa.EH$vectors[,1] p1 # [1] 0.9906565 -0.1363804 sqrt(2)*p1 # [1] 1.4009999 -0.1928711 f<-cbind(sqrt(2)*p1) Y<-transform(Y,v=Y%*%f) Y X1 X2 v 1 9 3 17.013535 2 6 2 11.342357 3 9 7 15.922492 4 0 4 -1.091044 5 2 0 3.962626 6 3 8 3.761852 7 1 9 -0.473535 8 2 7 2.053300 T<-(n-1)*cov(Y) T n1<-3;n2<-2;n3<-3 E<-(n1-1)*cov(Y[1:3,])+(n2-1)*cov(Y[4:5,])+(n3-1)*cov(Y[6:8,]) E H<-T-E H Fv<-(H[3,3]/2)/(E[3,3]/5) Fv [1] 20.19096 # (c) Y<-matrix(c(9,6,9,0,2,3,1,2,3,2,7,4,0,8,9,7),ncol=2) Y<-as.data.frame(Y) colnames(Y)<-c("x","y") attach(Y) plot(Y, xlim=c(0,10), ylim=c(-2,10)) points(Y[4:5,],pch=16) points(Y[6:8,],pch=2) points(mean(x[1:3]),mean(y[1:3]),pch=3) points(mean(x[4:5]),mean(y[4:5]),pch=3) points(mean(x[6:8]),mean(y[6:8]),pch=3) abline(0,1) abline(0,-0.1376667) ########### # 5.7 ######### Y<-matrix(c(1,2,4,6,6,4,5,5,8,8,3,5,7,11,12,5,5,6,7,9),ncol=2) n<-dim(Y)[1] n # Testataan hypoteesi H0: mu_1=mu_2 T<-(n-1)*cov(Y) T [,1] [,2] [1,] 46.9 39 [2,] 39.0 74 n1<-5;n2<-5 E<-(n1-1)*cov(Y[1:5,])+(n2-1)*cov(Y[6:10,]) E [,1] [,2] [1,] 34.8 45.6 [2,] 45.6 70.4 H<-T-E H [,1] [,2] [1,] 12.1 -6.6 [2,] -6.6 3.6 lambda<-det(E)/det(T) lambda # [1] 0.1900698 p<-2 q<-((n-p-1)/p)*((1-lambda)/lambda) q #[1] 14.91429 1-pf(q, p,n-p-1) # [1] 0.002993612 # Hypoteesi, että eri ryhmien odotusarvot ovat samat, voidaan hylätä # 1%:n riskitasolla # Yhden muuttujan analyysit F1<-(H[1,1])/(E[1,1]/8) F1 # 2.781609 F2<-(H[2,2])/(E[2,2]/8) F2 # 0.4090909 1-pf(c(F1,F2),1,8) # [1] 0.1339084 0.5403104 # 1. Odotusarvojen yhtäsuushypoteesi jää voimaan # (b) oaa.EH<-eigen(solve(E)%*%H) oaa.EH $values # [1] 4.261226e+00 -2.220446e-16 1/(4.261226+1) # =lambda # [1] 0.1900698 lambda # [1] 0.1900698