pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Further refactoring of the item_banking units. Remove the overloads from matrixlib writing reports to OutputFrm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7456 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-05-14 19:56:00 +00:00
parent 52f150f6a9
commit fac710ba0c
7 changed files with 256 additions and 414 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas
View File

@ -73,7 +73,6 @@ procedure TCodesForm.DisplayBtnClick(Sender: TObject);
var
currentno: integer;
i: integer;
outline: string;
lReport: TStrings;
begin
lReport := TStringList.Create;

1
applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas
View File

@ -246,7 +246,6 @@ end;
procedure TMCItemForm.CodeBrowseBtnClick(Sender: TObject);
var
i: integer;
outline: string;
nochoices: integer;
lReport: TStrings;
begin

17
applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm
View File

@ -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

235
applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas
View File

@ -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

1
applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas
View File

@ -143,7 +143,6 @@ end;
procedure TTFItemForm.CodeBrowseBtnClick(Sender: TObject);
var
i: integer;
outline: string;
lReport: TStrings;
begin
lReport := TStringList.Create;

119
applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas
View File

@ -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);

296
applications/lazstats/source/units/matrixlib.pas
View File

@ -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);