From fac710ba0c9bb21593587faa9de75494e43d7cb5 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 14 May 2020 19:56:00 +0000 Subject: [PATCH] Further refactoring of the item_banking units. Remove the overloads from matrixlib writing reports to OutputFrm. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7456 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../item_banking/itemcodesunit.pas | 1 - .../item_banking/mcitemunit.pas | 1 - .../item_banking/testspecsunit.lfm | 17 + .../item_banking/testspecsunit.pas | 235 ++++++-------- .../item_banking/tfitemunit.pas | 1 - .../measurement_programs/testscoreunit.pas | 119 +++---- .../lazstats/source/units/matrixlib.pas | 296 +++++------------- 7 files changed, 256 insertions(+), 414 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas index 2f3740a1a..00f08a96e 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas @@ -73,7 +73,6 @@ procedure TCodesForm.DisplayBtnClick(Sender: TObject); var currentno: integer; i: integer; - outline: string; lReport: TStrings; begin lReport := TStringList.Create; diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas index 1b0865b99..24752aad7 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas @@ -246,7 +246,6 @@ end; procedure TMCItemForm.CodeBrowseBtnClick(Sender: TObject); var i: integer; - outline: string; nochoices: integer; lReport: TStrings; begin diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm index db583bf6a..412f3329a 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm @@ -186,7 +186,24 @@ object TestSpecsForm: TTestSpecsForm BorderSpacing.Right = 8 BevelOuter = bvNone BorderStyle = bsSingle + ClientHeight = 459 + ClientWidth = 725 TabOrder = 6 + OnPaint = Panel1Paint + object Memo: TMemo + Left = 4 + Height = 451 + Top = 4 + Width = 717 + Align = alClient + BorderSpacing.Around = 4 + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqDraft + ParentFont = False + TabOrder = 0 + end end object SelectItemBtn: TButton AnchorSideLeft.Control = Panel1 diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas index e758fd36b..27f4cc983 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas @@ -14,6 +14,7 @@ type TTestSpecsForm = class(TForm) GroupBox1: TGroupBox; + Memo: TMemo; NoItemsEdit: TEdit; Label8: TLabel; SelectedEdit: TEdit; @@ -42,14 +43,15 @@ type ReturnBtn: TButton; SaveDialog1: TSaveDialog; procedure FormShow(Sender: TObject); + procedure Panel1Paint(Sender: TObject); procedure ReturnBtnClick(Sender: TObject); procedure SelectItemBtnClick(Sender: TObject); procedure SelectChoiceBoxItemClick(Sender: TObject; Index: integer); procedure SkipBtnClick(Sender: TObject); - procedure ShowMCItem(Sender: TObject; index : integer); - procedure ShowTFItem(Sender: TObject; index : integer); - procedure ShowEssayItem(Sender: TObject; index : integer); - procedure ShowMatchItem(Sender: TObject; index : integer); + procedure ShowMCItem(AIndex: integer); + procedure ShowTFItem(AIndex: integer); + procedure ShowEssayItem(AIndex: integer); + procedure ShowMatchItem(AIndex: integer); private { private declarations } public @@ -90,50 +92,70 @@ begin NoItemsEdit.Text := '0'; end; +procedure TTestSpecsForm.Panel1Paint(Sender: TObject); +begin + // +end; + procedure TTestSpecsForm.SelectChoiceBoxItemClick(Sender: TObject; Index: integer); var - nomc, notf, nomatch, noessay, i : integer; - response : string; + //nomc, notf, nomatch, noessay, i : integer; + //response: string; + i, response: Integer; begin - nomc := StrToInt(MCNoEdit.Text); - notf := StrToInt(TFNoEdit.Text); - nomatch := StrToInt(MatchNoEdit.Text); - noessay := StrToInt(EssayNoEdit.Text); + //nomc := StrToInt(MCNoEdit.Text); + //notf := StrToInt(TFNoEdit.Text); + //nomatch := StrToInt(MatchNoEdit.Text); + //noessay := StrToInt(EssayNoEdit.Text); case Index of 0 : begin // Select multiple choice items SelectedEdit.Text := 'MC'; - for i := 1 to nomc do + for i := 1 to StrToInt(MCNoEdit.Text) do begin - ShowMCItem(self,i); - response := InputBox('Add item to test','Add?','Y'); - if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + ShowMCItem(i); + response := MessageDlg('Add item to test?', mtConfirmation, [mbYes, mbNo], 0); + if response = mrYes then SelectItemBtnClick(self) else SkipBtnClick(self); + //response := InputBox('Add item to test','Add?','Y'); + //if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); end; end; 1 : begin // Select true or false items SelectedEdit.Text := 'TF'; - for i := 1 to notf do + for i := 1 to StrToInt(TFNoEdit.Text) do begin - ShowTFItem(self,i); + ShowTFItem(i); + response := MessageDlg('Add item to test?', mtConfirmation, [mbYes, mbNo], 0); + if response = mrYes then SelectItemBtnclick(self) else SkipBtnClick(self); + { response := InputBox('Add item to test','Add?','Y'); if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + } end; end; 2 : begin // Select Essay items SelectedEdit.Text := 'Essay'; - for i := 1 to noessay do + for i := 1 to StrToInt(EssayNoEdit.Text) do begin - ShowEssayItem(self,i); + ShowEssayItem(i); + response := MessageDlg('Add item to test?', mtConfirmation, [mbYes, mbNo], 0); + if response = mrYes then selectItemBtnClick(self) else SkipBtnClick(self); + { response := InputBox('Add item to test','Add?','Y'); if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + } end; end; 3 : begin // Select matching items SelectedEdit.Text := 'Matching'; - for i := 1 to nomc do + for i := 1 to StrToInt(MatchNoEdit.Text) do // was: "nomc", should probably be "nomatch" begin - ShowMatchItem(self,i); + ShowMatchItem(i); + response := MessageDlg('Add item to test?', mtConfirmation, [mbYes, mbNo], 0); + if response = mrYes then SelectItemBtnClick(self) else SkipBtnClick(self); + { response := InputBox('Add item to test','Add?','Y'); if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + } end; end; end; @@ -144,159 +166,90 @@ begin ShowMessage('Item skipped'); end; -// ToDoo: This must be moved to OnPaint handler. -procedure TTestSpecsForm.ShowMCItem(Sender: TObject; index : integer); +procedure TTestSpecsForm.ShowMCItem(AIndex : integer); var - outline: string; nochoices: integer; - space: integer; begin - Panel1.Canvas.Clear; - space := Panel1.Canvas.Height div 9; - ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].itemnumber); - MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].MajorCode); - MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].MinorCode); + ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[AIndex].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[AIndex].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[AIndex].MinorCode); - outline := ItemBankFrm.MCItemInfo[index].ItemStem; - Panel1.Canvas.TextOut(1, space, outline); + Memo.Lines.Clear; + Memo.Lines.Add(ItemBankFrm.MCItemInfo[AIndex].ItemStem); - nochoices := ItemBankFrm.MCItemInfo[index].NoChoices ; + nochoices := ItemBankFrm.MCItemInfo[AIndex].NoChoices ; if nochoices > 0 then - begin - outline := Format('Choice A %s', [ItemBankFrm.MCItemInfo[index].ChoiceOne]); - Panel1.Canvas.TextOut(1, space*2, outline); - end; - + Memo.Lines.Add(Format('Choice A %s', [ItemBankFrm.MCItemInfo[AIndex].ChoiceOne])); if nochoices > 1 then - begin - outline := Format('Choice B %s', [ItemBankFrm.MCItemInfo[index].ChoiceTwo]); - Panel1.Canvas.TextOut(1, space*3, outline); - end; - + Memo.Lines.Add(Format('Choice B %s', [ItemBankFrm.MCItemInfo[AIndex].ChoiceTwo])); if nochoices > 2 then - begin - outline := Format('Choice C %s', [ItemBankFrm.MCItemInfo[index].ChoiceThree]); - Panel1.Canvas.TextOut(1, space*4, outline); - end; - + Memo.Lines.Add(Format('Choice C %s', [ItemBankFrm.MCItemInfo[AIndex].ChoiceThree])); if nochoices > 3 then - begin - outline := Format('Choice D %s', [ItemBankFrm.MCItemInfo[index].ChoiceFour]); - Panel1.Canvas.TextOut(1, space*5, outline); - end; - + Memo.Lines.Add(Format('Choice D %s', [ItemBankFrm.MCItemInfo[AIndex].ChoiceFour])); if nochoices > 4 then - begin - outline := Format('Choice E %s', [ItemBankFrm.MCItemInfo[index].ChoiceFive]); - Panel1.Canvas.TextOut(1, space*6, outline); - end; - - outline := Format('Correct Choice %s', [ItemBankFrm.MCItemInfo[index].CorrectChoice]); - Panel1.Canvas.TextOut(1, space*7, outline); - - outline := Format('Graphic Image %s', [ItemBankFrm.MCItemInfo[index].PicName]); - Panel1.Canvas.TextOut(1, space*8, outline); + Memo.Lines.Add(Format('Choice E %s', [ItemBankFrm.MCItemInfo[AIndex].ChoiceFive])); + Memo.Lines.Add(Format('Correct Choice %s', [ItemBankFrm.MCItemInfo[AIndex].CorrectChoice])); + Memo.Lines.Add(Format('Graphic Image %s', [ItemBankFrm.MCItemInfo[AIndex].PicName])); end; -// ToDoo: This must be moved to OnPaint handler. -procedure TTestSpecsForm.ShowTFItem(Sender: TObject; index : integer); -var - outline: string; - space: integer; +procedure TTestSpecsForm.ShowTFItem(AIndex : integer); begin - Panel1.Canvas.Clear; - space := Panel1.Canvas.Height div 9; - ItemNoEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].itemnumber); - MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].MajorCode); - MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].MinorCode); - Panel1.Canvas.TextOut(1,space,ItemBankFrm.TFItemInfo[index].ItemStem); - Panel1.Canvas.TextOut(1,space*2,ItemBankFrm.TFItemInfo[index].CorrectChoice); - Panel1.Canvas.TextOut(1,space*3,ItemBankFrm.TFItemInfo[index].PicName); + ItemNoEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[AIndex].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[AIndex].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[AIndex].MinorCode); + + Memo.Lines.Clear; + Memo.Lines.Add(ItemBankFrm.TFItemInfo[AIndex].ItemStem); + Memo.Lines.Add(ItemBankFrm.TFItemInfo[AIndex].CorrectChoice); + Memo.Lines.Add(ItemBankFrm.TFItemInfo[AIndex].PicName); end; -// ToDo: This must be moved to OnPaint handler -procedure TTestSpecsForm.ShowEssayItem(Sender: TObject; index : integer); -var - outline: string; - space: integer; +procedure TTestSpecsForm.ShowEssayItem(AIndex : integer); begin - Panel1.Canvas.Clear; - space := Panel1.Canvas.Height div 9; - ItemNoEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].itemnumber); - MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].MajorCode); - MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].MinorCode); - Panel1.Canvas.TextOut(1, space, ItemBankFrm.EssayInfo[index].ItemStem); - Panel1.Canvas.TextOut(1, space*2, ItemBankFrm.EssayInfo[index].Answer); - Panel1.Canvas.TextOut(1, space*3, ItemBankFrm.EssayInfo[index].PicName); + ItemNoEdit.Text := IntToStr(ItemBankFrm.EssayInfo[AIndex].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[AIndex].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[AIndex].MinorCode); + + Memo.Lines.Clear; + Memo.Lines.Add(ItemBankFrm.EssayInfo[Aindex].ItemStem); + Memo.Lines.Add(ItemBankFrm.EssayInfo[AIndex].Answer); + Memo.Lines.Add(ItemBankFrm.EssayInfo[AIndex].PicName); end; -// ToDo: This must be moved to OnPaint handler -procedure TTestSpecsForm.ShowMatchItem(Sender: TObject; index : integer); +procedure TTestSpecsForm.ShowMatchItem(AIndex : integer); var - outline: string; - space: integer; noleft, noright: integer; begin - Panel1.Canvas.Clear; - noleft := ItemBankFrm.MatchInfo[index].NLeft; - noright := ItemBankFrm.MatchInfo[index].NRight; - space := Panel1.Canvas.Height div 13; - ItemNoEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].itemnumber); - MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].MajorCode); - MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].MinorCode); + noleft := ItemBankFrm.MatchInfo[AIndex].NLeft; + noright := ItemBankFrm.MatchInfo[AIndex].NRight; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MatchInfo[AIndex].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[AIndex].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[AIndex].MinorCode); + // do left and right stems + Memo.Lines.Clear; if noleft > 0 then - begin - outline := Format('Left Item 1 %s', [ItemBankFrm.MatchInfo[index].Left1]); - Panel1.Canvas.TextOut(1, space, outline); - end; + Memo.Lines.Add(Format('Left Item 1 %s', [ItemBankFrm.MatchInfo[AIndex].Left1])); if noright > 0 then - begin - outline := Format(' Right Item 1 %s', [ItemBankFrm.MatchInfo[index].Right1]); - Panel1.Canvas.TextOut(1, space*2, outline); - end; + Memo.Lines.Add(Format(' Right Item 1 %s', [ItemBankFrm.MatchInfo[AIndex].Right1])); if noleft > 1 then - begin - outline := Format('Left Item 2 %s', [ItemBankFrm.MatchInfo[index].Left2]); - Panel1.Canvas.TextOut(1, space*3, outline); - end; + Memo.Lines.Add(Format('Left Item 2 %s', [ItemBankFrm.MatchInfo[AIndex].Left2])); if noright > 1 then - begin - outline := Format(' Right Item 2 %s', [ItemBankFrm.MatchInfo[index].Right2]); - Panel1.Canvas.TextOut(1, space*4, outline); - end; + Memo.Lines.Add(Format(' Right Item 2 %s', [ItemBankFrm.MatchInfo[AIndex].Right2])); if noleft > 2 then - begin - outline := Format('Left Item 3 %s', [ItemBankFrm.MatchInfo[index].Left3]); - Panel1.Canvas.TextOut(1, space*5, outline); - end; + Memo.Lines.Add(Format('Left Item 3 %s', [ItemBankFrm.MatchInfo[AIndex].Left3])); if noright > 2 then - begin - outline := Format(' Right Item 3 %s', [ItemBankFrm.MatchInfo[index].Right3]); - Panel1.Canvas.TextOut(1, space*6, outline); - end; + Memo.Lines.Add(Format(' Right Item 3 %s', [ItemBankFrm.MatchInfo[AIndex].Right3])); if noleft > 3 then - begin - outline := Format('Left Item 4 %s', [ItemBankFrm.MatchInfo[index].Left4]); - Panel1.Canvas.TextOut(1, space*7, outline); - end; + Memo.Lines.Add(Format('Left Item 4 %s', [ItemBankFrm.MatchInfo[AIndex].Left4])); if noright > 3 then - begin - outline := Format(' Right Item 4 %s', [ItemBankFrm.MatchInfo[index].Right4]); - Panel1.Canvas.TextOut(1, space*8, outline); - end; + Memo.Lines.Add(Format(' Right Item 4 %s', [ItemBankFrm.MatchInfo[AIndex].Right4])); if noleft > 4 then - begin - outline := Format('Left Item 5 %s', [ItemBankFrm.MatchInfo[index].Left5]); - Panel1.Canvas.TextOut(1, space*9, outline); - end; + Memo.Lines.Add(Format('Left Item 5 %s', [ItemBankFrm.MatchInfo[AIndex].Left5])); if noright > 4 then - begin - outline := Format(' Right Item 5 %s', [ItemBankFrm.MatchInfo[index].Right5]); - Panel1.Canvas.TextOut(1, space*10, outline); - end; - Panel1.Canvas.TextOut(1, space*11, ItemBankFrm.MatchInfo[index].CorrectChoice); - Panel1.Canvas.TextOut(1, space*12, ItemBankFrm.MatchInfo[index].PicName); + Memo.Lines.Add(Format(' Right Item 5 %s', [ItemBankFrm.MatchInfo[AIndex].Right5])); + Memo.Lines.Add(ItemBankFrm.MatchInfo[AIndex].CorrectChoice); + Memo.Lines.Add(ItemBankFrm.MatchInfo[AIndex].PicName); end; initialization diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas index f33f972a7..29ef0e03b 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas @@ -143,7 +143,6 @@ end; procedure TTFItemForm.CodeBrowseBtnClick(Sender: TObject); var i: integer; - outline: string; lReport: TStrings; begin lReport := TStringList.Create; diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas index f163381ea..f7fc99e93 100644 --- a/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas +++ b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas @@ -84,32 +84,33 @@ type procedure ResetBtnClick(Sender: TObject); procedure ResponseScrollChange(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; User: boolean); + private { private declarations } - FAutoSized: Boolean; - NoItems : integer; - NoSelected : integer; - NCases : integer; // count of good records (not counting key if included) - ColNoSelected : IntDyneVec; - ColLabels, RowLabels : StrDyneVec; - Responses: array[1..5] of StrDyneVec; - RespWghts: array[1..5] of DblDyneVec; - Means, Variances, StdDevs : DblDyneVec; - CorMat : DblDyneMat; // correlations among items and total score - Data : DblDyneMat; //store item scores and total score - IDCol, FNameCol, LNameCol : integer; - MaxRespNo: integer; - procedure ItemScores; - procedure ScoreReport(AReport: TStrings); - procedure Alpha(AReport: TStrings); - procedure Cors(AReport: TStrings); - procedure SimMR(AReport: TStrings); - procedure Hoyt(AReport: TStrings); - procedure StepKR(AReport: TStrings); - procedure PlotScores; - procedure PlotMeans; + FAutoSized: Boolean; + NoItems : integer; + NoSelected : integer; + NCases : integer; // count of good records (not counting key if included) + ColNoSelected : IntDyneVec; + ColLabels, RowLabels : StrDyneVec; + Responses: array[1..5] of StrDyneVec; + RespWghts: array[1..5] of DblDyneVec; + Means, Variances, StdDevs : DblDyneVec; + CorMat : DblDyneMat; // correlations among items and total score + Data : DblDyneMat; //store item scores and total score + IDCol, FNameCol, LNameCol : integer; + MaxRespNo: integer; + procedure ItemScores; + procedure ScoreReport(AReport: TStrings); + procedure Alpha(AReport: TStrings); + procedure Cors(AReport: TStrings); + procedure SimMR(AReport: TStrings); + procedure Hoyt(AReport: TStrings); + procedure StepKR(AReport: TStrings); + procedure PlotScores; + procedure PlotMeans; - procedure UpdateBtnStates; + procedure UpdateBtnStates; public { public declarations } @@ -194,21 +195,25 @@ end; procedure TTestScoreFrm.ResponseScrollChange(Sender: TObject); var - item, respno : integer; + item, respno: integer; begin - item := StrToInt(ItemNoEdit.Text); - if item <= 0 then exit; - respno := StrToInt(RespNoEdit.Text); - if respno > 5 then exit; // already at max - if respno > MaxRespNo then MaxRespNo := respno; - // save current response - Responses[respno][item-1] := ResponseEdit.Text; - RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); - // display new position response - respno := ResponseScroll.Position; - RespNoEdit.Text := IntToStr(respno); - ResponseEdit.Text := Responses[respno][item-1]; - ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); + item := StrToInt(ItemNoEdit.Text); + if item <= 0 then exit; + + respno := StrToInt(RespNoEdit.Text); + if respno > 5 then exit; // already at max + + if respno > MaxRespNo then MaxRespNo := respno; + + // save current response + Responses[respno][item-1] := ResponseEdit.Text; + RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); + + // display new position response + respno := ResponseScroll.Position; + RespNoEdit.Text := IntToStr(respno); + ResponseEdit.Text := Responses[respno][item-1]; + ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); end; procedure TTestScoreFrm.FormActivate(Sender: TObject); @@ -278,26 +283,28 @@ end; procedure TTestScoreFrm.ItemScrollChange(Sender: TObject); var - item, respno : integer; + item, respno: integer; begin - item := StrToInt(ItemNoEdit.Text); - respno := StrToInt(RespNoEdit.Text); - if respno > MaxRespNo then MaxRespNo := respno; - // save last one - if (item <> ItemScroll.Position) then - begin - Responses[respno][item-1] := ResponseEdit.Text; - RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); - end; - item := ItemScroll.Position; - ItemNoEdit.Text := IntToStr(item); - respno := 1; - ResponseScroll.Position := 1; // first response - RespNoEdit.Text := '1'; // default - ScoreEdit.Text := '1'; // default - // load previous one - ResponseEdit.Text := Responses[respno][item-1]; - ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); + item := StrToInt(ItemNoEdit.Text); + respno := StrToInt(RespNoEdit.Text); + if respno > MaxRespNo then MaxRespNo := respno; + + // save last one + if (item <> ItemScroll.Position) then + begin + Responses[respno][item-1] := ResponseEdit.Text; + RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); + end; + item := ItemScroll.Position; + ItemNoEdit.Text := IntToStr(item); + respno := 1; + ResponseScroll.Position := 1; // first response + RespNoEdit.Text := '1'; // default + ScoreEdit.Text := '1'; // default + + // load previous one + ResponseEdit.Text := Responses[respno][item-1]; + ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); end; procedure TTestScoreFrm.LastInBtnClick(Sender: TObject); diff --git a/applications/lazstats/source/units/matrixlib.pas b/applications/lazstats/source/units/matrixlib.pas index fb547732c..2f37a9e01 100644 --- a/applications/lazstats/source/units/matrixlib.pas +++ b/applications/lazstats/source/units/matrixlib.pas @@ -5,8 +5,8 @@ unit MatrixLib; interface uses - Classes, SysUtils, Globals, DictionaryUnit, OutputUnit, Dialogs, - FunctionsLib, DataProcs, MainUnit; + Classes, SysUtils, Dialogs, + Globals, DictionaryUnit, FunctionsLib, DataProcs, MainUnit; procedure GridDotProd(col1, col2: integer; out Product: double; var Ngood: integer); @@ -16,23 +16,13 @@ procedure GridXProd(NoSelected : integer; Augment : boolean; VAR Ngood : integer); -procedure GridCovar(NoSelected : integer; - {VAR} Selected : IntDyneVec; - {VAR} Covar : DblDyneMat; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - VAR errorcode : boolean; - VAR Ngood : integer); +procedure GridCovar(NoSelected: integer; const Selected: IntDyneVec; + const Covar: DblDyneMat; const Means, Variances, StdDevs: DblDyneVec; + var ErrorCode: boolean; var NGood: Integer); -procedure Correlations(NoSelected : integer; - {VAR} Selected : IntDyneVec; - {VAR} Correlations : DblDyneMat; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - VAR errorcode : boolean; - VAR Ngood : integer); +procedure Correlations(NoSelected: integer; const Selected: IntDyneVec; + const Correlations: DblDyneMat; const Means, Variances, StdDevs: DblDyneVec; + var ErrorCode: boolean; var NGood: integer); procedure MatAxB(const A, B, C: DblDyneMat; BRows, BCols, CRows, CCols: Integer; out ErrorCode: boolean); @@ -56,25 +46,6 @@ procedure EffectCode(GridCol, min, max : integer; VAR startcol : integer; VAR endcol : integer; VAR novectors : integer); - -procedure MReg(NoIndep : integer; - {VAR} IndepCols : IntDyneVec; - DepCol : integer; - {VAR} RowLabels : StrDyneVec; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - {VAR} BWeights : DblDyneVec; - {VAR} BetaWeights : DblDyneVec; - {VAR} BStdErrs : DblDyneVec; - {VAR} Bttests : DblDyneVec; - {VAR} tProbs : DblDyneVec; - VAR R2 : double; - VAR stderrest : double; - VAR NCases : integer; - VAR errorcode : boolean; - PrintAll : boolean); - procedure MReg(NoIndep: integer; const IndepCols: IntDyneVec; DepCol: integer; const RowLabels: StrDyneVec; const Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tProbs: DblDyneVec; @@ -131,18 +102,9 @@ procedure MReg2(NCases : integer; procedure MatSub(const a, b, c: DblDyneMat; brows, bcols, crows, ccols: integer; out errorcode: boolean); -procedure IntArrayPrint(mat : IntDyneMat; - rows, cols : integer; - ytitle : string; - RowLabels, ColLabels : StrDyneVec; - Title : string; - AReport: TStrings); - -procedure IntArrayPrint(mat : IntDyneMat; - rows, cols : integer; - ytitle : string; - RowLabels, ColLabels : StrDyneVec; - Title : string); +procedure IntArrayPrint(const mat: IntDyneMat; rows, cols: integer; + const YTitle: string; const RowLabels, ColLabels: StrDyneVec; + const Title: string; AReport: TStrings); procedure eigens(VAR a: DblDyneMat; Var d : DblDyneVec; n : integer); @@ -160,24 +122,18 @@ function SEVS(nv,nf : integer; function SCPF(VAR x,y : DblDyneMat; kx,ky,n,nd : integer) : double; -procedure Mat_Print(var xmat: DblDyneMat; Rows,Cols: Integer; var Title: String; - var RowLabels, ColLabels: StrDyneVec; NCases: Integer); procedure MatPrint(const xmat: DblDyneMat; Rows,Cols: Integer; const Title: String; const RowLabels, ColLabels: StrDyneVec; NCases: Integer; AReport: TStrings); -procedure DynVectorPrint(var AVector: DblDyneVec; NoVars: integer; - Title: string; var Labels: StrDyneVec; NCases: integer); overload; procedure DynVectorPrint(const AVector: DblDyneVec; NoVars: integer; - Title: string; const Labels: StrDyneVec; NCases: integer; AReport: TStrings); overload; + Title: string; const Labels: StrDyneVec; NCases: integer; AReport: TStrings); -procedure scatplot(const x, y: DblDyneVec; NoCases: integer; +procedure ScatPlot(const x, y: DblDyneVec; NoCases: integer; const TitleStr, x_axis, y_axis: string; x_min, x_max, y_min, y_max: double; const VarLabels: StrDyneVec; AReport: TStrings); procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; - RowLabels, ColLabels: StrDyneVec; Title: string); overload; -procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; - RowLabels, ColLabels: StrDyneVec; Title: string; AReport: TStrings); overload; + RowLabels, ColLabels: StrDyneVec; Title: string; AReport: TStrings); procedure SymMatRoots(A : DblDyneMat; M : integer; VAR E : DblDyneVec; VAR V : DblDyneMat); procedure matinv(a, vtimesw, v, w: DblDyneMat; n: integer); @@ -292,35 +248,30 @@ begin end; //------------------------------------------------------------------- -procedure GridCovar(NoSelected : integer; - {VAR} Selected : IntDyneVec; - {VAR} Covar : DblDyneMat; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - VAR errorcode : boolean; - VAR Ngood : integer); -// Obtains the variance/covariance matrix of variables in the grid -// NoSelected is the number of variables selected from the grid -// Selected is a vector of integers for the grid columns of selected variables -// Covar is the variance/covariance matrix returned -// Means, StdDevs, Variances are double vectors obtained from the augmented matrix -// errorcode is true if an error occurs due to 0 variance -// Ngood is the number of records in the cross-product of vectors -// This procedure calls the GridXProd procedure with augmentation true -// in order to obtain the means, variances and standard deviations +{ Obtains the variance/covariance matrix of variables in the grid + NoSelected is the number of variables selected from the grid + Selected is a vector of integers for the grid columns of selected variables + Covar is the variance/covariance matrix returned + Means, StdDevs, Variances are double vectors obtained from the augmented matrix + errorcode is true if an error occurs due to 0 variance + Ngood is the number of records in the cross-product of vectors + This procedure calls the GridXProd procedure with augmentation true + in order to obtain the means, variances and standard deviations } +procedure GridCovar(NoSelected: integer; const Selected: IntDyneVec; + const Covar: DblDyneMat; const Means, Variances, StdDevs: DblDyneVec; + var errorcode: boolean; var NGood: integer); var i, j: integer; N: double; Augment: boolean; begin // initialize - errorcode := false; - for i := 1 to NoSelected do + ErrorCode := false; + for i := 0 to NoSelected-1 do begin - Means[i-1] := 0.0; - Variances[i-1] := 0.0; - StdDevs[i-1] := 0.0; + Means[i] := 0.0; + Variances[i] := 0.0; + StdDevs[i] := 0.0; end; Augment := true; // augment to get intercept, means, variances, std.devs. @@ -333,68 +284,61 @@ begin // Sums of squares are in diagonal, cross-products in off-diagonal cells // Sums of X's are in the augmented column // Get means and standard deviations first - for i := 1 to NoSelected do + for i := 0 to NoSelected-1 do begin - Means[i-1] := Covar[i-1,NoSelected] / N; - Variances[i-1] := Covar[i-1,i-1] - (Sqr(Covar[i-1,NoSelected]) / N); - Variances[i-1] := Variances[i-1] / (N - 1.0); - if Variances[i-1] > 0.0 then - StdDevs[i-1] := sqrt(Variances[i-1]) + Means[i] := Covar[i, NoSelected] / N; + Variances[i] := Covar[i, i] - (Sqr(Covar[i, NoSelected]) / N); + Variances[i] := Variances[i] / (N - 1.0); + if Variances[i] > 0.0 then + StdDevs[i] := sqrt(Variances[i]) else begin - StdDevs[i-1] := 0.0; - errorcode := true; + StdDevs[i] := 0.0; + ErrorCode := true; end; end; // Now get covariances - for i := 1 to NoSelected do + for i := 0 to NoSelected-1 do begin - for j := 1 to NoSelected do + for j := 0 to NoSelected-1 do begin - Covar[i-1,j-1] := Covar[i-1,j-1] - ((Covar[i-1,NoSelected] * Covar[j-1,NoSelected]) / N); - Covar[i-1,j-1] := Covar[i-1,j-1] / (N - 1); + Covar[i, j] := Covar[i, j] - ((Covar[i, NoSelected] * Covar[j, NoSelected]) / N); + Covar[i, j] := Covar[i, j] / (N - 1); end; end; end; //------------------------------------------------------------------- -procedure Correlations(NoSelected : integer; - {VAR} Selected : IntDyneVec; - {VAR} Correlations : DblDyneMat; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - VAR errorcode : boolean; - VAR Ngood : integer); -// Obtains the correlation matrix among grid variables -// NoSelected is the no. of grid variables selected for analysis -// Selected is a vector of integers of the grid variable columns selected -// Correlations are returned in the Correlations matrix -// Means, Variances, StdDevs are returned as double vectors -// errorcode is true if a 0 variance is detected -// Ngood is the number cases that do not contain missing values or are filtered -// This procedure calls the GridCovar procedure +{ Obtains the correlation matrix among grid variables + NoSelected is the no. of grid variables selected for analysis + Selected is a vector of integers of the grid variable columns selected + Correlations are returned in the Correlations matrix + Means, Variances, StdDevs are returned as double vectors + errorcode is true if a 0 variance is detected + Ngood is the number cases that do not contain missing values or are filtered + This procedure calls the GridCovar procedure } +procedure Correlations(NoSelected: integer; const Selected: IntDyneVec; + const Correlations: DblDyneMat; const Means, Variances, StdDevs: DblDyneVec; + var ErrorCode: boolean; var NGood: integer); var - i, j : integer; - + i, j: integer; begin - // get covariance matrix, means and standard deviations - GridCovar(NoSelected,Selected,Correlations,Means,Variances,StdDevs,errorcode, Ngood); - for i := 1 to NoSelected do - begin - for j := 1 to NoSelected do - begin - if (StdDevs[i-1] > 0.0) and (StdDevs[j-1] > 0.0) then - Correlations[i-1,j-1] := Correlations[i-1,j-1] / - (StdDevs[i-1] * StdDevs[j-1]) - else - begin - Correlations[i-1,j-1] := 0.0; - errorcode := true; - end; - end; - end; + // get covariance matrix, means and standard deviations + GridCovar(NoSelected, Selected, Correlations, Means, Variances, StdDevs, ErrorCode, Ngood); + for i := 0 to NoSelected-1 do + begin + for j := 0 to NoSelected-1 do + begin + if (StdDevs[i] > 0.0) and (StdDevs[j] > 0.0) then + Correlations[i, j] := Correlations[i, j] / (StdDevs[i] * StdDevs[j]) + else + begin + Correlations[i, j] := 0.0; + ErrorCode := true; + end; + end; + end; end; //------------------------------------------------------------------- @@ -595,21 +539,21 @@ BEGIN end; //------------------------------------------------------------------- -procedure DETERM(const a: DblDyneMat; Rows, Cols: integer; out determ: double; - out errorcode: boolean); +procedure Determ(const a: DblDyneMat; Rows, Cols: integer; out determ: double; + out ErrorCode: boolean); var indx: IntDyneVec; i: integer; begin SetLength(indx,rows); - errorcode := false; + ErrorCode := false; if (rows <> cols) then - errorcode := true + ErrorCode := true else begin LUDCMP(a, rows, indx, determ); - for i := 1 to rows do - determ := determ * a[i-1,i-1]; + for i := 0 to rows-1 do + determ := determ * a[i, i]; end; end; { of determ } //------------------------------------------------------------------- @@ -671,30 +615,6 @@ begin OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); coef := nil; end; -//------------------------------------------------------------------- - -procedure MReg(NoIndep : integer; - {VAR} IndepCols : IntDyneVec; - DepCol : integer; - {VAR} RowLabels : StrDyneVec; - {VAR} Means : DblDyneVec; - {VAR} Variances : DblDyneVec; - {VAR} StdDevs : DblDyneVec; - {VAR} BWeights : DblDyneVec; - {VAR} BetaWeights : DblDyneVec; - {VAR} BStdErrs : DblDyneVec; - {VAR} Bttests : DblDyneVec; - {VAR} tProbs : DblDyneVec; - VAR R2 : double; - VAR stderrest : double; - VAR NCases : integer; - VAR errorcode : boolean; - PrintAll : boolean); -begin - MReg(NoIndep, IndepCols, Depcol, RowLabels,means, Variances, StdDevs, - BWeights, BetaWeights, BStdErrs, BtTests, tProbs, R2, StdErrEst, NCases, - ErrorCode, PrintAll, OutputFrm.RichEdit.Lines); -end; procedure MReg(NoIndep: integer; const IndepCols: IntDyneVec; DepCol: integer; const RowLabels: StrDyneVec; @@ -788,7 +708,6 @@ begin AReport.Add('Variance Y: %10.3f', [VarY]); AReport.Add('SSY: %10.3f', [SSY]); AReport.Add('SDY: %10.3f', [SDY]); - // OutputFrm.ShowModal ; // augment the matrix for i := 1 to NCases do @@ -829,9 +748,6 @@ begin DynVectorPrint(Means, NoIndep+1, 'MEANS', RowLabels, NCases, AReport); DynVectorPrint(Variances, NoIndep+1,'VARIANCES',RowLabels, NCases, AReport); DynVectorPrint(StdDevs, NoIndep+1, 'STD. DEV.S', RowLabels, NCases, AReport); - - //OutputFrm.ShowModal; - //OutPutFrm.RichEdit.Clear; end; // get product of the augmented X transpose matrix times the Y vector @@ -1302,7 +1218,6 @@ var outcount : integer; varsout : IntDyneVec; begin - Assert(OutputFrm <> nil); Assert(AReport <> nil); SetLength(IndRowLabels,NoVars); @@ -1484,24 +1399,10 @@ begin a[i,j] := b[i,j] - c[i,j]; end; end; { of matsub } -//--------------------------------------------------------------------------- -procedure IntArrayPrint(mat : IntDyneMat; - rows, cols : integer; - ytitle : string; - RowLabels, ColLabels : StrDyneVec; - Title : string); -begin - Assert(OutputFrm <> nil); - IntArrayPrint(mat, rows, cols, ytitle, RowLabels, ColLabels, Title, OutputFrm.RichEdit.Lines); -end; - -procedure IntArrayPrint(Mat: IntDyneMat; - Rows, Cols: integer; - YTitle: string; - RowLabels, ColLabels: StrDyneVec; - Title: string; - AReport: TStrings); +procedure IntArrayPrint(const Mat: IntDyneMat; Rows, Cols: integer; + const YTitle: string; const RowLabels, ColLabels: StrDyneVec; + const Title: string; AReport: TStrings); var i, j, first, last, nflds: integer; done : boolean; @@ -1516,7 +1417,6 @@ begin while not done do begin -// AReport.Add(''); AReport.Add(' ' + ytitle);; AReport.Add('Variables'); @@ -1542,7 +1442,6 @@ begin first := last + 1; end; AReport.Add(''); -// AReport.Add(''); end; //--------------------------------------------------------------------------- @@ -1810,13 +1709,6 @@ begin end; scpf := scp; end; { of SCPF } -//------------------------------------------------------------------- - -procedure Mat_Print(var xmat: DblDyneMat; Rows, Cols: Integer; var Title: String; - var RowLabels, ColLabels: StrDyneVec; NCases: integer); -begin - MatPrint(xmat, Rows, Cols, Title, RowLabels, ColLabels, NCases, OutputFrm.RichEdit.Lines); -end; procedure MatPrint(const xmat: DblDyneMat; Rows, Cols: integer; const Title: string; const RowLabels, ColLabels: StrDyneVec; NCases: integer; AReport: TStrings); @@ -1861,25 +1753,10 @@ begin first := last + 1; end; AReport.Add(''); -// AReport.Add(''); -end; -//-------------------------------------------------------------------- - -procedure DynVectorPrint(var AVector: DblDyneVec; - NoVars: integer; - Title: string; - var Labels: StrDyneVec; - NCases: integer); -begin - DynVectorPrint(AVector, NoVars, Title, Labels, NCases, OutputFrm.RichEdit.Lines); end; -procedure DynVectorPrint(const AVector: DblDyneVec; - NoVars: integer; - Title: string; - const Labels: StrDyneVec; - NCases: integer; - AReport: TStrings); +procedure DynVectorPrint(const AVector: DblDyneVec; NoVars: integer; + Title: string; const Labels: StrDyneVec; NCases: integer; AReport: TStrings); var i, j, first, last, nflds: integer; done: boolean; @@ -1922,7 +1799,7 @@ begin end; //-------------------------------------------------------------------------- -procedure scatplot(const x, y: DblDyneVec; NoCases: integer; +procedure ScatPlot(const x, y: DblDyneVec; NoCases: integer; const TitleStr, x_axis, y_axis: string; x_min, x_max, y_min, y_max: double; const VarLabels: StrDyneVec; AReport: TStrings); var @@ -1937,8 +1814,6 @@ var outline : string; Labels : StrDyneVec; begin - Assert(OutputFrm <> nil); - SetLength(Labels,NoVariables); for i := 1 to nocases do Labels[i-1] := VarLabels[i-1]; height := 40; @@ -2049,13 +1924,6 @@ begin Labels := nil; end; { of scatplot procedure } -//------------------------------------------------------------------- - -procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; - RowLabels, ColLabels: StrDyneVec; Title: string); -begin - DynIntMatPrint(Mat, Rows, Cols, YTitle, RowLabels, ColLabels, Title, OutputFrm.RichEdit.Lines); -end; procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; RowLabels, ColLabels: StrDyneVec; Title: string; AReport: TStrings);