Přechod na menu, Přechod na obsah, Přechod na patičku

Prílohy

Test hypotézy o danej hodnote korelačného koeficienta – zdrojový kód

Option Base 1

Sub Main

Dim alpha As Double   'hladina vyznamnosti
Dim p As Double       'p hodnota
Dim r As Double       'vyberovy korelacni koeficient
Dim n As Double       'rozsah
Dim c As Double       'konstanta
Dim Z As Double       'Fisherova transformace
Dim U As Double       'testovaci statistika
  
Coef=InputBox("Zadejte hodnotu vyberoveho korelacniho koeficientu:",
"Koeficient r")
r=CDbl(Coef)

Range=InputBox("Zadejte rozsah vyberu:","Rozsah vyberu")
n=CDbl(Range)

LevOfSign=InputBox("Zadejte hladinu vyznamnosti, na ktere bude
hypoteza testovana:","Hladina vyznamnosti")
alpha=CDbl(LevOfSign)

'Vyber alternativni hypotezy
alt = DisplayListBox("Alternativni hypoteza","Oboustranna 
alternativa|Levostranna alternativa|Pravostranna alternativa",1)
 
'Fisherova transformace
Z = 0.5*Log((1+r)/(1-r))

'testovaci statistika
U = (Z-0.5*Log((1+c)/(1-c))-c/(2*(n-1)))*Sqrt(n-3)

'kvantily
If alt = 0 Then End
If alt = 1 Then
   u_1 = -VNormal(1-alpha/2,0,1)
   u_2 = VNormal(1-alpha/2,0,1)

   p1 = INormal(U,0,1)    'vypocet p-hodnoty
   p2 = 1-INormal(U,0,1)	
   If (pmen <= pvac) Then
     p = 2 * p1
   Else 
     p = 2 * p2
   End If 
 
'Vysledni tabulka oboustranne alternativy
Set Summary = Spreadsheets.New
Summary.SetSize(1,4)
Summary.Header="Test hypotezy o dane hodnote koeficientu R"
Summary.CaseName(1) = "Zhrnuti"
Summary.AutoFitCase
Summary.VariableName(1) = "n"
Summary.VariableName(2) = "U"
Summary.VariableName(3) = "u_1-alpha/2"
Summary.VariableName(4) = "p-value"

Summary.VariableFormatString(2) = "0.0000"
Summary.VariableFormatString(3) = "0.0000"
Summary.VariableFormatString(4) = "0.0000"

Summary.Variable(1).ColumnWidth=0.4
Summary.Value(1,1) = n
Summary.Variable(2).ColumnWidth=0.7
Summary.Value(1,2) =
U~Summary.Variable(3).ColumnWidth=0.9
Summary.Value(1,3) = u_2
Summary.Variable(4).ColumnWidth=0.7
Summary.Value(1,4) = p 
 
'Kdyz je p-hodnota mensi nebo rovna nez alpha, zobrazi se cervene.
   If (p <= alpha) Then 
      Summary.Cells(1,4).Font.Color = RGB(255,0,0)
      End If
      Summary.Visible=True
End If
 
If alt = 2 Then
   u_norm = VNormal(1-alpha,0,1)
   p = INormal(U,0,1)		'p-hodnota

'Vysledni tabulka levostranne alternativy
Set Summary = Spreadsheets.New
Summary.SetSize(1,4)
Summary.Header="Test hypotezy o dane hodnote koeficientu R"
Summary.CaseName(1) = "Zhrnuti"
Summary.AutoFitCase
Summary.VariableName(1) = "n"
Summary.VariableName(2) = "U"
Summary.VariableName(3) = "u_1-alpha"
Summary.VariableName(4) = "p-value"

Summary.VariableFormatString(2) = "0.0000"
Summary.VariableFormatString(3) = "0.0000"
Summary.VariableFormatString(4) = "0.0000"

Summary.Variable(1).ColumnWidth=0.4
Summary.Value(1,1) = n
Summary.Variable(2).ColumnWidth=0.7
Summary.Value(1,2) =
U~Summary.Variable(3).ColumnWidth=0.7
Summary.Value(1,3) = u_norm
Summary.Variable(4).ColumnWidth=0.7
Summary.Value(1,4) = p

'Kdyz je p-hodnota mensi nebo rovna nez alpha, zobrazi se cervene.
   If (p <= alpha) Then
      Summary.Cells(1,4).Font.Color = RGB(255,0,0)
   End If
   Summary.Visible=True
End If 

If alt = 3 Then
   u_norm = -VNormal(1-alpha,0,1)
   p = 1 - INormal(U,0,1)		'p-hodnota

'Vysledni tabulka pravostranne alternativy
Set Summary = Spreadsheets.New
Summary.SetSize(1,4)
Summary.Header="Test hypotezy o dane hodnote koeficientu R"
Summary.CaseName(1) = "Zhrnuti"
Summary.AutoFitCase
Summary.VariableName(1) = "n"
Summary.VariableName(2) = "U"
Summary.VariableName(3) = "u_1-alpha"
Summary.VariableName(4) = "p-value"

Summary.VariableFormatString(2) = "0.0000"
Summary.VariableFormatString(3) = "0.0000"
Summary.VariableFormatString(4) = "0.0000"

Summary.Variable(1).ColumnWidth=0.4
Summary.Value(1,1) = n
Summary.Variable(2).ColumnWidth=0.7
Summary.Value(1,2) =
U~Summary.Variable(3).ColumnWidth=0.7
Summary.Value(1,3) = u_norm
Summary.Variable(4).ColumnWidth=0.7
Summary.Value(1,4) = p

'Kdyz je p-hodnota mensi nebo rovna nez alpha, zobrazi se cervene.
   If (p <= alpha) Then
      Summary.Cells(1,4).Font.Color = RGB(255,0,0)
   End If
   Summary.Visible=True
End If

End Sub

Test zhody k korelačných koeficientov – zdrojový kód

Option Base 1

Sub Main

Dim alpha As Double        'hladina vyznamnosti
Dim p As Double            'p hodnota
Dim b As Double            'koeficient b
Dim Chi As Double          'testovaci statistika
Dim chiKvantil As Double   'kvantil
Dim VarList () As Long     'seznam vybranych promennych
Dim Matrix() As Double     'datova matice
Dim suma As Double         'soucet rozsahu
Dim Z() As Double          'Fisherova transformace

numvar=ActiveSpreadsheet.NumberOfVariables
numcas=ActiveSpreadsheet.NumberOfCases

'Volba promennych
ReDim VarList(1 To numvar)

If 0=SelectVariables2(ActiveDataSet,"Vyber promennych",1,1,Varlist(1)
    Count,"Koeficienty",1,1,Varlist(2),Count,"Rozsahy") Then
    End
End If

s1 = Varlist(1)
s2 = Varlist(2)

If numcas < 3 Then
    MsgBox("Prilis malo koeficientu.","Chyba")
    End
End If

'soucet rozsahu
ReDim Preserve Matrix(numcas,numvar) As Double
Matrix = ActiveSpreadsheet.Data

For i = 1 To numcas
    suma = suma + Matrix(i,s2)
Next i

'Fisherova transformace
ReDim Z(1 To numcas)

For i = 1 To numcas
    Z(i) = 0.5*Log((1+Matrix(i,s1))/(1-Matrix(i,s1)))
Next i

'b
For i = 1 To numcas
    b = b + (Matrix(i,s2)-3)*Z(i)
Next i
b = b/(suma-3*numcas)

'statistika
For i = 1 To numcas
    Chi = Chi + (Matrix(i,s2)-3)*(Z(i)-b)^2
Next i

'p hodnota
p =1- IChi2(Chi, numcas-1)

'alpha
LevOfSign=InputBox("Zadejte hladinu vvznamnosti, na ktere 
bude hypoteza testovana:","Hladina vyznamnosti")
alpha=CDbl(LevOfSign) 

'kvantil
chiKvantil = VChi2(1-alpha, numcas-1)

'vysledni tabulka
Set Summary = Spreadsheets.New
Summary.SetSize(1,4)
Summary.Header="Test zhody k korelacnich koeficientu"
Summary.CaseName(1) = "Zhrnuti"
Summary.AutoFitCase
Summary.VariableName(1) = "k"
Summary.VariableName(2) = "ChiStat"
Summary.VariableName(3) = "Chi_1-alpha (k-1)"
Summary.VariableName(4) = "p-value"

Summary.VariableFormatString(2) = "0.0000"
Summary.VariableFormatString(3) = "0.0000"
Summary.VariableFormatString(4) = "0.0000"

Summary.Variable(1).ColumnWidth=0.4
Summary.Value(1,1) = numcas
Summary.Variable(2).ColumnWidth=0.7
Summary.Value(1,2) = Chi
Summary.Variable(3).ColumnWidth=1.2
Summary.Value(1,3) = chiKvantil
Summary.Variable(4).ColumnWidth=0.7
Summary.Value(1,4) = p

'Kdyz je p-hodnota mensi nebo rovna nez alpha, zobrazi se cervene.
If (p <= alpha) Then
   Summary.Cells(1,4).Font.Color = RGB(255,0,0)
End If
Summary.Visible=True
	
End Sub

Tukeyov test – zdrojový kód

Option Base 1 
 
Sub Main

Dim VarList() As Long      'seznam vybranych promennych
Dim Z() As Double          'Fisherova transformace
Dim DZ() As Double         'rozdil Fisher transformaci
Dim C() As Double          'kriticka hodnota
Dim Matrix() As Double     'datova matice
Dim MatrixDif() As Double  'matice rozdilu Fisher transformaci
Dim MatrixCrit() As Double 'matice kritickych hodnot

numvar=ActiveSpreadsheet.NumberOfVariables 
numcas=ActiveSpreadsheet.NumberOfCases

'Volba promennych
ReDim VarList(1 To numvar)

If 0=SelectVariables2(ActiveDataSet,"Vyber promennych"1,1,VarList(1),
   Count,"Koeficienty",1,1,VarList(2),Count,"Rozsahy") Then
   End
End If    

s1 = VarList(1)
s2 = VarList(2)

'Fisherova transformace
ReDim Preserve Matrix(numcas,numvar) As Double
Matrix = ActiveSpreadsheet.Data
ReDim Z(1 To numcas)

For i = 1 To numcas
    Z(i) = 0.5*Log((1+Matrix(i,s1))/(1-Matrix(i,s1)))
Next i    

'matice rozdilu Fisher transformaci
ReDim MatrixDif(numcas,numcas)
ReDim DZ(1 To numcas)

For i= 1 To numcas
    For j = 1 To numcas
        DZ(i)= Abs(Z(i)-Z(j))
        MatrixDif(i,j)=DZ(i) 
    Next j    
Next i      

'matice kritickych hodnot
tabValue=InputBox("Zadajte tabelovanu hodnotu q_(k,inf)(alpha):",
"Tabelovana hodnota")
tv=CDbl(tabValue)

ReDim MatrixCrit(numcas,numcas)
ReDim C(1 To numcas)

For i= 1 To numcas
    For j= 1 To numcas
        C(i) = tv*Sqrt(0.5*(1/(Matrix(i,s2)-3)+ 1/(Matrix(j,s2)-3)))
        MatrixCrit(i,j)=C(i)
    Next j
Next i      

'Vysledni tabulka kritickych hodnot
Dim tabC As New Spreadsheet
tabC.SetSize(numcas,numcas)
tabC.Header="Tukeyuv test: tabulka Crit"
tabC.Infobox.VerticalAlignment = 1
tabC.Infobox.HorizontalAlignment = 1
For i= 1 To numcas
    tabC.VariableName(i)=""
    tabC.VariableFormatString(i)="0.0000"
Next i

For i= 1 To numcas
    For j= 1 To numcas
        tabC.Cells(i,j)=MatrixCrit(i,j)
        tabC.Cells(i,i)= ""          
    Next j
Next i            
'tabC.Visible=True
'zobrazeni tabulky v pripade, ze chceme videt vypoctene hodnoty  

'Vysledni tabulka rozdilu Fisher transformaci
Dim tabD As New Spreadsheet
tabD.SetSize(numcas,numcas)
tabD.Header="Tukeyov test:  Z(i) - Z(j) >= Crit"
tabD.InfoBox="  i / j "
tabD.InfoBox.VerticalAlignment = 1
tabD.InfoBox.HorizontalAlignment = 1
For i= 1 To numcas    
    tabD.VariableName(i) = ""
    tabD.VariableFormatString(i) = "0.0000"
Next i

For i= 1 To numcas
    For j= 1 To numcas
        tabD.Cells(i,j)=MatrixDif(i,j)
    Next j
Next i

'Rozdily splnujuci nerovnost testu oznaci cervene
For i= 1 To numcas
    For j= 1 To numcas
        If tabD.Cells(i,j) >= MatrixCrit(i,j) Then
           tabD.Cells(i,j).Font.Color = RGB(255,0,0)        
        End If
   Next j
Next i           
tabD.Visible=True

End Sub