From 6ca98774dbc05060c5bbdde9854b7f93ee7a3d1b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 3 Dec 2020 23:51:15 +0000 Subject: [PATCH] LazStats: Inherit LogLinScreenUnit from TBasicStatsReportFormUnit (still crashing). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7920 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../cross-classification/loglinscreenunit.lfm | 563 +++--- .../cross-classification/loglinscreenunit.pas | 1673 ++++++++--------- 2 files changed, 1082 insertions(+), 1154 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm index 0fe807b1d..94b002c42 100644 --- a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm +++ b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm @@ -1,324 +1,265 @@ -object LogLinScreenForm: TLogLinScreenForm +inherited LogLinScreenForm: TLogLinScreenForm Left = 417 - Height = 379 + Height = 294 Top = 130 - Width = 662 + Width = 833 HelpType = htKeyword HelpKeyword = 'LogLinearScreen.htm' - AutoSize = True Caption = 'Cross-Classification Log Linear Screen' - ClientHeight = 379 - ClientWidth = 662 - OnActivate = FormActivate - OnCreate = FormCreate - OnShow = FormShow - LCLVersion = '2.1.0.0' - object Label2: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 8 - Height = 15 - Top = 8 - Width = 97 - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - Caption = 'Available Variables' - ParentColor = False - end - object Label3: TLabel - AnchorSideLeft.Control = SelectList - AnchorSideTop.Control = Label2 - Left = 255 - Height = 15 - Top = 8 - Width = 44 - Caption = 'Selected' - ParentColor = False - end - object CountVarChk: TCheckBox - AnchorSideLeft.Control = SelectList - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = GroupBox1 - Left = 255 - Height = 19 - Top = 252 - Width = 247 - Anchors = [akLeft, akBottom] - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Last Variable Selected is a Frequency Count' - OnChange = CountVarChkChange - TabOrder = 4 - end - object VarList: TListBox - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Label2 - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = AllBtn - AnchorSideBottom.Control = CountVarChk - AnchorSideBottom.Side = asrBottom - Left = 8 - Height = 246 - Top = 25 - Width = 185 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 8 - BorderSpacing.Top = 2 - BorderSpacing.Right = 8 - ItemHeight = 0 - MultiSelect = True - OnSelectionChange = VarListSelectionChange - TabOrder = 0 - end - object InBtn: TBitBtn - AnchorSideLeft.Control = Bevel2 - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = VarList - Left = 210 - Height = 28 - Top = 25 - Width = 28 - Images = MainDataModule.ImageList - ImageIndex = 1 - OnClick = InBtnClick - Spacing = 0 - TabOrder = 1 - end - object OutBtn: TBitBtn - AnchorSideLeft.Control = Bevel2 - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = InBtn - AnchorSideTop.Side = asrBottom - Left = 210 - Height = 28 - Top = 57 - Width = 28 - BorderSpacing.Top = 4 - Images = MainDataModule.ImageList - ImageIndex = 0 - OnClick = OutBtnClick - Spacing = 0 - TabOrder = 2 - end - object AllBtn: TBitBtn - AnchorSideLeft.Control = Bevel2 - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = OutBtn - AnchorSideTop.Side = asrBottom - AnchorSideBottom.Side = asrBottom - Left = 201 - Height = 25 - Top = 89 - Width = 46 - AutoSize = True - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 24 - Caption = 'ALL' - OnClick = AllBtnClick - Spacing = 0 - TabOrder = 3 - end - object SelectList: TListBox - AnchorSideLeft.Control = AllBtn - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = VarList - AnchorSideRight.Control = MinMaxGrid - AnchorSideBottom.Control = CountVarChk - Left = 255 - Height = 219 - Top = 25 - Width = 185 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 8 - BorderSpacing.Right = 8 - ItemHeight = 0 - OnSelectionChange = SelectListSelectionChange - TabOrder = 7 - end - object GroupBox1: TGroupBox - AnchorSideLeft.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Bevel1 - Left = 8 - Height = 51 - Top = 279 - Width = 390 - Anchors = [akLeft, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Right = 8 - Caption = 'Options' - ChildSizing.LeftRightSpacing = 12 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.HorizontalSpacing = 20 - ChildSizing.VerticalSpacing = 2 - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 2 - ClientHeight = 31 - ClientWidth = 386 - TabOrder = 6 - object MarginsChk: TCheckBox - Left = 12 + ClientHeight = 294 + ClientWidth = 833 + inherited ParamsPanel: TPanel + Height = 278 + Width = 464 + ClientHeight = 278 + ClientWidth = 464 + inherited CloseBtn: TButton + Left = 409 + Top = 253 + TabOrder = 10 + end + inherited ComputeBtn: TButton + Left = 325 + Top = 253 + TabOrder = 9 + end + inherited ResetBtn: TButton + Left = 263 + Top = 253 + TabOrder = 8 + end + inherited HelpBtn: TButton + Tag = 131 + Left = 204 + Top = 253 + TabOrder = 7 + end + inherited ButtonBevel: TBevel + Top = 237 + Width = 464 + end + object Label2: TLabel[5] + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = ParamsPanel + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label3: TLabel[6] + AnchorSideLeft.Control = SelectList + AnchorSideTop.Control = Label2 + Left = 168 + Height = 15 + Top = 0 + Width = 44 + Caption = 'Selected' + ParentColor = False + end + object CountVarChk: TCheckBox[7] + AnchorSideLeft.Control = SelectList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OptionsGroup + Left = 168 Height = 19 - Top = 6 - Width = 129 - Caption = 'Print Marginal Totals' + Top = 159 + Width = 247 + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Last Variable Selected is a Frequency Count' + OnChange = CountVarChkChange + TabOrder = 6 + end + object VarList: TListBox[8] + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = CountVarChk + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 161 + Top = 17 + Width = 116 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 6 + ItemHeight = 0 + MultiSelect = True + OnDblClick = VarListDblClick + OnSelectionChange = VarListSelectionChange TabOrder = 0 end - object GenlModelChk: TCheckBox - Left = 161 - Height = 19 - Top = 6 - Width = 213 - Caption = 'Print General Linear Modle Estimates' + object InBtn: TBitBtn[9] + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 128 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 TabOrder = 1 end + object OutBtn: TBitBtn[10] + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 128 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn[11] + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 122 + Height = 25 + Top = 81 + Width = 40 + AutoSize = True + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 24 + Caption = 'All' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object SelectList: TListBox[12] + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideRight.Control = MinMaxGrid + AnchorSideBottom.Control = CountVarChk + Left = 168 + Height = 134 + Top = 17 + Width = 117 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 6 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnSelectionChange = SelectListSelectionChange + TabOrder = 4 + end + object MinMaxGrid: TStringGrid[13] + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectList + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = SelectList + AnchorSideBottom.Side = asrBottom + Left = 293 + Height = 134 + Top = 17 + Width = 171 + Anchors = [akTop, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Left = 8 + ColCount = 3 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goSmoothScroll] + RowCount = 1 + TabOrder = 5 + ColWidths = ( + 64 + 51 + 52 + ) + Cells = ( + 3 + 0 + 0 + 'Variable' + 1 + 0 + 'Min' + 2 + 0 + 'Max' + ) + end + object Label1: TLabel[14] + AnchorSideLeft.Control = MinMaxGrid + AnchorSideTop.Control = Label2 + AnchorSideBottom.Control = MinMaxGrid + Left = 293 + Height = 15 + Top = 0 + Width = 142 + Caption = 'Min/Max for each variable:' + ParentColor = False + end + object Bevel2: TBevel[15] + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = ParamsPanel + AnchorSideRight.Control = SelectList + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 4 + Top = 0 + Width = 285 + Anchors = [akTop, akLeft, akRight] + Shape = bsSpacer + end + object OptionsGroup: TGroupBox[16] + AnchorSideLeft.Control = ParamsPanel + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ButtonBevel + Left = 37 + Height = 51 + Top = 186 + Width = 390 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 20 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 386 + TabOrder = 11 + object MarginsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 129 + Caption = 'Print Marginal Totals' + TabOrder = 0 + end + object GenlModelChk: TCheckBox + Left = 161 + Height = 19 + Top = 6 + Width = 213 + Caption = 'Print General Linear Modle Estimates' + TabOrder = 1 + end + end end - object ResetBtn: TButton - AnchorSideRight.Control = ComputeBtn - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 453 - Height = 25 - Top = 346 - Width = 54 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Reset' - OnClick = ResetBtnClick - TabOrder = 9 - end - object ComputeBtn: TButton - AnchorSideRight.Control = CloseBtn - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 515 - Height = 25 - Top = 346 - Width = 76 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Compute' - OnClick = ComputeBtnClick - TabOrder = 10 - end - object CloseBtn: TButton - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 599 - Height = 25 - Top = 346 - Width = 55 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Close' - ModalResult = 11 - TabOrder = 11 - end - object HelpBtn: TButton - Tag = 131 - AnchorSideRight.Control = ResetBtn - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 394 - Height = 25 - Top = 346 - Width = 51 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Help' - OnClick = HelpBtnClick - TabOrder = 8 - end - object Bevel1: TBevel - AnchorSideLeft.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = CloseBtn - Left = 0 - Height = 8 - Top = 330 - Width = 662 - Anchors = [akLeft, akRight, akBottom] - Shape = bsBottomLine - end - object MinMaxGrid: TStringGrid - AnchorSideLeft.Control = SelectList - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = SelectList - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = SelectList - AnchorSideBottom.Side = asrBottom - Left = 448 - Height = 219 - Top = 25 - Width = 206 - Anchors = [akTop, akRight, akBottom] - AutoFillColumns = True - BorderSpacing.Left = 8 - BorderSpacing.Right = 8 - ColCount = 3 - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goSmoothScroll] - RowCount = 1 - TabOrder = 5 - ColWidths = ( - 64 - 69 - 69 - ) - Cells = ( - 3 - 0 - 0 - 'Variable' - 1 - 0 - 'Minimum' - 2 - 0 - 'Maximum' - ) - end - object Label1: TLabel - AnchorSideLeft.Control = MinMaxGrid - AnchorSideTop.Control = Label2 - AnchorSideBottom.Control = MinMaxGrid - Left = 448 - Height = 15 - Top = 8 - Width = 142 - Caption = 'Min/Max for each variable:' - ParentColor = False - end - object Bevel2: TBevel - AnchorSideLeft.Control = VarList - AnchorSideRight.Control = SelectList - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 4 - Top = 2 - Width = 432 - Anchors = [akTop, akLeft, akRight] - Shape = bsSpacer + inherited ParamsSplitter: TSplitter + Left = 476 + Height = 294 end end diff --git a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas index b52bafbdc..309a553f0 100644 --- a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas +++ b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas @@ -15,28 +15,23 @@ unit LogLinScreenUnit; interface uses - Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, Grids, - Globals, MainUnit, FunctionsLib, OutputUnit, DataProcs, ContextHelpUnit; + Globals, MainUnit, FunctionsLib, BasicStatsReportFormUnit; type { TLogLinScreenForm } - TLogLinScreenForm = class(TForm) - Bevel1: TBevel; + TLogLinScreenForm = class(TBasicStatsReportForm) Bevel2: TBevel; - HelpBtn: TButton; InBtn: TBitBtn; Label1: TLabel; OutBtn: TBitBtn; AllBtn: TBitBtn; - ResetBtn: TButton; - ComputeBtn: TButton; - CloseBtn: TButton; MarginsChk: TCheckBox; GenlModelChk: TCheckBox; - GroupBox1: TGroupBox; + OptionsGroup: TGroupBox; Label2: TLabel; Label3: TLabel; SelectList: TListBox; @@ -44,27 +39,17 @@ type VarList: TListBox; CountVarChk: TCheckBox; procedure AllBtnClick(Sender: TObject); - procedure ComputeBtnClick(Sender: TObject); procedure CountVarChkChange(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure HelpBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject); - procedure ResetBtnClick(Sender: TObject); procedure SelectListSelectionChange(Sender: TObject; {%H-}User: boolean); - function ArrayPosition(NumDims: integer; const Data: DblDyneVec; - const Subscripts, DimSize: IntDyneVec): integer; - procedure Marginals(NumDims, ArraySize: integer; const Indexes: IntDyneMat; - const Data: DblDyneVec; const Margins: IntDyneMat); - + procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); private - { private declarations } - FAutoSized: Boolean; - procedure UpdateBtnStates; + function ArrayPosition(ANumDims: integer; + const Subscripts, DimSize: IntDyneVec): integer; + procedure UpdateMinMaxGrid; procedure Screen(VAR NVAR : integer; @@ -96,10 +81,9 @@ type VAR DIM : IntDyneVec; VAR DF : integer); procedure RESET(VAR FIT : DblDyneVec; NTAB : Integer; - AVG : Double); + AVG : Double); - procedure LIKE(VAR GSQ : Double; VAR FIT : DblDyneVec; - VAR TABLE : DblDyneVec; NTAB : integer); + procedure LIKE(var GSQ: Double; const FIT, TABLE: DblDyneVec; NTAB: integer); procedure LOGFIT(NVAR, NTAB, NCON : integer; VAR DIM : IntDyneVec; @@ -110,8 +94,17 @@ type procedure MaxCombos(NumDims: integer; out MM, MP: integer); + procedure Marginals(NumDims, ArraySize: integer; const Indexes: IntDyneMat; + const Data: DblDyneVec; const Margins: IntDyneMat); + + 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 @@ -119,28 +112,574 @@ var implementation +{$R *.lfm} + uses - Math, LCLIntf, LCLType, Utils; + Math, LCLIntf, LCLType, + Utils, DataProcs, GridProcs; + { TLogLinScreenForm } -procedure TLogLinScreenForm.ResetBtnClick(Sender: TObject); -var - i : integer; +procedure TLogLinScreenForm.AdjustConstraints; begin + inherited; + ParamsPanel.Constraints.MinWidth := MaxValue([ + 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, + OptionsGroup.Width, + Label2.Width * 2 + AllBtn.Width + 2*varList.BorderSpacing.Right + + MinMaxGrid.Width + MinMaxGrid.BorderSpacing.Left + ]); + ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height + + CountVarChk.BorderSpacing.Top + CountVarChk.Height + + VarList.BorderSpacing.Bottom + OptionsGroup.Height + ButtonBevel.Height + + CloseBtn.BorderSpacing.Top + CloseBtn.Height; +end; + + +procedure TLogLinScreenForm.AllBtnClick(Sender: TObject); +var + i: integer; +begin + for i := 0 to VarList.Items.Count-1 do + SelectList.Items.Add(VarList.Items[i]); VarList.Clear; - for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); - SelectList.Clear; UpdateBtnStates; UpdateMinMaxGrid; end; -procedure TLogLinScreenForm.SelectListSelectionChange(Sender: TObject; - User: boolean); + +function TLogLinScreenForm.ArrayPosition(ANumDims: integer; + const Subscripts, DimSize: IntDyneVec): integer; +var + Pos : integer; + i, j : integer; + PriorSizes : IntDyneVec = nil; begin - UpdateBtnStates; + // allocate space for PriorSizes + SetLength(PriorSizes, ANumDims); + + // calculate PriorSizes values + for i := 0 to ANumDims - 2 do + PriorSizes[i] := 1; // initialize + + for i := ANumDims - 2 downto 0 do + for j := 0 to i do PriorSizes[i] := PriorSizes[i] * DimSize[j]; + + Pos := Subscripts[0] - 1; + for i := 0 to ANumDims - 2 do + Pos := Pos + (PriorSizes[i] * (Subscripts[i+1]-1)); + + Result := Pos; + PriorSizes := nil; end; + + +{ SUBROUTINE COMBO(ISET, N, M, LAST) + + ALGORITHM AS 160.2 APPL. STATIST. (1981) VOL.30, NO.1 + + Subroutine to generate all possible combinations of M of the + integers from 1 to N in a stepwise fashion. Prior to the first + call, LAST should be set to .FALSE. Thereafter, as long as LAST + is returned .FALSE., a new valid combination has been generated. + When LAST goes .TRUE., there are no more combinations. + + LOGICAL LAST + INTEGER N, M, ISET(M) +} +procedure TLogLinScreenForm.COMBO(var ISET: IntDyneVec; N, M: Integer; + var LAST: boolean); +label + 100, 110, 130, 150; +var + I, K, L : integer; +begin + IF (LAST) then GOTO 110; +// +// Get next element to increment +// + K := M; +100: L := ISET[K] + 1; + IF (L + M - K <= N) then GOTO 150; + K := K - 1; +// +// See if we are done +// + IF (K <= 0) then GOTO 130; + GOTO 100; +// +// Initialize first combination +// +110: for I := 1 to M do ISET[I] := I; +130: LAST := NOT LAST; + exit; +// +// Fill in remainder of combination. +// +150: for I := K to M do //DO 160 I = K, M + begin + ISET[I] := L; + L := L + 1; + end; //160 CONTINUE +end; + + +procedure TLogLinScreenForm.Compute; +var + ArraySize: integer; + N: integer; + index, index2, i, j, k, l, nVars: integer; + count: integer; + Data: DblDyneVec = nil; + Subscripts: IntDyneVec = nil; + DimSize: IntDyneVec = nil; + GridPos: IntDyneVec = nil; + Labels: StrDyneVec = nil; + Margins: IntDyneMat = nil; + Expected: DblDyneVec = nil; + WorkVec: IntDyneVec = nil; + Indexes: IntDyneMat = nil; + LogM: DblDyneVec = nil; + M: DblDyneMat = nil; + astr, HeadStr : string; + MaxDim, MP, MM : integer; + U, Mu : Double; + Chi2, G2 : double; + DF : integer; + ProbChi2, ProbG2 : double; + GSQ : DblDyneVec = nil; + DGFR : IntDyneVec = nil; + PART : DblDyneMat = nil; + MARG : DblDyneMat = nil; + DFS : IntDyneMat = nil; + IP : IntDyneMat = nil; + IM : IntDyneMat = nil; + ISET : IntDyneVec = nil; + JSET : IntDyneVec = nil; + CONFIG : IntDyneMat = nil; + FIT : DblDyneVec = nil; + SIZE : IntDyneVec = nil; + COORD : IntDyneVec = nil; + X: DblDyneVec = nil; + Y : DblDyneVec = nil; + IFAULT : integer; + TABLE : DblDyneVec = nil; + DIM : IntDyneVec = nil; + nDims: Integer; + Minimums: IntDyneVec = nil; + Maximums: IntDyneVec = nil; +// Response: BoolDyneVec; +// Interact: BoolDyneVec; + lReport: TStrings; +begin + lReport := TStringList.Create; + try + // Allocate space for labels, DimSize and SubScripts + nDims := MinMaxGrid.RowCount - 1; + nVars := SelectList.Items.Count; + + SetLength(Labels, nVars); + SetLength(GridPos, nVars); + SetLength(Minimums, nDims); + SetLength(Maximums, nDims); + SetLength(DimSize, nDims); + SetLength(Subscripts, nDims); + + for i := 1 to nDims do + begin + if not TryStrToInt(MinMaxGrid.Cells[1, i], Minimums[i-1]) then + begin + ErrorMsg('Valid Integer number > 0 expected.'); + exit; + end; + if not TryStrToInt(MinMaxGrid.Cells[2, i], Maximums[i-1]) then + begin + ErrorMsg('Integer number > 0 expected.'); + exit; + end; + end; + + // get variable labels and column positions + for i := 0 to nVars-1 do + begin + Labels[i] := SelectList.Items[i]; + GridPos[i] := GetVariableIndex(OS3MainFrm.DataGrid, Labels[i]); + end; + + // Get no. of categories for each dimension (DimSize) + MaxDim := 0; + ArraySize := 1; + for i := 0 to nDims - 1 do + begin + DimSize[i] := Maximums[i] - Minimums[i] + 1; + if DimSize[i] > MaxDim then MaxDim := DimSize[i]; + ArraySize := ArraySize * DimSize[i]; + end; + + // Allocate space for Data and marginals + SetLength(WorkVec, MaxDim); + SetLength(Data, ArraySize); + SetLength(Margins, nDims, MaxDim); + SetLength(Expected, ArraySize); + SetLength(Indexes, ArraySize+1, nDims); + SetLength(LogM, ArraySize); + SetLength(M, ArraySize, nDims); + + // Read and store frequencies in Data + for i := 1 to NoCases do + begin + if GoodRecord(OS3MainFrm.DataGrid, i, GridPos) then // casewise check + begin + // get cell subscripts + for j := 0 to nDims-1 do + begin + index := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[j], i]); + index := index - Minimums[j] + 1; + Subscripts[j] := index; + end; + + index := ArrayPosition(nDims, Subscripts, DimSize); + + // save subscripts for later use + for j := 0 to nDims-1 do + Indexes[index, j] := Subscripts[j]; + + if CountVarChk.Checked then + begin + k := GridPos[nVars-1]; + Data[index] := Data[index] + StrToInt(OS3MainFrm.DataGrid.Cells[k, i]); + end else + Data[index] := Data[index] + 1; + end; + end; + + // get total N + N := 0; + for i := 0 to ArraySize-1 do + N := N + Round(Data[i]); + + // Get marginal frequencies + Marginals(nDims, ArraySize, Indexes, Data, Margins); + + // Print Marginal totals if requested + if MarginsChk.Checked then + begin + lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); + lReport.Add(''); + for i := 0 to nDims-1 do + begin + HeadStr := 'Marginal Totals for ' + Labels[i]; + k := DimSize[i]; + for j := 0 to k-1 do WorkVec[j] := Margins[i, j]; + VecPrint(WorkVec, k, HeadStr, lReport); + end; + end; + lReport.Add(''); + lReport.Add('Total Frequencies: %d', [N]); + + lReport.Add(''); + lReport.Add(DIVIDER); + lReport.Add(''); + + // Get Expected cell values + U := 0.0; // overall mean (mu) of log linear model + for i := 0 to ArraySize-1 do // indexes point to each cell + begin + Expected[i] := 1.0; + for j := 0 to nDims-1 do + begin + k := Indexes[i, j]; + Expected[i] := Expected[i] * (Margins[j, k-1] / N); + end; + Expected[i] := Expected[i] * N; + LogM[i] := ln(Expected[i]); + end; + for i := 0 to ArraySize-1 do U := U + LogM[i]; + U := U / ArraySize; + + // print expected values + lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); + lReport.Add(''); + lReport.Add('EXPECTED CELL VALUES FOR MODEL OF COMPLETE INDEPENDENCE'); + lReport.Add(''); + + astr := 'Cell'; + for j := 2 to nDims do astr := astr + ' '; + lReport.Add(astr + 'Observed Expected Log Expected'); + + astr := ''; + for j := 1 to nDims do astr := astr + '--- '; + astr := astr + '---------- ---------- ----------'; + lReport.Add(astr); + + for i := 1 to ArraySize do + begin + astr := ''; + for j := 1 to nDims do + astr := astr + Format('%3d ', [Indexes[i-1, j-1]]); + astr := astr + Format('%10.0f %10.2f %10.3f',[Data[i-1], Expected[i-1], LogM[i-1]]); + lReport.Add(astr); + end; + + // Calculate chi-squared and G squared statistics + chi2 := 0.0; + G2 := 0.0; + for i := 0 to ArraySize-1 do + begin + chi2 := chi2 + Sqr(Data[i] - Expected[i]) / Expected[i]; + G2 := G2 + Data[i] * ln(Data[i] / Expected[i]); + end; + G2 := 2.0 * G2; + DF := 1; + for i := 0 to nDims-1 do + DF := DF * (DimSize[i] - 1); + ProbChi2 := 1.0 - ChiSquaredProb(chi2,DF); + ProbG2 := 1.0 - ChiSquaredProb(G2,DF); + lReport.Add('Chisquare: %10.3f with probability %10.3f (DF %d)', [chi2, ProbChi2, DF]); + lReport.Add('G squared: %10.3f with probability %10.3f (DF %d)', [G2, ProbG2, DF]); + lReport.Add(''); + lReport.Add('U (mu) for general loglinear model: %10.2f', [U]); + + lReport.Add(''); + lReport.Add(DIVIDER); + lReport.Add(''); + + // Get log linear model values for each cell + // get M's for each cell + lReport.Add('First Order LogLinear Model Factors and N of Cells in Each'); + astr := 'CELL '; + for i := 1 to nDims do + astr := astr + Format(' U%d N Cells ',[i]); + lReport.Add(astr); + lReport.Add(''); + for i := 1 to ArraySize do // cell + begin + astr := ''; + for j := 1 to nDims do + astr := astr + Format('%3d ', [Indexes[i-1,j-1]]); + for j := 1 to nDims do // jth mu + begin + index := Indexes[i-1,j-1]; // sum for this mu + count := 0; + Mu := 0.0; + for k := 1 to ArraySize do + begin + if index = Indexes[k-1,j-1] then + begin + count := count + 1; + Mu := Mu + LogM[k-1]; + end; + end; + Mu := Mu / count - U; + astr := astr + format('%10.3f %3d ',[Mu,count]); + end; + lReport.Add(astr); + end; + + lReport.Add(''); + lReport.Add(DIVIDER); + lReport.Add(''); + + // get second order interactions + lReport.Add('Second Order Loglinear Model Terms and N of Cells in Each'); + astr := 'CELL '; + for i := 1 to nDims-1 do + for j := i + 1 to nDims do + astr := astr + format('U%d%d N Cells ',[i,j]); + lReport.Add(astr); + lReport.Add(''); + for i := 1 to ArraySize do // cell + begin + astr := ''; + for j := 0 to nDims-1 do + astr := astr + Format('%3d ', [Indexes[i, j]]); + for j := 1 to nDims-1 do // jth + begin + index := Indexes[i-1,j-1]; // sum for this mu using j and k + for k := j+1 to nDims do // with kth + begin + index2 := Indexes[i-1,k-1]; + Mu := 0.0; + count := 0; + for l := 1 to ArraySize do + begin + if ((index = Indexes[l-1,j-1]) and (index2 = Indexes[l-1,k-1])) then + begin + Mu := Mu + LogM[l-1]; + count := count + 1; + end; + end; // next l + Mu := Mu / count - U; + astr := astr + Format('%10.3f %3d', [Mu, count]); + end; // next k (second term subscript) + end; // next j (first term subscript) + lReport.Add(astr); + end; // next i + + lReport.Add(''); + lReport.Add(DIVIDER); + lReport.Add(''); + + // get maximum no. of interactions in saturated model + MaxCombos(nDims, MM, MP); + + SetLength(GSQ, nDims+1); + SetLength(DGFR, nDims+1); + SetLength(PART, nDims+1, MP+1); + SetLength(MARG, nDims+1, MP+1); + SetLength(DFS, nDims+1, MP+1); + SetLength(IP, nDims+1, MP+1); + SetLength(IM, nDims+1, MM+1); + SetLength(ISET, nDims+1); + SetLength(JSET, nDims+1); + SetLength(CONFIG, nDims+1, MP+1); + SetLength(FIT, ArraySize+1); + SetLength(SIZE, nDims+1); + SetLength(COORD, nDims+1); + SetLength(X, ArraySize+1); + SetLength(Y, ArraySize+1); + SetLength(TABLE, ArraySize+1); + SetLength(DIM, nDims+1); + + // Load TABLE and DIM one up from Data + for i := 1 to ArraySize do Table[i] := Data[i-1]; + for i := 1 to nDims do DIM[i] := DimSize[i-1]; + + Screen( + nDims, MP, MM, ArraySize, TABLE, DIM, + GSQ, DGFR, PART, MARG, DFS, IP, IM, ISET, JSET, CONFIG, FIT, SIZE, + COORD, X, Y, IFAULT + ); + + // show results + lReport.Add('SCREEN FOR INTERACTIONS AMONG THE VARIABLES'); + lReport.Add('Adapted from the Fortran program by Lustbader and Stodola printed in'); + lReport.Add('Applied Statistics, Volume 30, Issue 1, 1981, pages 97-105 as Algorithm'); + lReport.Add('AS 160 Partial and Marginal Association in Multidimensional Contingency Tables'); + lReport.Add(''); + lReport.Add('Statistics for tests that the interactions of a given order are zero'); + lReport.Add('ORDER STATISTIC D.F. PROB.'); + lReport.Add('----- ---------- ---- ----------'); + for i := 1 to nDims do + begin + ProbChi2 := 1.0 - ChiSquaredProb(GSQ[i], DGFR[i]); + lReport.Add('%5d %10.3f %4d %10.3f',[i,GSQ[i], DGFR[i], ProbChi2]); + end; + lReport.Add(''); + lReport.Add('Statistics for Marginal Association Tests'); + lReport.Add('VARIABLE ASSOC. PART ASSOC. MARGINAL ASSOC. D.F. PROB'); + lReport.Add('-------- ------ ----------- --------------- ---- ----------'); + for i := 1 to nDims-1 do + begin + for j := 1 to MP do + begin + ProbChi2 := 1.0 - ChiSquaredProb(MARG[i,j],DFS[i,j]); + lReport.Add('%6d %5d %10.3f %12.3f %3d %10.3f', + [i, j, PART[i,j], MARG[i,j], DFS[i,j], ProbChi2]); + end; + end; + + FReportFrame.DisplayReport(lReport); + + finally + lReport.Free; + end; +end; + + +{ SUBROUTINE CONF(N, M, MP, MM, ISET, JSET, IP, IM, NP) + + ALGORITHM AS 160.1 APPL. STATIST. (1981) VOL.30, NO.1 + + Set up the arrays IP and IM for a given N and M. Essentially + IP contains all possible combinations of (N choose M). For each + combination found IM contains all combinations of degree M-1. + + INTEGER ISET(N), JSET(N), IP(N,MP), IM(N,MM) + LOGICAL ILAST, JLAST +} +procedure TLogLinScreenForm.CONF(var N: integer; var M: integer; + var MP: integer; var MM: integer; var ISET: IntDyneVec; var JSET: IntDyneVec; + var IP: IntDyneMat; var IM: IntDyneMat; var NP: integer); +label + 100, 120; +var + ILAST, JLAST: boolean; + I, L, NM, JS: integer; +begin + ILAST := TRUE; + NP := 0; + NM := 0; + // + // Get IP + // + 100: + COMBO(ISET, N, M, ILAST); + IF (ILAST) then exit; + NP := NP + 1; + for I := 1 to M do IP[I,NP] := ISET[I]; + IF (M = 1) then GOTO 100; +// +// Get IM +// + JLAST := TRUE; + L := M - 1; + 120: + COMBO(JSET, M, L, JLAST); + IF (JLAST) then GOTO 100; + NM := NM + 1; + for I := 1 to L do // DO 130 I = 1, L + begin + JS := JSET[I]; + IM[I,NM] := ISET[JS]; + end; // 130 CONTINUE + GOTO 120; +end; + + +procedure TLogLinScreenForm.CountVarChkChange(Sender: TObject); +begin + UpdateMinMaxGrid; +end; + + +procedure TLogLinScreenForm.EVAL(var IAR: IntDyneMat; NC, NV, IBEG, NVAR, + MAX: integer; var CONFIG: IntDyneMat; var DIM: IntDyneVec; var DF: integer); +VAR I, J, K, KK, L : integer; +// SUBROUTINE EVAL(IAR, NC, NV, IBEG, NVAR, MAX, CONFIG, DIM, DF) +// +// ALGORITHM AS 160.3 APPL. STATIST. (1981) VOL.30, NO.1 +// +// IAR = array containing the effects to be fitted +// NC = number of columns of IAR to be used +// NV = number of variables in each effect +// IBEG = gebinning column +// DF = degrees of freedom +// +// CONFIG is in a format compatible with algorithm AS 51 +// +// INTEGER IAR(NVAR,MAX), CONFIG(NVAR,NC), DIM(NVAR), DF +// +begin + DF := 0; + for J := 1 to NC do //DO 110 J = 1, NC + begin + KK := 1; + for I := 1 to NV do //DO 100 I = 1, NV + begin + L := IBEG + J - 1; + K := IAR[I,L]; + KK := KK * (DIM[K] - 1); + CONFIG[I,J] := K; + end; // 100 CONTINUE + CONFIG[NV+1,J] := 0; + DF := DF + KK; + end; // 110 CONTINUE +end; + + procedure TLogLinScreenForm.InBtnClick(Sender: TObject); var i: integer; @@ -160,453 +699,189 @@ begin UpdateBtnStates; end; -procedure TLogLinScreenForm.FormActivate(Sender: TObject); + +{ SUBROUTINE LIKE(GSQ, FIT, TABLE, NTAB) + ALGORITHM AS 160.5 APPL. STATIST. (1981) VOL.30, NO.1 + + Compute the likelihood-ration chi-square + + REAL FIT(NTAB), TABLE(NTAB), ZERO, TWO + DATA ZERO /0.0/, TWO /2.0/ +} +procedure TLogLinScreenForm.LIKE(var GSQ: Double; const FIT, TABLE: DblDyneVec; + NTAB: integer); +const + ZERO = 0.0; + TWO = 2.0; var - w: Integer; + I: integer; begin - if FAutoSized then - exit; - - w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); - HelpBtn.Constraints.MinWidth := w; - ResetBtn.Constraints.MinWidth := w; - ComputeBtn.Constraints.MinWidth := w; - CloseBtn.Constraints.MinWidth := w; - - MinMaxGrid.ClientWidth := 3 * MinMaxGrid.Canvas.TextWidth('Maximum ') + 6*varCellPadding; - - Constraints.MinWidth := MinMaxGrid.Width * 3 + AllBtn.Width + 4 * VarList.BorderSpacing.Left; - Constraints.MinHeight := Height; - AutoSize := false; - Height := 2*Height; - - Position := poMainFormCenter; - - FAutoSized := true; + GSQ := ZERO; + for I := 1 to NTAB do //DO 100 I = 1, NTAB + begin + if (FIT[I] = ZERO) or (TABLE[I] = ZERO) then continue; // GO TO 100 + GSQ := GSQ + TABLE[I] * Ln(TABLE[I] / FIT[I]); + end; // 100 CONTINUE + GSQ := TWO * GSQ; end; -procedure TLogLinScreenForm.FormCreate(Sender: TObject); -begin - Assert(OS3MainFrm <> nil); -end; -procedure TLogLinScreenForm.FormShow(Sender: TObject); -begin - ResetBtnClick(Self); -end; +{ + SUBROUTINE LOGFIT(NVAR, NTAB, NCON, DIM, CONFIG, TABLE, FIT, SIZE, COORD, X, Y) -procedure TLogLinScreenForm.HelpBtnClick(Sender: TObject); -begin - if ContextHelpForm = nil then - Application.CreateForm(TContextHelpForm, ContextHelpForm); - ContextHelpForm.HelpMessage((Sender as TButton).Tag); -end; + ALGORITHM AS 160.6 APPL. STATIST. (1981) VOL.30, NO.1 -procedure TLogLinScreenForm.AllBtnClick(Sender: TObject); + Iterative proportional fitting of the marginals of a contingency table. + Relevant code from AS 51 is used. + + REAL TABLE(NTAB), FIT(NTAB), MAXDEV, X(NTAB), Y(NTAB), ZERO + INTEGER CONFIG(NVAR,NCON), DIM(NVAR), SIZE(NVAR), COORD(NVAR) + LOGICAL OPTION + DATA MAXDEV /0.25/, MAXIT /25/, ZERO /0.0/ +} +procedure TLogLinScreenForm.LOGFIT(NVAR, NTAB, NCON: integer; + var DIM: IntDyneVec; var CONFIG: IntDyneMat; var TABLE: DblDyneVec; + var FIT: DblDyneVec; var SIZE: IntDyneVec; var COORD: IntDyneVec; + var X: DblDyneVec; var Y: DblDyneVec); +label + 110, 130, 150, 170, 180, 200; +const + ZERO = 0.0; + MAXDEV = 0.25; + MAXIT = 25; var - i: integer; + II, K, KK, L, N, J, I: integer; + OPTION: boolean; + XMAX, E: double; + NV1, ISZ: integer; begin - for i := 0 to VarList.Items.Count-1 do - SelectList.Items.Add(VarList.Items[i]); - VarList.Clear; - UpdateBtnStates; - UpdateMinMaxGrid; + for KK := 1 to MAXIT do //DO 230 KK = 1, MAXIT + begin + // + // XMAX is the maximum deviation between fitted and true marginal + // + XMAX := ZERO; + for II := 1 to NCON do //DO 220 II = 1, NCON + begin + OPTION := TRUE; + // + // Initialize arrays + // + SIZE[1] := 1; + NV1 := NVAR - 1; + for K := 1 to NV1 do //DO 100 K = 1, NV1 + begin + L := CONFIG[K,II]; + IF (L = 0) then GOTO 110; + SIZE[K+1] := SIZE[K] * DIM[L]; + end; // 100 CONTINUE + K := NVAR; + 110: N := K - 1; + ISZ := SIZE[K]; + for J := 1 to ISZ do //DO 120 J = 1, ISZ + begin + X[J] := ZERO; + Y[J] := ZERO; + end; // 120 CONTINUE + // + // Initialize co-ordinates + // + 130: for K := 1 to NVAR do COORD[K] := 0; + // + // Find locations in tables + // + I := 1; + 150: J := 1; + for K := 1 to N do //DO 160 K = 1, N + begin + L := CONFIG[K,II]; + J := J + COORD[L] * SIZE[K]; + end; //160 CONTINUE + IF (NOT OPTION) then GOTO 170; + // + // Compute marginals + // + X[J] := X[J] + TABLE[I]; + Y[J] := Y[J] + FIT[I]; + GOTO 180; + // + // Make adjustments + // + 170: IF (Y[J] <= ZERO) then FIT[I] := ZERO; + IF (Y[J] > ZERO) then FIT[I] := FIT[I] * X[J] / Y[J]; + // + // Update co-ordinates + // + 180: I := I + 1; + for K := 1 to NVAR do //DO 190 K = 1, NVAR + begin + COORD[K] := COORD[K] + 1; + IF (COORD[K] < DIM[K]) then GOTO 150; + COORD[K] := 0; + end; //190 CONTINUE + IF (NOT OPTION) then GOTO 200; + OPTION := FALSE; + GOTO 130; + // + // Find the largest deviation + // + 200: for I := 1 to ISZ do //DO 210 I = 1, ISZ + begin + E := ABS(X[I] - Y[I]); + IF (E > XMAX) then XMAX := E; + end; // 210 CONTINUE + end; // 220 CONTINUE + // + // Test convergence + // + IF (XMAX < MAXDEV) then exit; + end; // 230 CONTINUE end; -procedure TLogLinScreenForm.ComputeBtnClick(Sender: TObject); + +procedure TLogLinScreenForm.Marginals(NumDims, ArraySize: integer; + const Indexes: IntDyneMat; const Data: DblDyneVec; const Margins: IntDyneMat); var - ArraySize : integer; - N : integer; - index, index2, i, j, k, l, NoVars : integer; - count : integer; - Data : DblDyneVec; - Subscripts : IntDyneVec; - DimSize : IntDyneVec; - GridPos : IntDyneVec; - Labels : StrDyneVec; - Margins : IntDyneMat; - Expected : DblDyneVec; - WorkVec : IntDyneVec; - Indexes : IntDyneMat; - LogM : DblDyneVec; - M : DblDyneMat; - astr, HeadStr : string; - MaxDim, MP, MM : integer; - U, Mu : Double; - Chi2, G2 : double; - DF : integer; - ProbChi2, ProbG2 : double; - GSQ : DblDyneVec; - DGFR : IntDyneVec; - PART : DblDyneMat; - MARG : DblDyneMat; - DFS : IntDyneMat; - IP : IntDyneMat; - IM : IntDyneMat; - ISET : IntDyneVec; - JSET : IntDyneVec; - CONFIG : IntDyneMat; - FIT : DblDyneVec; - SIZE : IntDyneVec; - COORD : IntDyneVec; - X, Y : DblDyneVec; - IFAULT : integer; - TABLE : DblDyneVec; - DIM : IntDyneVec; - NoDims: Integer; - Minimums: IntDyneVec; - Maximums: IntDyneVec; -// Response: BoolDyneVec; -// Interact: BoolDyneVec; - lReport: TStrings; + i, j, category: integer; begin - lReport := TStringList.Create; - try - // Allocate space for labels, DimSize and SubScripts - NoDims := MinMaxGrid.RowCount - 1; - NoVars := SelectList.Items.Count; - - SetLength(Labels, NoVars); - SetLength(GridPos, NoVars); - SetLength(Minimums, NoDims); - SetLength(Maximums, NoDims); - SetLength(DimSize, NoDims); - SetLength(Subscripts, NoDims); - - for i := 1 to NoDims do - begin - if not TryStrToInt(MinMaxGrid.Cells[1, i], Minimums[i-1]) then - begin - MessageDlg('Integer number > 0 expected.', mtError, [mbOK], 0); - exit; - end; - if not TryStrToInt(MinMaxGrid.Cells[2, i], Maximums[i-1]) then - begin - MessageDlg('Integer number > 0 expected.', mtError, [mbOK], 0); - exit; - end; - end; - - // get variable labels and column positions - for i := 1 to NoVars do - begin - astr := SelectList.Items.Strings[i-1]; - for j := 1 to NoVariables do - begin - if OS3MainFrm.DataGrid.Cells[j,0] = astr then - begin - Labels[i-1] := astr; - GridPos[i-1] := j; - break; - end; - end; - end; - - // Get no. of categories for each dimension (DimSize) - MaxDim := 0; - ArraySize := 1; - for i := 0 to NoDims - 1 do - begin - DimSize[i] := Maximums[i] - Minimums[i] + 1; - if DimSize[i] > MaxDim then MaxDim := DimSize[i]; - ArraySize := ArraySize * DimSize[i]; - end; - - // Allocate space for Data and marginals - SetLength(WorkVec,MaxDim); - SetLength(Data,ArraySize); - SetLength(Margins,NoDims,MaxDim); - SetLength(Expected,ArraySize); - SetLength(Indexes,ArraySize+1,NoDims); - SetLength(LogM,ArraySize); - SetLength(M,ArraySize,NoDims); - - // Initialize data and margins arrays - for i := 1 to NoDims do - for j := 1 to MaxDim do - Margins[i-1,j-1] := 0; - for i := 1 to ArraySize do - Data[i-1] := 0; - - // Read and store frequencies in Data - for i := 1 to NoCases do - begin - if GoodRecord(i, NoVars, GridPos) then // casewise check - begin - // get cell subscripts - for j := 1 to NoDims do - begin - index := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[j-1],i]); - index := index - Minimums[j-1] + 1; - Subscripts[j-1] := index; - end; - - index := ArrayPosition(NoDims, Data, Subscripts, DimSize); - - // save subscripts for later use - for j := 1 to NoDims do - Indexes[index,j-1] := Subscripts[j-1]; - - if CountVarChk.Checked then - begin - k := GridPos[NoVars-1]; - Data[index] := Data[index] + StrToInt(OS3MainFrm.DataGrid.Cells[k,i]); - end else - Data[index] := Data[index] + 1; - end; - end; - - // get total N - N := 0; - for i := 1 to ArraySize do - N := N + Round(Data[i-1]); - - // Get marginal frequencies - Marginals(NoDims, ArraySize, Indexes, Data, Margins); - - // Print Marginal totals if requested - if MarginsChk.Checked then - begin - lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); - lReport.Add(''); - for i := 1 to NoDims do - begin - HeadStr := 'Marginal Totals for ' + Labels[i-1]; - k := DimSize[i-1]; - for j := 0 to k-1 do WorkVec[j] := Margins[i-1,j]; - VecPrint(WorkVec,k,HeadStr, lReport); - end; - end; - lReport.Add(''); - lReport.Add('Total Frequencies: %d', [N]); - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - // Get Expected cell values - U := 0.0; // overall mean (mu) of log linear model - for i := 1 to ArraySize do // indexes point to each cell - begin - Expected[i-1] := 1.0; - for j := 1 to NoDims do - begin - k := Indexes[i-1,j-1]; - Expected[i-1] := Expected[i-1] * (Margins[j-1,k-1] / N); - end; - Expected[i-1] := Expected[i-1] * N; - LogM[i-1] := ln(Expected[i-1]); - end; - for i := 1 to ArraySize do U := U + LogM[i-1]; - U := U / ArraySize; - - // print expected values - lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); - lReport.Add(''); - lReport.Add('EXPECTED CELL VALUES FOR MODEL OF COMPLETE INDEPENDENCE'); - lReport.Add(''); - astr := 'Cell'; - for j := 2 to NoDims do astr := astr + ' '; - lReport.Add(astr + 'Observed Expected Log Expected'); - astr := ''; - for j := 1 to NoDims do astr := astr + '--- '; - astr := astr + '---------- ---------- ----------'; - lReport.Add(astr); - for i := 1 to ArraySize do - begin - astr := ''; - for j := 1 to NoDims do astr := astr + format('%3d ',[Indexes[i-1,j-1]]); - astr := astr + format('%10.0f %10.2f %10.3f',[Data[i-1],Expected[i-1],LogM[i-1]]); - lReport.Add(astr); - end; - - // Calculate chi-squared and G squared statistics - chi2 := 0.0; - G2 := 0.0; - for i := 1 to ArraySize do - begin - chi2 := chi2 + Sqr(Data[i-1] - Expected[i-1]) / Expected[i-1]; - G2 := G2 + Data[i-1] * ln(Data[i-1] / Expected[i-1]); - end; - G2 := 2.0 * G2; - DF := 1; - for i := 1 to NoDims do DF := DF * (DimSize[i-1]-1); - ProbChi2 := 1.0 - ChiSquaredProb(chi2,DF); - ProbG2 := 1.0 - ChiSquaredProb(G2,DF); - lReport.Add('Chisquare: %10.3f with probability %10.3f (DF = %d)', [chi2, ProbChi2, DF]); - lReport.Add('G squared: %10.3f with probability %10.3f (DF = %d)', [G2, ProbG2, DF]); - lReport.Add(''); - lReport.Add('U (mu) for general loglinear model: %10.2f', [U]); - - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - // Get log linear model values for each cell - // get M's for each cell - lReport.Add('First Order LogLinear Model Factors and N of Cells in Each'); - astr := 'CELL '; - for i := 1 to NoDims do astr := astr + format(' U%d N Cells ',[i]); - lReport.Add(astr); - lReport.Add(''); - for i := 1 to ArraySize do // cell - begin - astr := ''; - for j := 1 to NoDims do - astr := astr + format('%3d ',[Indexes[i-1,j-1]]); - for j := 1 to NoDims do // jth mu - begin - index := Indexes[i-1,j-1]; // sum for this mu - count := 0; - Mu := 0.0; - for k := 1 to ArraySize do - begin - if index = Indexes[k-1,j-1] then - begin - count := count + 1; - Mu := Mu + LogM[k-1]; - end; - end; - Mu := Mu / count - U; - astr := astr + format('%10.3f %3d ',[Mu,count]); - end; - lReport.Add(astr); - end; - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - // get second order interactions - lReport.Add('Second Order Loglinear Model Terms and N of Cells in Each'); - astr := 'CELL '; - for i := 1 to NoDims-1 do - for j := i + 1 to NoDims do - astr := astr + format('U%d%d N Cells ',[i,j]); - lReport.Add(astr); - lReport.Add(''); - for i := 1 to ArraySize do // cell - begin - astr := ''; - for j := 1 to NoDims do - astr := astr + format('%3d ',[Indexes[i-1,j-1]]); - for j := 1 to NoDims-1 do // jth - begin - index := Indexes[i-1,j-1]; // sum for this mu using j and k - for k := j+1 to NoDims do // with kth - begin - index2 := Indexes[i-1,k-1]; - Mu := 0.0; - count := 0; - for l := 1 to ArraySize do - begin - if ((index = Indexes[l-1,j-1]) and (index2 = Indexes[l-1,k-1])) then - begin - Mu := Mu + LogM[l-1]; - count := count + 1; - end; - end; // next l - Mu := Mu / count - U; - astr := astr + Format('%10.3f %3d', [Mu, count]); - end; // next k (second term subscript) - end; // next j (first term subscript) - lReport.Add(astr); - end; // next i - - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - // get maximum no. of interactions in saturated model - MaxCombos(NoDims, MM, MP); - - SetLength(GSQ,NoDims+1); - SetLength(DGFR,NoDims+1); - SetLength(PART,NoDims+1,MP+1); - SetLength(MARG,NoDims+1,MP+1); - SetLength(DFS,NoDims+1,MP+1); - SetLength(IP,NoDims+1,MP+1); - SetLength(IM,NoDims+1,MM+1); - SetLength(ISET,NoDims+1); - SetLength(JSET,NoDims+1); - SetLength(CONFIG,NoDims+1,MP+1); - SetLength(FIT,ArraySize+1); - SetLength(SIZE,NoDims+1); - SetLength(COORD,NoDims+1); - SetLength(X,ArraySize+1); - SetLength(Y,ArraySize+1); - SetLength(TABLE,ArraySize+1); - SetLength(DIM,NoDims+1); - - // Load TABLE and DIM one up from Data - for i := 1 to ArraySize do Table[i] := Data[i-1]; - for i := 1 to NoDims do DIM[i] := DimSize[i-1]; - - Screen(NoDims,MP,MM,ArraySize,TABLE,DIM, - GSQ,DGFR,PART,MARG,DFS,IP,IM,ISET,JSET,CONFIG,FIT,SIZE, - COORD,X,Y,IFAULT); - - // show results - lReport.Add('SCREEN FOR INTERACTIONS AMONG THE VARIABLES'); - lReport.Add('Adapted from the Fortran program by Lustbader and Stodola printed in'); - lReport.Add('Applied Statistics, Volume 30, Issue 1, 1981, pages 97-105 as Algorithm'); - lReport.Add('AS 160 Partial and Marginal Association in Multidimensional Contingency Tables'); - lReport.Add(''); - lReport.Add('Statistics for tests that the interactions of a given order are zero'); - lReport.Add('ORDER STATISTIC D.F. PROB.'); - lReport.Add('----- ---------- ---- ----------'); - for i := 1 to NoDims do - begin - ProbChi2 := 1.0 - ChiSquaredProb(GSQ[i],DGFR[i]); - lReport.Add('%5d %10.3f %4d %10.3f',[i,GSQ[i],DGFR[i],ProbChi2]); - end; - lReport.Add(''); - lReport.Add('Statistics for Marginal Association Tests'); - lReport.Add('VARIABLE ASSOC. PART ASSOC. MARGINAL ASSOC. D.F. PROB'); - lReport.Add('-------- ------ ----------- --------------- ---- ----------'); - for i := 1 to NoDims-1 do - begin - for j := 1 to MP do - begin - ProbChi2 := 1.0 - ChiSquaredProb(MARG[i,j],DFS[i,j]); - lReport.Add('%6d %5d %10.3f %12.3f %3d %10.3f', - [i,j,Part[i,j],MARG[i,j], DFS[i,j],ProbChi2]); - end; - end; - - DisplayReport(lReport); - - finally - lReport.Free; - TABLE := nil; - DIM := nil; - Y := nil; - X := nil; - COORD := nil; - SIZE := nil; - FIT := nil; - CONFIG := nil; - JSET := nil; - ISET := nil; - IM := nil; - IP := nil; - DFS := nil; - MARG := nil; - PART := nil; - DGFR := nil; - GSQ := nil; - M := nil; - LogM := nil; - Indexes := nil; - Expected := nil; - Margins := nil; - Data := nil; - WorkVec := nil; - GridPos := nil; - Subscripts := nil; - DimSize := nil; - Labels := nil; + for i := 1 to ArraySize do + begin + for j := 1 to NumDims do + begin + category := Indexes[i-1,j-1]; + Margins[j-1,category-1] := Margins[j-1,category-1] + Round(Data[i-1]); + end; end; end; + +procedure TLogLinScreenForm.MaxCombos(NumDims: integer; out MM, MP: integer); +var + combos: integer; + i,j: integer; +begin + MM := 0; + MP := 0; + for i := 1 to NumDims do + begin + combos := 1; + + // get numerator factorial products down to i + for j := NumDims downto i + 1 do + combos := combos * j; + + // divide by factorial of NumDims - i; + for j := (NumDims - i) downto 2 do + combos := combos div j; + + if combos > MP then + MP := combos; + if i * combos > MM then + MM := i * combos; + end; +end; + + procedure TLogLinScreenForm.OutBtnClick(Sender: TObject); var i: integer; @@ -626,6 +901,51 @@ begin UpdateMinMaxGrid; end; + +{ SUBROUTINE RESET(FIT, NTAB, AVG) + + ALGORITHM AS 160.4 APPL. STATIST. (1981) VOL.30, NO.1 + + Initialize the fitted values to the average entry + + REAL FIT(NTAB) +} +procedure TLogLinScreenForm.RESET(var FIT: DblDyneVec; NTAB: Integer; AVG: Double); +var + I: integer; +begin + for I := 1 to NTAB do //DO 100 I = 1, NTAB + begin + FIT[I] := AVG; + end; // 100 CONTINUE +end; + + +procedure TLogLinScreenForm.Reset; +begin + inherited; + CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items); + SelectList.Clear; + UpdateBtnStates; + UpdateMinMaxGrid; +end; + + +{ SUBROUTINE SCREEN(NVAR, MP, MM, NTAB, TABLE, DIM, GSQ, DGFR, + * PART, MARG, DFS, IP, IM, ISET, JSET, CONFIG, FIT, SIZE, + * COORD, X, Y, IFAULT) + + ALGORITHM AS 160 APPL. STATIST. (1981) VOL.30, NO.1 + + Screen all efects for partial and marginal association. + + INTEGER NVAR, MP, MM, NTAB, IP(NVAR,MP), IM(NVAR,MM), DGFR(NVAR), + * DFS(NVAR,MP), ISET(NVAR), JSET(NVAR), CONFIG(NVAR,MP), + * DIM(NVAR), DF, SIZE(NVAR), COORD(NVAR) + REAL GSQ(NVAR), PART(NVAR,MP), MARG(NVAR,MP), TABLE(NTAB), + * FIT(NTAB), X(NTAB), Y(NTAB), ZERO + DATA ZERO /0.0/ +} procedure TLogLinScreenForm.Screen(var NVAR: integer; var MP: integer; var MM: integer; var NTAB: integer; var TABLE: DblDyneVec; var DIM: IntDyneVec; var GSQ: DblDyneVec; var DGFR: IntDyneVec; @@ -634,29 +954,18 @@ procedure TLogLinScreenForm.Screen(var NVAR: integer; var MP: integer; var JSET: IntDyneVec; var CONFIG: IntDyneMat; var FIT: DblDyneVec; var SIZE: IntDyneVec; var COORD: IntDyneVec; var X: DblDyneVec; var Y: DblDyneVec; var IFAULT: integer); -Label 160, 170; -VAR ISZ, MAX, LIM, I, J, NV1, M, M1, ITP, NP, NP1, L3, DF : integer; - ZERO, G21, G22, G23, AVG : double; +Label + 160, 170; +const + ZERO = 0.0; +var + ISZ, MAX, LIM, I, J, NV1, M, M1, ITP, NP, NP1, L3, DF: integer; + G21, G22, G23, AVG: double; begin -// SUBROUTINE SCREEN(NVAR, MP, MM, NTAB, TABLE, DIM, GSQ, DGFR, -// * PART, MARG, DFS, IP, IM, ISET, JSET, CONFIG, FIT, SIZE, -// * COORD, X, Y, IFAULT) -// -// ALGORITHM AS 160 APPL. STATIST. (1981) VOL.30, NO.1 -// -// Screen all efects for partial and marginal association. -// -// INTEGER NVAR, MP, MM, NTAB, IP(NVAR,MP), IM(NVAR,MM), DGFR(NVAR), -// * DFS(NVAR,MP), ISET(NVAR), JSET(NVAR), CONFIG(NVAR,MP), -// * DIM(NVAR), DF, SIZE(NVAR), COORD(NVAR) -// REAL GSQ(NVAR), PART(NVAR,MP), MARG(NVAR,MP), TABLE(NTAB), -// * FIT(NTAB), X(NTAB), Y(NTAB), ZERO -// DATA ZERO /0.0/ // // Check for input errors // - ZERO := 0.0; IFAULT := 1; IF (NVAR <= 1) then exit; ISZ := 1; @@ -775,374 +1084,24 @@ begin end; // 200 CONTINUE end; -procedure TLogLinScreenForm.CONF(var N: integer; var M: integer; - var MP: integer; var MM: integer; var ISET: IntDyneVec; var JSET: IntDyneVec; - var IP: IntDyneMat; var IM: IntDyneMat; var NP: integer); -Label 100, 120; -VAR - ILAST, JLAST : boolean; - I, L, NM, JS : integer; -// SUBROUTINE CONF(N, M, MP, MM, ISET, JSET, IP, IM, NP) -//C -//C ALGORITHM AS 160.1 APPL. STATIST. (1981) VOL.30, NO.1 -//C -//C Set up the arrays IP and IM for a given N and M. Essentially -//C IP contains all possible combinations of (N choose M). For each -//C combination found IM contains all combinations of degree M-1. -//C -// INTEGER ISET(N), JSET(N), IP(N,MP), IM(N,MM) -// LOGICAL ILAST, JLAST -//C +procedure TLogLinScreenForm.SelectListSelectionChange(Sender: TObject; + User: boolean); begin - ILAST := TRUE; - NP := 0; - NM := 0; - // - // Get IP - // - 100: - COMBO(ISET, N, M, ILAST); - IF (ILAST) then exit; - NP := NP + 1; - for I := 1 to M do IP[I,NP] := ISET[I]; - IF (M = 1) then GOTO 100; -// -// Get IM -// - JLAST := TRUE; - L := M - 1; - 120: - COMBO(JSET, M, L, JLAST); - IF (JLAST) then GOTO 100; - NM := NM + 1; - for I := 1 to L do // DO 130 I = 1, L - begin - JS := JSET[I]; - IM[I,NM] := ISET[JS]; - end; // 130 CONTINUE - GOTO 120; + UpdateBtnStates; end; -procedure TLogLinScreenForm.CountVarChkChange(Sender: TObject); -begin - UpdateMinMaxGrid; -end; - -procedure TLogLinScreenForm.COMBO(var ISET: IntDyneVec; N, M: Integer; - var LAST: boolean); -label 100, 110, 130, 150; -VAR - I, K, L : integer; - -// SUBROUTINE COMBO(ISET, N, M, LAST) -// -// ALGORITHM AS 160.2 APPL. STATIST. (1981) VOL.30, NO.1 -// -// Subroutine to generate all possible combinations of M of the -// integers from 1 to N in a stepwise fashion. Prior to the first -// call, LAST should be set to .FALSE. Thereafter, as long as LAST -// is returned .FALSE., a new valid combination has been generated. -// When LAST goes .TRUE., there are no more combinations. -// -// LOGICAL LAST -// INTEGER N, M, ISET(M) -// - -begin - IF (LAST) then GOTO 110; -// -// Get next element to increment -// - K := M; -100: L := ISET[K] + 1; - IF (L + M - K <= N) then GOTO 150; - K := K - 1; -// -// See if we are done -// - IF (K <= 0) then GOTO 130; - GOTO 100; -// -// Initialize first combination -// -110: for I := 1 to M do ISET[I] := I; -130: LAST := NOT LAST; - exit; -// -// Fill in remainder of combination. -// -150: for I := K to M do //DO 160 I = K, M - begin - ISET[I] := L; - L := L + 1; - end; //160 CONTINUE -end; - -procedure TLogLinScreenForm.EVAL(var IAR: IntDyneMat; NC, NV, IBEG, NVAR, - MAX: integer; var CONFIG: IntDyneMat; var DIM: IntDyneVec; var DF: integer); -VAR I, J, K, KK, L : integer; -// SUBROUTINE EVAL(IAR, NC, NV, IBEG, NVAR, MAX, CONFIG, DIM, DF) -// -// ALGORITHM AS 160.3 APPL. STATIST. (1981) VOL.30, NO.1 -// -// IAR = array containing the effects to be fitted -// NC = number of columns of IAR to be used -// NV = number of variables in each effect -// IBEG = gebinning column -// DF = degrees of freedom -// -// CONFIG is in a format compatible with algorithm AS 51 -// -// INTEGER IAR(NVAR,MAX), CONFIG(NVAR,NC), DIM(NVAR), DF -// -begin - DF := 0; - for J := 1 to NC do //DO 110 J = 1, NC - begin - KK := 1; - for I := 1 to NV do //DO 100 I = 1, NV - begin - L := IBEG + J - 1; - K := IAR[I,L]; - KK := KK * (DIM[K] - 1); - CONFIG[I,J] := K; - end; // 100 CONTINUE - CONFIG[NV+1,J] := 0; - DF := DF + KK; - end; // 110 CONTINUE -end; - -procedure TLogLinScreenForm.RESET(var FIT: DblDyneVec; NTAB: Integer; AVG: Double - ); -VAR I : integer; - -begin -// -// SUBROUTINE RESET(FIT, NTAB, AVG) -// -// ALGORITHM AS 160.4 APPL. STATIST. (1981) VOL.30, NO.1 -// -// Initialize the fitted values to the average entry -// -// REAL FIT(NTAB) -// - for I := 1 to NTAB do //DO 100 I = 1, NTAB - begin - FIT[I] := AVG; - end; // 100 CONTINUE -end; - -procedure TLogLinScreenForm.LIKE(var GSQ: Double; var FIT: DblDyneVec; - var TABLE: DblDyneVec; NTAB: integer); -VAR I : integer; - ZERO, TWO : Double; - -begin - ZERO := 0.0; - TWO := 2.0; -// SUBROUTINE LIKE(GSQ, FIT, TABLE, NTAB) -// -// ALGORITHM AS 160.5 APPL. STATIST. (1981) VOL.30, NO.1 -// -// Compute the likelihood-ration chi-square -// -// REAL FIT(NTAB), TABLE(NTAB), ZERO, TWO -// DATA ZERO /0.0/, TWO /2.0/ -// - GSQ := ZERO; - for I := 1 to NTAB do //DO 100 I = 1, NTAB - begin - IF (FIT[I] = ZERO) OR (TABLE[I] = ZERO) then continue; // GO TO 100 - GSQ := GSQ + TABLE[I] * Ln(TABLE[I] / FIT[I]); - end; // 100 CONTINUE - GSQ := TWO * GSQ; -end; - -procedure TLogLinScreenForm.LOGFIT(NVAR, NTAB, NCON: integer; - var DIM: IntDyneVec; var CONFIG: IntDyneMat; var TABLE: DblDyneVec; - var FIT: DblDyneVec; var SIZE: IntDyneVec; var COORD: IntDyneVec; - var X: DblDyneVec; var Y: DblDyneVec); -LABEL 110, 130, 150, 170, 180, 200; -VAR - II, K, KK, L, N, J, I : integer; - OPTION : boolean; - MAXDEV, ZERO, XMAX, E : double; - MAXIT, NV1, ISZ : integer; - -begin -// SUBROUTINE LOGFIT(NVAR, NTAB, NCON, DIM, CONFIG, TABLE, FIT, SIZE, -// * COORD, X, Y) -// -// ALGORITHM AS 160.6 APPL. STATIST. (1981) VOL.30, NO.1 -// -// Iterative proportional fitting of the marginals of a contingency -// table. Relevant code from AS 51 is used. -// -// REAL TABLE(NTAB), FIT(NTAB), MAXDEV, X(NTAB), Y(NTAB), ZERO -// INTEGER CONFIG(NVAR,NCON), DIM(NVAR), SIZE(NVAR), COORD(NVAR) -// LOGICAL OPTION -// DATA MAXDEV /0.25/, MAXIT /25/, ZERO /0.0/ - - MAXDEV := 0.25; - ZERO := 0.0; - MAXIT := 25; - for KK := 1 to MAXIT do //DO 230 KK = 1, MAXIT - begin - // - // XMAX is the maximum deviation between fitted and true marginal - // - XMAX := ZERO; - for II := 1 to NCON do //DO 220 II = 1, NCON - begin - OPTION := TRUE; - // - // Initialize arrays - // - SIZE[1] := 1; - NV1 := NVAR - 1; - for K := 1 to NV1 do //DO 100 K = 1, NV1 - begin - L := CONFIG[K,II]; - IF (L = 0) then GOTO 110; - SIZE[K+1] := SIZE[K] * DIM[L]; - end; // 100 CONTINUE - K := NVAR; - 110: N := K - 1; - ISZ := SIZE[K]; - for J := 1 to ISZ do //DO 120 J = 1, ISZ - begin - X[J] := ZERO; - Y[J] := ZERO; - end; // 120 CONTINUE - // - // Initialize co-ordinates - // - 130: for K := 1 to NVAR do COORD[K] := 0; - // - // Find locations in tables - // - I := 1; - 150: J := 1; - for K := 1 to N do //DO 160 K = 1, N - begin - L := CONFIG[K,II]; - J := J + COORD[L] * SIZE[K]; - end; //160 CONTINUE - IF (NOT OPTION) then GOTO 170; - // - // Compute marginals - // - X[J] := X[J] + TABLE[I]; - Y[J] := Y[J] + FIT[I]; - GOTO 180; - // - // Make adjustments - // - 170: IF (Y[J] <= ZERO) then FIT[I] := ZERO; - IF (Y[J] > ZERO) then FIT[I] := FIT[I] * X[J] / Y[J]; - // - // Update co-ordinates - // - 180: I := I + 1; - for K := 1 to NVAR do //DO 190 K = 1, NVAR - begin - COORD[K] := COORD[K] + 1; - IF (COORD[K] < DIM[K]) then GOTO 150; - COORD[K] := 0; - end; //190 CONTINUE - IF (NOT OPTION) then GOTO 200; - OPTION := FALSE; - GOTO 130; - // - // Find the largest deviation - // - 200: for I := 1 to ISZ do //DO 210 I = 1, ISZ - begin - E := ABS(X[I] - Y[I]); - IF (E > XMAX) then XMAX := E; - end; // 210 CONTINUE - end; // 220 CONTINUE - // - // Test convergence - // - IF (XMAX < MAXDEV) then exit; - end; // 230 CONTINUE -end; - -procedure TLogLinScreenForm.MaxCombos(NumDims: integer; out MM, MP: integer); -var - combos: integer; - i,j: integer; -begin - MM := 0; - MP := 0; - for i := 1 to NumDims do - begin - combos := 1; - - // get numerator factorial products down to i - for j := NumDims downto i + 1 do - combos := combos * j; - - // divide by factorial of NumDims - i; - for j := (NumDims - i) downto 2 do - combos := combos div j; - - if combos > MP then - MP := combos; - if i * combos > MM then - MM := i * combos; - end; -end; - -function TLogLinScreenForm.ArrayPosition(NumDims: integer; - const Data: DblDyneVec; const Subscripts, DimSize: IntDyneVec): integer; -var - Pos : integer; - i, j : integer; - PriorSizes : IntDyneVec; -begin - // allocate space for PriorSizes - SetLength(PriorSizes, NumDims); - - // calculate PriorSizes values - for i := 0 to NumDims - 2 do - PriorSizes[i] := 1; // initialize - - for i := NumDims - 2 downto 0 do - for j := 0 to i do PriorSizes[i] := PriorSizes[i] * DimSize[j]; - - Pos := Subscripts[0] - 1; - for i := 0 to NumDims - 2 do - Pos := Pos + (PriorSizes[i] * (Subscripts[i+1]-1)); - - Result := Pos; - PriorSizes := nil; -end; - -procedure TLogLinScreenForm.Marginals(NumDims, ArraySize: integer; - const Indexes: IntDyneMat; const Data: DblDyneVec; const Margins: IntDyneMat); -var - i, j, category: integer; -begin - for i := 1 to ArraySize do - begin - for j := 1 to NumDims do - begin - category := Indexes[i-1,j-1]; - Margins[j-1,category-1] := Margins[j-1,category-1] + Round(Data[i-1]); - end; - end; -end; procedure TLogLinScreenForm.UpdateBtnStates; begin + inherited; + InBtn.Enabled := AnySelected(VarList); OutBtn.Enabled := AnySelected(SelectList); AllBtn.Enabled := VarList.Items.Count > 0; end; + procedure TLogLinScreenForm.UpdateMinMaxGrid; var NumDims, j: Integer; @@ -1161,13 +1120,41 @@ begin end; end; + +function TLogLinScreenForm.Validate(out AMsg: String; + out AControl: TWinControl): Boolean; +begin + Result := false; + + if SelectList.Count = 0 then + begin + AMsg := 'No variables selected.'; + AControl := VarList; + exit; + end; + + Result := true; +end; + + +procedure TLogLinScreenForm.VarListDblClick(Sender: TObject); +var + index: Integer; +begin + index := VarList.ItemIndex; + if index > -1 then begin + SelectList.Items.Add(VarList.Items[index]); + VarList.Items.Delete(index); + UpdateBtnStates; + end; +end; + + procedure TLogLinScreenForm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; -initialization - {$I loglinscreenunit.lrs} end.