unit KappaUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, MainUnit, FunctionsLib, DictionaryUnit, MatrixLib, BasicStatsReportFormUnit; type { TWeightedKappaForm } TWeightedKappaForm = class(TBasicStatsReportForm) ObsChk: TCheckBox; ExpChk: TCheckBox; PropChk: TCheckBox; ChiChk: TCheckBox; YatesChk: TCheckBox; SaveChk: TCheckBox; OptionsGroup: TGroupBox; NCasesEdit: TEdit; NCasesLbl: 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; DepLbl: TLabel; VarList: TListBox; InputGroup: TRadioGroup; procedure ColInClick(Sender: TObject); procedure ColOutClick(Sender: TObject); procedure DepInClick(Sender: TObject); procedure DepOutClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure InputGroupClick(Sender: TObject); procedure RowInClick(Sender: TObject); procedure RowOutClick(Sender: TObject); procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); private { private declarations } protected procedure AdjustConstraints; override; procedure Compute; override; procedure UpdateBtnStates; override; function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override; public { public declarations } procedure Reset; override; end; var WeightedKappaForm: TWeightedKappaForm; implementation {$R *.lfm} uses Math, Globals, DataProcs, GridProcs, Utils; { TWeightedKappaForm } procedure TWeightedKappaForm.AdjustConstraints; begin inherited; ParamsPanel.Constraints.MinHeight := OptionsGroup.Top + OptionsGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; ParamsPanel.Constraints.MinWidth := MaxValueI([ InputGroup.Width, OptionsGroup.Width + NCasesEdit.Left + NCasesEdit.Width + VarList.BorderSpacing.Right ]); end; procedure TWeightedKappaForm.ColInClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (RaterBEdit.Text = '') then begin RaterBEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TWeightedKappaForm.ColOutClick(Sender: TObject); begin if RaterBEdit.Text <> '' then begin VarList.Items.Add(RaterBEdit.Text); RaterBEdit.Text := ''; end; UpdateBtnStates; end; procedure TWeightedKappaForm.Compute; var ColNoSelected: IntDyneVec = nil; Freq: IntDyneMat = nil; Prop: DblDyneMat = nil; Expected: DblDyneMat = nil; CellChi: DblDyneMat = nil; weights: DblDyneMat = nil; quadweights: DblDyneMat = nil; RowLabels: StrDyneVec = nil; ColLabels: StrDyneVec = nil; i, j, k, RowNo, ColNo, DepNo, MinRow, MaxRow, MinCol, MaxCol: integer; Row, Col, Ncases, Nrows, Ncols, FObs, df: integer; PObs, ChiSquare, ProbChi, likelihood, Fval, phi: double; yates: boolean; title: string; Adjchisqr, Adjprobchi, problikelihood, pearsonr: double; pobserved, SumX, SumY, VarX, VarY, obsdiag, expdiag, expnondiag: double; pexpected, MantelHaenszel, MHprob, CoefCont, CramerV: Double; KappaU, KappaL, KappaQ: double; Frq: integer; lReport: TStrings; begin pobserved := 0.0; pexpected := 0.0; RowNo := GetVariableIndex(OS3MainFrm.DataGrid, RaterAEdit.Text); ColNo := GetVariableIndex(OS3MainFrm.DataGrid, RaterBEdit.Text); DepNo := GetVariableIndex(OS3MainFrm.DataGrid, DepEdit.Text); if (not DataProcs.ValidValue(RowNo, 1)) or (not DataProcs.ValidValue(ColNo, 1)) then exit; if (InputGroup.ItemIndex = 1) and (not DataProcs.ValidValue(DepNo, 1)) then exit; if (InputGroup.ItemIndex = 2) and (not DataProcs.ValidValue(DepNo, 0)) then exit; if (InputGroup.ItemIndex = 0) then SetLength(ColNoSelected, 2) else begin // for reading proportions or frequencies SetLength(ColNoSelected, 3); ColNoSelected[2] := DepNo; end; ColNoSelected[0] := RowNo; ColNoSelected[1] := ColNo; // get min and max of row and col numbers MinRow := MaxInt; MaxRow := 0; MinCol := MaxInt; MaxCol := 0; for i := 1 to NoCases do begin if (not GoodRecord(OS3MainFrm.DataGrid, i,ColNoSelected)) then Continue; Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); Col := round(StrToFloat(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 RowLabels[i-1] := Format('Row %d', [i]); RowLabels[Nrows] := 'Total'; for j := 1 to Ncols do ColLabels[j-1] := Format('COL. %d', [j]); ColLabels[Ncols] := 'Total'; // get cell data Ncases := 0; case InputGroup.ItemIndex of 0: begin // count number of cases in each row and column combination for i := 1 to NoCases do begin if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue; Ncases := Ncases + 1; Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); Col := round(StrToFloat(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; 1: begin // read frequencies data from grid for i := 1 to NoCases do begin if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue; Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); Row := Row - MinRow + 1; Col := Col - MinCol + 1; FObs := round(StrToFloat(OS3MainFrm.DataGrid.Cells[DepNo,i])); Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + FObs; Ncases := Ncases + FObs; end; end; 2: begin // get no. of cases and proportions for each cell Ncases := StrToInt(NCasesEdit.Text); for i := 1 to NoCases do begin if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue; Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); Row := Row - MinRow + 1; Col := Col - MinCol + 1; PObs := round(StrToFloat(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; end; Freq[Nrows, Ncols] := Ncases; // Now, calculate expected values // Get row totals first for i := 1 to Nrows do for j := 1 to Ncols do Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; // Get col totals next for j := 1 to Ncols do for i := 1 to Nrows do Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; // Then get expected values and cell chi-squares yates := YatesChk.Checked and (Nrows = 2) and (Ncols = 2); ChiSquare := 0.0; Adjchisqr := 0.0; 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 ErrorMsg('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 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 lReport := TStringList.Create; try lReport.Add('CHI-SQUARE ANALYSIS RESULTS FOR ' + RaterAEdit.Text + ' AND ' + RaterBEdit.Text); lReport.Add('No. of Cases: %d', [Ncases]); lReport.Add(''); // print tables requested by use if ObsChk.Checked then begin IntArrayPrint(Freq, Nrows+1, Ncols+1, 'Frequencies', RowLabels, ColLabels, 'OBSERVED FREQUENCIES', lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); end; if ExpChk.Checked then begin // Expected frequencies MatPrint(Expected, Nrows, Ncols, 'EXPECTED FREQUENCIES', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); end; if PropChk.Checked then begin // 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; MatPrint(Prop, Nrows+1, Ncols+1, 'ROW PROPORTIONS', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); // 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; MatPrint(Prop, Nrows+1, Ncols+1, 'COLUMN PROPORTIONS', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); // 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; MatPrint(Prop, Nrows+1, Ncols+1, 'PROPORTIONS OF TOTAL N', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); end; if ChiChk.Checked then begin // Chi-squared value for cells MatPrint(CellChi, Nrows, Ncols, 'CHI-SQUARED VALUE FOR CELLS', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); end; lReport.Add('Chi-square: %.3f with D.F. %d. Prob. > value %.3f', [ChiSquare, df, ProbChi]); if yates then lReport.Add('Chi-square using Yates correction %.3f and Prob > value %.3f', [Adjchisqr, Adjprobchi]); likelihood := 0.0; for i := 0 to Nrows - 1 do for j := 0 to Ncols - 1 do likelihood := likelihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j])); likelihood := -2.0 * likelihood; problikelihood := 1.0 - chisquaredprob(likelihood,df); lReport.Add('Likelihood Ratio %.3f with prob. > value %.4f', [likelihood, problikelihood]); phi := sqrt(ChiSquare / Ncases); lReport.Add('phi correlation: %.4f', [phi]); 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); lReport.Add('Pearson Correlation r: %.4f', [pearsonr]); MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); lReport.Add('Mantel-Haenszel Test of Linear Association: %.3f with probability > value = %.4f', [MantelHaenszel, MHprob]); CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); lReport.Add('Coefficient of contingency: %.3f', [CoefCont]); if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * ((Nrows-1)))) else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); lReport.Add('Cramers V: %.3f', [CramerV]); // kappa if (Nrows = Ncols) then begin lReport.Add(''); lReport.Add(DIVIDER_AUTO); lReport.Add(''); 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; // Unweighted kappa KappaU := (obsdiag - expdiag) / expnondiag; // 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; // Observed Linear Weights MatPrint(weights, Nrows, Ncols, 'Observed Linear Weights', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(''); // Observed Quadratic Weights MatPrint(quadweights, Nrows, Ncols, 'Observed Quadratic Weights', RowLabels, ColLabels, NoCases, lReport); lReport.Add(DIVIDER_SMALL_AUTO); lReport.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; // Linear weighted kappa KappaL := (pobserved - pexpected) / (1.0 - pexpected); 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; // Quadratic weighted kappa KappaQ := (pobserved - pexpected) / (1.0 - pexpected); lReport.Add('Unweighted Kappa: %.4f', [KappaU]); lReport.Add('Linear Weighted Kappa: %.4f', [KappaL]); lReport.Add('Quadratic Weighted Kappa: %.4f', [KappaQ]); end; FReportFrame.DisplayReport(lReport); finally lReport.Free; end; // 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 OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); 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 TWeightedKappaForm.DepInClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (DepEdit.Text = '') then begin DepEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TWeightedKappaForm.DepOutClick(Sender: TObject); begin if DepEdit.Text <> '' then begin VarList.Items.Add(DepEdit.Text); DepEdit.Text := ''; end; UpdateBtnStates; end; procedure TWeightedKappaForm.FormCreate(Sender: TObject); begin if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); end; procedure TWeightedKappaForm.InputGroupClick(Sender: TObject); begin UpdateBtnStates; end; procedure TWeightedKappaForm.Reset; begin RaterAEdit.Text := ''; RaterBEdit.Text := ''; DepEdit.Text := ''; NCasesEdit.Text := ''; CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items); UpdateBtnStates; end; procedure TWeightedKappaForm.RowInClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (RaterAEdit.Text = '') then begin RaterAEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TWeightedKappaForm.RowOutClick(Sender: TObject); begin if RaterAEdit.Text <> '' then begin VarList.Items.Add(RaterAEdit.Text); RaterAEdit.Text := ''; end; UpdateBtnStates; end; procedure TWeightedKappaForm.UpdateBtnStates; begin RowIn.Enabled := (VarList.ItemIndex > -1) and (RaterAEdit.Text = ''); RowOut.Enabled := (RaterAEdit.Text <> ''); ColIn.Enabled := (VarList.ItemIndex > -1) and (RaterBEdit.Text = ''); ColOut.Enabled := (RaterBEdit.Text <> ''); DepIn.Enabled := (InputGroup.ItemIndex > 0) and (VarList.ItemIndex > -1) and (DepEdit.Text = ''); DepOut.Enabled := (InputGroup.ItemIndex > 0) and (DepEdit.Text <> ''); DepEdit.Enabled := (InputGroup.ItemIndex > 0); DepLbl.Enabled := DepEdit.Enabled; NCasesEdit.Enabled := (InputGroup.ItemIndex = 2); NCasesLbl.Enabled := NCasesEdit.Enabled; end; function TWeightedKappaForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; var n: Integer; begin Result := false; if InputGroup.ItemIndex = -1 then begin AMsg := 'No input option selected.'; AControl := InputGroup; exit; end; if RaterAEdit.Text = '' then begin AMsg := 'Rater A is not specified.'; AControl := RaterAEdit; exit; end; if RaterBEdit.Text = '' then begin AMsg := 'Rater B is not specified.'; AControl := RaterBEdit; exit; end; if InputGroup.ItemIndex > 0 then begin if DepEdit.Text = '' then begin AMsg := 'Dependent variable is not specified.'; AControl := DepEdit; exit; end; end; if InputGroup.ItemIndex = 2 then begin if NCasesEdit.Text = '' then begin AMsg := 'Total number of cases is not specified.'; AControl := NCasesEdit; exit; end; if not TryStrToInt(NCasesEdit.Text, n) then begin AMsg := 'Total number of cases is not a valid number.'; AControl := NCasesEdit; exit; end; end; Result := true; end; procedure TWeightedKappaForm.VarListDblClick(Sender: TObject); var index: Integer; begin index := VarList.ItemIndex; if index > -1 then begin if RaterAEdit.Text = '' then RaterAEdit.Text := VarList.Items[index] else if RaterBEdit.Text = '' then RaterBEdit.Text := VarList.Items[index] else if DepEdit.Enabled and (DepEdit.Text = '') then DepEdit.Text := VarList.Items[index] else exit; VarList.Items.Delete(index); UpdateBtnStates; end; end; procedure TWeightedKappaForm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; end.