Funkcia vypočíta prítomnosť heteroskedaticity, vypíše vypočítanú a tabuľkovú hodnotu F štatistiky.
Ak je parameter rem nastavený na hodnotu ‘true’ a je pritomna heteroskedaticita
Pokúsi sa ju odstrániť 1/x, a tiež vypíše nové hodnoty
Postup:
1. nakopírovať funkciu do R-cran
2. načítať dáta
3. zavolať funkciu het so 4 parametrami (matica hodnôt, parameter ktorý spôsobuje hetero, počet vynechaných prvkov, a či sa ma odstraňovať het)
1.
Het = function (mat, x, m,rem)
{
nr = nrow(mat)
nc = ncol(mat)
mat1 = mat
matt=mat
mat1 = mat1[order(mat1[,x+1]),]
if (nr%%2==1){
if (m%%2==1){
k=m
}
else{
k=m+1
}
}
else {
if (m%%2==1){
k=m+1
}
else{
k=m
}
}
l=0
l=(nr-k)/2
mt1 = mat1[1:l,1:nc]
cat(mt1,"\n")
mt2 = mat1[(l+k+1):nr,1:nc]
cat(mt2,"\n")
y1=mt1[1:l,1]
cat(y1,"\n")
y2=mt2[1:l,1]
cat(y2,"\n")
reg = function (Yt, mm)
{
regr = lm (Yt~mm)
nr = nrow(mm)
nc = ncol(mm)
y = c()
b = c()
for (i in 1:(nc+1))
{
b[i]=regr$coef[i]
}
for (i in 1:nr)
{
ypom = 0;
for (j in 2:(nc+1))
{
ypom = ypom + b[j]*mm[i,(j-1)]
}
y[i]=b[1]+ypom
}
y
}
yt1 = reg(y1,mt1[1:l,2:nc])
yt2 = reg(y2,mt2[1:l,2:nc])
sum1 = 0
sum2 = 0
et1=c()
et2=c()
for (i in 1:l){
et1[i]=y1[i]-yt1[i]
et1[i]=et1[i]*et1[i]
sum1 =sum1 + et1[i]
}
for (i in 1:l){
et2[i]=y2[i]-yt2[i]
et2[i]=et2[i]*et2[i]
sum2 = sum2 + et2[i]
}
if (sum1>sum2){
Fv=sum1/sum2
}
else {
Fv=sum2/sum1
}
sv = l-(nc-1)-1
Ftab = qf(0.95,sv,sv)
if (Fv>Ftab){
H1='true'
cat(
" =======================================","\n",
" Results:","\n\n",
"---------------------------------------","\n",
" F stats. calculated: ",Fv,"\n",
" F stats. tabulated: ",Ftab,"\n",
" Presence of heteroscedasticity","\n",
"=======================================","\n\n"
)
}
else {
H1='false'
cat(
" =======================================","\n",
" Results:","\n\n",
"---------------------------------------","\n",
" F stats. calculated: ",Fv,"\n",
" F stats. tabulated: ",Ftab,"\n",
" The absence of heteroskedasticity","\n",
"=======================================","\n\n"
)
}
if (H1=='true' & rem=='true'){
cat(
" +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+","\n",
" Removing heteroscedasticity","\n",
"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+","\n\n"
)
xx=matt[1:nr,x+1]
for (i in 1:nc){
if (i==x+1){
for (j in 1:nr){
matt[j,i]=1/xx[j]
}
}
else{
for (j in 1:nr){
matt[j,i]=matt[j,i]/xx[j]
}
}
}
Het(matt,1,1,'false')
}
if (rem=='true'){
cat(
" =======================================","\n",
" New values:","\n\n",
"---------------------------------------","\n",
"yt=c("
)
for (j in 1:nr){
if(j<nr){
cat(
matt[j,1],","
)
}
else{
cat(
matt[j,1]
)
}
}
cat(
")\n"
)
for (i in 2:nc){
cat(
" x",i-1,"=",matt[1:nr,i],"\n"
)
}
cat(
" =======================================","\n\n"
)
}
}
2.
yt=c(210,211,214,212,215,216,217,218,220,222,223,224,226,225,228)
xt1=c(165,165,162,170,94,90,90,90,90,75,75,75,40,70,15)
xt2=c(36,42,62,50,64,72,75,87,94,85,104,107,134,115,150)
3.
Het(cbind(yt,xt1,xt2),1,1,'true')
4. Výsledok
=======================================
Results:
---------------------------------------
F stats. calculated: 4983.088
F stats. tabulated: 6.388233
Presence of heteroscedasticity
=======================================
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
Removing heteroscedasticity
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
=======================================
Results:
---------------------------------------
F stats. calculated: 2.023129e-05
F stats. tabulated: 6.388233
The absence of heteroskedasticity
=======================================
=======================================
New values:
---------------------------------------
yt=c(0.007713497 ,0.00775023 ,0.008154247 ,0.007335641 ,0.02433228 ,0.02666667 ,0.02679012 ,0.02691358 ,0.02716049 ,0.03946667 ,0.03964444 ,0.03982223 ,0.14125 ,0.04591837 ,1.013333)
x1 = 0.006060606 0.006060606 0.00617284 0.005882353 0.0106383 0.01111111 0.01111111 0.01111111 0.01111111 0.01333333 0.01333333 0.01333333 0.025 0.01428571 0.06666667
x2 = 0.2181818 0.2545455 0.382716 0.2941176 0.6808511 0.8 0.8333333 0.9666667 1.044444 1.133333 1.386667 1.426667 3.35 1.642857 10
=======================================
