Input Data

library(readxl)

## Warning: package 'readxl' was built under R version 4.3.3

data <- read_excel("Data.xlsx")
data

## # A tibble: 10 × 3
##    Siswa matematika fisika
##    <dbl>      <dbl>  <dbl>
##  1     1       72.8   69.9
##  2     2       46     68.9
##  3     3       59.2   58.4
##  4     4       66.7   78.2
##  5     5       84.2   63.9
##  6     6       50.4   54.6
##  7     7       49.6   66.5
##  8     8       77.9   71.6
##  9     9       63.9   77.2
## 10    10       55.1   56.8

Menghitung vektor rataan dan matriks covarians

xbar = apply(data[,2:3], 2, mean)
xbar

## matematika     fisika 
##      62.58      66.60

cov_m = cov(data[,2:3])
cov_m

##            matematika   fisika
## matematika  164.93289 36.00889
## fisika       36.00889 66.96444

Uji T2 Hotelling Satu Populasi

\[H_{0}:\mu_{0}=\begin{bmatrix} 55\\ 60 \end{bmatrix}\]

\[H_{1}:\mu_{0}\neq \begin{bmatrix} 55\\ 60 \end{bmatrix}\]

?OneSampleHT2

## No documentation for 'OneSampleHT2' in specified packages and libraries:
## you could try '??OneSampleHT2'

#Dengan Package "MVTEsts"
library(MVTests)

## Warning: package 'MVTests' was built under R version 4.3.3

## 
## Attaching package: 'MVTests'

## The following object is masked from 'package:datasets':
## 
##     iris

mean0 = c(55,60)
result = OneSampleHT2(data[,2:3],mu0=mean0,alpha=0.1)
summary(result)

##        One Sample Hotelling T Square Test 
## 
## Hotelling T Sqaure Statistic = 7.621161 
##  F value = 3.387 , df1 = 2 , df2 = 8 , p-value: 0.086 
## 
##                    Descriptive Statistics
## 
##       matematika    fisika
## N       10.00000 10.000000
## Means   62.58000 66.600000
## Sd      12.84262  8.183181
## 
## 
##                  Detection important variable(s)
## 
##               Lower    Upper Mu0 Important Variables?
## matematika 51.83163 73.32837  55                FALSE
## fisika     59.75125 73.44875  60                FALSE

#Dengan Package "ICSNP"
library(ICSNP)

## Warning: package 'ICSNP' was built under R version 4.3.3

## Loading required package: mvtnorm

## Loading required package: ICS

## Warning: package 'ICS' was built under R version 4.3.3

test = HotellingsT2(data[,2:3],mu=mean0,test="f")
print(test)

## 
##  Hotelling's one sample T2-test
## 
## data:  data[, 2:3]
## T.2 = 3.3872, df1 = 2, df2 = 8, p-value = 0.08597
## alternative hypothesis: true location is not equal to c(55,60)

Kesimpulan : Tolak H0 pada taraf nyata 10% karena p-value < alpha
Artinya : Dengan tingkat kepercayaan 90%, dapat disimpulkan bahwa minimal ada salah satu dari rata-rata ujian matematika dan fisika yang memiliki nilai rata-rata tidak sama dengan nilai 55 atau nilai 60.

Menggambar Elips Kepercayaan

library(ellipse)

## Warning: package 'ellipse' was built under R version 4.3.2

## 
## Attaching package: 'ellipse'

## The following object is masked from 'package:graphics':
## 
##     pairs

n = 10 # Jumlah Amatan
p = 2 # Jumlah Peubah
plot(ellipse(cov_m,centre=xbar,level = 0.90, t=sqrt(((n-1)*p/(n*(n-p)))*qf(0.90,p,n-p))),type="l",main = "Ellips Kepercayaan 90%")
points(xbar[1],xbar[2])

#Siswa dengan skor matematika 65 dan fisika 70
points(65,70,col = "red")

Berdasarkan gambar terlihat bahwa nilai tersebut dalam elips, dengan kata lain masuk ke dalam elips kepercayaan.

Selang Kepercayaan Simultan

T.ci = function(mu, Sigma, n, avec=rep(1,length(mu)), level=0.95){
p = length(mu)
cval = qf(level, p, n-p) * p * (n-1) / (n-p)
zhat = crossprod(avec, mu)
zvar = crossprod(avec, Sigma %*% avec) / n
const = sqrt(cval * zvar)
c(lower = zhat - const, upper = zhat + const)
}

n = 10 # Jumlah Amatan

#Matematika
T.ci(mu=xbar, Sigma=cov_m, n=n, avec=c(1,0),level=0.9)

##    lower    upper 
## 51.83163 73.32837

#Fisika
T.ci(mu=xbar, Sigma=cov_m, n=n, avec=c(0,1),level=0.9)

##    lower    upper 
## 59.75125 73.44875

Selang Kepercayaan Bonferroni

bon = function(mu,S,n,alpha,k){
 p = length(mu)
 lower = mu[k] - sqrt(S[k,k]/n) * abs(qt(alpha/(2*p), df=n-1))
 upper = mu[k] + sqrt(S[k,k]/n) * abs(qt(alpha/(2*p), df=n-1))
 c(lower = lower,upper = upper)
}

#Matematika
bon(xbar, cov_m,10,0.1,1)

## lower.matematika upper.matematika 
##         53.39294         71.76706

#Fisika
bon(xbar, cov_m,10,0.1,2)

## lower.fisika upper.fisika 
##     60.74611     72.45389