unit KappaUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, MainUnit, Globals, OutPutUnit, FunctionsLib, Math, DictionaryUnit, DataProcs, MatrixLib, contexthelpunit; type { TWeightedKappaFrm } TWeightedKappaFrm = class(TForm) HelpBtn: TButton; ResetBtn: TButton; Cancel: TButton; ComputeBtn: TButton; ReturnBtn: TButton; ObsChk: TCheckBox; ExpChk: TCheckBox; PropChk: TCheckBox; ChiChk: TCheckBox; YatesChk: TCheckBox; SaveChk: TCheckBox; GroupBox1: TGroupBox; NCasesEdit: TEdit; Label5: TLabel; RowIn: TBitBtn; RowOut: TBitBtn; ColIn: TBitBtn; ColOut: TBitBtn; DepIn: TBitBtn; DepOut: TBitBtn; RaterAEdit: TEdit; RaterBEdit: TEdit; DepEdit: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; VarList: TListBox; InputGroup: TRadioGroup; procedure ColInClick(Sender: TObject); procedure ColOutClick(Sender: TObject); procedure ComputeBtnClick(Sender: TObject); procedure DepInClick(Sender: TObject); procedure DepOutClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure HelpBtnClick(Sender: TObject); procedure InputGroupClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject); procedure RowInClick(Sender: TObject); procedure RowOutClick(Sender: TObject); private { private declarations } public { public declarations } end; var WeightedKappaFrm: TWeightedKappaFrm; implementation { TWeightedKappaFrm } procedure TWeightedKappaFrm.ResetBtnClick(Sender: TObject); VAR i : integer; begin VarList.Clear; RaterAEdit.Text := ''; RaterBEdit.Text := ''; DepEdit.Text := ''; DepEdit.Visible := false; RowIn.Visible := true; RowOut.Visible := false; ColIn.Visible := true; ColOut.Visible := false; DepIn.Visible := false; DepOut.Visible := false; NCasesEdit.Text := ''; NCasesEdit.Visible := false; Label4.Visible := false; Label5.Visible := false; InputGroup.ItemIndex := 0; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); end; procedure TWeightedKappaFrm.RowInClick(Sender: TObject); VAR index : integer; begin index := VarList.ItemIndex; RaterAEdit.Text := VarList.Items.Strings[index]; VarList.Items.Delete(index); RowIn.Visible := false; RowOut.Visible := true; end; procedure TWeightedKappaFrm.RowOutClick(Sender: TObject); begin VarList.Items.Add(RaterAEdit.Text); RaterAEdit.Text := ''; RowIn.Visible := true; RowOut.Visible := false; end; procedure TWeightedKappaFrm.FormShow(Sender: TObject); begin ResetBtnClick(self); end; procedure TWeightedKappaFrm.HelpBtnClick(Sender: TObject); begin ContextHelpForm.HelpMessage((Sender as TButton).tag); end; procedure TWeightedKappaFrm.InputGroupClick(Sender: TObject); VAR index : integer; begin index := InputGroup.ItemIndex; if (index = 2) then // only proportions available - get N size begin Label4.Visible := true; NCasesEdit.Visible := true; NCasesEdit.SetFocus; DepIn.Visible := true; DepOut.Visible := false; DepEdit.Visible := true; Label5.Visible := true; end; if (index = 1) then // frequencies available for each row and column combo begin Label4.Visible := true; NCasesEdit.Visible := false; DepIn.Visible := true; DepOut.Visible := false; DepEdit.Visible := true; Label5.Visible := false; end; if (index = 0) then // have to count cases in each row and col. combination begin NCasesEdit.Visible := false; DepIn.Visible := false; DepOut.Visible := false; DepEdit.Visible := false; Label4.Visible := false; Label5.Visible := false; end; end; procedure TWeightedKappaFrm.ColInClick(Sender: TObject); VAR index : integer; begin index := VarList.ItemIndex; RaterBEdit.Text := VarList.Items.Strings[index]; VarList.Items.Delete(index); ColIn.Visible := false; ColOut.Visible := true; end; procedure TWeightedKappaFrm.ColOutClick(Sender: TObject); begin VarList.Items.Add(RaterBEdit.Text); RaterBEdit.Text := ''; ColIn.Visible := true; ColOut.Visible := false; end; procedure TWeightedKappaFrm.ComputeBtnClick(Sender: TObject); VAR i, j, k, RowNo, ColNo, DepNo, MinRow, MaxRow, MinCol, MaxCol : integer; Row, Col, NoSelected, Ncases, Nrows, Ncols, FObs, df : integer; RowLabels, ColLabels : StrDyneVec; ColNoSelected : IntDyneVec; cellstring : string; outline : string; Freq : IntDyneMat; Prop, Expected, CellChi : DblDyneMat; PObs, ChiSquare, ProbChi, liklihood, Fval, phi : double; yates, aresult : boolean; title : string; filename : string; Adjchisqr, Adjprobchi, probliklihood, pearsonr : double; pobserved, SumX, SumY, VarX, VarY, obsdiag, expdiag, expnondiag : double; pexpected, MantelHaenszel, MHprob, CoefCont, CramerV, Kappa : double; Frq : integer; weights, quadweights : DblDyneMat; begin SetLength(ColNoSelected,NoVariables); yates := false; RowNo := 0; ColNo := 0; DepNo := 0; pobserved := 0.0; pexpected := 0.0; for i := 1 to NoVariables do begin cellstring := OS3MainFrm.DataGrid.Cells[i,0]; if (cellstring = RaterAEdit.Text) then RowNo := i; if (cellstring = RaterBEdit.Text) then ColNo := i; if (cellstring = DepEdit.Text) then DepNo := i; end; if ((InputGroup.ItemIndex > 0) and (DepNo = 0)) then begin ShowMessage('ERROR! You must select a dependent variable.'); ColNoSelected := nil; exit; end; if ((RowNo = 0) or (ColNo = 0)) then // || (DepNo == 0)) begin ShowMessage('ERROR! A required variable has not been selected.'); ColNoSelected := nil; exit; end; aresult := ValidValue(RowNo,1); if (aresult = false) then begin ColNoSelected := nil; exit; end; aresult := ValidValue(ColNo,1); if (aresult = false) then begin ColNoSelected := nil; exit; end; ColNoSelected[0] := RowNo; ColNoSelected[1] := ColNo; NoSelected := 2; if (InputGroup.ItemIndex > 0) then // for reading proportions or frequencies begin NoSelected := 3; ColNoSelected[2] := DepNo; end; if (InputGroup.ItemIndex = 1) then begin aresult := ValidValue(DepNo,1); if (aresult = false) then begin ColNoSelected := nil; exit; end; end; if (InputGroup.ItemIndex = 2) then begin aresult := ValidValue(DepNo,0); if (aresult = false) then begin ColNoSelected := nil; exit; end; end; // get min and max of row and col numbers MinRow := 1000; MaxRow := 0; MinCol := 1000; MaxCol := 0; for i := 1 to NoCases do begin if (NOT GoodRecord(i,NoSelected,ColNoSelected)) then continue; Row := StrToInt(OS3MainFrm.DataGrid.Cells[RowNo,i]); Col := StrToInt(OS3MainFrm.DataGrid.Cells[ColNo,i]); if (Row > MaxRow) then MaxRow := Row; if (Row < MinRow) then MinRow := Row; if (Col > MaxCol) then MaxCol := Col; if (Col < MinCol) then MinCol := Col; end; Nrows := MaxRow - MinRow + 1; Ncols := MaxCol - MinCol + 1; // allocate and initialize SetLength(Freq,Nrows+1,Ncols+1); SetLength(Prop,Nrows+1,Ncols+1); SetLength(Expected,Nrows,Ncols); SetLength(CellChi,Nrows,Ncols); SetLength(RowLabels,Nrows+1); SetLength(ColLabels,Ncols+1); for i := 1 to Nrows + 1 do for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0; for i := 1 to Nrows do begin outline := format('Row %d',[i]); cellstring := outline; RowLabels[i-1] := cellstring; end; RowLabels[Nrows] := 'Total'; for j := 1 to Ncols do begin outline := format('COL. %d',[j]); cellstring := outline; ColLabels[j-1] := cellstring; end; ColLabels[Ncols] := 'Total'; // get cell data Ncases := 0; if (InputGroup.ItemIndex = 0) then begin // count number of cases in each row and column combination for i := 1 to NoCases do begin if (NOT GoodRecord(i,NoSelected,ColNoSelected)) then continue; Ncases := Ncases + 1; Row := StrToInt(OS3MainFrm.DataGrid.Cells[RowNo,i]); Col := StrToInt(OS3MainFrm.DataGrid.Cells[ColNo,i]); Row := Row - MinRow + 1; Col := Col - MinCol + 1; Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + 1; end; end; if (InputGroup.ItemIndex = 1) then // read frequencies data from grid begin for i := 1 to NoCases do begin if (NOT GoodRecord(i,NoSelected,ColNoSelected)) then continue; Row := StrToInt(OS3MainFrm.DataGrid.Cells[RowNo,i]); Col := StrToInt(OS3MainFrm.DataGrid.Cells[ColNo,i]); Row := Row - MinRow + 1; Col := Col - MinCol + 1; FObs := StrToInt(OS3MainFrm.DataGrid.Cells[DepNo,i]); Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + FObs; Ncases := Ncases + FObs; end; end; if (InputGroup.ItemIndex = 2) then // get no. of cases and proportions for each cell begin Ncases := StrToInt(NCasesEdit.Text); for i := 1 to NoCases do begin if (NOT GoodRecord(i,NoSelected,ColNoSelected)) then continue; Row := StrToInt(OS3MainFrm.DataGrid.Cells[RowNo,i]); Col := StrToInt(OS3MainFrm.DataGrid.Cells[ColNo,i]); Row := Row - MinRow + 1; Col := Col - MinCol + 1; PObs := StrToInt(OS3MainFrm.DataGrid.Cells[DepNo,i]); Frq := round(PObs * Ncases); Fval := PObs * Ncases; if (Fval - Frq < 0.5) then Frq := round(Fval) else Frq := ceil(Fval); Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + Frq; end; end; Freq[Nrows,Ncols] := Ncases; // Now, calculate expected values // Get row totals first for i := 1 to Nrows do begin for j := 1 to Ncols do begin Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; end; end; // Get col totals next for j := 1 to Ncols do begin for i := 1 to Nrows do begin Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; end; end; // Then get expected values and cell chi-squares ChiSquare := 0.0; Adjchisqr := 0.0; if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true; for i := 1 to Nrows do begin for j := 1 to Ncols do begin Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / Ncases; if (Expected[i-1,j-1] > 0.0) then CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1] else begin ShowMessage('ERROR! Zero expected value found.'); CellChi[i-1,j-1] := 0.0; end; ChiSquare := ChiSquare + CellChi[i-1,j-1]; end; end; df := (Nrows - 1) * (Ncols - 1); if (yates = true) then // 2 x 2 corrected chi-square begin Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0])); Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]); Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df); end; ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi //Print results to output form OutPutFrm.RichEdit.Clear; OutPutFrm.RichEdit.Lines.Add('Chi-square Analysis Results for ' + RaterAEdit.Text + ' and ' + RaterBEdit.Text); outline := format('No. of Cases = %d',[Ncases]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); // print tables requested by use if (ObsChk.Checked) then begin IntArrayPrint(Freq, Nrows+1, Ncols+1,'Frequencies', RowLabels, ColLabels,'OBSERVED FREQUENCIES'); end; if (ExpChk.Checked) then begin outline := 'EXPECTED FREQUENCIES'; MAT_PRINT(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); end; if (PropChk.Checked) then begin outline := 'ROW PROPORTIONS'; for i := 1 to Nrows + 1 do begin for j := 1 to Ncols do begin if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols] else Prop[i-1,j-1] := 0.0; end; if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,Ncols] := 1.0 else Prop[i-1][Ncols] := 0.0; end; MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases); outline := 'COLUMN PROPORTIONS'; for j := 1 to Ncols + 1 do begin for i := 1 to Nrows do begin if (Freq[Nrows,j-1] > 0.0) then Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1] else Prop[i-1,j-1] := 0.0; end; if (Freq[Nrows,j-1] > 0.0) then Prop[Nrows][j-1] := 1.0 else Prop[Nrows,j-1] := 0.0; end; MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases); outline := 'PROPORTIONS OF TOTAL N'; for i := 1 to Nrows + 1 do for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / Ncases; Prop[Nrows,Ncols] := 1.0; MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases); end; if (ChiChk.Checked) then begin outline := 'CHI-SQUARED VALUE FOR CELLS'; MAT_PRINT(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); end; OutPutFrm.RichEdit.Lines.Add(''); outline := format('Chi-square = %8.3f with D.F. = %d. Prob. > value = %8.3f', [ChiSquare,df,ProbChi]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); if (yates = true) then begin outline := format('Chi-square using Yates correction = %8.3f and Prob > value = %8.3f', [Adjchisqr,Adjprobchi]); OutPutFrm.RichEdit.Lines.Add(outline); end; liklihood := 0.0; for i := 0 to Nrows - 1 do for j := 0 to Ncols - 1 do liklihood := Liklihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j])); liklihood := -2.0 * liklihood; probliklihood := 1.0 - chisquaredprob(liklihood,df); outline := format('Liklihood Ratio = %8.3f with prob. > value = %6.4f', [liklihood,probliklihood]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); phi := sqrt(ChiSquare / Ncases); outline := format('phi correlation = %6.4f',[phi]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); pearsonr := 0.0; SumX := 0.0; SumY := 0.0; VarX := 0.0; VarY := 0.0; for i := 0 to Nrows - 1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] ); for j := 0 to Ncols - 1 do SumY := SumY + ( (j+1) * Freq[Nrows,j] ); for i := 0 to Nrows - 1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] ); for j := 0 to Ncols - 1 do VarY := VarY + ( ((j+1)*(j+1)) * Freq[Nrows,j] ); VarX := VarX - ((SumX * SumX) / Ncases); VarY := VarY - ((SumY * SumY) / Ncases); for i := 0 to Nrows - 1 do for j := 0 to Ncols - 1 do pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]); pearsonr := pearsonr - (SumX * SumY / Ncases); pearsonr := pearsonr / sqrt(VarX * VarY); outline := format('Pearson Correlation r = %6.4f',[pearsonr]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); outline := format('Mantel-Haenszel Test of Linear Association = %8.3f with probability > value = %6.4f', [MantelHaenszel, MHprob]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); outline := format('The coefficient of contingency = %8.3f',[CoefCont]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * ((Nrows-1)))) else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); outline := format('Cramers V = %8.3f',[CramerV]); OutPutFrm.RichEdit.Lines.Add(outline); // kappa if (Nrows = Ncols) then begin obsdiag := 0.0; expdiag := 0.0; for i := 0 to Nrows - 1 do begin obsdiag := obsdiag + Freq[i,i]; expdiag := expdiag + Expected[i,i]; end; expnondiag := Ncases - expdiag; Kappa := (obsdiag - expdiag) / expnondiag; OutPutFrm.RichEdit.Lines.Add(''); outline := format('Unweighted Kappa = %8.4f',[Kappa]); OutPutFrm.RichEdit.Lines.Add(outline); // get linear weights SetLength(weights,Nrows,Ncols); SetLength(quadweights,Nrows,Ncols); for i := 0 to Nrows - 1 do begin for j := 0 to Ncols - 1 do begin weights[i,j] := 0.0; quadweights[i,j] := 0.0; end; end; for i := 0 to Nrows - 1 do begin for j := 0 to Ncols - 1 do begin weights[i,j] := 1.0 - (abs((i-j)) / (Nrows-1)); quadweights[i,j] := 1.0 - ( abs((i-j)*(i-j)) / ((Nrows-1)*(Nrows-1)) ); end; end; outline := 'Observed Linear Weights'; MAT_PRINT(weights, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); outline := 'Observed Quadratic Weights'; MAT_PRINT(quadweights, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); OutPutFrm.RichEdit.Lines.Add(''); for i := 0 to Nrows - 1 do begin for j := 0 to Ncols - 1 do begin pobserved := pobserved + (Freq[i][j] / Ncases) * weights[i,j]; pexpected := pexpected + (Expected[i,j] / Ncases) * weights[i,j]; end; end; Kappa := (pobserved - pexpected) / (1.0 - pexpected); outline := format('Linear Weighted Kappa = %8.4f',[Kappa]); OutPutFrm.RichEdit.Lines.Add(outline); pobserved := 0.0; pexpected := 0.0; for i := 0 to Nrows - 1 do begin for j := 0 to Ncols - 1 do begin pobserved := pobserved + (Freq[i,j] / Ncases) * quadweights[i,j]; pexpected := pexpected + (Expected[i,j] / Ncases) * quadweights[i,j]; end; end; Kappa := (pobserved - pexpected) / (1.0 - pexpected); outline := format('Quadratic Weighted Kappa = %8.4f',[Kappa]); OutPutFrm.RichEdit.Lines.Add(outline); quadweights := nil; weights := nil; end; OutPutFrm.ShowModal; OutPutFrm.RichEdit.Clear; // save frequency data file if elected if ((SaveChk.Checked) and (InputGroup.ItemIndex = 0)) then begin ClearGrid; for i := 1 to 3 do DictionaryFrm.NewVar(i); DictionaryFrm.DictGrid.Cells[1,1] := 'ROW'; DictionaryFrm.DictGrid.Cells[1,2] := 'COL'; DictionaryFrm.DictGrid.Cells[1,3] := 'FREQ.'; OS3MainFrm.DataGrid.Cells[1,0] := 'ROW'; OS3MainFrm.DataGrid.Cells[2,0] := 'COL'; OS3MainFrm.DataGrid.Cells[3,0] := 'Freq.'; k := 1; for i := 1 to Nrows do begin for j := 1 to Ncols do begin OS3MainFrm.DataGrid.RowCount := k + 1; OS3MainFrm.DataGrid.Cells[1,k] := IntToStr(i); OS3MainFrm.DataGrid.Cells[2,k] := IntToStr(j); OS3MainFrm.DataGrid.Cells[3,k] := IntToStr(Freq[i-1,j-1]); k := k + 1; end; end; for i := 1 to k - 1 do begin title := 'CASE ' + IntToStr(i); OS3MainFrm.DataGrid.Cells[0,i] := title; end; title := InputBox('FILE:','File Name:','Frequencies.LAZ'); OS3MainFrm.FileNameEdit.Text := title; OS3MainFrm.NoVarsEdit.Text := IntToStr(3); OS3MainFrm.NoCasesEdit.Text := IntToStr(k-1); NoVariables := 3; NoCases := k-1; SaveOS2File; end; //clean up ColLabels := nil; RowLabels := nil; CellChi := nil; Expected := nil; Prop := nil; Freq := nil; ColNoSelected := nil; end; procedure TWeightedKappaFrm.DepInClick(Sender: TObject); VAR index : integer; begin index := VarList.ItemIndex; DepEdit.Text := VarList.Items.Strings[index]; VarList.Items.Delete(index); DepIn.Visible := false; DepOut.Visible := true; end; procedure TWeightedKappaFrm.DepOutClick(Sender: TObject); begin VarList.Items.Add(DepEdit.Text); DepEdit.Text := ''; DepIn.Visible := true; DepOut.Visible := false; end; initialization {$I kappaunit.lrs} end.