Census Code
Brought to you by:
kestrel_999,
lasse_l
Menu
▾
▴
[r12]: / main.pas Maximize Restore History
17884 lines (16954 with data), 684.5 kB
{* ***** BEGIN LICENSE BLOCK ***** *}
{* Version: MPL 1.1 *}
{* *}
{* The contents of this file are subject to the Mozilla Public License *}
{* Version 1.1 (the "License"); you may not use this file except in *}
{* compliance with the License. You may obtain a copy of the License at *}
{* http://www.mozilla.org/MPL/ *}
{* *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
{* for the specific language governing rights and limitations under the *}
{* License. *}
{* *}
{* The Original Code is Census *}
{* *}
{* The Initial Developer of the Original Code is Justin Wilkins *}
{* *}
{* Portions created by Justin Wilkins are Copyright (C)2001-2011 *}
{* Justin Wilkins. All Rights Reserved. *}
{* *}
{* Contributor(s): *}
{* *}
{* ***** END LICENSE BLOCK ***** *}
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, StdCtrls, ovcbase, JclSysInfo, SHfolder,
ffdb, ffdbbase, ffllbase, ffllcomp,
fflleng, ffsrintm, ffsreng, JvBaseDlg, JvBrowseFolder, ImgList,
StExpLog, ovcfiler, Menus, Brkapart, ComCtrls,
ToolWin, ExtCtrls, o32lkout, o32sbar, ffsqlbas, ffsqleng, DBCtrls,
ovcdbhll, OvcDbHFF, o32editf, o32flxed, o32dbfe, Mask, ShellAPI,
SynEditHighlighter, SynHighlighterFortran, SynEdit,
Buttons, JvDataEmbedded, ovcdlg, ovcmodg,
JvTipOfDay, FFLLDict, ovcviewr, Registry,
ovcnbk, XPMan, Math, JclStrings,
fmxutils, kstrgrid, JvComponent, Grids, JvStringGrid,
JvMemoryDataset, JvExGrids, JvProgressDialog,
DBGrids, PerlRegEx,
JvExExtCtrls, ActiveX,
JvNetscapeSplitter, OleServer,
SynHighlighterNONMEM, StBase, JvComponentBase, DBCGrids, VirtualTrees,
JvStringHolder, JvgStringGrid, JvAppStorage, JvAppRegistryStorage,
JFCAppUpdate, JvMRUManager, JvMRUList, IdHashMessageDigest,
JvFormPlacement, ovcrvidx, ovcrptvw, ovcdbrpv, Compile, xmldom, XMLIntf,
msxmldom, XMLDoc, nmoutput;
type
{TConsoleThread = class(TThread)
private
fwhandle: integer; // Write handle of the pipe
fecode: longword; // variable that holds the exit code of the console process
fexecpath: PChar; // variable that holds the path of the console process
protected
constructor
Create(CreateSuspended: boolean; aExecPath: PChar; writeHandle: integer);
procedure Execute; override;
end; }
TfrmNMRun = class(TForm)
dlgOpen: TOpenDialog;
srcRuns: TDataSource;
srcThetas: TDataSource;
srcEtas: TDataSource;
brkUpp: TBrkApart;
srcSigmas: TDataSource;
MainMenu1: TMainMenu;
File1: TMenuItem;
Help1: TMenuItem;
AboutNMRun1: TMenuItem;
Exit1: TMenuItem;
barStatus: TO32StatusBar;
loBar: TO32LookoutBar;
New1: TMenuItem;
N1: TMenuItem;
Open1: TMenuItem;
Close1: TMenuItem;
N2: TMenuItem;
Edit1: TMenuItem;
Cut1: TMenuItem;
Copy1: TMenuItem;
Paste1: TMenuItem;
logExcept: TStExceptionLog;
Runs1: TMenuItem;
ImportRun1: TMenuItem;
ScanFolder1: TMenuItem;
imgListGrey: TImageList;
imgList16: TImageList;
dlgScanFolder: TJvBrowseForFolderDialog;
N3: TMenuItem;
PurgeRuns1: TMenuItem;
nmEngine: TffServerEngine;
nmClient: TffClient;
nmSession: TffSession;
nmDatabase: TffDatabase;
tblRuns: TffTable;
tblThetas: TffTable;
tblEtas: TffTable;
tblSigmas: TffTable;
tblRunsID: TAutoIncField;
tblRunsComment: TStringField;
tblRunsObsRecs: TIntegerField;
tblRunsIndividuals: TIntegerField;
tblRunsMinShort: TStringField;
tblRunsMinimization: TMemoField;
tblRunsFnEvals: TIntegerField;
tblRunsSigDigits: TStringField;
tblRunsObj: TFloatField;
tblRunsCovStep: TMemoField;
tblRunsCovShort: TStringField;
tblRunsCondEst: TBooleanField;
tblRunsCenteredEta: TBooleanField;
tblRunsInteraction: TBooleanField;
tblRunsLaplacian: TBooleanField;
tblRunsModel: TStringField;
tblRunspatab: TStringField;
tblRunssdtab: TStringField;
tblRunscatab: TStringField;
tblRunscotab: TStringField;
tblRunsCtl: TStringField;
tblRunsLst: TStringField;
tblRunsMsf: TStringField;
tblThetasID: TAutoIncField;
tblThetasTheta: TIntegerField;
tblThetasThetaLabel: TStringField;
tblThetasThetaValue: TFloatField;
tblThetasThetaSE: TFloatField;
tblThetasLower: TFloatField;
tblThetasInitial: TFloatField;
tblThetasUpper: TFloatField;
tblEtasID: TAutoIncField;
tblEtasEta: TIntegerField;
tblEtasEtaValue: TFloatField;
tblEtasEtaBar: TFloatField;
tblEtasEtaPVal: TFloatField;
tblEtasEtaInit: TFloatField;
tblEtasEtaSE: TFloatField;
tblEtasEtaLabel: TStringField;
tblSigmasID: TAutoIncField;
tblSigmasSigma: TIntegerField;
tblSigmasSigmaValue: TFloatField;
tblSigmasSigmaInit: TFloatField;
tblSigmasSigmaSE: TFloatField;
sqlEngine: TffSqlEngine;
sqlDel: TffQuery;
dlgOpenDB: TJvBrowseForFolderDialog;
nmHelper: TOvcDbFFEngineHelper;
imgBar: TImageList;
imgEdit: TImageList;
txtRunNo: TDBText;
Label1: TLabel;
tblRunsmutab: TStringField;
tblRunsData: TStringField;
tblRunsFit: TStringField;
dlgOpenMod: TOpenDialog;
tblThetasThetaRSE: TFloatField;
tblEtasEtaRSE: TFloatField;
tblSigmasSigmaRSE: TFloatField;
embEta: TJvDataEmbedded;
embTheta: TJvDataEmbedded;
embFFSTRAN: TJvDataEmbedded;
embRuns: TJvDataEmbedded;
embSigma: TJvDataEmbedded;
dlgNewDB: TJvBrowseForFolderDialog;
dlgLog: TOvcMemoDialog;
tblThetasRunNo: TStringField;
tblEtasRunNo: TStringField;
tblSigmasRunNo: TStringField;
tblRunsComments: TMemoField;
dlgTips: TJvTipOfDay;
tblRunsiRunNo: TIntegerField;
barPrg: TProgressBar;
mnuPopMru: TPopupMenu;
EditCurrentRun1: TMenuItem;
N4: TMenuItem;
tblRunsmytab: TStringField;
N5: TMenuItem;
Options1: TMenuItem;
CopyRunFilestoSPLUS1: TMenuItem;
N6: TMenuItem;
IndividualPlots1: TMenuItem;
embSubjReport: TJvDataEmbedded;
dlgComment: TOvcMemoDialog;
ExportRunSummary1: TMenuItem;
tblEtasModel: TStringField;
tblThetasModel: TStringField;
tblRunsOmegaMatrix: TMemoField;
tblRunsSigmaMatrix: TMemoField;
tblRunsOmegaSEMatrix: TMemoField;
tblRunsSigmaSEMatrix: TMemoField;
tblRunsCovMatrix: TMemoField;
tblRunsCorrMatrix: TMemoField;
tblRunsInvCovMatrix: TMemoField;
tblRunsEigenvalues: TMemoField;
mnuEdit: TPopupMenu;
Cut2: TMenuItem;
Copy2: TMenuItem;
Paste2: TMenuItem;
N7: TMenuItem;
SelectAll1: TMenuItem;
N8: TMenuItem;
SelectAll2: TMenuItem;
mnuSetLabelEta: TPopupMenu;
ParameterLabel1: TMenuItem;
mnuSetLabelTheta: TPopupMenu;
MenuItem1: TMenuItem;
tblThetasThetaMatrix: TMemoField;
tblEtasEtaMatrix: TMemoField;
tblSigmasSigmaMatrix: TMemoField;
tblRunsOmegaInitMatrix: TMemoField;
tblRunsSigmaInitMatrix: TMemoField;
tlbMain: TToolBar;
btnNewDB: TToolButton;
btnOpenDB: TToolButton;
div2: TToolButton;
btnImportRun: TToolButton;
btnScanFolder: TToolButton;
btnDelete: TToolButton;
ToolButton1: TToolButton;
btnPlots: TToolButton;
btnCopy: TToolButton;
btnExport: TToolButton;
ToolButton10: TToolButton;
btnOptions: TToolButton;
btnHelp: TToolButton;
div3: TToolButton;
btnExit: TToolButton;
dlgSave: TSaveDialog;
memData: TJvMemoryData;
memDataRunNo: TStringField;
memDataADVAN: TStringField;
memDataError: TStringField;
memDataKA: TFloatField;
memDataCL: TFloatField;
memDataV: TFloatField;
memDataALAG: TFloatField;
memDataV2: TFloatField;
memDataV3: TFloatField;
memDataQ: TFloatField;
memDataEtaKA: TFloatField;
memDataEtaCL: TFloatField;
memDataEtaV: TFloatField;
memDataEtaALAG: TFloatField;
memDataEtaV2: TFloatField;
memDataEtaV3: TFloatField;
memDataEtaQ: TFloatField;
memDataPercEtaCL: TFloatField;
memDataPercEtaV: TFloatField;
memDataPercEtaKA: TFloatField;
memDataPercEtaALAG: TFloatField;
memDataPercEtaV2: TFloatField;
memDataPercEtaV3: TFloatField;
memDataPercEtaQ: TFloatField;
memDataResAdd: TFloatField;
memDataResCCV: TFloatField;
memDataData: TStringField;
memDataObj: TFloatField;
memDataComments: TMemoField;
mnuMainPop: TPopupMenu;
CopyFilestoXpose1: TMenuItem;
N9: TMenuItem;
Delete1: TMenuItem;
tblThetasThetaSigDig: TFloatField;
tblEtasEtaSigDig: TFloatField;
tblSigmasSigmaSigDig: TFloatField;
N10: TMenuItem;
SearchNMusers1: TMenuItem;
btnNMusers: TToolButton;
tblRunsConditionNumber: TFloatField;
N11: TMenuItem;
RunaBootstrap1: TMenuItem;
Edit2: TMenuItem;
N12: TMenuItem;
PackageRuns1: TMenuItem;
jvZipDll: TJvDataEmbedded;
PlotWizard1: TMenuItem;
popPlots: TPopupMenu;
DiagnosticPlots1: TMenuItem;
PlotWizard2: TMenuItem;
pnlFiles: TPanel;
pgcFiles: TPageControl;
tabCtl: TTabSheet;
synCtl: TSynEdit;
edtCtl: TDBEdit;
tabData: TTabSheet;
edtData: TDBEdit;
grdData: TJvStringGrid;
tabLst: TTabSheet;
edtLst: TDBEdit;
memLst: TMemo;
tabSdtab: TTabSheet;
edtSdtab: TDBEdit;
tabPatab: TTabSheet;
edtPatab: TDBEdit;
grdPatab: TJvStringGrid;
tabCotab: TTabSheet;
edtCotab: TDBEdit;
grdCotab: TJvStringGrid;
tabCatab: TTabSheet;
edtCatab: TDBEdit;
grdCatab: TJvStringGrid;
tabMutab: TTabSheet;
edtMutab: TDBEdit;
grdMutab: TJvStringGrid;
tabMytab: TTabSheet;
edtMytab: TDBEdit;
grdMytab: TJvStringGrid;
tabMsf: TTabSheet;
edtMsf: TDBEdit;
memMsf: TOvcFileViewer;
pnlMain: TPanel;
Splitter1: TSplitter;
pnlTop: TPanel;
pnlBottom: TPanel;
pgcMain: TPageControl;
tabTheta: TTabSheet;
rvwThetas: TOvcDbReportView;
tabOmega: TTabSheet;
nbOmega: TOvcNotebook;
rvwEtas: TOvcDbReportView;
grdOmInit: TKStringGrid;
grdCovMatrix: TKStringGrid;
grdOmMatrix: TKStringGrid;
grdOmSE: TKStringGrid;
tabSigma: TTabSheet;
nbSigma: TOvcNotebook;
rvwSigmas: TOvcDbReportView;
grdSigInit: TKStringGrid;
grdSigMatrix: TKStringGrid;
grdSigSE: TKStringGrid;
tabMatrices: TTabSheet;
nbMatrices: TOvcNotebook;
grdCorrMatrix: TKStringGrid;
grdInvCovMatrix: TKStringGrid;
grdEigenvalues: TKStringGrid;
tabMisc: TTabSheet;
Panel3: TPanel;
DBCheckBox4: TDBCheckBox;
DBCheckBox3: TDBCheckBox;
DBCheckBox2: TDBCheckBox;
DBCheckBox1: TDBCheckBox;
LogLikelihoodProfiling1: TMenuItem;
Wizards1: TMenuItem;
LogLikelihoodProfiling2: TMenuItem;
N13: TMenuItem;
tblRunsRunNo: TStringField;
tblEtasBlocks: TBooleanField;
tblSigmasBlocks: TBooleanField;
tblEtasEtaCIs: TStringField;
tblEtasEtaCIUpper: TFloatField;
tblEtasEtaCILower: TFloatField;
tblSigmasSigmaCIs: TStringField;
tblSigmasSigmaCIUpper: TFloatField;
tblSigmasSigmaCILower: TFloatField;
tblThetasThetaCIs: TStringField;
tblThetasThetaCIUpper: TFloatField;
tblThetasThetaCILower: TFloatField;
BatchRuns1: TMenuItem;
dlgProg: TJvProgressDialog;
PsN1: TMenuItem;
StartNONMEMRun1: TMenuItem;
N15: TMenuItem;
OpenRecent1: TMenuItem;
mnuAnchor: TMenuItem;
embData: TJvDataEmbedded;
srcPlotData: TDataSource;
tblPlotData: TffTable;
tblPlotDataID: TAutoIncField;
tblPlotDataRunNo: TStringField;
tblPlotDataSID: TFloatField;
tblPlotDataTIME: TFloatField;
tblPlotDataIPRE: TFloatField;
tblPlotDataIWRE: TFloatField;
tblPlotDataDV: TFloatField;
tblPlotDataPRED: TFloatField;
tblPlotDataRES: TFloatField;
tblPlotDataWRES: TFloatField;
tblPlotDataOCC: TFloatField;
tblRunsWarnings: TStringField;
tblPlotDataAbsIWRE: TFloatField;
tblRunsLookupTitle: TStringField;
btnRunReport: TToolButton;
embReport: TJvDataEmbedded;
dlgSaveRtf: TSaveDialog;
pgcNotes: TPageControl;
tabMinSum: TTabSheet;
tabCovStep: TTabSheet;
tabNotes: TTabSheet;
memMinSum: TDBMemo;
memCovStep: TDBMemo;
memNotes: TDBMemo;
tblEtasEtaPerc: TFloatField;
tblRunsParentNo: TStringField;
srcTrans: TDataSource;
tblTrans: TffTable;
embTrans: TJvDataEmbedded;
tblTransID: TAutoIncField;
tblTransAction: TStringField;
tblTransRunNo: TStringField;
tblTransTimestamp: TDateTimeField;
tblTransUser: TStringField;
tblRunsTimestamp: TDateTimeField;
tblRunsUser: TStringField;
tblThetasTimestamp: TDateTimeField;
tblThetasUser: TStringField;
tblEtasTimestamp: TDateTimeField;
tblEtasUser: TStringField;
tblSigmasTimestamp: TDateTimeField;
tblSigmasUser: TStringField;
tblPlotDataTimestamp: TDateTimeField;
tblPlotDataUser: TStringField;
synNONMEM: TSynNONMEMSyn;
grdSdtab: TJvStringGrid;
vstMain: TVirtualStringTree;
tblRunsKeyRun: TBooleanField;
Keyrun1: TMenuItem;
strSrc: TJvStrHolder;
strDest: TJvStrHolder;
txtParentNo: TDBText;
Label2: TLabel;
tblRunsdOFV: TFloatField;
sqlParent: TffQuery;
pnlCompare: TPanel;
imgList: TImageList;
grdCompare: TJvgStringGrid;
Reports1: TMenuItem;
SimpleRunSummary1: TMenuItem;
RunReport1: TMenuItem;
MultipleRunReport1: TMenuItem;
jvTipStore: TJvAppRegistryStorage;
Keyruns1: TMenuItem;
Currentrunrichtext1: TMenuItem;
btnExportCompare: TButton;
dlgSaveCompare: TSaveDialog;
tblEtasEtaBarSE: TFloatField;
appUpdate: TJFCAppUpdate;
N17: TMenuItem;
CheckforUpdates1: TMenuItem;
tblEtasEtaCV: TFloatField;
tblSigmasSigmaCV: TFloatField;
tblRunsdOFVb: TFloatField;
N18: TMenuItem;
DisplayTransactions1: TMenuItem;
N19: TMenuItem;
oNLINEhELP1: TMenuItem;
mnuExportMatrix: TPopupMenu;
Exportcovariancematrix1: TMenuItem;
dlgSaveMatrix: TSaveDialog;
tblRunsModelMD5: TStringField;
tblRunspatabMD5: TStringField;
tblRunssdtabMD5: TStringField;
tblRunscatabMD5: TStringField;
tblRunscotabMD5: TStringField;
tblRunsmutabMD5: TStringField;
tblRunsmytabMD5: TStringField;
tblRunsCtlMD5: TStringField;
tblRunsDataMD5: TStringField;
tblRunsLstMD5: TStringField;
tblRunsMsfMD5: TStringField;
tblRunsFitMD5: TStringField;
Label3: TLabel;
txtCtlMD5: TDBText;
Label4: TLabel;
txtLstMD5: TDBText;
Label5: TLabel;
txtDataMD5: TDBText;
Label6: TLabel;
txtsdtabMD5: TDBText;
Label7: TLabel;
txtpatabMD5: TDBText;
Label8: TLabel;
txtcotabMD5: TDBText;
Label9: TLabel;
txtcatabMD5: TDBText;
Label10: TLabel;
txtmutabMD5: TDBText;
Label11: TLabel;
txtmytabMD5: TDBText;
Label12: TLabel;
txtMsfMD5: TDBText;
tabCwtabEst: TTabSheet;
txtCwtabEstMD5: TDBText;
Label13: TLabel;
grdCwtabEst: TJvStringGrid;
edtCwtabEst: TDBEdit;
tblRunscwtab: TStringField;
tblRunscwtabMD5: TStringField;
tblRunscwtabEst: TStringField;
tblRunscwtabEstMD5: TStringField;
tblRunscwtabDeriv: TStringField;
tblRunscwtabDerivMD5: TStringField;
tabCwtabDeriv: TTabSheet;
edtCwtabDeriv: TDBEdit;
grdCwtabDeriv: TJvStringGrid;
Label14: TLabel;
txtCwtabDerivMD5: TDBText;
ExportcovariancematrixtoR1: TMenuItem;
btnR: TToolButton;
ToolButton3: TToolButton;
RestartR1: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
PackandGo1: TMenuItem;
dlgMD5: TJvProgressDialog;
mruList: TJvMruList;
formStorage: TJvFormStorage;
appRegStore: TJvAppRegistryStorage;
mruManager: TJvMRUManager;
Compile1: TCompile;
tblRunscoi: TStringField;
tblRunscor: TStringField;
tblRunsext: TStringField;
tblRunsphi: TStringField;
tblRunscov: TStringField;
tblRunscoiMD5: TStringField;
tblRunscorMD5: TStringField;
tblRunscovMD5: TStringField;
tblRunsphiMD5: TStringField;
tblRunsextMD5: TStringField;
tblRunsMethod: TStringField;
tblEtasEtaShrinkage: TFloatField;
tblRunsEpsilonShrinkage: TFloatField;
tblRunsEstTime: TFloatField;
tblRunsCovTime: TFloatField;
tabPhi: TTabSheet;
tabExt: TTabSheet;
tabCor: TTabSheet;
tabCov: TTabSheet;
tabCoi: TTabSheet;
edtExt: TDBEdit;
Label15: TLabel;
txtExtMD5: TDBText;
edtPhi: TDBEdit;
Label16: TLabel;
txtPhiMD5: TDBText;
edtCov: TDBEdit;
Label17: TLabel;
txtCovMD5: TDBText;
edtCor: TDBEdit;
Label18: TLabel;
txtCorMD5: TDBText;
edtCoi: TDBEdit;
Label19: TLabel;
txtCoiMD5: TDBText;
Panel1: TPanel;
Label20: TLabel;
txtEpsShrinkage: TDBText;
tblRunsStructuralModel: TMemoField;
tblRunsCovariateModel: TMemoField;
tblRunsIIV: TMemoField;
tblRunsIOV: TMemoField;
tblRunsRV: TMemoField;
tblRunsEstimation: TMemoField;
tblRunsDescription: TMemoField;
tblRunsLabel: TStringField;
N16: TMenuItem;
Properties1: TMenuItem;
grdPhi: TJvStringGrid;
grdCov: TJvStringGrid;
grdCor: TJvStringGrid;
grdCoi: TJvStringGrid;
grdExt: TJvStringGrid;
tblSigmasSigmaShrinkage: TFloatField;
tblRunsMethFO: TBooleanField;
tblRunsMethFOCE: TBooleanField;
tblRunsMethSAEM: TBooleanField;
tblRunsMethImp: TBooleanField;
tblRunsMethImpMap: TBooleanField;
tblRunsMethBayes: TBooleanField;
grpMethod: TGroupBox;
cbITS: TDBCheckBox;
cbImp: TDBCheckBox;
cbImpMap: TDBCheckBox;
cbSAEM: TDBCheckBox;
cbLaplacian: TDBCheckBox;
cbFOCE: TDBCheckBox;
cbFO: TDBCheckBox;
cbBayes: TDBCheckBox;
tblRunsMethITS: TBooleanField;
tblVPC: TffTable;
srcVPC: TDataSource;
tblVPCID: TAutoIncField;
tblVPCRunNo: TStringField;
tblVPCvpcRoot: TStringField;
tblVPCvpcTab: TStringField;
tblVPCvpcResults: TStringField;
tblVPCvpcOptions: TMemoField;
tblVPCPsNVersion: TStringField;
ImportVPC1: TMenuItem;
dlgOpenVPC: TOpenDialog;
xmlDoc: TXMLDocument;
tabXML: TTabSheet;
tvXML: TTreeView;
memDisplay: TMemo;
edtXML: TDBEdit;
Label21: TLabel;
txtXmlMD5: TDBText;
btnLoadXml: TButton;
tblRunsXML: TStringField;
tblRunsXMLMD5: TStringField;
procedure CaptureRun(nmFile: string);
procedure CaptureRun7(nmFile: string);
procedure CaptureRun72(nmFile: string);
function BrkUp(brkStr: string; brkBase: string;
brkInt: Integer): string;
function ExtractNumberInString(strFileName: string): Integer;
procedure Exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ImportRun1Click(Sender: TObject);
procedure ScanFolder1Click(Sender: TObject);
procedure PurgeRuns1Click(Sender: TObject);
function DisconnectFile: Boolean;
function ConnectFile: Boolean;
procedure btnDeleteClick(Sender: TObject);
procedure btnNextClick(Sender: TObject);
procedure btnPreviousClick(Sender: TObject);
procedure btnFirstClick(Sender: TObject);
procedure btnLastClick(Sender: TObject);
procedure btnOpenDBClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AboutNMRun1Click(Sender: TObject);
procedure loBarItemClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
procedure CtlOpen;
procedure DataOpen;
procedure DataClose;
procedure Close1Click(Sender: TObject);
procedure LstOpen;
procedure sdtabOpen;
procedure LoadMemo(nmFile: TStringField; nmMemo:
TMemo);
procedure PatabOpen;
procedure MsfOpen;
procedure MutabOpen;
procedure CatabOpen;
procedure CotabOpen;
procedure CwtabEstOpen;
procedure CwtabDerivOpen;
procedure GetFiles(DirStr: string; filelist: TStrings; rec: Boolean);
procedure btnNewDBClick(Sender: TObject);
procedure PackTables1Click(Sender: TObject);
procedure MytabOpen;
procedure EditCurrentRun1Click(Sender: TObject);
function NumConv(strNo: string): string;
function NMGridLoad(Grid: TJvStringGrid;
FileName: string; FileType: Integer): Boolean;
procedure mruFilesMRUItemClick(Sender: TObject; AFilename: string);
procedure btnPlotsdtabClick(Sender: TObject);
procedure memPrdErrExit(Sender: TObject);
procedure memPrdErrEnter(Sender: TObject);
procedure IndividualPlots1Click(Sender: TObject);
procedure CopyRunFilestoSPLUS1Click(Sender: TObject);
procedure Options1Click(Sender: TObject);
procedure CreateDataTables;
procedure RestructureRuns;
procedure RestructureThetas;
procedure RestructureEtas;
procedure RestructureSigmas;
procedure RestructureData;
procedure RestructureTrans;
procedure RestructureVPC;
procedure DefDictRuns;
procedure DefDictThetas;
procedure DefDictEtas;
procedure DefDictSigmas;
procedure DefDictData;
procedure DefDictTrans;
procedure DefDictVPC;
procedure AddThetaMSFInits(str: string; lstInit,
lstLower, lstUpper: TStrings);
procedure Cut2Click(Sender: TObject);
procedure Copy2Click(Sender: TObject);
procedure Paste2Click(Sender: TObject);
procedure SelectAll1Click(Sender: TObject);
procedure synCtlEnter(Sender: TObject);
procedure synCtlExit(Sender: TObject);
procedure LoadMatrix(DataField: TMemoField; Grid: TKStringGrid);
procedure nbOmegaPageChanged(Sender: TObject; Index: Integer);
procedure ParameterLabel1Click(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure btnExportClick(Sender: TObject);
// procedure ekRTFScanRecord(ScanInfo: TEkScanInfo);
function TabDataLoad(FileName: string): Boolean;
procedure btnNMusersClick(Sender: TObject);
function CaseConvert(strIn: string): string;
function NMCapData(Table: TffTable; FileName: string): Boolean;
procedure CopySP(const source, dest: string;
op, flags: Integer);
procedure nbMatricesPageChanged(Sender: TObject; Index: Integer);
procedure pgcMainChange(Sender: TObject);
procedure grdEigenvaluesDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure grdCorrMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure RunaBootstrap1Click(Sender: TObject);
function GetRegistryValue(KeyName: string; Key: string): string;
function NoAlpha(strIn: string): Boolean;
procedure tblRunsAfterRefresh(DataSet: TDataSet);
procedure pgcFilesChange(Sender: TObject);
procedure SimpleRunSummary1Click(Sender: TObject);
procedure PackageRuns1Click(Sender: TObject);
procedure LogLikelihoodProfiling1Click(Sender: TObject);
procedure nbSigmaPageChanged(Sender: TObject; Index: Integer);
procedure BatchRuns1Click(Sender: TObject);
function RunProg(Cmd, WorkDir: string): string;
procedure StartNONMEMRun1Click(Sender: TObject);
procedure MyExceptionHandler(Sender: TObject; E: Exception);
{procedure ovcMruClick(Sender: TObject; const ItemText: string;
var Action: TOvcMRUClickAction); }
procedure tblPlotDataCalcFields(DataSet: TDataSet);
procedure FormActivate(Sender: TObject);
procedure MRUGo(Sender: TObject);
procedure RunDosInMemo(DosApp: string; AMemo: TMemo);
procedure Execute1Click(Sender: TObject);
function StripBlanks(lstIn: TStrings): TStrings;
procedure BlastRun;
procedure RunReportOld1Click(Sender: TObject);
procedure tblRunsCalcFields(DataSet: TDataSet);
procedure InsertMatrix(DataField: TMemoField; RTF: TStrings;
strMarker, strMain: string);
function ContainsChar(strIn: string): Boolean;
procedure ClearCompare;
function GetTextWidth(CanvasOwner: TJvgStringGrid; Text: string; TextFont:
TFont): Integer;
{ procedure RunXpose(strPlot: string);
procedure Basicgoodnessoffitplots1Click(Sender: TObject);
procedure DVvsPRED1Click(Sender: TObject);
procedure PREDvsIDV1Click(Sender: TObject);
procedure Individualplots3Click(Sender: TObject); }
procedure NotImplemented;
{ procedure Prepare1Click(Sender: TObject);
procedure InterpretResults1Click(Sender: TObject);
procedure Prepare4Click(Sender: TObject);
procedure InterpretResults4Click(Sender: TObject);
procedure Prepare2Click(Sender: TObject);
procedure InterpretResults2Click(Sender: TObject);
procedure Prepare3Click(Sender: TObject);
procedure InterpretResults3Click(Sender: TObject);
procedure Wizard1Click(Sender: TObject);
procedure PREDvsDVIDV1Click(Sender: TObject);
procedure IPREDvsDVIDV1Click(Sender: TObject);
procedure WRESvsIDV1Click(Sender: TObject);
procedure WRESvsIDVBW1Click(Sender: TObject);
procedure WRESvsPRED1Click(Sender: TObject);
procedure WRESvsPREDbw1Click(Sender: TObject);
procedure PREDvsDVCovariates1Click(Sender: TObject);
procedure IPREDvsDVCovariates1Click(Sender: TObject);
procedure DistributionofWRES1Click(Sender: TObject);
procedure IndividualdistributionsofWRES1Click(Sender: TObject);
procedure WRESvsPRED2Click(Sender: TObject);
procedure CovariatesvsWRES1Click(Sender: TObject);
procedure WRESvsPREDCovariates1Click(Sender: TObject);
procedure IWRESvsIPREDCovariates1Click(Sender: TObject);
procedure AutocorrelationofWRES1Click(Sender: TObject);
procedure Numericallysummarizetheparameters1Click(Sender: TObject);
procedure DistributionofparametersQQplots1Click(Sender: TObject);
procedure Distributionofparametershistograms1Click(Sender: TObject);
procedure Scatterplotmatrixofparameters1Click(Sender: TObject);
procedure Parametervsparameter1Click(Sender: TObject);
procedure Randomeffectsvstypicalparametervalues1Click(Sender: TObject);
procedure Parametersvscovariates1Click(Sender: TObject);
procedure Parametersvscovariatesmodelprediction1Click(Sender: TObject);
procedure WRESvscovariates1Click(Sender: TObject);
procedure GAM1Click(Sender: TObject);
procedure BootstrapoftheGAM1Click(Sender: TObject);
procedure ree1Click(Sender: TObject);
procedure Basicmodelcomparisons1Click(Sender: TObject);
procedure Additionalmodelcomparisons1Click(Sender: TObject);
procedure DeltaPREDIPREDWRESvscovariates1Click(Sender: TObject); }
function GetLoginName: string;
procedure CtlClose;
procedure vstMainInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure vstMainGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstMainFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure RefreshTree;
procedure vstMainClick(Sender: TObject);
procedure vstMainPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
function Pad(RunNo: string): WideString;
procedure vstMainKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure vstMainGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
var ImageIndex: Integer);
procedure Keyrun1Click(Sender: TObject);
procedure mnuMainPopPopup(Sender: TObject);
procedure vstMainDragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
procedure vstMainDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vstMainDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
function FindNodeByText(StartNode: PVirtualNode; const S:
string): PVirtualNode;
procedure CheckNodeForText(Sender: TBaseVirtualTree;
Node: PVirtualNode; pText: Pointer; var Abort: Boolean);
procedure vstMainDblClick(Sender: TObject);
procedure RefreshCompare;
procedure grdCompareSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure grdCompareDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure RunReport1Click(Sender: TObject);
procedure Keyruns1Click(Sender: TObject);
procedure MultipleRunReport1Click(Sender: TObject);
procedure btnExportCompareClick(Sender: TObject);
function GetTempDirectory: string;
function BitmapToRTF(pict: TBitmap): string;
function ShortDir(Dir: string): string;
procedure CheckforUpdates1Click(Sender: TObject);
procedure tblEtasCalcFields(DataSet: TDataSet);
procedure tblSigmasCalcFields(DataSet: TDataSet);
procedure DisplayTransactions1Click(Sender: TObject);
procedure oNLINEhELP1Click(Sender: TObject);
function GetSpecialFolderPath(folder : integer) : string;
procedure Exportcovariancematrix1Click(Sender: TObject);
function IsStrANumber(const S: string): Boolean;
function IsStrAFloat(const S: string): Boolean;
procedure rgCovMatrixClick(Sender: TObject);
function MD5(const fileName : string) : string;
function GatherCovMatrix: TStringList;
procedure ExportcovariancematrixtoR1Click(Sender: TObject);
procedure btnRClick(Sender: TObject);
procedure RestartR1Click(Sender: TObject);
procedure GoR;
procedure PackandGo1Click(Sender: TObject);
procedure mruManagerClick(Sender: TObject; const RecentName,
Caption: string; UserData: Integer);
procedure ExtOpen;
procedure PhiOpen;
procedure CovOpen;
procedure CorOpen;
procedure CoiOpen;
function StripSpaces(st: string): string;
procedure Properties1Click(Sender: TObject);
function OneLineRegEx(strIn: string; strRegEx: string; blnMsg: Boolean): string;
function OneLineRegExAgain(strIn: string; strRegEx: string; blnMsg: Boolean): string;
function RndSig(Number: Extended; Sig: Word; Direction: Boolean): Extended;
function RoundD(x: Extended; d: Integer): Extended;
procedure ImportVPC1Click(Sender: TObject);
procedure DOMShow(ATree: TTreeView; Anode: IXMLNode; TNode: TTreeNode);
procedure btnLoadXmlClick(Sender: TObject);
function GetNodeByText(ATree : TTreeView; AValue: String;
AVisible: Boolean): TTreeNode;
function LineBreaks(inTxt: WideString): TStringList;
function SigDig(inFlt: Double; Prec: Integer): Double;
private
{ Private declarations }
public
{ Public declarations }
end;
type
PRunRec = ^TRunRec;
TRunRec = packed record
RunNo: WideString;
Problem: WideString;
Lbl: WideString;
OFV: WideString;
dOFV: WideString;
CondNo: WideString;
Description: WideString;
MinShort: WideString;
Inds: WideString;
FnEvals: WideString;
Observations: WideString;
SigDigits: WideString;
Key: Boolean;
Parent: WideString;
Warnings: WideString;
iRunNo: WideString;
Data: WideString;
EstTime: WideString;
CovTime: WideString;
StructuralModel: WideString;
CovariateModel: WideString;
IIV: WideString;
IOV: WideString;
RV: WideString;
Estimation: WideString;
end;
PPsNRunRec = ^TPsNRunRec;
TPsNRunRec = packed record
BasedOn: WideString;
Description: WideString;
PsNLabel: WideString;
StructuralModel: WideString;
CovariateModel: WideString;
InterIndividualVariability: WideString;
InterOccasionVariability: WideString;
ResidualVariability: WideString;
Estimation: WideString;
end;
type TMatrix = array of array of string;
var
frmNMRun: TfrmNMRun;
DictRuns, DictThetas, DictEtas, DictSigmas, DictData, DictTrans,
DictVPC, DictBootstrap, DictCDD, DictSCM: TffDataDictionary;
FldArray: TffFieldList;
IdxHelpers: TffFieldIHList;
extLst, extCtl, extXpose, extFit, extMSF, runPrefix, txtUser: string;
fs: TFormatSettings;
ShowPlots: Boolean;
rtfOut: TStrings;
SrcArray, DestArray: array of PVirtualNode;
blnPerl, blnPsN, blnR, blnRDCOM, blnXpose, blnMD5, blnAsk: Boolean;
XMLIn, XMLOutput: IXMLOutput;
const
XposeReleased: Boolean = True;
implementation
uses about, edit, plot, scandialog, options, runreport, xml,
packageruns, llp, etalabels, batch, execute, getxpose,
xpose, wait, transactions, r, MD5, dataparse, project, search, properties;
const
strVersion: string = '1.2b3';
{$R *.dfm}
// ********************************************************************
// Capture run
// ********************************************************************
procedure TfrmNMRun.CaptureRun(nmFile: string);
var
strComment, strMin, strFnEval, strSigDig, strModel,
strObsRecs, strInds, strCondEst, strCentEta, strInter,
strLaplacian, strCov, strObj, strObj2, strMinFull, strRun, strParent, strTemp: string;
strList, strOmegaList, strSigmaList: TStrings;
n, m, p, q, r, intTheta, intOmega, intOmegaBlk, intSigma, intSigmaBlk, intRun, intBOCount,
intBO2, intBSCount, intBS2, intLines, intT2L, intHessian, intOmegaRatio: Integer;
ThLabel, ThLower, ThInit, ThUpper, ThValue, ThSE: TStrings;
OmInit, SigInit, EtaBar, EtaP, EtaBarSE, Eta, Eps, SigSE, OmSE: TStrings;
lstLog, lstMinTerm, lstCovSum, lstBlockOmega, lstBlockSigma, lstPsNRunRec: TStrings;
EtaLabel, ThetaModel, PKParams, lstMatrixOmega, lstMatrixSigma,
lstMatrixOmegaInit, lstMatrixSigmaInit, lstLargeSEs, lstZeroCIs,
lstMatrixOmegaSE, lstMatrixSigmaSE, lstScratch, lstTemp, lstTemp2,
lstCovMatrix, lstCorrMatrix, lstInvCovMatrix, lstEigen: TStrings;
lstOmegaBlkVars, lstSigmaBlkVars, lstNotes: TStrings;
swFP, swSE, swMinTerm, swCovSum, blnDebug, swBlockOmega,
swBlockSigma, blnLT, blnGoodRun, blnInlineCtl, blnOFVSeen, blnOFVWarn,
blnNM7Run, blnNM72Run, blnNMQualRun: Boolean;
strModFile, strDataFile, strEtaL, strEtaL2, strT, strT2, strWFN: string;
RegIni: TRegIniFile;
btnPK, blnARun, blnBOInit, blnBSInit, blnCovStep, blnEtaBlocks,
blnSigmaBlocks, blnThetasOn, blnEtasOn, blnZeroGradients, btnSub, blnPriors,
blnFZeroGradients, blnLargeSEs, blnBoundaries, blnZeroCIs, blnPrdErr: Boolean;
arSigDig: array of string;
fltCondNo, fltEigenUpper, fltEigenLower: Double;
intEtCt, intFixedOmegas, intFixedSigmas: Integer;
PsNRunRec: TPsNRunRec;
regEx: TPerlRegEx;
begin
// ********************************************************************
// Go to safe page
// ********************************************************************
pgcMain.ActivePageIndex := 0;
// ********************************************************************
// Initialize variables
// ********************************************************************
//tblRuns.Filtered := False;
intEtCt := 0; // Eta count
brkUpp.AllowEmptyString := False;
strList := TStringList.Create; // Main output file
lstPsNRunRec := TStringList.Create; // PsN run record
swFP := True; // Final parameters switch
swSE := False; // Standard errors switch
swCovSum := False; // Covariance summary switch
swMinTerm := False; // MINIMIZATION TERMINATED switch
swBlockOmega := False; // Block OMEGA switch
swBlockSigma := False; // Block SIGMA switch
blnPrdErr := False; // errors in PRDERR
blnDebug := False; // Debug mode
if pgcMain.ActivePageIndex = 3 then
pgcMain.ActivePageIndex := 0;
blnInlineCtl := False; // Inline control stream?
blnOFVSeen := False; // OFV present?
strEtaL := '';
strEtaL2 := '';
blnOFVWarn := False;
blnARun := False;
blnBOInit := False;
blnBSInit := False;
blnCovStep := True;
strInter := 'NO';
strLaplacian := 'NO';
strCondEst := 'NO';
strCentEta := 'NO';
blnEtaBlocks := False;
blnSigmaBlocks := False;
blnZeroGradients := False;
blnFZeroGradients := False;
blnLargeSEs := False;
blnBoundaries := False;
blnZeroCIs := False;
intOmega := 0;
intOmegaBlk := 0;
intTheta := 0;
intSigma := 0;
intSigmaBlk := 0;
intRun := 0;
intBOCount := 0;
intBSCount := 0;
strSigDig := '';
strT := '';
strT2 := '';
intLines := 0;
intT2L := 0;
intHessian := 0;
intFixedOmegas := 0;
intFixedSigmas := 0;
strParent := '';
blnGoodRun := False;
blnNM7Run := False;
blnNM72Run := False;
blnNMQualRun := False;
//blnDebug := True;
// ********************************************************************
// Load output file into strList
// ********************************************************************
if FileExists(nmFile) = False then
begin
MessageDlg('The specified file does not exist.', mtError, [mbOK], 0);
Exit;
end;
if Pos(' ', ExtractFileName(nmFile)) > 0 then
begin
MessageDlg('Spaces and control characters in filenames are not supported by Census. Please rename ' +
'this file (' + ExtractFileName(nmFile) + ') before attempting to import it.', mtWarning, [mbOK], 0);
Exit;
end;
if FileExists(nmFile) then
begin
try
strList.LoadFromFile(nmFile);
// Check for valid input - can be anywhere in the file
for n := 0 to strList.Count - 1 do
begin
if (Pos('DEVELOPED AND PROGRAMMED BY STUART BEAL AND LEWIS SHEINER', strList[n]) > 0) then
blnGoodRun := True;
if (Pos('ORIGINALLY DEVELOPED BY STUART BEAL, LEWIS SHEINER, AND ALISON BOECKMANN', strList[n]) > 0) then
blnNM7Run := True;
if (Pos('1NONLINEAR MIXED EFFECTS MODEL PROGRAM (NONMEM) VERSION 7.2.0', strList[n]) > 0) then
blnNM72Run := True;
if (Pos('<identifier>This log was generated by nmqual.pl', strList[n]) > 0) then
blnNMQualRun := True;
end;
//if blnGoodRun then ShowMessage('good');
//if blnNM7Run then ShowMessage('nm7');
//if blnNM72Run then ShowMessage('nm72');
if (blnGoodRun = False) and (blnNM7Run = False) and (blnNM72Run = False) then
begin
if MessageDlg('The specified file (' + ExtractFileName(nmFile) +
') does not appear to be a valid ' +
'NONMEM output stream. Would you like to attempt to capture it' +
' anyway?', mtError, [mbYes, mbNo], 0) = mrNo then
Exit;
end
else
if (blnGoodRun = False) and (blnNM7Run = True) and (blnNM72Run = False) then
begin
//MessageDlg('The specified file (' + ExtractFileName(nmFile) +
// ') appears to be a NONMEM 7 output stream. NONMEM 7 is not yet ' +
// 'supported, but will be in future releases!', mtInformation, [mbOK], 0);
CaptureRun7(nmFile);
strList.Free;
Exit;
end
else
if (blnGoodRun = False) and (blnNM72Run = True) then
begin
//MessageDlg('The specified file (' + ExtractFileName(nmFile) +
// ') appears to be a NONMEM 7.2 output stream. NONMEM 7.2 is not yet ' +
// 'supported, but will be in future releases!', mtInformation, [mbOK], 0);
CaptureRun72(nmFile);
strList.Free;
Exit;
end
except
;
end;
end;
// Create all objects
lstLog := TStringList.Create; // Log file
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
ThLabel := TStringList.Create; // List of THETA labels
strOmegaList := TStringList.Create; // List of OMEGA labels
strSigmaList := TStringList.Create; // List of SIGMA labels
ThLower := TStringList.Create; // List of THETA lower bounds
ThInit := TStringList.Create; // List of THETA initial estimates
ThUpper := TStringList.Create; // List of THETA upper bounds
ThValue := TStringList.Create; // List of THETA estimates
ThSE := TStringList.Create; // List of THETA standard errors
OmInit := TStringList.Create; // List of OMEGA initial estimates
OmSE := TStringList.Create; // List of OMEGA standard errors
SigInit := TStringList.Create; // List of SIGMA initial estimates
SigSE := TStringList.Create; // List of SIGMA standard errors
EtaBar := TStringList.Create; // List of ETABARs
EtaBarSE := TStringList.Create; // List of ETABAR SEs
EtaP := TStringList.Create; // List of ETABAR P values
EtaLabel := TStringList.Create; // List of ETA labels
Eta := TStringList.Create; // List of ETA estimates
Eps := TStringList.Create; // List of EPS estimates
lstCovSum := TStringList.Create; // Covariance summary
lstMinTerm := TStringList.Create; // MINIMIZATION TERMINATED message
lstBlockOmega := TStringList.Create; // BLOCK OMEGA section
lstOmegaBlkVars := TStringList.Create; // List of BLOCK OMEGA vars
lstSigmaBlkVars := TStringList.Create; // List of BLOCK SIGMA vars
lstBlockSigma := TStringList.Create; // BLOCK SIGMA section
lstMatrixOmega := TStringList.Create; // OMEGA matrix
lstMatrixSigma := TStringList.Create; // SIGMA matrix
lstMatrixOmegaSE := TStringList.Create; // OMEGA matrix SEs
lstMatrixSigmaSE := TStringList.Create; // SIGMA matrix SEs
lstMatrixOmegaInit := TStringList.Create; // OMEGA matrix initial estimates
lstMatrixSigmaInit := TStringList.Create; // SIGMA matrix initial estimates
lstCovMatrix := TStringList.Create; // Covariance matrix
lstCorrMatrix := TStringList.Create; // Correlation matrix
lstInvCovMatrix := TStringList.Create; // Inverse covariance matrix
lstEigen := TStringList.Create; // Eigenvalues
lstScratch := TStringList.Create; // Scratch area
lstTemp := TStringList.Create; // Another temp list
lstTemp2 := TStringList.Create; // Another temp list
lstZeroCIs := TStringList.Create; // Zero CIs
lstLargeSEs := TStringList.Create; // Large SEs
lstNotes := TStringList.Create; // Notes
blnAsk := RegIni.ReadBool('Options', 'AskNonNumeric', False);
blnMD5 := RegIni.ReadBool('Options', 'MD5', False);
if FileExists(nmFile) then
begin
try
lstLog.Add('Opened ' + nmFile + '...');
lstLog.Add('-----------------------------------------');
strRun := StringReplace(ExtractFileName(nmFile), runPrefix, '', [rfReplaceAll]);
strRun := StringReplace(strRun, extLst, '', [rfReplaceAll]);
lstLog.Add('Length of filename... ' + IntToStr(Length(strRun)));
for n := 1 to Length(strRun) do
if not (strRun[n] in ['0'..'9']) then
blnARun := True;
intRun := ExtractNumberInString(ExtractFileName(nmFile));
if (blnARun) and (blnAsk) {strRun <> IntToStr(intRun)} then
strRun := InputBox('Please confirm your run number... [' +
nmFile + ']', 'Run Number', strRun);
lstLog.Add('Run number... ' + strRun);
try
tblRuns.IndexName := 'runno2';
// ********************************************************************
// Does run exist? If so then replace
// ********************************************************************
if tblRuns.FindKey([strRun]) then
begin
lstLog.Add('Run exists!');
if MessageDlg('This run (' + strRun + ') may already be present in the database. Would you '
+ 'like to replace it?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if MessageDlg('This will delete the current run record (' +
tblRunsRunNo.Value + '), and cannot be ' +
'reversed. Your original run files will not be ' +
'removed. Do you wish to continue?', mtWarning,
[mbYes, mbNo], 0) = mrYes then
begin
lstLog.Add('Replacing run...');
BlastRun;
end;
end
else
begin
if MessageDlg('Would you like to add this run with a different ' +
'number?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
strRun := InputBox('Please enter the new run number... [' +
nmFile + ']', 'Run Number', strRun)
else
Exit;
lstLog.Add('New run number... ' + strRun);
end;
end;
finally
tblRuns.IndexName := 'irunno';
end;
lstLog.Add('Length of output file... ' + IntToStr(strList.Count));
// ********************************************************************
// Proper estimation? OFV present?
// ********************************************************************
for n := 0 to strList.Count - 1 do
begin
// ********************************************************************
// Read objective function value
// ********************************************************************
if Pos(' ************************************************** ',
strList.Strings[n]) > 0 then
blnOFVSeen := True;
if n = strList.Count - 1 then
if blnOFVSeen = False then
begin
if not Assigned(frmScanDialog) then
MessageDlg('This run seems to have terminated prematurely, ' +
'or contains no estimation step. No objective function value ' +
'appears to be present. Import cancelled.', mtError, [mbOK], 0);
Exit;
end;
end;
// ********************************************************************
// Iterate through file
// ********************************************************************
for n := 0 to strList.Count - 1 do
begin
// ********************************************************************
// Count hessian resets
// ********************************************************************
// ShowMessage('Line ' + IntToStr(n));
if Pos('RESET HESSIAN', strList.Strings[n]) > 0 then
begin
intHessian := intHessian + 1;
lstLog.Add('Hessian reset detected...');
end;
// ********************************************************************
// Exit if premature end
// ********************************************************************
if Pos('THERE ARE ERROR MESSAGES IN FILE PRDERR', strList.Strings[n]) > 0 then
begin
blnPrdErr := True;
lstLog.Add('Errors in PRDERR...');
end;
// ********************************************************************
// Zero gradients
// ********************************************************************
if Pos(' GRADIENT: ', strList.Strings[n]) > 0 then
begin
m := 0;
strT2 := StringReplace(strList[n], ' GRADIENT:', '', [rfReplaceAll]);
while (Pos('0ITERATION NO.:', strList[n + m]) = 0) and
(Pos('MINIMIZATION', strList[n + m]) = 0) and
(Pos('PRED EXIT', strList[n + m]) = 0) do
begin
strT2 := strT2 + strList[n + m];
m := m + 1;
end;
if Pos('0.0000E+00', strT2) > 0 then
begin
blnZeroGradients := True;
lstLog.Add('Zero gradients detected...');
end;
end;
// ********************************************************************
// Interim objective function
// ********************************************************************
if Pos('ITERATION', strList.Strings[n]) > 0 then
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := strList.Strings[n];
brkUpp.BreakApart;
if brkUpp.StringList.Count > 5 then
strObj2 := brkUpp.StringList[5];
end;
// ********************************************************************
// Final parameters switch
// ********************************************************************
lstLog.Add('Line: ' + IntToStr(n + 1));
if blnDebug then
lstLog.Add('Processing line: ' + IntToStr(n));
if Pos(' ******************** FINAL PARAMETER ESTIMATE',
strList.Strings[n]) > 0 then
begin
swFP := True;
swSE := False;
lstLog.Add('Final parameter block detected...');
lstLog.Add(' Final parameters switched ON');
lstLog.Add(' SEs switched OFF');
//ShowMessage('Final Params on');
end;
// ********************************************************************
// Standard errors switch
// ********************************************************************
if Pos(' ******************** STANDARD ERROR OF ESTIMATE',
strList.Strings[n]) > 0 then
begin
swFP := False;
swSE := True;
lstLog.Add('Standard error block detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' SEs switched ON');
//ShowMessage('Standard Errors on');
end;
// ********************************************************************
// Inline control stream
// ********************************************************************
if Pos('$PROB',
strList.Strings[n]) > 0 then
begin
blnInlineCtl := True;
lstLog.Add('Inline control stream found...');
end;
// ********************************************************************
// Covariance step
// ********************************************************************
if Pos('COVARIANCE STEP ABORTED',
strList.Strings[n]) > 0 then
begin
blnCovStep := False;
lstLog.Add('Covariance step aborted...');
//ShowMessage('Standard Errors on');
end;
// ********************************************************************
// Covariance matrix switch
// ********************************************************************
if Pos(' ******************** COVARIANCE MATRIX OF ESTIMATE',
strList.Strings[n]) > 0 then
begin
swFP := False;
swSE := False;
lstLog.Add('Covariance matrix detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' SEs switched OFF');
//ShowMessage('Standard Errors off');
end;
// ********************************************************************
// T Matrix switch
// ********************************************************************
if Pos(' ******************** T MATRIX',
strList.Strings[n]) > 0 then
begin
swFP := False;
swSE := False;
lstLog.Add('T matrix detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' SEs switched OFF');
//ShowMessage('Standard Errors on');
end;
// ********************************************************************
// Minimization terminated case
// ********************************************************************
if swMinTerm then
if Pos('0', strList[n]) = 1 then
lstMinTerm.Add(Copy(strList[n], 2, 500))
else
lstMinTerm.Add(strList[n]);
// ********************************************************************
// Covariance step case
// ********************************************************************
if swCovSum then
if (Pos('0', strList[n]) = 1) or (Pos('1', strList[n]) = 1) then
if (Length(Trim(strList[n])) > 0) and (Pos('***', strList[n]) = 0) then
lstCovSum.Add(Copy(strList[n], 2, 500))
else
if not (Pos(' ', strList[n]) = 1) then
if (Length(Trim(strList[n])) > 0) and (Pos('***', strList[n]) = 0) then
lstCovSum.Add(strList[n]);
// ********************************************************************
// Read comment
// ********************************************************************
if Pos('PROBLEM NO.:', strList.Strings[n]) > 0 then
begin
strComment := Trim(strList.Strings[n + 1]);
lstLog.Add('Comment... ' + strComment);
end;
// ********************************************************************
// Read no of observations
// ********************************************************************
if Pos('TOT. NO. OF OBS RECS:', strList.Strings[n]) > 0 then
begin
strObsRecs := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Observation Records... ' + strObsRecs);
end;
// ********************************************************************
// Read no of individuals
// ********************************************************************
if Pos('TOT. NO. OF INDIVIDUALS:', strList.Strings[n]) > 0 then
begin
strInds := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Individuals... ' + strInds);
end;
// ********************************************************************
// Count THETAs
// ********************************************************************
if Pos('LENGTH OF THETA:', strList.Strings[n]) > 0 then
begin
intTheta := StrToInt(BrkUp(':', strList.Strings[n], 1));
lstLog.Add('THETAs... ' + IntToStr(intTheta));
end;
// ********************************************************************
// Count OMEGAs (simple diagonal)
// ********************************************************************
if Pos('OMEGA HAS SIMPLE DIAGONAL', strList.Strings[n]) > 0 then
begin
lstLog.Add('OMEGAs: Simple diagonal');
intOmega := StrToInt(BrkUp(':', strList.Strings[n], 1));
lstLog.Add('OMEGAs... ' + IntToStr(intOmega));
end;
// ********************************************************************
// Count OMEGAs (block)
// ********************************************************************
if Pos('OMEGA HAS BLOCK FORM', strList.Strings[n]) > 0 then
begin
swBlockOmega := True;
blnEtaBlocks := True;
intBOCount := 0;
lstLog.Add('Block OMEGAs ON');
end;
if (swBlockOmega) and (swBlockSigma = False) then
begin
intBOCount := intBOCount + 1;
if (Pos('YES', strList[n]) = 0)
and (Pos('NO', strList[n]) = 0)
and (Pos('SIGMA', strList[n]) = 0)
and (Pos('OMEGA', strList[n]) = 0)
and (Pos('BLOCK', strList[n]) = 0) then
begin
//lstBlockOmega.Add(strList[n]);
if Length(strList[n]) > 0 then
if (strList[n][Length(strList[n])] in ['0'..'9']) and
(Pos(':', strList[n]) = 0) and
(Pos('E', strList[n]) = 0) then
begin
lstOmegaBlkVars.Add(Trim(strList[n][Length(strList[n]) - 1] +
strList[n][Length(strList[n])]));
lstLog.Add('Adding ' + Trim(strList[n][Length(strList[n]) - 1] +
strList[n][Length(strList[n])]) + ' to OMEGA block...');
end;
end;
end;
// ********************************************************************
// Finish block OMEGAs
// ********************************************************************
if (Pos('SIGMA HAS', strList.Strings[n]) > 0) then
if swBlockOmega then
begin
lstLog.Add('Finishing block OMEGAs...');
brkUpp.StringList.Clear;
// support for NMVI 2.0
if Pos('DEFAULT OMEGA BOUNDARY TEST', strList.Strings[n - 1]) > 0 then
brkUpp.BaseString := strList[n - 2]
else
brkUpp.BaseString := strList[n - 1];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intOmega := brkUpp.StringList.Count;
//ShowMessage('OMEGAs: ' + IntToStr(intOmega));
intOmegaBlk := StrToInt(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstLog.Add('OMEGAs: ' + IntToStr(intOmega));
lstLog.Add('Block OMEGAs: ' + IntToStr(intOmegaBlk));
//ShowMessage('OMEGA blocks: ' + IntToStr(intOmegaBlk));
strOmegaList.Clear;
for q := 0 to intOmega - 1 do
begin
brkUpp.StringList.Clear;
// support for NMVI 2.0
if Pos('DEFAULT OMEGA BOUNDARY TEST', strList.Strings[n - 1]) > 0 then
brkUpp.BaseString := strList[n - (intOmega - q + 1)]
else
brkUpp.BaseString := strList[n - (intOmega - q)];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
lstLog.Add('Adding OMEGA: ' + brkUpp.StringList[brkUpp.StringList.Count - 1]);
//ShowMessage(brkUpp.StringList[brkUpp.StringList.Count - 1]);
if IsStrANumber(brkUpp.StringList[brkUpp.StringList.Count - 1]) then
strOmegaList.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
//intOmega := strOmegaList.Count;
//ShowMessage('OmegaList: ' + #10#13 + strOmegaList.Text);
{intBOCount := intBOCount - 2;
intOmega := intBOCount;
intBOCount := 0;
lstBlockOmega.Delete(lstBlockOmega.Count - 1);
swBlockOmega := False;
lstLog.Add('Block omegas OFF'); }
lstLog.Add('Confirm OMEGAs... ' + IntToStr(intOmega));
end;
// ********************************************************************
// Count SIGMAs (simple diagonal)
// ********************************************************************
if Pos('SIGMA HAS SIMPLE DIAGONAL', strList.Strings[n]) > 0 then
begin
lstLog.Add('SIGMAs: Simple diagonal');
intSigma := StrToInt(BrkUp(':', strList.Strings[n], 1));
lstLog.Add('SIGMAs... ' + IntToStr(intSigma));
end;
// ********************************************************************
// Count SIGMAs (block)
// ********************************************************************
if Pos('SIGMA HAS BLOCK FORM', strList.Strings[n]) > 0 then
begin
swBlockSigma := True;
blnSigmaBlocks := True;
intBSCount := 0;
lstLog.Add('Block SIGMAs ON');
end;
//if swBlockSigma then
//begin
// intBSCount := intBSCount + 1;
// if intBSCount > 1 then
// lstBlockSigma.Add(strList[n]);
//
//end;
if swBlockSigma then
begin
intBSCount := intBSCount + 1;
if (Pos('YES', strList[n]) = 0)
and (Pos('NO', strList[n]) = 0)
and (Pos('SIGMA', strList[n]) = 0)
and (Pos('OMEGA', strList[n]) = 0)
and (Pos('BLOCK', strList[n]) = 0) then
begin
//lstBlockSigma.Add(strList[n]);
if Length(strList[n]) > 0 then
if (strList[n][Length(strList[n])] in ['0'..'9']) and
(Pos(':', strList[n]) = 0) and
(Pos('E', strList[n]) = 0) then
begin
lstSigmaBlkVars.Add(Trim(strList[n][Length(strList[n]) - 1] +
strList[n][Length(strList[n])]));
lstLog.Add('Adding ' + Trim(strList[n][Length(strList[n]) - 1] +
strList[n][Length(strList[n])]) + ' to SIGMA block...');
end;
end;
end;
// ********************************************************************
// Finish SIGMAs (works only for constrained SIGMA)
// ********************************************************************
{ if Pos('SIGMA CONSTRAINED', strList.Strings[n]) > 0 then
if swBlockSigma then
begin
intBSCount := intBSCount - 2;
intSigma := intBSCount;
intBSCount := 0;
lstBlockSigma.Delete(lstBlockSigma.Count - 1);
swBlockSigma := False;
lstLog.Add('Block sigmas OFF');
lstLog.Add('Sigmas... ' + IntToStr(intSigma));
end; }
if Pos('ESTIMATION STEP OMITTED:', strList.Strings[n]) > 0 then
if swBlockSigma then
begin
lstLog.Add('Finishing block SIGMAs...');
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n - 2];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intSigma := brkUpp.StringList.Count;
//ShowMessage(brkUpp.StringList[brkUpp.StringList.Count - 1]);
//intSigmaBlk := StrToInt(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstLog.Add('SIGMAs: ' + IntToStr(intSigma));
//lstLog.Add('Block SIGMAs: ' + IntToStr(intSigmaBlk));
strSigmaList.Clear;
for q := 0 to intSigma - 1 do
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n - (intSigma - q)];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strSigmaList.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
{intBOCount := intBOCount - 2;
intOmega := intBOCount;
intBOCount := 0;
lstBlockOmega.Delete(lstBlockOmega.Count - 1);
swBlockOmega := False;
lstLog.Add('Block omegas OFF'); }
lstLog.Add('Confirm SIGMAs... ' + IntToStr(intSigma));
end;
// ********************************************************************
// Initial estimates & bounds of THETA
// ********************************************************************
if Pos('INITIAL ESTIMATE OF THETA:', strList.Strings[n]) > 0 then
if Pos('LOWER BOUND', strList[n + 1]) > 0 then
begin
lstLog.Add('Starting THETA initial estimates...');
for m := 1 to intTheta do
begin
if blnDebug then
// ShowMessage('Starting THETA ' + IntToStr(m));
ThLower.Add(BrkUp(' ', strList.Strings[n + m + 1], 0));
lstLog.Add('THETA(' + IntToStr(m) + ') Lower Bound... ' +
BrkUp(' ', strList.Strings[n + m + 1], 0));
ThInit.Add(BrkUp(' ', strList.Strings[n + m + 1], 1));
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strList.Strings[n + m + 1], 1));
ThUpper.Add(BrkUp(' ', strList.Strings[n + m + 1], 2));
lstLog.Add('THETA(' + IntToStr(m) + ') Upper Bound... ' +
BrkUp(' ', strList.Strings[n + m + 1], 2));
end;
end
else
// No bounds!
begin
lstLog.Add('No THETA boundaries detected...');
strT := '';
strT := strT + strList[n + 1];
if intTheta > 8 then
strT := strT + strList[n + 2];
if intTheta > 16 then
strT := strT + strList[n + 3];
if intTheta > 24 then
strT := strT + strList[n + 4];
//ShowMessage(strT);
for m := 1 to intTheta do
begin
if blnDebug then
ShowMessage('Starting THETA ' + IntToStr(m));
ThLower.Add('-1000000');
lstLog.Add('THETA(' + IntToStr(m) + ') Lower Bound... -1000000');
//ShowMessage(BrkUp(' ', Trim(strT), m-1));
ThInit.Add(BrkUp(' ', Trim(strT), m - 1));
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strT, m - 1));
ThUpper.Add('1000000');
lstLog.Add('THETA(' + IntToStr(m) + ') Upper Bound... 1000000');
end;
strT := '';
end;
// ********************************************************************
// Initial estimates of OMEGA
// ********************************************************************
// added 25/2/2011
try
if (Pos('INITIAL ESTIMATE OF OMEGA:', strList.Strings[n]) > 0) and
(Pos('BLOCK', strList[n + 1]) = 0) then
begin
lstLog.Add('--------------------------------------------');
lstLog.Add('Starting OMEGA initial estimates (simple)...');
lstLog.Add('--------------------------------------------');
for m := 1 to intOmega do
begin
if blnDebug then
ShowMessage('Starting OMEGA ' + IntToStr(m));
strT := '';
if m <= 10 then
OmInit.Add(BrkUp(' ', strList.Strings[n + m], m - 1))
else
OmInit.Add(BrkUp(' ', strList.Strings[n + m + (m - 10)], m - 11));
if m > 1 then
for p := 2 to m do
strT := strT + '0,';
if m <= 10 then
strT := strT + FloatToStr(StrToFloat(BrkUp(' ',
strList.Strings[n + m], m - 1), fs))
else
strT := strT + FloatToStr(StrToFloat(BrkUp(' ',
strList.Strings[n + m + (m - 10)], m - 11), fs));
lstMatrixOmegaInit.Add(strT);
if m <= 10 then
lstLog.Add('Eta(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strList.Strings[n + m], m - 1))
else
lstLog.Add('Eta(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strList.Strings[n + m + (m - 10)], m - 11));
end;
end;
except
;
end;
// ********************************************************************
// Initial estimates of OMEGA (block)
// ********************************************************************
try
if (Pos('INITIAL ESTIMATE OF OMEGA:', strList.Strings[n]) > 0) and
(Pos('BLOCK', strList[n + 1]) > 0) then
begin
blnBOInit := True;
lstLog.Add('--------------------------------------------');
lstLog.Add('Starting OMEGA initial estimates (block)...');
lstLog.Add('--------------------------------------------');
lstBlockOmega.Clear;
lstMatrixOmegaInit.Clear;
end;
if (blnBOInit)
and (Pos('YES', strList[n]) = 0)
and (Pos('NO', strList[n]) = 0)
and (Pos('SIGMA', strList[n]) = 0)
and (Pos('OMEGA', strList[n]) = 0)
and (Pos('BLOCK', strList[n]) = 0) then
begin
lstLog.Add('Adding line [' + IntToStr(n) + '] to OMEGA block...');
lstBlockOmega.Add(strList[n]);
//Showmessage('Adding line [' + IntToStr(n) + '] to OMEGA block...');
end;
if (blnBOInit)
and (Pos('YES', strList[n]) > 0) then
begin
intFixedOmegas := intFixedOmegas + 1;
lstLog.Add(' ETA(' + IntToStr(lstBlockOmega.Count + 1) + ') fixed!');
end;
except
;
end;
// ********************************************************************
// Finish initial estimates of OMEGA
// ********************************************************************
if ((Pos('INITIAL ESTIMATE OF SIGMA:', strList.Strings[n]) > 0)
or (Pos(' MONITORING OF SEARCH:', strList.Strings[n]) > 0)) and
(swBlockOmega = True) then
begin
//dlgLog.Lines.Assign(lstOmegaBlkVars);
//dlgLog.Execute;
blnBOInit := False;
lstLog.Add('Finishing OMEGA initial estimates...');
//ShowMessage(IntToStr(intOmega));
//ShowMessage('OmegaBlockList: ' + #10#13 + lstBlockOmega.Text);
//Capture ETAs
//p := -1;
brkUpp.StringList.Clear;
//ShowMessage(lstBlockOmega[m-1]);
//ShowMessage(lstBlockOmega.Text);
brkUpp.BaseString := '';
//ShowMessage(lstBlockOmega.Text);
//ShowMessage(strOmegaList.Text);
//ShowMessage(IntToStr(lstBlockOmega.Count) + '=' + IntToStr(strOmegaList.Count));
if lstBlockOmega.Count = strOmegaList.Count then
for m := 0 to lstBlockOmega.Count - 1 do
begin
brkUpp.BaseString := lstBlockOmega[m];
brkUpp.BreakApart;
OmInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
end
else
begin
p := 0;
//ShowMessage('go');
for m := 0 to strOmegaList.Count - 1 do
//for m := 0 to lstBlockOmega.Count - 1 do
begin
if m > 0 then
begin
// this code is faulty //
// rewrite to use strOmegaList as an index
// blocks are not handled properly
if (strOmegaList[m] <> strOmegaList[m-1]) and
(p <= lstBlockOmega.Count) then
p := p + 1;
brkUpp.BaseString := lstBlockOmega[p];
brkUpp.BreakApart;
OmInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
// end fault //
end
else
begin
brkUpp.BaseString := lstBlockOmega[m];
brkUpp.BreakApart;
OmInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
//ShowMessage(IntToStr(p) + ' ' + IntToStr(m) + ' ' + lstBlockOmega[p]);
end;
end;
//ShowMessage(OmInit.Text);
{for m := 1 to intOmega do
begin
if blnDebug then
ShowMessage('Starting OMEGA ' + IntToStr(m));
// Deal with SAMEs
p := p + m;
OmInit.Add(brkUpp.StringList[p]);
end; }
//ShowMessage('To here');
// Capture block
//ShowMessage(inttostr(intOmega));
if lstBlockOmega.Count = strOmegaList.Count then
for m := 0 to intOmega - 1 do
begin
strT := '';
brkUpp.BaseString := lstBlockOmega[m];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
for p := 0 to brkUpp.StringList.Count - 1 do
begin
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
end;
lstMatrixOmegaInit.Add(strT);
lstLog.Add('Processing ETA initial estimates (' + IntToStr(m) + ')...' +
strT);
if blnDebug then
begin
ShowMessage(strT);
ShowMessage(IntToStr(m) + ' - ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
end
else
begin
p := 0;
for m := 0 to intOmega - 1 do
begin
strT := '';
if m > 0 then
begin
//showmessage('here');
try
if (strOmegaList[m] <> strOmegaList[m-1]) and
(p <= lstBlockOmega.Count - 1) then
p := p + 1;
//showmessage('here 2');
brkUpp.BaseString := lstBlockOmega[p];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
for p := 0 to brkUpp.StringList.Count - 1 do
begin
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
end;
lstMatrixOmegaInit.Add(strT);
lstLog.Add('Processing ETA initial estimates (' + IntToStr(m) + ')...' +
strT);
except
//Showmessage('m=' + IntToStr(m) + ', p=' + IntToStr(p) +
// ', lstBlockOmega.Count=' + IntToStr(lstBlockOmega.Count));
//ShowMessage(lstBlockOmega.Text);
end;
end
else
begin
strT := '';
brkUpp.BaseString := lstBlockOmega[m];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
for p := 0 to brkUpp.StringList.Count - 1 do
begin
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
end;
lstMatrixOmegaInit.Add(strT);
lstLog.Add('Processing ETA initial estimates (' + IntToStr(m) + ')...' +
strT);
end;
if blnDebug then
begin
ShowMessage(strT);
ShowMessage(IntToStr(m) + ' - ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
end;
end;
{ for q := m to m+p do
if q < m+p then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q-1], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q-1], fs));
p := p + m; }
//end;
{for p := 0 to brkUpp.StringList.Count - 1 do
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//OmInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstMatrixOmegaInit.Add(strT);
lstLog.Add('Processing ETA initial estimates (' + IntToStr(m) + ')...' +
strT);
if blnDebug then
begin
ShowMessage(strT);
ShowMessage(IntToStr(m) + ' - ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end; }
//end;
//ShowMessage(OmInit.Text);
//ShowMessage(lstMatrixOmegaInit.Text);
end;
// ********************************************************************
// Initial estimates of SIGMA
// ********************************************************************
try
if (Pos('INITIAL ESTIMATE OF SIGMA:', strList.Strings[n]) > 0) and
(Pos('BLOCK', strList[n + 1]) = 0) then
for m := 1 to intSigma do
begin
if blnDebug then
ShowMessage('Starting Sigma ' + IntToStr(m));
lstLog.Add('Starting Sigma initial estimates (simple)...');
strT := '';
if m <= 10 then
SigInit.Add(BrkUp(' ', strList.Strings[n + m], m - 1))
else
SigInit.Add(BrkUp(' ', strList.Strings[n + m + (m - 10)], m - 11));
if m > 1 then
for p := 2 to m do
strT := strT + '0,';
if m <= 10 then
strT := strT + FloatToStr(StrToFloat(BrkUp(' ',
strList.Strings[n + m], m - 1), fs))
else
strT := strT + FloatToStr(StrToFloat(BrkUp(' ',
strList.Strings[n + m + (m - 10)], m - 11), fs));
lstMatrixSigmaInit.Add(strT);
if m <= 10 then
lstLog.Add('Eps(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strList.Strings[n + m], m - 1))
else
lstLog.Add('Eps(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', strList.Strings[n + m + (m - 10)], m - 11));
//SigInit.Add(BrkUp(' ', strList.Strings[n + m], m - 1));
//if m > 1 then
// for p := 2 to m do
// strT := strT + '0,';
//strT := strT + FloatToStr(StrToFloat(BrkUp(' ',
// strList.Strings[n + m], m - 1), fs));
//lstMatrixSigmaInit.Add(strT);
//lstLog.Add('Eps(' + IntToStr(m) + ') Initial Est... ' +
// BrkUp(' ', strList.Strings[n + m], m - 1));
end;
except
;
end;
// ********************************************************************
// Initial estimates of SIGMA (block)
// ********************************************************************
try
if (Pos('INITIAL ESTIMATE OF SIGMA:', strList.Strings[n]) > 0) and
(Pos('BLOCK', strList[n + 1]) > 0) then
begin
blnBSInit := True;
lstLog.Add('-------------------------------------------');
lstLog.Add('Starting Sigma initial estimates (block)...');
lstLog.Add('-------------------------------------------');
lstBlockSigma.Clear;
lstMatrixSigmaInit.Clear;
end;
if (blnBSInit)
and (Pos('YES', strList[n]) = 0)
and (Pos('NO', strList[n]) = 0)
and (Pos('SIGMA', strList[n]) = 0)
and (Pos('OMEGA', strList[n]) = 0)
and (Pos('BLOCK', strList[n]) = 0) then
begin
lstBlockSigma.Add(strList[n]);
end;
if (blnBSInit)
and (Pos('YES', strList[n]) > 0) then
begin
intFixedSigmas := intFixedSigmas + 1;
lstLog.Add(' ETA(' + IntToStr(lstBlockSigma.Count + 1) + ') fixed!');
end;
except
;
end;
// ********************************************************************
// Finish initial estimates of SIGMA
// ********************************************************************
if (Pos('ESTIMATION STEP OMITTED:', strList.Strings[n]) > 0) and
(swBlockSigma = True) then
begin
//dlgLog.Lines.Assign(lstSigmaBlkVars);
//dlgLog.Execute;
blnBSInit := False;
lstLog.Add('Finishing SIGMA initial estimates...');
//Capture EPSILONs
p := -1;
brkUpp.StringList.Clear;
brkUpp.BaseString := '';
for m := 0 to lstBlockSigma.Count - 1 do
brkUpp.BaseString := brkUpp.BaseString + ' ' + lstBlockSigma[m];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strT := '';
for m := 1 to intSigma do
begin
if blnDebug then
ShowMessage('Starting SIGMA ' + IntToStr(m));
// Deal with SAMEs
p := p + m;
//showmessage('m=' + IntToStr(m) + ', p=' + IntToStr(p) +
// 'brkupp=' + IntToStr(brkUpp.stringlist.Count-1));
if p <= brkUpp.StringList.Count - 1 then
SigInit.Add(brkUpp.StringList[p])
else
//ShowMessage(brkUpp.BaseString);
SigInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1])
//showmessage('done');
end;
// Capture block
for m := 0 to intSigma - 1 do
begin
strT := '';
brkUpp.BaseString := lstBlockSigma[m];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
for p := 0 to brkUpp.StringList.Count - 1 do
begin
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
end;
lstMatrixSigmaInit.Add(strT);
lstLog.Add('Processing EPSILON initial estimates (' + IntToStr(m) + ')...' +
strT);
if blnDebug then
begin
ShowMessage(strT);
ShowMessage(IntToStr(m) + ' - ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
end;
{//ShowMessage(IntToStr(intSigma));
for m := 1 to intSigma do
begin
if blnDebug then
ShowMessage('Starting Sigma ' + IntToStr(m));
// Deal with SAMEs
brkUpp.StringList.Clear;
//ShowMessage(lstBlockSigma[m-1]);
brkUpp.BaseString :=
lstBlockSigma[StrToInt(lstSigmaBlkVars[m - 1]) - 1];
//brkUpp.BaseString := lstBlockOmega[m - 1];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if p < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs)) + ','
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
SigInit.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstMatrixSigmaInit.Add(strT);
lstLog.Add('Processing SIGMA initial estimates (' + IntToStr(m) + ')...' +
strT);
if blnDebug then
begin
ShowMessage(strT);
ShowMessage(IntToStr(m) + ' - ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
end; }
end;
// ********************************************************************
// FOCE
// ********************************************************************
if Pos('CONDITIONAL ESTIMATES USED:', strList.Strings[n]) > 0 then
begin
strCondEst := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Conditional Estimates... ' + strCondEst);
end;
// ********************************************************************
// Centered ETA
// ********************************************************************
if Pos('CENTERED ETA:', strList.Strings[n]) > 0 then
begin
strCentEta := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Centered Eta... ' + strCentEta);
end;
// ********************************************************************
// INTERACTION
// ********************************************************************
if Pos('EPS-ETA INTERACTION:', strList.Strings[n]) > 0 then
begin
strInter := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Eps-Eta Interaction... ' + strInter);
end;
// ********************************************************************
// Laplacian
// ********************************************************************
if Pos('LAPLACIAN OBJ. FUNC.:', strList.Strings[n]) > 0 then
begin
strLaplacian := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Laplacian Obj Fn... ' + strLaplacian);
end;
// ********************************************************************
// Model
// ********************************************************************
if Pos('MAXIMUM NO. OF BASIC PK PARAMETERS:', strList.Strings[n]) > 0 then
begin
if Pos('MODEL SUBROUTINE USER-SUPPLIED', Trim(strList.Strings[n - 1])) > 0 then
strModel := Trim(strList.Strings[n - 2])
else
strModel := Trim(strList.Strings[n - 1]);
if Pos('0', strModel) = 1 then
strModel := Copy(strModel, 2, 500);
lstLog.Add('Model... ' + strModel);
end;
// ********************************************************************
// Check minimization step
// ********************************************************************
if Pos('0MINIMIZATION', strList.Strings[n]) > 0 then
begin
// Check final gradients
if Pos('0.0000E+00', strT2) > 0 then
begin
blnFZeroGradients := True;
lstLog.Add('Zero gradients detected in final iteration...');
strT2 := '';
end;
strMin := BrkUp(' ', strList.Strings[n], 1);
lstLog.Add('Minimization... ' + strMin);
if strMin = 'TERMINATED' then
begin
swMinTerm := True;
blnCovStep := False;
lstLog.Add('Minimization terminated ON');
lstLog.Add('Covariance step OFF');
if Pos('0', strList[n]) = 1 then
lstMinTerm.Add(Copy(strList[n], 2, 500))
else
lstMinTerm.Add(strList[n]);
end;
end;
// ********************************************************************
// Number of function evals
// ********************************************************************
if Pos('NO. OF FUNCTION EVALUATIONS USED:', strList.Strings[n]) > 0 then
begin
swMinTerm := False;
lstLog.Add('Minimization terminated OFF');
// if (strMin = 'TERMINATED') and (lstCovSum.Count > 0) then
//lstCovSum.Delete(lstCovSum.Count - 1);
strFnEval := BrkUp(':', strList.Strings[n], 1);
lstLog.Add('Fn Evals... ' + strFnEval);
end;
// ********************************************************************
// Number of significant digits overall
// ********************************************************************
if Pos('NO. OF SIG. DIGITS', strList.Strings[n]) > 0 then
begin
if Pos('NO. OF SIG. DIGITS IN FINAL EST.:', strList.Strings[n]) > 0 then
strSigDig := BrkUp(':', strList.Strings[n], 1)
else
strSigDig := 'UNREPORTABLE';
lstLog.Add('Sig Digits... ' + strSigDig);
swCovSum := True;
lstLog.Add('Covariate summary ON');
end;
// ********************************************************************
// ETABAR
// ********************************************************************
if Pos('ETABAR', strList.Strings[n]) > 0 then
begin
swCovSum := False;
lstLog.Add('Covariate summary OFF');
//if lstCovSum.Count > 0 then
//lstCovSum.Delete(lstCovSum.Count - 1);
end;
if Pos('ETABAR:', strList.Strings[n]) > 0 then
begin
strT := '';
intOmegaRatio := (intOmega - intFixedOmegas) div 10;
//ShowMessage(inttostr(intOmega - intFixedOmegas));
for m := 0 to intOmegaRatio do
strT := strT + strList.Strings[n + m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
m := 0;
//ShowMessage(strT + ' ' + inttostr(intOmega));
while brkUpp.StringList.Count < intOmega + 1 do
begin
m := m + 1;
if Pos('SE', strList[n + m]) = 0 then
strT := strT + strList[n+m]
else
begin
MessageDlg('Error processing EtaBar!', mtError, [mbOK], 0);
Exit;
end;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
if m = 10 then
begin
MessageDlg('Error processing EtaBar!', mtError, [mbOK], 0);
Exit;
end;
end;
//for m := 1 to (intOmega - intFixedOmegas) do
//ShowMessage(strT);
for m := 1 to intOmega do
begin
//ShowMessage(strT);
EtaBar.Add(BrkUp(' ', strT, m));
lstLog.Add('EtaBar (' + IntToStr(m) + ')... ' +
BrkUp(' ', strT, m));
end;
//ShowMessage(EtaBar.Text);
end;
// ********************************************************************
// ETABAR SEs
// ********************************************************************
if (Pos('SE:', strList.Strings[n]) > 0) then
begin
strT := '';
intOmegaRatio := (intOmega - intFixedOmegas) div 10;
for m := 0 to intOmegaRatio do
strT := strT + strList.Strings[n + m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
m := 0;
while brkUpp.StringList.Count < intOmega + 1 do
begin
m := m + 1;
if Pos('P VAL', strList[n + m]) = 0 then
strT := strT + strList[n+m]
else
begin
MessageDlg('Error [1] processing EtaBar SEs!', mtError, [mbOK], 0);
Exit;
end;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
if m = 10 then
begin
MessageDlg('Error [2] processing EtaBar SEs!', mtError, [mbOK], 0);
Exit;
end;
end;
//ShowMessage(strT);
//for m := 1 to (intOmega - intFixedOmegas) do
for m := 1 to intOmega do
begin
EtaBarSE.Add(BrkUp(' ', strT, m));
lstLog.Add('Eta SE (' + IntToStr(m) + ')... ' +
BrkUp(' ', strT, m));
end;
//ShowMessage(EtaBarSE.Text);
swCovSum := True;
lstLog.Add('Covariate summary ON');
end;
// ********************************************************************
// ETABAR P values
// ********************************************************************
if Pos('P VAL.:', strList.Strings[n]) > 0 then
begin
strT := '';
intOmegaRatio := (intOmega - intFixedOmegas) div 10;
for m := 0 to intOmegaRatio do
strT := strT + strList.Strings[n + m];
//for m := 2 to (intOmega - intFixedOmegas) + 1 do
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
m := 0;
while brkUpp.StringList.Count < intOmega + 2 do
begin
m := m + 1;
if (Pos('***', strList[n + m]) = 0) and (Pos('1', strList[n + m]) <> 1) then
strT := strT + strList[n+m]
else
begin
MessageDlg('Error processing EtaBar p-values!', mtError, [mbOK], 0);
Exit;
end;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
if m = 10 then
begin
MessageDlg('Error processing EtaBar p-values!', mtError, [mbOK], 0);
Exit;
end;
end;
//ShowMessage(strT);
for m := 2 to intOmega + 1 do
begin
EtaP.Add(BrkUp(' ', strT, m));
lstLog.Add('Eta P Value (' + IntToStr(m) + ')... ' +
BrkUp(' ', strT, m));
end;
//ShowMessage(EtaP.Text);
swCovSum := True;
lstLog.Add('Covariate summary ON');
end;
// ********************************************************************
// Turn off covariance summary
// ********************************************************************
if Pos('********************',
strList.Strings[n]) > 0 then
begin
swCovSum := False;
lstLog.Add('Covariance summary OFF');
end;
// ********************************************************************
// Read objective function value
// ********************************************************************
if Pos(' ************************************************** ',
strList.Strings[n]) > 0 then
begin
strObj := BrkUp(' ', strList.Strings[n], 1);
lstLog.Add('Obj... ' + strObj);
if Pos('*', strObj) > 0 then // No OBF case
begin
strObj := '';
if Length(strObj2) > 0 then
begin
strObj := strObj2;
blnOFVWarn := True;
end;
end;
//ShowMessage('obj');
blnOFVSeen := True;
end;
// ********************************************************************
// Standard errors switch
// ********************************************************************
if Pos(' ******************** STANDARD ERROR OF ESTIMATE',
strList.Strings[n]) > 0 then
begin
swFP := False;
swSE := True;
lstLog.Add('Standard error block detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' SEs switched ON');
//ShowMessage('Standard Errors on');
end;
// ********************************************************************
// Read THETA & ETA & EPS estimates
// ********************************************************************
if (swFP = True) or (swSE = True) then
begin
if Pos(' TH 1', strList.Strings[n]) > 0 then
if swFP then
begin // new begin
lstLog.Add('Starting THETA FP section...');
// ********************************************************************
// Read THETA estimates - MSF case
// ********************************************************************
if intTheta = 0 then // cope with MSFO runs
begin
lstLog.Add('MSFO detected...');
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n] + ' ' + strList[n + 1];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intTheta := brkUpp.StringList.Count;
end;
// ********************************************************************
// Read THETA estimates
// ********************************************************************
m := 0;
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
brkUpp.BreakString := ' ';
while Pos('OMEGA - COV MATRIX FOR RANDOM EFFECTS', strList[n + m]) = 0 do
begin
if Pos('TH', strList[n + m]) = 0 then
brkUpp.BaseString := brkUpp.BaseString + strList[n + m];
m := m + 1;
end;
brkUpp.BreakApart;
// Single-subject fix
if ThValue.Count = intTheta then
ThValue.Clear;
// end fix
for m := 0 to brkUpp.StringList.Count - 1 do
begin
ThValue.Add(brkUpp.StringList[m]);
lstLog.Add('Theta(' + IntToStr(m + 1) + ')... ' +
brkUpp.StringList[m]);
end;
//ShowMessage(ThValue.Text);
//ShowMessage(IntToStr(n));
end
else
if swSE then
// ********************************************************************
// Read THETA standard errors
// ********************************************************************
begin
lstLog.Add('Starting THETA SE section...');
m := 0;
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
brkUpp.BreakString := ' ';
while Pos('OMEGA - COV MATRIX FOR RANDOM EFFECTS', strList[n + m]) = 0 do
begin
if Pos('TH', strList[n + m]) = 0 then
brkUpp.BaseString := brkUpp.BaseString + strList[n + m];
m := m + 1;
end;
brkUpp.BreakApart;
for m := 0 to brkUpp.StringList.Count - 1 do
begin
ThSE.Add(brkUpp.StringList[m]);
lstLog.Add('Theta SE(' + IntToStr(m + 1) + ')... ' +
brkUpp.StringList[m]);
end;
end;
// ********************************************************************
// Read ETA results
// ********************************************************************
if Pos('******************** S MATRIX',
strList[n]) > 0 then
begin
lstLog.Add('S matrix detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' Standard errors switched OFF');
swFP := False;
swSE := False;
end;
if Pos('******************** R MATRIX',
strList[n]) > 0 then
begin
lstLog.Add('R matrix detected...');
lstLog.Add(' Final parameters switched OFF');
lstLog.Add(' Standard errors switched OFF');
swFP := False;
swSE := False;
end;
if (Pos(' ETA1', strList.Strings[n]) > 0) then
begin
lstLog.Add('Starting ETA FP section...');
if intOmega = 0 then // cope with MSFO runs
begin
lstLog.Add('MSFO detected...');
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n] + ' ' + strList[n + 1];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intOmega := brkUpp.StringList.Count;
end;
// ********************************************************************
// ETA final parameters
// ********************************************************************
if (swFP) and (lstMatrixOmega.Count <> intOmega) then
// for m := 1 to intOmega do
begin
blnLT := False; // Line length
if Length(strList[n]) < 125 then
blnLT := True;
// ********************************************************************
// ETA final parameters - matrix
// ********************************************************************
lstLog.Add('Starting ETA FP matrix...');
intT2L := 0;
p := 0;
strT2 := '';
lstScratch.Clear;
if intSigma > 0 then
while (Pos('SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS ****', strList[n + p]) = 0) do
begin
strT2 := '';
if Pos('+ ', strList[n + p]) > 0 then
begin
intLines := 1;
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) then
begin
intLines := 2;
if (Pos('E+', strList[n + p + 2]) > 0) or
(Pos('E-', strList[n + p + 2]) > 0) then
begin
intLines := 3;
if (Pos('E+', strList[n + p + 3]) > 0) or
(Pos('E-', strList[n + p + 3]) > 0) then
begin
intLines := 4;
if (Pos('E+', strList[n + p + 4]) > 0) or
(Pos('E-', strList[n + p + 4]) > 0) then
begin
intLines := 5;
if (Pos('E+', strList[n + p + 5]) > 0) or
(Pos('E-', strList[n + p + 5]) > 0) then
intLines := 6;
end;
end;
end;
end;
end;
//ShowMessage('test');
for r := 0 to intLines - 1 do
strT2 := strT2 + ' ' + strList[n + p + r];
if (Trim(strT2) <> '') and (Pos('ET', strT2) = 0) and
(Length(strT2) > intT2L) then
begin
lstScratch.Add(strT2);
intT2L := Length(strT2);
//ShowMessage(strT2);
end;
p := p + 1;
end
else
while ((Pos(' ************************************************************************************************************************', strList[n + p]) = 0)
and ((Pos('MONITORING OF SEARCH:', strList[n + p]) = 0))) do
begin
strT2 := '';
if Pos('+ ', strList[n + p]) > 0 then
begin
intLines := 1;
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) then
begin
intLines := 2;
if (Pos('E+', strList[n + p + 2]) > 0) or
(Pos('E-', strList[n + p + 2]) > 0) then
begin
intLines := 3;
if (Pos('E+', strList[n + p + 3]) > 0) or
(Pos('E-', strList[n + p + 3]) > 0) then
begin
intLines := 4;
if (Pos('E+', strList[n + p + 4]) > 0) or
(Pos('E-', strList[n + p + 4]) > 0) then
begin
intLines := 5;
if (Pos('E+', strList[n + p + 5]) > 0) or
(Pos('E-', strList[n + p + 5]) > 0) then
intLines := 6;
end;
end;
end;
end;
end;
//ShowMessage('test');
for r := 0 to intLines - 1 do
strT2 := strT2 + ' ' + strList[n + p + r];
if (Trim(strT2) <> '') and (Pos('ET', strT2) = 0) and
(Length(strT2) > intT2L) then
begin
lstScratch.Add(strT2);
intT2L := Length(strT2);
//ShowMessage(strT2);
end;
p := p + 1;
end;
//ShowMessage(IntToStr(lstScratch.Count));
for p := 0 to lstScratch.Count - 1 do
begin
brkUpp.BaseString := '';
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BaseString := lstScratch[p];
brkUpp.BreakString := ' ';
brkUpp.BaseString := StringReplace(brkUpp.BaseString, '+', '', [rfReplaceAll]);
brkUpp.BreakApart;
strT := '';
for q := 0 to brkUpp.StringList.Count - 1 do
if q < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs)) + ','
else
begin
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs));
Eta.Add(FloatToStr(StrToFloat(brkUpp.StringList[q], fs)));
end;
if lstMatrixOmega.Count < lstScratch.Count then
begin
lstMatrixOmega.Add(strT);
//ShowMessage(strT);
//Showmessage(IntToStr(lstMatrixOmega.Count));
//if lstMatrixOmega.Count = intOmega + 1 then
// lstMatrixOmega.Delete(lstMatrixOmega.Count - 1);
lstLog.Add('OMEGA matrix [' + IntToStr(lstMatrixOmega.Count) + '] completed...');
end;
//ShowMessage('OMEGA matrix [' + IntToStr(lstMatrixOmega.Count) + '] completed...');
end;
Eta.Clear;
for r := 0 to lstMatrixOmega.Count - 1 do
begin
Eta.Add(brkUp(',', lstMatrixOmega[r], r));
end;
end
else
if (swSE) and (OmSE.Count <> intOmega) then
// ********************************************************************
// ETA standard error - estimates
// ********************************************************************
begin
lstLog.Add('Starting ETA SE matrix...');
intT2L := 0;
p := 0;
strT2 := '';
lstScratch.Clear;
if intSigma > 0 then
while Pos('SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS ****', strList[n + p]) = 0 do
begin
strT2 := '';
if Pos('+ ', strList[n + p]) > 0 then
begin
intLines := 1;
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) or
(Pos('.........', strList[n + p + 1]) > 0) then
begin
intLines := 2;
if (Pos('E+', strList[n + p + 2]) > 0) or
(Pos('E-', strList[n + p + 2]) > 0) or
(Pos('.........', strList[n + p + 2]) > 0) then
begin
intLines := 3;
if (Pos('E+', strList[n + p + 3]) > 0) or
(Pos('E-', strList[n + p + 3]) > 0) or
(Pos('.........', strList[n + p + 3]) > 0) then
begin
intLines := 4;
if (Pos('E+', strList[n + p + 4]) > 0) or
(Pos('E-', strList[n + p + 4]) > 0) or
(Pos('.........', strList[n + p + 4]) > 0) then
begin
intLines := 5;
if (Pos('E+', strList[n + p + 5]) > 0) or
(Pos('E-', strList[n + p + 5]) > 0) or
(Pos('.........', strList[n + p + 5]) > 0) then
intLines := 6;
end;
end;
end;
end;
end;
for r := 0 to intLines - 1 do
strT2 := strT2 + ' ' + strList[n + p + r];
if (Trim(strT2) <> '') and (Pos('ET', strT2) = 0) and
(Length(strT2) > intT2L) then
begin
lstScratch.Add(strT2);
intT2L := Length(strT2);
//ShowMessage(strT2);
end;
p := p + 1;
end
else
while Pos(' ************************************************************************************************************************', strList[n + p]) = 0 do
begin
strT2 := '';
if Pos('+ ', strList[n + p]) > 0 then
begin
intLines := 1;
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) or
(Pos('.........', strList[n + p + 1]) > 0) then
begin
intLines := 2;
if (Pos('E+', strList[n + p + 2]) > 0) or
(Pos('E-', strList[n + p + 2]) > 0) or
(Pos('.........', strList[n + p + 2]) > 0) then
begin
intLines := 3;
if (Pos('E+', strList[n + p + 3]) > 0) or
(Pos('E-', strList[n + p + 3]) > 0) or
(Pos('.........', strList[n + p + 3]) > 0) then
begin
intLines := 4;
if (Pos('E+', strList[n + p + 4]) > 0) or
(Pos('E-', strList[n + p + 4]) > 0) or
(Pos('.........', strList[n + p + 4]) > 0) then
begin
intLines := 5;
if (Pos('E+', strList[n + p + 5]) > 0) or
(Pos('E-', strList[n + p + 5]) > 0) or
(Pos('.........', strList[n + p + 5]) > 0) then
intLines := 6;
end;
end;
end;
end;
end;
for r := 0 to intLines - 1 do
strT2 := strT2 + ' ' + strList[n + p + r];
if (Trim(strT2) <> '') and (Pos('ET', strT2) = 0) and
(Length(strT2) > intT2L) then
begin
lstScratch.Add(strT2);
intT2L := Length(strT2);
//ShowMessage(strT2);
end;
p := p + 1;
end;
for p := 0 to lstScratch.Count - 1 do
begin
brkUpp.BaseString := '';
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BaseString := lstScratch[p];
brkUpp.BreakString := ' ';
brkUpp.BaseString := StringReplace(brkUpp.BaseString, '+', '', [rfReplaceAll]);
brkUpp.BaseString := StringReplace(brkUpp.BaseString, '.........', '0', [rfReplaceAll]);
brkUpp.BreakApart;
strT := '';
for q := 0 to brkUpp.StringList.Count - 1 do
if q < brkUpp.StringList.Count - 1 then
begin
if Pos('..', brkUpp.StringList[q]) > 0 then
strT := strT + '0,'
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs)) + ',';
end
else
begin
if Pos('..', brkUpp.StringList[q]) > 0 then
strT := strT + '0'
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs));
if Pos('..', brkUpp.StringList[q]) > 0 then
OmSE.Add('0')
else
OmSE.Add(FloatToStr(StrToFloat(brkUpp.StringList[q], fs)));
end;
if lstMatrixOmegaSE.Count < lstScratch.Count then
begin
lstMatrixOmegaSE.Add(strT);
lstLog.Add('OMEGA matrix [' + IntToStr(lstMatrixOmegaSE.Count) + '] completed...');
end;
end;
OmSE.Clear;
for r := 0 to lstMatrixOmegaSE.Count - 1 do
begin
OmSE.Add(brkUp(',', lstMatrixOmegaSE[r], r));
end;
end
else
lstLog.Add('No ETA SE section...');
end;
// ********************************************************************
// Read SIGMA results
// ********************************************************************
if Pos(' EPS1', strList[n]) > 0 then
begin
lstLog.Add('Starting EPSILON FP section...');
if intSigma = 0 then // cope with MSFO runs
begin
lstLog.Add('MSFO detected...');
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n] + ' ' + strList[n + 1];
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intSigma := brkUpp.StringList.Count;
end;
// ********************************************************************
// EPSILON final parameters
// ********************************************************************
if (swFP) and (lstMatrixSigma.Count <> intSigma) then
// for m := 1 to intOmega do
begin
blnLT := False; // Line length
if Length(strList[n]) < 125 then
blnLT := True;
// ********************************************************************
// EPSILON final parameters - matrix
// ********************************************************************
if Trim(strMin) = 'TERMINATED' then
begin
lstLog.Add('Starting EPS FP matrix (terminated)...');
p := 0;
lstScratch.Clear;
while (n + p + 1 <= strList.Count - 1) do
begin
if Pos('+ ', strList[n + p]) > 0 then
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) then
lstScratch.Add(strList[n + p] + ' ' + strList[n + p + 1])
else
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
end
else
begin
lstLog.Add('Starting EPS FP matrix (successful)...');
p := 0;
lstScratch.Clear;
//while Pos('1', strList[n + p]) <> 1 do
//ShowMessage(IntToStr(strList.Count - 1));
while ((n + p < strList.Count - 1) and
(Pos('1', strList[n + p]) <> 1)) do
begin
//ShowMessage(strList[n + p]);
if Pos('+ ', strList[n + p]) > 0 then
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) then
lstScratch.Add(strList[n + p] + ' ' + strList[n + p + 1])
else
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
end;
for p := 0 to lstScratch.Count - 1 do
begin
brkUpp.BaseString := '';
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BaseString := lstScratch[p];
brkUpp.BreakString := ' ';
brkUpp.BaseString := StringReplace(brkUpp.BaseString, '+', '', [rfReplaceAll]);
brkUpp.BreakApart;
strT := '';
for q := 0 to brkUpp.StringList.Count - 1 do
if q < brkUpp.StringList.Count - 1 then
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs)) + ','
else
begin
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs));
Eps.Add(FloatToStr(StrToFloat(brkUpp.StringList[q], fs)));
end;
lstMatrixSigma.Add(strT);
//ShowMessage(strT);
//Showmessage(IntToStr(lstMatrixOmega.Count));
if lstMatrixSigma.Count = intSigma + 1 then
lstMatrixSigma.Delete(lstMatrixSigma.Count - 1);
lstLog.Add('SIGMA matrix [' + IntToStr(lstMatrixSigma.Count) + '] completed...');
end;
end
else
if (swSE) and (SigSE.Count <> intSigma) then
// ********************************************************************
// EPSILON standard error - estimates
// ********************************************************************
begin
lstLog.Add('Starting SIGMA SE matrix...');
p := 0;
lstScratch.Clear;
//while Pos('1', strList[n + p]) <> 1 do
while ((n + p + 1 < strList.Count - 1) and
(Pos('1', strList[n + p]) <> 1)) do
begin
if Pos('+ ', strList[n + p]) > 0 then
if (Pos('E+', strList[n + p + 1]) > 0) or
(Pos('E-', strList[n + p + 1]) > 0) then
lstScratch.Add(strList[n + p] + ' ' + strList[n + p + 1])
else
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
for p := 0 to lstScratch.Count - 1 do
begin
brkUpp.BaseString := '';
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BaseString := lstScratch[p];
brkUpp.BreakString := ' ';
brkUpp.BaseString := StringReplace(brkUpp.BaseString, '+', '', [rfReplaceAll]);
brkUpp.BreakApart;
strT := '';
for q := 0 to brkUpp.StringList.Count - 1 do
if q < brkUpp.StringList.Count - 1 then
begin
if Pos('..', brkUpp.StringList[q]) > 0 then
strT := strT + '0,'
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs)) + ',';
end
else
begin
if Pos('..', brkUpp.StringList[q]) > 0 then
strT := strT + '0'
else
strT := strT + FloatToStr(StrToFloat(brkUpp.StringList[q], fs));
if Pos('..', brkUpp.StringList[q]) > 0 then
SigSE.Add('0')
else
SigSE.Add(FloatToStr(StrToFloat(brkUpp.StringList[q], fs)));
end;
lstMatrixSigmaSE.Add(strT);
lstLog.Add('SIGMA matrix [' + IntToStr(lstMatrixSigmaSE.Count) + '] completed...');
end;
end
else
lstLog.Add('No SIGMA SE section...');
end;
{ m := 0;
if blnCovStep then
begin
lstLog.Add('EPSILONS: Covariance case...');
while (Pos('************************************************************************************************************************',
strList[n + m]) = 0) do
begin
if Pos('+ ', strList[n + m]) > 0 then
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n + m];
brkUpp.BreakString := ' ';
brkUpp.AllowEmptyString := False;
if Pos('E+', strList[n + m + 1]) > 0 then
brkUpp.BaseString := brkUpp.BaseString + ' ' +
strList[n + m + 1];
//ShowMessage(brkUpp.BaseString);
brkUpp.BaseString := StringReplace(brkUpp.BaseString,
'+ ', '', [rfReplaceAll]);
//ShowMessage(brkUpp.BaseString);
brkUpp.BreakApart;
Eps.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstLog.Add('Epsilon(' + IntToStr(Eps.Count) + ')... ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
if n + m <= strList.Count - 1 then
m := m + 1;
end;
end
else
begin
lstLog.Add('EPSILONS: No covariance case...');
while (n + m <= strList.Count - 1) do
begin
if Pos('+ ', strList[n + m]) > 0 then
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := strList[n + m];
brkUpp.BreakString := ' ';
brkUpp.AllowEmptyString := False;
if Pos('E+', strList[n + m + 1]) > 0 then
brkUpp.BaseString := brkUpp.BaseString + ' ' +
strList[n + m + 1];
//ShowMessage(brkUpp.BaseString);
brkUpp.BaseString := StringReplace(brkUpp.BaseString,
'+ ', '', [rfReplaceAll]);
//ShowMessage(brkUpp.BaseString);
brkUpp.BreakApart;
Eps.Add(brkUpp.StringList[brkUpp.StringList.Count - 1]);
lstLog.Add('Epsilon(' + IntToStr(Eps.Count) + ')... ' +
brkUpp.StringList[brkUpp.StringList.Count - 1]);
end;
m := m + 1;
end;
end;
end;
end; }
end;
// ********************************************************************
// Covariance matrix
// ********************************************************************
if Pos(' ******************** COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting covariance matrix...');
//ShowMessage('Starting Cov matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
// Nick's exception
if (Pos('Optimality', strList[n + p]) = 0) and
(Pos('Optimality', strList[n + p - 1]) = 0) and
(Pos('Optimality', strList[n + p - 2]) = 0) and
(Pos('Optimality', strList[n + p - 3]) = 0) and
(Pos('Optimality', strList[n + p - 4]) = 0) and
(Pos('Optimality', strList[n + p - 5]) = 0) then
// On with the show
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCovMatrix.Add(strT)
else
if lstCovMatrix.Count = 0 then
lstCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCovMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Correlation matrix
// ********************************************************************
if Pos(' ******************** CORRELATION MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting correlation matrix...');
//ShowMessage('Starting Corr matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCorrMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCorrMatrix.Add(strT)
else
if lstCorrMatrix.Count = 0 then
lstCorrMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate correlation matrix
// ********************************************************************
begin
lstLog.Add('Alternate correlation matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCorrMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCorrMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Inverse covariance matrix
// ********************************************************************
if Pos(' ******************** INVERSE COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting inverse covariance matrix...');
//ShowMessage('Starting InvCov matrix');
p := 5;
lstScratch.Clear;
while (n + p + 1 <= strList.Count - 1) and
(Pos('***************', strList[n + p]) = 0) do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
// showmessage('done');
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstInvCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstInvCovMatrix.Add(strT)
else
if lstInvCovMatrix.Count = 0 then
lstInvCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate inverse covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate inverse covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstInvCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstInvCovMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Eigenvalues
// ********************************************************************
if Pos(' ******************** EIGENVALUES OF COR MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting eigenvalues...');
lstScratch.Clear;
strT := '';
if (Pos('E', strList[n + 5]) >= 1) then
strT := Trim(strList[n + 5]);
if (Pos('E', strList[n + 6]) >= 1) then
strT := strT + strList[n + 6];
//ShowMessage(strT);
if (n + 7 <= strList.Count - 1) and
(NoAlpha(strList[n + 7])) and
(Pos('****', strList[n + 7]) = 0) and
(Pos('E', strList[n + 7]) >= 1) then
strT := strT + strList[n + 7];
if (n + 8 <= strList.Count - 1) then
if (Length(Trim(strList[n + 8])) > 0) and
(NoAlpha(strList[n + 8])) and
(Pos('****', strList[n + 8]) = 0) and
(Pos('E', strList[n + 8]) >= 1) then
strT := strT + strList[n + 8];
if (n + 9 <= strList.Count - 1) then
if (Length(Trim(strList[n + 9])) > 0) and
(NoAlpha(strList[n + 9])) and
(Pos('****', strList[n + 9]) = 0) and
(Pos('E', strList[n + 9]) >= 1) then
strT := strT + strList[n + 9];
if (n + 10 <= strList.Count - 1) then
if (Length(Trim(strList[n + 10])) > 0) and
(NoAlpha(strList[n + 10])) and
(Pos('****', strList[n + 10]) = 0) and
(Pos('E', strList[n + 10]) >= 1) then
strT := strT + strList[n + 10];
if (n + 11 <= strList.Count - 1) then
if (Length(Trim(strList[n + 11])) > 0) and
(NoAlpha(strList[n + 11])) and
(Pos('****', strList[n + 11]) = 0) and
(Pos('E', strList[n + 11]) >= 1) then
strT := strT + strList[n + 11];
if (n + 12 <= strList.Count - 1) then
if (Length(Trim(strList[n + 12])) > 0) and
(NoAlpha(strList[n + 12])) and
(Pos('****', strList[n + 12]) = 0) and
(Pos('E', strList[n + 12]) >= 1) then
strT := strT + strList[n + 12];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strT := '';
//showmessage(brkUpp.StringList.Text);
//ShowMessage(IntToStr(Round((brkUpp.StringList.Count/2)) - 1));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
lstEigen.Add(strT);
SetRoundMode(rmNearest);
//ShowMessage(strT);
//ShowMessage(brkUpp.StringList.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
begin
strT := FloatToStr(StrToFloat(brkUpp.StringList[m]));
for p := 0 to brkUpp.StringList.Count - 1 do
begin
strT := strT + ',' + FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
end;
//ShowMessage(strT);
lstEigen.Add(strT);
end;
end;
{ for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
strT := FloatToStr(StrToFloat(brkUpp.StringList[m], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' +
FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
lstEigen.Add(strT);
end; }
lstLog.Add('Starting condition number...');
// ********************************************************************
// Condition number
// ********************************************************************
fltEigenUpper := 0.00000000001;
fltEigenLower := 100000000000;
fltCondNo := 0;
//ShowMessage(brkUpp.StringList.Text);
//ShowMessage(lstEigen.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
//ShowMessage(IntToStr(m) + ' ' + brkUpp.StringList[m]);
if (StrToFloat(brkUpp.StringList[m], fs) > fltEigenUpper) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenUpper := StrToFloat(brkUpp.StringList[m], fs);
if (StrToFloat(brkUpp.StringList[m], fs) < fltEigenLower) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenLower := StrToFloat(brkUpp.StringList[m], fs);
end;
fltCondNo := Abs(RoundTo(fltEigenUpper / fltEigenLower, -2));
end;
end;
except
on E: Exception do
// ********************************************************************
// Exception message
// ********************************************************************
begin
MessageDlg('An error has occurred while processing the NONMEM output file. ' +
'Please check to make sure that the output file being read is ' +
'correctly structured.' + #10#13#10#13 + 'If it seems correct, please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtWarning, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
lstLog.SaveToFile(ExtractFilePath(Application.Exename) + 'run' +
strRun + '_error.log');
dlgLog.Execute;
end;
end;
end;
// ********************************************************************
// Free strList
// ********************************************************************
strList.Free;
lstLog.Add('Completed output file...');
strT := '';
//dlgLog.Lines.Assign(lstLog);
//dlgLog.Execute;
// ********************************************************************
// Read model specification file
// ********************************************************************
lstLog.Add('Starting model specification file...');
strModFile := StringReplace(nmFile, extLst, extCtl,
[rfIgnoreCase]);
// showmessage(strModFile);
if not FileExists(strModFile) then
begin
if FileExists(StringReplace(strModFile, '.mod', '.ctl',
[rfIgnoreCase])) then
strModFile := StringReplace(strModFile, '.mod', '.ctl',
[rfIgnoreCase]);
if FileExists(StringReplace(strModFile, '.ctl', '.mod',
[rfIgnoreCase])) then
strModFile := StringReplace(strModFile, '.ctl', '.mod',
[rfIgnoreCase]);
end;
if not FileExists(strModFile) then
begin
lstLog.Add('No control stream found');
if blnInlineCtl then
strModFile := nmFile
else
if MessageDlg('No likely control stream file (ideally looking for ' +
strModFile + ') was located for ' +
'this run (' + strRun + '). ' +
'Would you like to select one?', mtConfirmation, [mbYes,
mbNo], 0) = mrYes then
begin
if dlgOpenMod.Execute then
strModFile := dlgOpenMod.FileName;
end
else
strModFile := '';
end;
lstLog.Add('-----------------------------------------');
lstLog.Add('Control stream... ' + strModFile);
lstLog.Add('Attempting to open...');
lstLog.Add('-----------------------------------------');
// ********************************************************************
// Open control stream
// ********************************************************************
if strModFile <> '' then
if FileExists(strModFile) then
begin
strList := TStringList.Create;
ThetaModel := TStringList.Create;
strList.LoadFromFile(strModFile);
PKParams := TStringList.Create;
blnPriors := False;
for n := 0 to strList.Count - 1 do
begin
try
//ShowMessage(strList[n]);
// ********************************************************************
// Read ;;;C Parent
// ********************************************************************
if (Pos(';;;C Parent=', strList[n]) > 0) then
strParent := Trim(StringReplace(strList[n], ';;;C Parent=', '', [rfReplaceAll]));
// ********************************************************************
// Notes
// ********************************************************************
if ((Pos(';;', strList[n]) > 0) and (Pos(';;;C', strList[n]) = 0)) then
lstNotes.Add(Trim(StringReplace(strList[n], ';;', '', [rfReplaceAll])));
// ********************************************************************
// PsN runrecord annotation
// ********************************************************************
if ((Pos(';;', strList[n]) > 0) and (Pos(';;;C', strList[n]) = 0)) then
lstPsNRunRec.Add(Trim(strList[n]));
// ********************************************************************
// $SUBROUTINE block on/off
// ********************************************************************
if ((Pos('$SUBS', strList[n]) > 0) or (Pos('$SUBROUTINES', strList[n]) > 0)) then
begin
btnSub := True;
//ShowMessage('Subs on');
end;
if (Pos('$', strList[n]) > 0) and
((Pos('$SUBS', strList[n]) = 0) and (Pos('$SUBROUTINES', strList[n]) = 0)) then
begin
btnSub := False;
end;
// ********************************************************************
// Check for priors
// ********************************************************************
if btnSub then
if Pos('PRIOR', strList[n]) > 0 then
begin
//ShowMessage('Priors on');
blnPriors := True;
end;
// ********************************************************************
// $PK block on/off
// ********************************************************************
if Pos('$PK', strList[n]) > 0 then
btnPK := True;
if (Pos('$', strList[n]) > 0) and
(Pos('$PK', strList[n]) = 0) then
btnPK := False;
// ********************************************************************
// Read $PK block
// ********************************************************************
if btnPK then
PKParams.Add(strList[n]);
// ********************************************************************
// Read $DATA block
// ********************************************************************
if Pos('$DATA', strList.Strings[n]) > 0 then
begin
strDataFile := BrkUp(' ', strList.Strings[n], 1);
//ShowMessage(strDatafile);
strDataFile := StringReplace(strDataFile, '"', '', [rfReplaceall]);
strDataFile := StringReplace(strDataFile, '''', '', [rfReplaceall]);
strDataFile := StringReplace(strDataFile, '/', '\', [rfReplaceall]);
if Pos(':', strDataFile) = 0 then
strDataFile := ExtractFilePath(nmFile) + strDataFile;
lstLog.Add('Datafile... ' + strDataFile);
//ShowMessage(strDatafile);
end;
// ********************************************************************
// Read $THETA block
// ********************************************************************
if (Pos('$THETA', strList.Strings[n]) = 0) and
(Pos('$', Trim(strList.Strings[n])) = 1) then
blnThetasOn := False;
if Pos('$THETA', strList.Strings[n]) > 0 then
begin
blnThetasOn := True;
if ThInit.Count <> intTheta then
AddThetaMSFInits(strList[n], ThInit, ThLower, ThUpper);
if Pos(';', strList[n]) > 0 then
begin
ThLabel.Add(BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Theta Label... ' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage(BrkUp(';', strList.Strings[n], 1) + ' one');
end
else
begin
ThLabel.Add(' ');
lstLog.Add('Theta Label... None!');
end;
end;
// In a block
if (blnThetasOn) and (Pos(';', strList[n]) > 0) and
(Pos(';', Trim(strList[n])) > 1) and (Pos('$THETA', strList.Strings[n]) = 0) then
begin
ThLabel.Add(BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Theta Label... ' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage(BrkUp(';', strList.Strings[n], 1) + ' two');
end;
// ********************************************************************
// Read ETA labels
// ********************************************************************
if Pos('$OMEGA', strList.Strings[n]) > 0 then
begin
// Is it commented out?
//Showmessage('on');
if Pos(';', strList.Strings[n]) > Pos('$OMEGA', strList.Strings[n]) then
blnEtasOn := True;
// No comment?
if Pos(';', strList.Strings[n]) = 0 then
blnEtasOn := True;
end;
if (Pos('$OMEGA', strList.Strings[n]) = 0) and
(Pos('$', Trim(strList.Strings[n])) = 1) then
begin
blnEtasOn := False;
lstTemp.Clear;
// If populated, process ETA labels
// If bars are present, assume done and skip
if (EtaLabel.Count > 0) and (Pos('|', EtaLabel.Text) = 0) then
begin
for p := 0 to EtaLabel.Count - 1 do
begin
// Is there a comment?
if Pos(';', EtaLabel[p]) > 0 then
// Is there text before the comment?
if Pos(';', Trim(EtaLabel[p])) > 1 then
lstTemp.Add(EtaLabel[p]);
end;
EtaLabel.Clear;
for p := 0 to lstTemp.Count - 1 do
begin
EtaLabel.Add(IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
lstLog.Add('Eta Label... ' + IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
//ShowMessage('Eta Label... ' + IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
end;
(EtaLabel as TStringList).Sorted := True; // changed 11/10/05
(EtaLabel as TStringList).Duplicates := dupIgnore;
//ShowMessage(EtaLabel.Text);
end;
end;
// Collect lines with $OMEGA records
if blnEtasOn then
EtaLabel.Add(strList[n]);
{if Pos('$OMEGA', strList.Strings[n]) > 0 then
begin
blnEtasOn := True;
if (Pos('BLOCK', strList[n]) > 0)
and (Pos('BLOCK(1)', StringReplace(strList[n], ' ', '', [rfReplaceAll])) = 0) then
begin
for m := Pos('(', strList[n]) + 1 to Pos(')', strList[n]) - 1 do
strT := strT + strList[n][m];
r := 0;
try
r := StrToInt(strT);
except
ShowMessage('An error has occurred reading the number of ' +
'dimensions in an $OMEGA BLOCK structure.' + #10#13#10#13 +
'Control stream line: ' + IntToStr(n) + '; Block dimension: ' + strT);
end;
//ShowMessage(IntToStr(r));
for m := n + 1 to r do
begin
if Pos(';', Trim(strList[n])) > 1 then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
end;
end;
end
else
if (Pos(';', strList[n]) > 0) and (Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
end
else
if (Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + ' ');
lstLog.Add('Eta Label... None!');
if RegIni.ReadBool('Options', 'PromptEtaLabels', True) then
begin
if not Assigned(frmEtaLabels) then
frmEtaLabels := TfrmEtaLabels.Create(Application);
frmEtaLabels.ShowModal;
end;
end;
end; }
// In a block
{ if (blnEtasOn) and (Pos(';', strList[n]) > 0) and
(Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + BrkUp(';', strList.Strings[n], 1));
// ShowMessage(BrkUp(';', strList.Strings[n], 1));
end; }
// ********************************************************************
// Read $DATA block
// ********************************************************************
if (Pos('ETA(', strList.Strings[n]) > 0) then
begin
end;
except
on EStringListError do
MessageDlg('Error parsing model control ' +
'stream at line ' + IntToStr(n + 1) + ' (' +
strList[n] + ').', mtError, [mbOK], 0);
end;
end;
end
else
lstLog.Add('No Control stream found!');
// ********************************************************************
// Sort ETA list
// ********************************************************************
//ShowMessage('Start sort');
//ShowMessage(EtaLabel.Text);
lstTemp2.Clear;
for n := 0 to EtaLabel.Count - 1 do
begin
strT := EtaLabel[n];
if Pos('|', strT) = 2 then
strT := '0' + strT;
lstTemp2.Add(strT);
end;
EtaLabel.Clear;
for n := 0 to lstTemp2.Count - 1 do
EtaLabel.Add(lstTemp2[n]);
lstTemp2.Clear;
//ShowMessage('Presort');
(EtaLabel as TStringList).Sort;
//ShowMessage('Postsort');
{for n := 0 to EtaLabel.Count - 1 do
begin
strT := EtaLabel[n];
if Pos('|', EtaLabel[n]) > 0 then
EtaLabel[n] := Copy(EtaLabel[n], Pos('|', EtaLabel[n]), 500);
end; }
//ShowMessage('Checxkpoint');
// ********************************************************************
// Process PsN run record
// ********************************************************************
regEx := TPerlRegEx.Create;
regEx.Subject := lstPsNRunRec.Text;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
//ShowMessage(regEx.Subject);
// 1 based on
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Based on:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.BasedOn := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Based on: ' + PsNRunRec.BasedOn);
end;
// 2 description
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Description:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.Description := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Description: ' + PsNRunRec.Description);
end;
// 3 label
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Label:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.PsNLabel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Label: ' + PsNRunRec.PsNLabel);
end;
// 4 structural model
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Structural model:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.StructuralModel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Structural model: ' + PsNRunRec.StructuralModel);
end;
// 5 covariate model
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Covariate model:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.CovariateModel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Covariate model: ' + PsNRunRec.CovariateModel);
end;
// 6 iiv
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Inter-individual variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.InterIndividualVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('IIV: ' + PsNRunRec.InterIndividualVariability);
end;
// 7 iov
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Inter-occasion variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.InterOccasionVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('IOV: ' + PsNRunRec.InterOccasionVariability);
end;
// 8 residual
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Residual variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.ResidualVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('RV: ' + PsNRunRec.ResidualVariability);
end;
regEx.Options := [preMultiLine,preSingleLine];
// 9 estimation
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Estimation:).*';
if (regEx.Match) then
begin
PsNRunRec.Estimation := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Estimation: ' + PsNRunRec.Estimation);
end;
regEx.Options := [];
// ********************************************************************
// Insert into RUNS table
// ********************************************************************
lstLog.Add('-----------------------------------------');
lstLog.Add('Inserting into database...');
lstLog.Add('-----------------------------------------');
try
if Length(strCondEst) > 0 then
try
try
tblRuns.Insert;
tblRunsUser.Value := txtUser;
tblRunsTimestamp.Value := Now;
lstLog.Add('Inserting into Runs table...');
tblRunsRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblRunsiRunNo.Value := intRun;
lstLog.Add('iRunNo...');
tblRunsComment.Value := strComment;
lstLog.Add('Comment...');
if RegIni.ReadBool('Options', 'PromptComment', False) then
if dlgComment.Execute then
tblRunsComments.Assign(dlgComment.Lines);
lstLog.Add('Long comment...');
tblRunsObsRecs.Value := StrToInt(strObsRecs);
lstLog.Add('ObsRecs...');
tblRunsIndividuals.Value := StrToInt(strInds);
lstLog.Add('Inds...');
tblRunsMinShort.Value := CaseConvert(strMin);
lstLog.Add('MinShort...');
if lstMinTerm.Count > 0 then
if Pos('NO. OF FUNCTION EVALUATIONS USED:',
lstMinTerm[lstMinTerm.Count - 1]) > 0 then
lstMinTerm.Delete(lstMinTerm.Count - 1);
tblRunsMinimization.Assign(lstMinTerm);
lstLog.Add('MinFull...');
if strFnEval <> '' then
tblRunsFnEvals.Value := StrToInt(strFnEval);
lstLog.Add('FnEval...');
tblRunsSigDigits.Value := CaseConvert(strSigDig);
lstLog.Add('SigDigits...');
if strObj <> '' then
tblRunsObj.Value := StrToFloat(strObj, fs);
lstLog.Add('Obj...');
tblRunsModel.Value := CaseConvert(strModel);
lstLog.Add('Model...');
tblRunsCovStep.Assign(lstCovSum);
lstLog.Add('CovStep...');
tblRunsCondEst.Value := False;
if strCondEst = 'YES' then
tblRunsCondEst.Value := True;
lstLog.Add('CondEst...');
if strCentEta = 'YES' then
tblRunsCenteredEta.Value := True
else
tblRunsCenteredEta.Value := False;
lstLog.Add('CenteredEta...');
if strInter = 'YES' then
tblRunsInteraction.Value := True
else
tblRunsInteraction.Value := False;
lstLog.Add('Interaction...');
if strLaplacian = 'YES' then
tblRunsLaplacian.Value := True
else
tblRunsLaplacian.Value := False;
lstLog.Add('Laplacian...');
tblRunsComments.Assign(lstNotes);
lstLog.Add('Notes...');
// PsN runrecord
tblRunsIIV.Value := PsNRunRec.InterIndividualVariability;
tblRunsIOV.Value := PsNRunRec.InterOccasionVariability;
tblRunsLabel.Value := PsNRunRec.PsNLabel;
tblRunsStructuralModel.Value := PsNRunRec.StructuralModel;
tblRunsCovariateModel.Value := PsNRunRec.CovariateModel;
tblRunsRV.Value := PsNRunRec.ResidualVariability;
tblRunsEstimation.Value := PsNRunRec.Estimation;
tblRunsDescription.Value := PsNRunRec.Description;
// Warnings
strT2 := '';
lstLog.Add('Warnings - OFV...');
if blnOFVWarn then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'OFV carried over from final iteration';
end;
lstLog.Add('Warnings - Covariance step...');
if ThSE.Count = 0 then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'No covariance step';
end;
lstLog.Add('Warnings - Algorithmically singular S matrix...');
if (Pos('ALGORITHMICALLY SINGULAR', lstCovSum.Text) > 0) and
(Pos('S MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'S matrix algorithmically singular';
end;
lstLog.Add('Warnings - Algorithmically singular R matrix...');
if (Pos('ALGORITHMICALLY SINGULAR', lstCovSum.Text) > 0) and
(Pos('R MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'R matrix algorithmically singular';
end;
lstLog.Add('Warnings - Non-positive-semidefinite S matrix...');
if (Pos('NON-POSITIVE-SEMIDEFINITE', lstCovSum.Text) > 0) and
(Pos('S MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'S matrix non-positive-semidefinite';
end;
lstLog.Add('Warnings - Non-positive-semidefinite R matrix...');
if (Pos('NON-POSITIVE-SEMIDEFINITE', lstCovSum.Text) > 0) and
(Pos('R MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'R matrix non-positive-semidefinite';
end;
lstLog.Add('Warnings - Rounding errors...');
if (Pos('ROUNDING ERRORS', lstMinTerm.Text) > 0) and
(Pos('R MATRIX', lstMinTerm.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Rounding errors';
end;
lstLog.Add('Warnings - Hessian count...');
if intHessian > 0 then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
if intHessian = 1 then
strT2 := strT2 + IntToStr(intHessian) + ' hessian reset'
else
strT2 := strT2 + IntToStr(intHessian) + ' hessian resets';
end;
lstLog.Add('Warnings - Zero gradients...');
if blnZeroGradients then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Zero gradients';
end;
lstLog.Add('Warnings - Condition number...');
if fltCondNo > RegIni.ReadInteger('Options', 'CondLimit', 1000) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'High condition number';
end;
lstLog.Add('Warnings - Final zero gradients...');
if blnFZeroGradients then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Final zero gradients';
end;
// Check standard errors
lstLog.Add('Warnings - Polling THETAs...');
if ThSE.Count > 0 then
begin
for m := 1 to intTheta do
begin
lstLog.Add('Warnings - THETA large SEs (' + IntToStr(m) + ')...');
if Pos('..', ThSE[m - 1]) = 0 then
if (StrToFloat(FloatToStrF(Abs(StrToFloat(ThSE[m - 1], fs) /
StrToFloat(ThValue[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'ThetaCVLimit', '0.3'))) then
begin
blnLargeSEs := True;
//ShowMessage(RegIni.ReadString('Options', 'ThetaCVLimit', '0.3'));
lstLargeSEs.Add('Th ' + IntToStr(m));
end;
lstLog.Add('Warnings - THETA zero CIs (' + IntToStr(m) + ')...');
if Pos('..', ThSE[m - 1]) = 0 then
if ((StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) -
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) < 0) and
(StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) +
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) > 0)) or
((StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) -
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) > 0) and
(StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) +
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) < 0)) then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Th ' + IntToStr(m));
end;
end;
end;
if OmSE.Count > 0 then
begin
for m := 1 to intOmega do
begin
lstLog.Add('Warnings - OMEGA large SEs (' + IntToStr(m) + ')...');
if Pos('...', OmSE[m - 1]) = 0 then
try
if StrToFloat(FloatToStrF(Abs(StrToFloat(OmSE[m - 1], fs) /
StrToFloat(Eta[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'OmegaCVLimit', '0.5')) then
begin
blnLargeSEs := True;
lstLargeSEs.Add('Om ' + IntToStr(m));
end;
except
;
end;
lstLog.Add('Warnings - OMEGA zero CIs (' + IntToStr(m) + ')...');
if Pos('...', OmSE[m - 1]) = 0 then
try
if StrToFloat(FloatToStrF(StrToFloat(Eta[m - 1], fs) -
(1.96 * StrToFloat(OmSE[m - 1], fs)), ffGeneral, 3, 0)) < 0 then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Om ' + IntToStr(m));
end;
except
;
end;
end;
end;
if SigSE.Count > 0 then
begin
for m := 1 to intSigma do
begin
lstLog.Add('Warnings - SIGMA large SEs (' + IntToStr(m) + ')...');
if Pos('..', SigSE[m - 1]) = 0 then
if StrToFloat(Eps[m - 1], fs) <> 0 then
if StrToFloat(FloatToStrF(Abs(StrToFloat(SigSE[m - 1], fs) /
StrToFloat(Eps[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'SigmaCVLimit', '0.3')) then
begin
blnLargeSEs := True;
lstLargeSEs.Add('Sg ' + IntToStr(m));
end;
lstLog.Add('Warnings - SIGMA zero CIs (' + IntToStr(m) + ')...');
if Pos('..', SigSE[m - 1]) = 0 then
if StrToFloat(FloatToStrF(StrToFloat(Eps[m - 1], fs) -
(1.96 * StrToFloat(SigSE[m - 1], fs)), ffGeneral, 3, 0)) < 0 then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Sg ' + IntToStr(m));
end;
end;
end;
lstLog.Add('Warnings - Large SEs...');
if blnLargeSEs then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Large SEs (';
for m := 0 to lstLargeSEs.Count - 1 do
begin
strT2 := strT2 + lstLargeSEs[m];
if m < lstLargeSEs.Count - 1 then
strT2 := strT2 + ', ';
end;
strT2 := strT2 + ')';
end;
lstLog.Add('Warnings - Errors in PRDERR...');
if blnPrdErr then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Prediction errors (PRDERR)';
//pgcNotes.ActivePage := tabPrdErr;
//pgcMain.ActivePage := tabMisc;
end;
lstLog.Add('Warnings - Zero CIs...');
if blnZeroCIs then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'CIs overlap zero (';
for m := 0 to lstZeroCIs.Count - 1 do
begin
strT2 := strT2 + lstZeroCIs[m];
if m < lstZeroCIs.Count - 1 then
strT2 := strT2 + ', ';
end;
strT2 := strT2 + ')';
end;
tblRunsWarnings.Value := strT2;
strT2 := '';
// WFN prefix
strWFN := ExtractFilePath(nmFile) + StringReplace(ExtractFileName(nmFile),
ExtLst, '', [rfReplaceAll]) + '.';
// Xpose structure
if (FileExists(ExtractFilePath(nmFile) + 'patab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'patab' + strRun + extXpose))}then
begin
tblRunspatab.Value := ExtractFilePath(nmFile) +
'patab' + strRun + extXpose;
if blnMD5 then
tblRunspatabMD5.Value := MD5(ExtractFilePath(nmFile) +
'patab' + strRun + extXpose);
lstLog.Add('patab...' + tblRunspatab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'sdtab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'sdtab' + strRun + extXpose))}then
begin
tblRunssdtab.Value := ExtractFilePath(nmFile) +
'sdtab' + strRun + extXpose;
if blnMD5 then
tblRunssdtabMD5.Value := MD5(ExtractFilePath(nmFile) +
'sdtab' + strRun + extXpose);
lstLog.Add('sdtab...' + tblRunssdtab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'catab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'catab' + strRun + extXpose))}then
begin
tblRunscatab.Value := ExtractFilePath(nmFile) +
'catab' + strRun + extXpose;
if blnMD5 then
tblRunscatabMD5.Value := MD5(ExtractFilePath(nmFile) +
'catab' + strRun + extXpose);
lstLog.Add('catab...' + tblRunscatab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cotab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'cotab' + strRun + extXpose))}then
begin
tblRunscotab.Value := ExtractFilePath(nmFile) +
'cotab' + strRun + extXpose;
if blnMD5 then
tblRunscotabMD5.Value := MD5(ExtractFilePath(nmFile) +
'cotab' + strRun + extXpose);
lstLog.Add('cotab...' + tblRunscotab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'mutab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mutab' + strRun + extXpose)) }then
begin
tblRunsmutab.Value := ExtractFilePath(nmFile) +
'mutab' + strRun + extXpose;
if blnMD5 then
tblRunsmutabMD5.Value := MD5(ExtractFilePath(nmFile) +
'mutab' + strRun + extXpose);
lstLog.Add('mutab...' + tblRunsmutab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'mytab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunsmytab.Value := ExtractFilePath(nmFile) +
'mytab' + strRun + extXpose;
if blnMD5 then
tblRunsmytabMD5.Value := MD5(ExtractFilePath(nmFile) +
'mytab' + strRun + extXpose);
lstLog.Add('mytab...' + tblRunsmytab.Value);
end;
// CWRES
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtab.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + extXpose;
if blnMD5 then
tblRunscwtabMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + extXpose);
lstLog.Add('cwtab...' + tblRunscwtab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + '.est')) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtabEst.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + '.est';
if blnMD5 then
tblRunscwtabEstMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + '.est');
lstLog.Add('cwtab.est...' + tblRunscwtabEst.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + '.deriv')) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtabDeriv.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + '.deriv';
if blnMD5 then
tblRunscwtabDerivMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + '.deriv');
lstLog.Add('cwtab.deriv...' + tblRunscwtabDeriv.Value);
end;
tblRunsLst.Value := nmFile;
if blnMD5 then
tblRunsLstMD5.Value := MD5(nmFile);
lstLog.Add('lst...' + nmFile);
tblRunsData.Value := strDataFile;
if blnMD5 then
tblRunsDataMD5.Value := MD5(strDataFile);
lstLog.Add('dat...' + strDataFile);
if FileExists(strModFile) then
begin
tblRunsCtl.Value := strModFile;
if blnMD5 then
tblRunsCtlMD5.Value := MD5(strModFile);
lstLog.Add('ctl...' + strModFile);
end;
if FileExists(StringReplace(nmFile, extLst, extMsf,
[rfIgnoreCase])) then
begin
tblRunsMsf.Value := StringReplace(nmFile, extLst,
extMSF, [rfIgnoreCase]);
if blnMD5 then
tblRunsMsfMD5.Value := MD5(StringReplace(nmFile, extLst,
extMSF, [rfIgnoreCase]));
lstLog.Add('MSF...' + tblRunsMsf.Value);
end;
if FileExists(StringReplace(nmFile, extLst, extFit,
[rfIgnoreCase])) then
begin
tblRunsFit.Value := StringReplace(nmFile, extLst,
extFit, [rfIgnoreCase]);
if blnMD5 then
tblRunsFitMD5.Value := MD5(StringReplace(nmFile, extLst,
extFit, [rfIgnoreCase]));
lstLog.Add('fit...' + tblRunsFit.Value);
end;
{if FileExists(ExtractFilePath(nmFile) + '\PRDERR') then
tblRunsPrdErr.LoadFromFile(ExtractFilePath(nmFile) + '\PRDERR');
lstLog.Add('PRDERR...'); }
if fltCondNo <> 0 then
tblRunsConditionNumber.Value := fltCondNo;
if Length(strParent) > 0 then
begin
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Obj FROM Runs');
if IsStrANumber(strParent) then
sqlParent.SQL.Add('WHERE RunNo = ' + strParent + ';')
else
sqlParent.SQL.Add('WHERE RunNo = ''' + strParent + ''';');
try
sqlParent.Active := True;
if sqlParent.RecordCount > 0 then
begin
tblRunsParentNo.Value := strParent;
tblRunsdOFV.Value := RoundD(tblRunsObj.Value - sqlParent.Fields[0].AsFloat, 3);
end;
finally
sqlParent.Active := False;
end;
end;
lstLog.Add('Condition Number...' + FloatToStr(tblRunsConditionNumber.Value));
// ********************************************************************
// OMEGA initial estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixOmegaInit.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmegaInit[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmegaInit[n - 1] := '0,' + lstMatrixOmegaInit[n - 1];
end;
for n := 1 to lstMatrixOmegaInit.Count do
lstMatrixOmegaInit[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmegaInit[n - 1];
lstMatrixOmegaInit.Insert(0, strT);
tblRunsOmegaInitMatrix.Value := lstMatrixOmegaInit.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// OMEGA final estimates matrix
// ********************************************************************
strT := '';
//ShowMessage(IntToStr(lstMatrixOmega.Count));
for n := 1 to lstMatrixOmega.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmega[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmega[n - 1] := '0,' + lstMatrixOmega[n - 1];
end;
for n := 1 to lstMatrixOmega.Count do
lstMatrixOmega[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmega[n - 1];
lstMatrixOmega.Insert(0, strT);
tblRunsOmegaMatrix.Value := lstMatrixOmega.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// OMEGA standard errors matrix
// ********************************************************************
strT := '';
//ShowMessage(IntToStr(lstMatrixOmegaSE.Count));
for n := 1 to lstMatrixOmegaSE.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmegaSE[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmegaSE[n - 1] := '0,' + lstMatrixOmegaSE[n - 1];
end;
for n := 1 to lstMatrixOmegaSE.Count do
lstMatrixOmegaSE[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmegaSE[n - 1];
lstMatrixOmegaSE.Insert(0, strT);
tblRunsOmegaSEMatrix.Value := lstMatrixOmegaSE.Text;
// ********************************************************************
// SIGMA initial estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigmaInit.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigmaInit[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigmaInit[n - 1] := '0,' + lstMatrixSigmaInit[n - 1];
end;
for n := 1 to lstMatrixSigmaInit.Count do
lstMatrixSigmaInit[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigmaInit[n - 1];
lstMatrixSigmaInit.Insert(0, strT);
tblRunsSigmaInitMatrix.Value := lstMatrixSigmaInit.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// SIGMA final estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigma.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigma[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigma[n - 1] := '0,' + lstMatrixSigma[n - 1];
end;
for n := 1 to lstMatrixSigma.Count do
lstMatrixSigma[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigma[n - 1];
lstMatrixSigma.Insert(0, strT);
tblRunsSigmaMatrix.Value := lstMatrixSigma.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// SIGMA standard errors matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigmaSE.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigmaSE[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigmaSE[n - 1] := '0,' + lstMatrixSigmaSE[n - 1];
end;
for n := 1 to lstMatrixSigmaSE.Count do
lstMatrixSigmaSE[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigmaSE[n - 1];
lstMatrixSigmaSE.Insert(0, strT);
tblRunsSigmaSEMatrix.Value := lstMatrixSigmaSE.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
//dlgLog.Lines.Assign(lstCovMatrix);
//dlgLog.Execute;
//dlgLog.Lines.Assign(lstCorrMatrix);
//dlgLog.Execute;
//dlgLog.Lines.Assign(lstEigen);
//dlgLog.Execute;
// ********************************************************************
// Covariance, correlation, inv cov matrix
// ********************************************************************
tblRunsCovMatrix.Value := lstCovMatrix.Text;
tblRunsCorrMatrix.Value := lstCorrMatrix.Text;
tblRunsInvCovMatrix.Value := lstInvCovMatrix.Text;
tblRunsEigenvalues.Value := lstEigen.Text;
except
// ********************************************************************
// Exception block
// ********************************************************************
on E: Exception do
begin
MessageDlg('An error has occurred while processing results into the RUN table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblRuns.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the RUNS table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblRuns.Cancel;
end;
end;
end;
// ********************************************************************
// Insert into THETAS table
// ********************************************************************
//ShowMessage(ThValue.Text);
ThLabel := StripBlanks(ThLabel);
if blnPriors then
begin
if RegIni.ReadBool('Options', 'WarnPriors', True) then
begin
if MessageDlg('Use of the PRIOR subroutine has been detected. Since this means ' +
'that more parameter records will be present than expected, the number of ' +
'parameter variables captured will be limited to those reported by the NONMEM ' +
'output file (THETAs: ' + intToStr(ThValue.Count) + ', ETAs: ' +
intToStr(Eta.Count) + ', EPSILONs: ' + intToStr(Eps.Count) + ').' + #10#13#10#13 +
'Full PRIOR functionality will follow in a later release.' + #10#13#10#13 +
'Do you wish to see this warning again?', mtWarning, [mbYes, mbNo], 0) = mrYes then
RegIni.WriteBool('Options', 'WarnPriors', True)
else
RegIni.WriteBool('Options', 'WarnPriors', False);
end;
intTheta := ThValue.Count;
end;
for m := 1 to intTheta do
begin
try
try
tblThetas.Insert;
lstLog.Add('Inserting into Theta table...');
tblThetasUser.Value := txtUser;
tblThetasTimestamp.Value := Now;
tblThetasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblThetasTheta.Value := m;
lstLog.Add('Theta...' + IntToStr(m));
// ShowMessage(IntToStr(intTheta));
// ShowMessage(IntToStr(ThLabel.Count));
// ShowMessage(ThLabel.Text);
for n := 0 to ThLabel.Count - 1 do
if Length(Trim(ThLabel[n])) = 0 then
ThLabel.Delete(n);
// ShowMessage(ThLabel.Text);
if (ThLabel.Count = intTheta) or ((blnPriors = True)
and (ThLabel.Count >= intTheta)) then
begin
tblThetasThetaLabel.Value := ThLabel[m - 1];
lstLog.Add(' Label...' + ThLabel[m - 1]);
//showmessage(' Label...' + ThLabel[m - 1]);
end;
if ThValue.Count = intTheta then
begin
tblThetasThetaValue.Value := StrToFloat(ThValue[m - 1], fs);
lstLog.Add(' Value...' + ThValue[m - 1]);
//showmessage(' Value...' + ThValue[m - 1]);
end;
if (ThLower.Count = intTheta) or ((blnPriors = True)
and (ThLower.Count >= intTheta)) then
begin
tblThetasLower.Value := StrToFloat(ThLower[m - 1], fs);
lstLog.Add(' Lower...' + ThLower[m - 1]);
//showmessage(' Lower...' + ThLower[m - 1]);
end;
if (ThInit.Count = intTheta) or ((blnPriors = True)
and (ThInit.Count >= intTheta)) then
begin
tblThetasInitial.Value := StrToFloat(ThInit[m - 1], fs);
lstLog.Add(' InitEst...' + ThInit[m - 1]);
//showmessage(' InitEst...' + ThInit[m - 1]);
end;
if (ThUpper.Count = intTheta) or ((blnPriors = True)
and (ThUpper.Count >= intTheta)) then
begin
tblThetasUpper.Value := StrToFloat(ThUpper[m - 1], fs);
lstLog.Add(' Upper...' + ThUpper[m - 1]);
//showmessage(' Upper...' + ThUpper[m - 1]);
end;
if (ThSE.Count = intTheta) or ((blnPriors = True)
and (ThSE.Count >= intTheta)) then
if Pos('...', ThSE[m - 1]) = 0 then
begin
tblThetasThetaSE.Value := StrToFloat(ThSE[m - 1], fs);
lstLog.Add(' SE...' + ThSE[m - 1]);
if tblThetasThetaValue.Value <> 0 then
tblThetasThetaRSE.Value := StrToFloat(FloatToStrF(Abs(tblThetasThetaSE.Value /
tblThetasThetaValue.Value) * 100, ffGeneral, 3, 0));
lstLog.Add(' RSE...' + FloatToStr(tblThetasThetaRSE.Value));
if (tblThetasThetaValue.Value <> 0) and
(tblThetasThetaSE.Value <> 0) then
begin
tblThetasThetaCIUpper.Value := StrToFloat(FloatToStrF(tblThetasThetaValue.Value +
(1.96 * tblThetasThetaSE.Value), ffGeneral, 3, 0));
tblThetasThetaCILower.Value := StrToFloat(FloatToStrF(tblThetasThetaValue.Value -
(1.96 * tblThetasThetaSE.Value), ffGeneral, 3, 0));
tblThetasThetaCIs.Value := FloatToStr(tblThetasThetaCILower.Value) +
' ... ' + FloatToStr(tblThetasThetaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblThetasThetaCIs.Value);
end;
end;
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing data into the THETA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblThetas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the THETAS table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblThetas.Cancel;
end;
end;
end;
end;
// ********************************************************************
// Insert into ETAS table
// ********************************************************************
{dlgLog.Lines.Assign(Eta);
dlgLog.Execute; }
intOmega := lstMatrixOmega.Count - 1;
//ShowMessage(EtaLabel.Text);
EtaLabel := StripBlanks(EtaLabel);
//ShowMessage(EtaLabel.Text);
{ShowMessage('intOmega ' + IntToStr(intOmega));
ShowMessage('OmSE ' + IntToStr(OmSE.Count));
ShowMessage('Eta ' + IntToStr(Eta.Count));
ShowMessage(OMSE.Text);
ShowMessage(Eta.Text); }
for m := 0 to EtaLabel.Count - 1 do
begin
if (CharIsDigit(EtaLabel[m][2]) = False) and
(CharIsDigit(EtaLabel[m][1]) = True) and
(intOmega > 9) then
EtaLabel[m] := '0' + EtaLabel[m];
EtaLabel[m] := EtaLabel[m] + '§§';
end;
(EtaLabel as TStringList).Sort;
for m := 1 to intOmega do
begin
try
try
tblEtas.Insert;
lstLog.Add('Inserting into OMEGA table...');
tblEtasUser.Value := txtUser;
tblEtasTimestamp.Value := Now;
tblEtasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblEtasEta.Value := m;
lstLog.Add('Eta...' + IntToStr(m));
if EtaLabel.Count = intOmega then
begin
//Showmessage(EtaLabel[m - 1]);
tblEtasEtaLabel.Value := Copy(EtaLabel[m - 1],
0, Pos('§§', EtaLabel[m - 1]) - 1);
{tblEtasEtaLabel.Value := StringReplace(tblEtasEtaLabel.Value,
'|', '', [rfReplaceAll]); }
tblEtasEtaLabel.Value := Copy(tblEtasEtaLabel.Value,
Pos('|', tblEtasEtaLabel.Value) + 1, 500);
lstLog.Add(' Label...' + EtaLabel[m - 1]);
tblEtasModel.Value := Copy(EtaLabel[m - 1],
Pos('§§', EtaLabel[m - 1]) + 1, 50);
end;
if (Eta.Count = intOmega) and (Eta.Count > 0) then
begin
//ShowMessage(IntToStr(Eta.Count));
tblEtasEtaValue.Value := StrToFloat(Eta[m - 1], fs);
lstLog.Add(' Value...' + Eta[m - 1]);
end;
if OmInit.Count > 0 then
begin
tblEtasEtaInit.Value := StrToFloat(OmInit[m - 1], fs);
lstLog.Add(' InitEst...' + OmInit[m - 1]);
end;
if EtaBar.Count = intOmega then
begin
if Pos('E', EtaBar[m - 1]) > 0 then
begin
tblEtasEtaBar.Value := StrToFloat(EtaBar[m - 1], fs);
end
else
tblEtasEtaBar.Value :=
StrToFloat(StringReplace(EtaBar[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' EtaBar...' + FloatToStr(tblEtasEtaBar.Value));
if EtaBarSE.Count = intOmega then
begin
if Pos('E', EtaBarSE[m - 1]) > 0 then
begin
tblEtasEtaBarSE.Value := StrToFloat(EtaBarSE[m - 1], fs);
end
else
tblEtasEtaBarSE.Value :=
StrToFloat(StringReplace(EtaBarSE[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' EtaBarSE...' + FloatToStr(tblEtasEtaBarSE.Value));
if EtaP.Count = intOmega then
if Pos('E', EtaP[m - 1]) > 0 then
tblEtasEtaPVal.Value := StrToFloat(EtaP[m - 1], fs)
else
tblEtasEtaPVal.Value :=
StrToFloat(StringReplace(EtaP[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
lstLog.Add(' EtaBarPVal...' + FloatToStr(tblEtasEtaPVal.Value));
//ShowMessage(IntToStr(OmSE.Count) + ',' + IntToStr(intOmega));
if OmSE.Count = intOmega then
begin
if (Pos('...', OmSE[m - 1]) = 0) and (OmSE[m - 1] <> '0') then
tblEtasEtaSE.Value := StrToFloat(OmSE[m - 1], fs);
{ShowMessage(lstMatrixOmegaSE[m]);
ShowMessage(brkUp(',', lstMatrixOmegaSE[m], m));
tblEtasEtaSE.Value := StrToFloat(brkUp(',', lstMatrixOmegaSE[m], m), fs); }
lstLog.Add(' SE...' + OmSE[m - 1]);
if (tblEtasEtaValue.Value <> 0) and
(tblEtasEtaSE.Value <> 0) then
tblEtasEtaRSE.Value := StrToFloat(FloatToStrF((tblEtasEtaSE.Value /
tblEtasEtaValue.Value) * 100, ffGeneral, 3, 0));
lstLog.Add(' RSE...' + FloatToStr(tblEtasEtaRSE.Value));
if (tblEtasEtaValue.Value <> 0) and
(tblEtasEtaSE.Value <> 0) then
begin
tblEtasEtaCIUpper.Value := StrToFloat(FloatToStrF(tblEtasEtaValue.Value +
(1.96 * tblEtasEtaSE.Value), ffGeneral, 3, 0));
tblEtasEtaCILower.Value := StrToFloat(FloatToStrF(tblEtasEtaValue.Value -
(1.96 * tblEtasEtaSE.Value), ffGeneral, 3, 0));
tblEtasEtaCIs.Value := FloatToStr(tblEtasEtaCILower.Value) +
' ... ' + FloatToStr(tblEtasEtaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblEtasEtaCIs.Value);
end;
tblEtasBlocks.Value := blnEtaBlocks;
end;
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing data into the OMEGA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblEtas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the OMEGA table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblEtas.Cancel;
end;
end;
end;
end;
// ********************************************************************
// Insert into SIGMAS table
// ********************************************************************
// Fix initial estimates
intSigma := Eps.Count;
//lstTemp.Clear;
if Eps.Count > SigInit.Count then
for m := 0 to Eps.Count - 1 do
begin
if m <= SigInit.Count - 1 then
strTemp := SigInit[m];
if m = 0 then
;
if (m > 0) then
begin
if (Eps[m] = Eps[m - 1]) then
SigInit.Insert(m, strTemp);
end;
end;
//ShowMessage(Eps.Text);
//ShowMessage(SigInit.Text);
//ShowMessage(SigSE.Text);
for m := 1 to intSigma do
begin
try
try
tblSigmas.Insert;
lstLog.Add('Inserting into Sigma table...');
tblSigmasUser.Value := txtUser;
tblSigmasTimestamp.Value := Now;
tblSigmasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblSigmasSigma.Value := m;
lstLog.Add('Sigma...' + IntToStr(m));
if Eps.Count = intSigma then
begin
tblSigmasSigmaValue.Value := StrToFloat(Eps[m - 1], fs);
lstLog.Add('Value...' + Eps[m - 1]);
end;
if SigInit.Count = intSigma then
begin
tblSigmasSigmaInit.Value := StrToFloat(SigInit[m - 1], fs);
lstLog.Add('Init Est...' + SigInit[m - 1]);
end;
if SigSE.Count = intSigma then
if Pos('...', SigSE[m - 1]) = 0 then
begin
tblSigmasSigmaSE.Value := StrToFloat(SigSE[m - 1], fs);
lstLog.Add(' SE...' + SigSE[m - 1]);
if (tblSigmasSigmaValue.Value <> 0) and
(tblSigmasSigmaSE.Value <> 0) then
tblSigmasSigmaRSE.Value := StrToFloat(FloatToStrF((tblSigmasSigmaSE.Value /
tblSigmasSigmaValue.Value) * 100, ffGeneral, 3, 0));
if (tblSigmasSigmaValue.Value <> 0) and
(tblSigmasSigmaSE.Value <> 0) then
begin
tblSigmasSigmaCIUpper.Value := StrToFloat(FloatToStrF(tblSigmasSigmaValue.Value +
(1.96 * tblSigmasSigmaSE.Value), ffGeneral, 3, 0));
tblSigmasSigmaCILower.Value := StrToFloat(FloatToStrF(tblSigmasSigmaValue.Value -
(1.96 * tblSigmasSigmaSE.Value), ffGeneral, 3, 0));
tblSigmasSigmaCIs.Value := FloatToStr(tblSigmasSigmaCILower.Value) +
' ... ' + FloatToStr(tblSigmasSigmaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblSigmasSigmaCIs.Value);
end;
lstLog.Add(' RSE...' + FloatToStr(tblSigmasSigmaRSE.Value));
end;
tblSigmasBlocks.Value := blnSigmaBlocks;
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing the SIGMA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblSigmas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the SIGMA table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblSigmas.Cancel;
end;
end;
end;
end;
finally
tblTrans.InsertRecord([Null, 'add', strRun, Now, txtUser]);
if tblTrans.Active = False then
tblTrans.Active := True;
if tblRuns.Active = False then
tblRuns.Active := True;
if tblThetas.Active = False then
tblThetas.Active := True;
if tblEtas.Active = False then
tblEtas.Active := True;
if tblSigmas.Active = False then
tblSigmas.Active := True;
if tblPlotData.Active = False then
tblPlotData.Active := True;
//if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
//tblRuns.Filtered := True;
end;
// ********************************************************************
// Debug info
// ********************************************************************
if blnDebug then
begin
lstLog.Add(#10#13);
lstLog.Add('Done!');
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
// ********************************************************************
// Free all variables
// ********************************************************************
if Assigned(PKParams) then
PKParams.Free;
ThLabel.Free;
ThLower.Free;
ThInit.Free;
ThUpper.Free;
ThValue.Free;
ThSE.Free;
SigInit.Free;
OmInit.Free;
EtaBar.Free;
EtaBarSE.Free;
EtaP.Free;
Eta.Free;
Eps.Free;
OmSE.Free;
SigSE.Free;
EtaLabel.Free;
lstLog.Free;
lstCovSum.Free;
lstMinTerm.Free;
lstBlockOmega.Free;
lstOmegaBlkVars.Free;
lstSigmaBlkVars.Free;
lstBlockSigma.Free;
lstMatrixOmega.Free;
lstMatrixSigma.Free;
lstMatrixOmegaInit.Free;
lstMatrixSigmaInit.Free;
lstMatrixOmegaSE.Free;
lstMatrixSigmaSE.Free;
lstCovMatrix.Free;
lstCorrMatrix.Free;
lstInvCovMatrix.Free;
lstScratch.Free;
lstTemp.Free;
lstTemp2.Free;
strOmegaList.Free;
strSigmaList.Free;
lstLargeSEs.Free;
lstZeroCIs.Free;
lstNotes.Free;
lstPsNRunRec.Free;
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
brkUpp.BreakString := '';
RegIni.Free;
regEx.Free;
end;
// ********************************************************************
// BrkUpp function
// ********************************************************************
function TfrmNMRun.BrkUp(brkStr: string; brkBase: string;
brkInt: Integer): string;
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := brkBase;
brkUpp.BreakString := brkStr;
brkUpp.BreakApart;
//ShowMessage(Trim(brkUpp.StringList[brkInt]));
Result := Trim(brkUpp.StringList[brkInt]);
end;
// ********************************************************************
// ExtractNumberInString function
// ********************************************************************
function TfrmNMRun.ExtractNumberInString(strFileName: string): Integer;
var
i: Integer;
ResultStr: string;
begin
for i := Length(strFileName) downto 1 do
begin
if (strFileName[i] in ['0'..'9']) then
begin
ResultStr := strFileName[i] + ResultStr;
end
else
if Length(ResultStr) > 0 then
begin
Result := StrToIntDef(ResultStr, 0);
Exit;
end;
end;
Result := StrToIntDef(ResultStr, 0);
end;
// ********************************************************************
// Close
// ********************************************************************
procedure TfrmNMRun.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TfrmNMRun.Exportcovariancematrix1Click(Sender: TObject);
var
lstOut: TStringList;
oldCursor: TCursor;
begin
lstOut := TStringList.Create;
lstOut.Assign(GatherCovMatrix);
if dlgSaveCompare.Execute then
begin
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
try
lstOut.SaveToFile(dlgSaveCompare.FileName);
finally
lstOut.Free;
Screen.Cursor := oldCursor;
end;
end;
end;
procedure TfrmNMRun.ExportcovariancematrixtoR1Click(Sender: TObject);
var
lstMatrix: TStringList;
txtR, txtTest, txtDimnames, strFileName: string;
n: Integer;
FormatSettings: TFormatSettings;
begin
lstMatrix := TStringList.Create;
lstMatrix.Assign(GatherCovMatrix);
// Remove junk
brkUpp.StringList.Clear;
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FormatSettings);
brkUpp.BreakString := string(FormatSettings.ListSeparator);
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
for n := 0 to lstMatrix.Count - 1 do
brkUpp.BaseString := brkUpp.BaseString + lstMatrix[n] +
string(FormatSettings.ListSeparator);
brkUpp.BreakApart;
for n := 0 to brkUpp.StringList.Count - 1 do
begin
txtTest := brkUpp.StringList[n];
if txtTest = '......' then
txtTest := '0';
if IsStrAFloat(txtTest) then
begin
txtR := txtR + txtTest;
if n < brkUpp.StringList.Count - 1 then
txtR := txtR + ',';
end;
end;
txtDimnames := '"';
for n := 1 to grdCovMatrix.Columns.Count - 1 do
begin
txtDimnames := txtDimnames + grdCovMatrix.Columns.Items[n].Caption;
if n < grdCovMatrix.Columns.Count - 1 then
txtDimnames := txtDimnames + '","'
else
txtDimnames := txtDimnames + '"'
end;
if Assigned(frmR) then
begin
frmR.RCommand.SendLine('covmat <- matrix(data=c(' + txtR +
'),ncol=' + IntToStr(grdCovMatrix.Columns.Count - 1) +
',nrow=' + IntToStr(grdCovMatrix.Columns.Count - 1) +
',dimnames=list(c(' + txtDimnames + '),c(' + txtDimnames + ')))', True);
frmR.RCommand.SendLine('covmat', True);
frmR.RCommand.SendLine('cov2cor(covmat)', True);
end;
lstMatrix.Clear;
lstMatrix.Add('################################################################################');
lstMatrix.Add('# R code for the variance-covariance matrix of ' +
'run ' + frmNMRun.tblRunsRunNo.Value);
lstMatrix.Add('# Created by Census at ' + DateTimeToStr(Now));
lstMatrix.Add('################################################################################');
lstMatrix.Add('');
lstMatrix.Add('covmat <- matrix(data=c(' + txtR + '),');
lstMatrix.Add(' ncol=' + IntToStr(grdCovMatrix.Columns.Count - 1) + ',');
lstMatrix.Add(' nrow=' + IntToStr(grdCovMatrix.Columns.Count - 1) + ',');
lstMatrix.Add(' dimnames=list(c(' + txtDimnames + '),');
lstMatrix.Add(' c(' + txtDimnames + ')))');
dlgSaveMatrix.DefaultExt := 'R';
dlgSaveMatrix.Filter := 'R source files (*.R)|*.R';
if dlgSaveMatrix.Execute then
lstMatrix.SaveToFile(dlgSaveMatrix.FileName);
lstMatrix.Free;
end;
function TfrmNMRun.GatherCovMatrix: TStringList;
var
lstOut: TStringList;
txtTemp: string;
n, m: Integer;
matOut: TMatrix;
ListSeparator: string;
FormatSettings: TFormatSettings;
begin
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FormatSettings);
ListSeparator := string(FormatSettings.ListSeparator);
SetLength(matOut, grdCovMatrix.Columns.Count - 1, grdCovMatrix.RowCount);
//ShowMessage(IntToStr(grdCovMatrix.Columns.Count));
//ShowMessage(IntToStr(grdCovMatrix.RowCount));
for m := 0 to grdCovMatrix.RowCount - 1 do
for n := 1 to grdCovMatrix.Columns.Count - 1 do
begin
//ShowMessage(grdCovMatrix.Cells[n,m]);
//ShowMessage(grdCovMatrix.Cells[n,m]);
if Length(grdCovMatrix.Cells[n,m]) > 0 then
matOut[n-1,m] := grdCovMatrix.Cells[n,m];
end;
for m := 0 to grdCovMatrix.RowCount - 1 do
for n := 0 to grdCovMatrix.Columns.Count - 2 do
begin
if Length(matOut[n,m]) = 0 then
matOut[n,m] := matOut[m,n];
end;
lstOut := TStringList.Create;
txtTemp := ListSeparator;
for m := 0 to grdCovMatrix.RowCount - 1 do
txtTemp := txtTemp + grdCovMatrix.Cells[0,m] + ListSeparator;
lstOut.Add(Copy(txtTemp, 1, Length(txtTemp) - 1));
for m := 0 to grdCovMatrix.RowCount - 1 do
begin
txtTemp := grdCovMatrix.Cells[0,m] + ListSeparator;
for n := 0 to grdCovMatrix.Columns.Count - 2 do
txtTemp := txtTemp + matOut[n,m] + ListSeparator;
txtTemp := Copy(txtTemp, 1, Length(txtTemp) - 1);
lstOut.Add(txtTemp);
end;
Result := lstOut;
//lstOut.Free;
end;
// ********************************************************************
// OnFormClose
// ********************************************************************
procedure TfrmNMRun.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{if Assigned(DictRuns) then
DictRuns.Free;
if Assigned(DictThetas) then
DictThetas.Free;
if Assigned(DictEtas) then
DictEtas.Free;
if Assigned(DictSigmas) then
DictSigmas.Free;
ShowMessage('Closed'); }
try
DisconnectFile;
XMLIn := nil;
XMLOutput := nil;
finally
if Assigned(frmR) then
try
frmR.RCommand.Stop;
frmR.Close;
except;
end;
Action := caFree;
frmNMRun := nil;
end;
end;
// ********************************************************************
// Capture run
// ********************************************************************
procedure TfrmNMRun.ImportRun1Click(Sender: TObject);
var
lstIni: TStrings;
begin
if dlgOpen.Execute then
begin
CaptureRun(dlgOpen.FileName);
lstIni := TStringList.Create;
lstIni.Add('WorkingDirectory=' + ExtractFilePath(dlgOpen.FileName));
lstIni.SaveToFile(nmDatabase.AliasName + '\census.ini');
lstIni.Free;
end;
end;
procedure TfrmNMRun.ImportVPC1Click(Sender: TObject);
begin
if tblRuns.RecordCount = 0 then
begin
MessageDlg('There are no NONMEM runs in this database - VPCs need to be ' +
'associated with runs.', mtInformation, [mbOK], 0);
Exit;
end;
dlgOpenVPC.InitialDir := dlgOpen.InitialDir;
if dlgOpenVPC.Execute then
begin
end;
end;
// ********************************************************************
// Capture many runs
// ********************************************************************
procedure TfrmNMRun.ScanFolder1Click(Sender: TObject);
var
n: Integer;
lstFiles: TStrings;
lstIni: TStrings;
begin
if dlgScanFolder.Execute then
begin
memData.Tag := 0;
lstFiles := TStringList.Create;
if MessageDlg('Would you like to scan subfolders as well?',
mtInformation, [mbYes, mbNo], 0) = mrYes then
GetFiles(dlgScanFolder.Directory + '\*' + extLst, lstFiles, True)
else
GetFiles(dlgScanFolder.Directory + '\*' + extLst, lstFiles, False);
//ShowMessage(lstFiles.Text);
if lstFiles.Count = 0 then
begin
MessageDlg('No suitable NONMEM output files found in this directory. Is ' +
'the correct output file extension set in Options?', mtInformation,
[mbOK], 0);
Exit;
end;
try
//rvwRuns.DataSource := nil;
rvwThetas.DataSource := nil;
pgcMain.ActivePage := tabTheta;
if not Assigned(frmScanDialog) then
frmScanDialog := TfrmScanDialog.Create(Application);
frmScanDialog.Show;
frmScanDialog.prgBar.Max := lstFiles.Count - 1;
frmScanDialog.prgBar.Min := 0;
for n := 0 to lstFiles.Count - 1 do
begin
frmScanDialog.prgBar.Position := n;
frmScanDialog.Panel1.Caption := lstFiles[n];
frmScanDialog.Repaint;
if memData.Tag = 0 then
CaptureRun(lstFiles[n])
else
Exit;
Application.ProcessMessages;
end;
finally
//rvwRuns.DataSource := srcRuns;
if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
rvwThetas.DataSource := srcThetas;
lstFiles.Free;
frmScanDialog.Close;
end;
lstIni := TStringList.Create;
lstIni.Add('WorkingDirectory=' + dlgScanFolder.Directory);
lstIni.SaveToFile(nmDatabase.AliasName + '\census.ini');
lstIni.Free;
end;
end;
function TfrmNMRun.GetTextWidth(CanvasOwner: TJvgStringGrid;
Text: string; TextFont: TFont): integer;
var
OldFont: TFont;
begin
OldFont := TFont.Create;
try
OldFont.Assign(CanvasOwner.Font);
CanvasOwner.Font.Assign(TextFont);
Result := CanvasOwner.Canvas.TextWidth(Text);
CanvasOwner.Font.Assign(OldFont);
finally
OldFont.Free;
end;
end;
procedure TfrmNMRun.RefreshCompare;
var
n, m, intThetas, intEtas, intEpsilons, p: Integer;
begin
if tblRuns.Active then
begin
// Disconnect DB tables
rvwThetas.DataSource := nil;
rvwEtas.DataSource := nil;
rvwSigmas.DataSource := nil;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Theta) FROM Thetas;');
sqlParent.Active := True;
intThetas := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Eta) FROM Etas;');
sqlParent.Active := True;
intEtas := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Sigma) FROM Sigmas;');
sqlParent.Active := True;
intEpsilons := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
//ShowMessage(IntToStr(intThetas));
//ShowMessage(IntToStr(intEtas));
//ShowMessage(IntToStr(intEpsilons));
grdCompare.ColCount := 8 + intThetas + intEtas + intEpsilons;
grdCompare.RowCount := tblRuns.RecordCount + 1;
for n := 8 to grdCompare.ColCount - 1 do
grdCompare.ColWidths[n] := 96;
grdCompare.FixedCols := 0;
grdCompare.FixedRows := 1;
grdCompare.Captions.Clear;
grdCompare.Captions.Add('Run No');
grdCompare.Captions.Add('Label');
grdCompare.Captions.Add('OFV');
grdCompare.Captions.Add('dOFV');
grdCompare.Captions.Add('Parent');
grdCompare.Captions.Add('Cond No');
grdCompare.Captions.Add('Notes');
grdCompare.Captions.Add('Minimization');
grdCompare.Captions.Add('Warnings');
grdCompare.Captions.Add('Problem');
grdCompare.Captions.Add('Str Model');
grdCompare.Captions.Add('Cov Model');
grdCompare.Captions.Add('IIV');
grdCompare.Captions.Add('IOV');
grdCompare.Captions.Add('RV');
grdCompare.Captions.Add('Estimation');
grdCompare.Captions.Add('Description');
grdCompare.ColWidths[0] := 64;
grdCompare.ColWidths[1] := 160;
grdCompare.ColWidths[2] := 64;
grdCompare.ColWidths[3] := 64;
grdCompare.ColWidths[4] := 64;
grdCompare.ColWidths[5] := 64;
grdCompare.ColWidths[6] := 128;
grdCompare.ColWidths[7] := 96;
grdCompare.ColWidths[8] := 160;
grdCompare.ColWidths[9] := 160;
grdCompare.ColWidths[10] := 160;
grdCompare.ColWidths[11] := 160;
grdCompare.ColWidths[12] := 160;
grdCompare.ColWidths[13] := 160;
grdCompare.ColWidths[14] := 160;
grdCompare.ColWidths[15] := 160;
grdCompare.ColWidths[16] := 160;
for n := 1 to intThetas do
grdCompare.Captions.Add('Th ' + IntToStr(n));
for n := 1 to intEtas do
grdCompare.Captions.Add('Om ' + IntToStr(n));
for n := 1 to intEpsilons do
grdCompare.Captions.Add('Si ' + IntToStr(n));
tblRuns.First;
for n := 1 to tblRuns.RecordCount do
begin
with grdCompare do
begin
Cells[0, n] := tblRunsRunNo.Value;
Cells[1, n] := tblRunsLabel.Value;
if FloatToStr(tblRunsObj.Value) <> '0' then
Cells[2, n] := FloatToStr(tblRunsObj.Value);
if FloatToStr(tblRunsdOFV.Value) <> '0' then
Cells[3, n] := FloatToStr(tblRunsdOFV.Value);
if FloatToStr(tblRunsdOFV.Value) <> '0' then
Cells[4, n] := tblRunsParentNo.Value;
if FloatToStr(tblRunsConditionNumber.Value) <> '0' then
Cells[5, n] := FloatToStr(tblRunsConditionNumber.Value);
Cells[6, n] := tblRunsComments.Value;
Cells[7, n] := tblRunsMinShort.Value;
Cells[8, n] := tblRunsWarnings.Value;
// new fields
Cells[9, n] := tblRunsComment.Value;
Cells[10, n] := tblRunsStructuralModel.Value;
Cells[11, n] := tblRunsCovariateModel.Value;
Cells[12, n] := tblRunsIIV.Value;
Cells[13, n] := tblRunsIOV.Value;
Cells[14, n] := tblRunsRV.Value;
Cells[15, n] := tblRunsEstimation.Value;
Cells[16, n] := tblRunsDescription.Value;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Theta, ThetaValue, ThetaSE, ThetaRSE');
sqlParent.SQL.Add('FROM Thetas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Theta;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
//ShowMessage(IntToStr(tblThetas.RecordCount));
for m := 17 to 17 + intThetas - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat)
+ ' (' + FloatToStr(sqlParent.Fields[2].AsFloat) + ')'
else
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat);
end
else
Cells[m, n] := '';
p := p + 1;
sqlParent.Next;
end;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Eta, EtaValue, EtaSE, EtaRSE');
sqlParent.SQL.Add('FROM Etas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Eta;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
for m := 17 + intThetas to 17 + intThetas + intEtas - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat)
+ ' (' + FloatToStr(sqlParent.Fields[2].AsFloat) + ')'
else
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat);
end
else
Cells[m, n] := '';
p := p + 1;
sqlParent.Next;
end;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Sigma, SigmaValue, SigmaSE, SigmaRSE');
sqlParent.SQL.Add('FROM Sigmas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Sigma;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
for m := 17 + intThetas + intEtas to 17 + intThetas + intEtas + intEpsilons - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat)
+ ' (' + FloatToStr(sqlParent.Fields[2].AsFloat) + ')'
else
Cells[m, n] := FloatToStr(sqlParent.Fields[1].AsFloat);
end
else
Cells[m, n] := '';
p := p + 1;
sqlParent.Next;
end;
end;
tblRuns.Next;
end;
// Reconnect DB tables
rvwThetas.DataSource := srcThetas;
rvwEtas.DataSource := srcEtas;
rvwSigmas.DataSource := srcSigmas;
end;
end;
procedure TfrmNMRun.RefreshTree;
var
n: Integer;
SrcRec, DestRec: PRunRec;
SrcNode, DestNode, pNode: PVirtualNode;
bookMark: TBookmark;
S: string;
begin
if tblRuns.Active then
begin
strSrc.Strings.Clear;
strDest.Strings.Clear;
try
try
tblRuns.IndexName := 'irunno';
try
bookMark := tblRuns.GetBookmark;
except
bookMark := nil;
end;
tblRuns.First;
tblRuns.Refresh;
tblThetas.MasterSource := nil;
tblEtas.MasterSource := nil;
tblSigmas.MasterSource := nil;
Application.ProcessMessages;
finally
vstMain.BeginUpdate;
vstMain.Clear;
vstMain.NodeDataSize := Sizeof(TRunRec);
tblRuns.First;
vstMain.RootNodeCount := tblRuns.RecordCount;
vstMain.EndUpdate;
end;
finally
tblThetas.MasterSource := srcRuns;
tblEtas.MasterSource := srcRuns;
tblSigmas.MasterSource := srcRuns;
end;
SetLength(SrcArray, strSrc.Strings.Count);
SetLength(DestArray, strDest.Strings.Count);
for n := 0 to strSrc.Strings.Count - 1 do
begin
SrcNode := FindNodeByText(nil, strSrc.Strings[n]);
DestNode := FindNodeByText(nil, strDest.Strings[n]);
SrcRec := vstMain.GetNodeData(SrcNode);
DestRec := vstMain.GetNodeData(DestNode);
if (srcNode <> nil) and
(DestNode <> nil) and
(srcNode.Parent <> DestNode) and
(SrcRec.RunNo = strSrc.Strings[n]) and
(DestRec.RunNo = strDest.Strings[n]) then
try
vstMain.MoveTo(SrcNode, DestNode, amAddChildLast, False);
vstMain.Expanded[DestNode] := True;
except
//on E: EVirtualTreeError do
//begin
MessageDlg('There was a problem constructing the tree! All master-child '
+ 'relationships will be removed to prevent database corruption.', mtError,
[mbOK], 0);
try
sqlParent.SQL.Clear;
sqlParent.SQL.Add('UPDATE Runs SET ParentNo = NULL;');
sqlParent.ExecSQL;
finally
sqlParent.Active := False;
end;
//end;
end;
//if SrcNode <> nil then
//begin
//vstMain.Selected[Node] := True;
//vstMain.FocusedNode := Node;
//SrcArray[n] := SrcNode;
//end;
end;
if bookMark <> nil then
begin
tblRuns.GotoBookmark(bookMark);
S := tblRunsRunNo.Value;
//ShowMessage(S);
pNode := vstMain.GetFirst;
while (pNode <> nil) do
begin
//vstMain.IterateSubtree(pNode, CheckNodeForText, @S, [],
//true);
srcNode := FindNodeByText(nil, S);
srcRec := vstMain.GetNodeData(SrcNode);
if srcRec.RunNo = S then
destNode := srcNode;
pNode := pNode.NextSibling;
end;
if (destNode <> nil) then
vstMain.FocusedNode := destNode;
end;
end;
end;
function TfrmNMRun.FindNodeByText(StartNode: PVirtualNode; const S:
string): PVirtualNode;
begin
Result := vstMain.IterateSubtree(StartNode, CheckNodeForText, @S, [],
true);
end;
procedure TfrmNMRun.CheckforUpdates1Click(Sender: TObject);
begin
appUpdate.Execute;
end;
procedure TfrmNMRun.CheckNodeForText(Sender: TBaseVirtualTree;
Node: PVirtualNode; pText: Pointer; var Abort: Boolean);
var
RunRecord: PRunRec;
begin
Abort := FALSE;
RunRecord := vstMain.GetNodeData(Node);
// JCL string match
if StrMatches(PString(pText)^, RunRecord.RunNo) then
begin
//ShowMessage( PString(pText)^);
Abort := True;
end;
end;
// ********************************************************************
// Purge database
// ********************************************************************
procedure TfrmNMRun.PurgeRuns1Click(Sender: TObject);
begin
if MessageDlg('This will empty the file of all runs, and cannot be ' +
'reversed. Are you sure you wish to continue?', mtWarning,
[mbYes, mbNo], 0) = mrYes then
begin
tblThetas.EmptyTable;
tblEtas.EmptyTable;
tblSigmas.EmptyTable;
tblRuns.EmptyTable;
if tblPlotData.Active = False then
tblPlotData.Active := True;
tblPlotData.EmptyTable;
tblTrans.InsertRecord([Null, '!!! purge runs', tblRunsRunNo.Value, Now, txtUser]);
if DisconnectFile then
ConnectFile;
end;
end;
// ********************************************************************
// Load database
// ********************************************************************
function TfrmNMRun.ConnectFile: Boolean;
var
testDict: TffDataDictionary;
oldCursor: TCursor;
lstIni: TStrings;
strTemp: string;
n: Integer;
RegIni: TRegIniFile;
begin
if Assigned(DictTrans) then
DictTrans.Clear;
if Assigned(DictRuns) then
DictRuns.Clear;
if Assigned(DictThetas) then
DictThetas.Clear;
if Assigned(DictEtas) then
DictEtas.Clear;
if Assigned(DictSigmas) then
DictSigmas.Clear;
if Assigned(DictData) then
DictData.Clear;
if Assigned(DictVPC) then
DictVPC.Clear;
Result := True;
brkUpp.BaseString := dlgOpenDB.Directory;
brkUpp.BreakString := '\';
brkUpp.StringList.Clear;
brkUpp.BreakApart;
frmNMRun.Caption := 'Census - ' +
nmDatabase.AliasName;
Application.Title := 'Census - ' +
nmDatabase.AliasName;
barStatus.Panels[0].Text := 'Connected';
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
barPrg.Visible := True;
try
nmClient.Active := True;
nmSession.Active := True;
nmDatabase.Connected := True;
try
testDict := tblTrans.Dictionary;
//if not Assigned(DictRuns) then
DefDictTrans;
if testDict <> DictTrans then
RestructureTrans;
finally
//testDict.Free;
end;
try
testDict := tblRuns.Dictionary;
//if not Assigned(DictRuns) then
DefDictRuns;
if testDict <> DictRuns then
RestructureRuns;
finally
//testDict.Free;
end;
try
testDict := tblThetas.Dictionary;
//if not Assigned(DictThetas) then
DefDictThetas;
if testDict <> DictThetas then
RestructureThetas;
finally
//testDict.Free;
end;
try
testDict := tblEtas.Dictionary;
//if not Assigned(DictEtas) then
DefDictEtas;
if testDict <> DictEtas then
RestructureEtas;
finally
//testDict.Free;
end;
try
testDict := tblSigmas.Dictionary;
//if not Assigned(DictSigmas) then
DefDictSigmas;
if testDict <> DictSigmas then
RestructureSigmas;
finally
//testDict.Free;
end;
try
testDict := tblPlotData.Dictionary;
//if not Assigned(DictSigmas) then
DefDictData;
if testDict <> DictData then
RestructureData;
finally
//testDict.Free;
end;
try
testDict := tblVPC.Dictionary;
//if not Assigned(DictRuns) then
DefDictVPC;
if testDict <> DictVPC then
RestructureVPC;
finally
//testDict.Free;
end;
// Transactions
try
tblTrans.Active := True;
except
on EDatabaseError do
begin
try
RestructureTrans;
finally
try
tblTrans.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured TRANSACTIONS table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
// Runs
try
tblRuns.Active := True;
// Remove orphaned dOFV values
//sqlDel.Active := False;
//sqlDel.SQL.Clear;
//sqlDel.SQL.Add('UPDATE Runs SET dOFV = ''''' +
// ' WHERE ParentNo = ''''');
//sqlDel.ExecSQL;
tblRuns.First;
for n := 0 to tblRuns.RecordCount - 1 do
begin
if Trim(tblRunsParentNo.Value) = '' then
begin
tblRuns.Edit;
tblRunsdOFV.Clear;
tblRuns.Post;
end;
tblRuns.Next;
end;
tblRuns.First;
except
on EDatabaseError do
begin
try
RestructureRuns;
finally
try
tblRuns.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured RUNS table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
try
tblThetas.Active := True;
except
on EDatabaseError do
begin
try
RestructureThetas;
finally
try
tblThetas.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured THETAS table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
// Etas
try
tblEtas.Active := True;
except
on EDatabaseError do
begin
try
RestructureEtas;
finally
try
tblEtas.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured ETAS table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
// Sigmas
try
tblSigmas.Active := True;
except
on EDatabaseError do
begin
try
RestructureSigmas;
finally
try
tblSigmas.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured SIGMAS table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
// Data
try
tblPlotData.Active := True;
except
on EDatabaseError do
begin
try
RestructureData;
finally
try
tblPlotData.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured DATA table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
// VPC
try
tblVPC.Active := True;
except
on EDatabaseError do
begin
try
RestructureVPC;
finally
try
tblVPC.Active := True;
except
Result := False;
MessageDlg('Unable to open restructured VPC table due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
end;
end;
end;
end;
except
Result := False;
MessageDlg('Unable to open this database due to an unknown error.',
mtError, [mbOK], 0);
DisconnectFile;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
Screen.Cursor := OldCursor;
barPrg.Visible := False;
end;
barPrg.Visible := False;
Screen.Cursor := OldCursor;
//mruFiles.AddItem(nmDatabase.AliasName);
if Length(Trim(nmDatabase.AliasName)) > 0 then
{ovcMru.Add(nmDatabase.AliasName)}
mruManager.Add(nmDatabase.AliasName, 0);
// XPmenu
//XPMenu1.InitComponent(frmNMRun);
btnImportRun.Enabled := True;
ImportVPC1.Enabled := True;
btnRunReport.Enabled := True;
btnScanFolder.Enabled := True;
ImportRun1.Enabled := True;
ScanFolder1.Enabled := True;
PurgeRuns1.Enabled := True;
btnPlots.Enabled := True;
PlotWizard1.Enabled := True;
btnCopy.Enabled := True;
IndividualPlots1.Enabled := True;
CopyRunFilestoSPLUS1.Enabled := True;
SimpleRunSummary1.Enabled := True;
RunReport1.Enabled := True;
Reports1.Enabled := True;
MultipleRunReport1.Enabled := True;
Currentrunrichtext1.Enabled := True;
Keyruns1.Enabled := True;
PackageRuns1.Enabled := True;
LogLikelihoodProfiling2.Enabled := True;
EditCurrentRun1.Enabled := True;
RunaBootstrap1.Enabled := True;
btnDelete.Enabled := True;
DisplayTransactions1.Enabled := True;
Properties1.Enabled := True;
//ShowMessage(nmDatabase.AliasName + '\census.ini');
if FileExists(nmDatabase.AliasName + '\census.ini') then
begin
lstIni := TStringList.Create;
lstIni.LoadFromFile(nmDatabase.AliasName + '\census.ini');
strTemp := StringReplace(Trim(lstIni.Text), 'WorkingDirectory=', '', []);
if DirectoryExists(strTemp) then
dlgOpen.InitialDir := strTemp;
lstIni.Free;
end;
// Execute R, if available
//showmessage('R');
GoR;
// Tracker
//if tblTrans.Active = False then
// tblTrans.Active := True;
//ShowMessage(txtUser);
try
if btnNewDB.Tag = 1 then
begin
tblTrans.InsertRecord([Null, 'create', '---', Now, txtUser]);
btnNewDB.Tag := 0;
end;
tblTrans.InsertRecord([Null, 'connect', '---', Now, txtUser]);
except
MessageDlg('Connect: Transaction table failed to update!', mtError, [mbOK], 0);
DisconnectFile;
end;
// Populate tree
RefreshTree;
end;
// ********************************************************************
// Close database
// ********************************************************************
function TfrmNMRun.DisconnectFile: Boolean;
begin
// Tracker
if nmDatabase.Connected then
try
tblTrans.InsertRecord([Null, 'disconnect', '---', Now, txtUser]);
except
MessageDlg('Transaction table failed to update!', mtError, [mbOK], 0);
end;
Result := True;
barStatus.Panels[0].Text := 'No File Open';
frmNMRun.Caption := 'Census';
Application.Title := 'Census';
try
tblRuns.Active := False;
tblThetas.Active := False;
tblEtas.Active := False;
tblSigmas.Active := False;
tblPlotData.Active := False;
tblTrans.Active := False;
tblVPC.Active := False;
nmDatabase.Connected := False;
nmClient.Active := False;
nmSession.Active := False;
vstMain.Clear;
ClearCompare;
except
Result := False;
end;
if Assigned(frmR) then
begin
frmR.RCommand.SendLine('q()', True);
frmR.RCommand.SendLine('n', True);
frmR.RCommand.Stop;
frmR.memR.Clear;
end;
RestartR1.Enabled := False;
//mruFiles.AddItem(nmDatabase.AliasName);
if Length(Trim(nmDatabase.AliasName)) > 0 then
{ovcMru.Add(nmDatabase.AliasName)}
mruManager.Add(nmDatabase.AliasName, 0);
PurgeRuns1.Enabled := False;
EditCurrentRun1.Enabled := False;
btnExport.Enabled := False;
btnImportRun.Enabled := False;
IndividualPlots1.Enabled := False;
SimpleRunSummary1.Enabled := False;
RunReport1.Enabled := False;
MultipleRunReport1.Enabled := False;
Currentrunrichtext1.Enabled := False;
Keyruns1.Enabled := False;
Reports1.Enabled := False;
PackageRuns1.Enabled := False;
LogLikelihoodProfiling2.Enabled := False;
btnPlots.Enabled := False;
btnCopy.Enabled := False;
PlotWizard1.Enabled := False;
CopyRunFilestoSPLUS1.Enabled := False;
btnScanFolder.Enabled := False;
RunaBootstrap1.Enabled := False;
//btnFirst.Enabled := False;
//btnLast.Enabled := False;
//btnPrevious.Enabled := False;
//btnNext.Enabled := False;
btnDelete.Enabled := False;
ImportRun1.Enabled := False;
ScanFolder1.Enabled := False;
btnRunReport.Enabled := False;
DisplayTransactions1.Enabled := False;
Properties1.Enabled := False;
ImportVPC1.Enabled := False;
end;
procedure TfrmNMRun.DisplayTransactions1Click(Sender: TObject);
begin
if not Assigned(frmTRansactions) then
frmTransactions := TfrmTransactions.Create(Application);
frmTransactions.ShowModal;
end;
procedure TfrmNMRun.ClearCompare;
begin
grdCompare.RowCount := 1;
grdCompare.ColCount := 6;
end;
// ********************************************************************
// Delete run
// ********************************************************************
procedure TfrmNMRun.btnDeleteClick(Sender: TObject);
//var
//n: Integer;
//oldCursor: TCursor;
begin
if MessageDlg('This will delete the current run record (' +
tblRunsRunNo.Value + '), and cannot be ' +
'reversed. Your original run files will not be ' +
'removed. Do you wish to continue?', mtWarning,
[mbYes, mbNo], 0) = mrYes then
begin
BlastRun;
end;
end;
// ********************************************************************
// Next run
// ********************************************************************
procedure TfrmNMRun.btnNextClick(Sender: TObject);
begin
tblRuns.Next;
end;
// ********************************************************************
// Previous run
// ********************************************************************
procedure TfrmNMRun.btnPreviousClick(Sender: TObject);
begin
tblRuns.Prior;
end;
procedure TfrmNMRun.btnRClick(Sender: TObject);
begin
if btnR.Down then
frmR.Show
else
frmR.Hide;
end;
// ********************************************************************
// First run
// ********************************************************************
procedure TfrmNMRun.btnFirstClick(Sender: TObject);
begin
tblRuns.First;
end;
// ********************************************************************
// Last run
// ********************************************************************
procedure TfrmNMRun.btnLastClick(Sender: TObject);
begin
tblRuns.Last;
end;
procedure TfrmNMRun.btnLoadXmlClick(Sender: TObject);
var
tn : TTreeNode;
begin
if FileExists(edtXml.Text) then
begin
try
xmlDoc.LoadFromFile(edtXml.Text);
xmlDoc.Active := True;
except
;
end;
try
Cursor := Screen.Cursor;
Screen.Cursor := crHourglass;
DOMShow(tvXML, xmlDoc.DocumentElement, nil);
tvXML.FullExpand;
finally
Screen.Cursor := Cursor;
//frmXML.Show;
end;
try
tn := GetNodeByText(tvXML,'<NM:OUTPUT>', True);
tvXML.SetFocus;
tn.Selected := True;
except
;
end;
end;
end;
// ********************************************************************
// Open database
// ********************************************************************
procedure TfrmNMRun.btnOpenDBClick(Sender: TObject);
begin
if dlgOpenDB.Execute then
if (FileExists(dlgOpenDB.Directory + '\Runs.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Thetas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Etas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Sigmas.FF2')) then
begin
DisconnectFile;
nmDatabase.AliasName := dlgOpenDB.Directory;
if FileExists(dlgOpenDB.Directory + '\PlotData.FF2') = False then
embData.DataSaveToFile(dlgOpenDB.Directory + '\PlotData.FF2');
if FileExists(dlgOpenDB.Directory + '\Trans.FF2') = False then
embTrans.DataSaveToFile(dlgOpenDB.Directory + '\Trans.FF2');
ConnectFile;
end
else
MessageDlg('That is not a valid database directory.',
mtError, [mbOK], 0);
end;
// ********************************************************************
// Initialize
// ********************************************************************
procedure TfrmNMRun.FormCreate(Sender: TObject);
var
RegIni: TRegIniFile;
n: Integer;
strProg, strRDir, strRVer: string;
strPerlVer, strPerlDir, strPsNDir, strPsNVer, strXposeVer, strXposeDate: string;
strPsN, strXpose: TStrings;
regEx: TPerlRegEx;
// valor: Double;
begin
// Global exception handler
vstMain.ClipboardFormats.Add('Virtual Tree Data');
Application.OnException := MyExceptionHandler;
dlgOpenDB.Directory := ExtractFilePath(Application.ExeName);
pnlMain.Visible := True;
pnlFiles.Visible := False;
pgcMain.ActivePage := tabTheta;
pgcFiles.ActivePage := tabCtl;
pgcNotes.ActivePage := tabNotes;
// Unpack ZipDll.dll
if FileExists(ExtractFilePath(Application.ExeName) + 'DelZip179.dll') = False then
jvZipDll.DataSaveToFile(ExtractFilePath(Application.ExeName) + 'DelZip179.dll');
// Check for programs
{strProg := RunProg('perl -V:prefix -V:version', ExtractFilePath(Application.ExeName));
regEx.RegEx := 'prefix=''.*'';';
regEx.Subject := strProg;
if RegEx.Match then
blnPerl := True
else
blnPerl := False;
if blnPerl then
begin
strPerlVer := BrkUp('''', BrkUp(';', strProg, 1), 1);
strPerlDir := BrkUp('''', BrkUp(';', strProg, 0), 1);
if FileExists(strPerlDir + '\site\lib\PsN.pm') then
begin
blnPsN := True;
strPsNDir := strPerlDir + '\site\lib';
strPsN := TStringList.Create;
strPsN.LoadFromFile(strPerlDir + '\site\lib\PsN.pm');
//ShowMessage(strPsN.Text);
for n := 0 to strPsN.Count - 1 do
if Pos('$config_file', strPsN[n]) = 1 then
strPsNVer := BrkUp('-', BrkUp('/', StringReplace(strPsN[n], '_', '-', [rfReplaceAll]), 1), 1);
strPsN.Free;
end
else
begin
strPsNVer := 'NA';
strPsNDir := '';
blnPsN := False;
end;
end
else
begin
strPerlVer := 'NA';
strPerlDir := '';
strPsNVer := 'NA';
strPsNDir := '';
blnPsN := False;
end; }
// Set locale
GetLocaleFormatSettings(LOCALE_USER_DEFAULT, fs);
fs.DecimalSeparator := '.';
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
// Show dialogs
if RegIni.ReadInteger('Options', 'RunAbout', 1) = 1 then
begin
{MessageDlg('Please note that Xpose is not compatible with R 2.11.x. ' +
'If you would like to continue to use Xpose, please make sure ' +
'that you have an earlier version of R installed.', mtInformation,
[mbOK], 0); }
if not Assigned(AboutBox) then
AboutBox := TAboutBox.Create(Application);
AboutBox.pnlVer.Caption := 'Version ' + strVersion;
AboutBox.ShowModal;
RegIni.WriteInteger('Options', 'RunAbout', 0);
end;
if RegIni.ReadInteger('Options', 'RunOptions', 1) = 1 then
begin
if not Assigned(frmOptions) then
frmOptions := TfrmOptions.Create(Application);
frmOptions.ShowModal;
RegIni.WriteInteger('Options', 'RunOptions', 0);
end;
// Read in file extensions
extCtl := RegIni.ReadString('Options', 'ExtCtl', '.mod');
extLst := RegIni.ReadString('Options', 'ExtLst', '.lst');
extXpose := RegIni.ReadString('Options', 'ExtXpose', '.');
extFit := RegIni.ReadString('Options', 'ExtFit', '.fit');
extMsf := RegIni.ReadString('Options', 'ExtMsf', '.msf');
runPrefix := RegIni.ReadString('Options', 'RunPrefix', 'run');
blnAsk := RegIni.ReadBool('Options', 'AskNonNumeric', False);
blnMD5 := RegIni.ReadBool('Options', 'MD5', False);
// Update updates
appUpdate.ProxyAddress := RegIni.ReadString('Options', 'ProxyServer', '');
appUpdate.ProxyPort := RegIni.ReadString('Options', 'ProxyPort', '');
// Set open dialog correctly
dlgOpen.DefaultExt := extLst;
dlgOpen.Filter := 'NONMEM Output Files (*' + extLst + ')|*' + extLst +
'|All files (*.*)|*.*';
// XPmenu
//XPMenu1.InitComponent(frmNMRun);
// Set up Xpose
blnR := False;
blnXpose := False;
strRVer := RegIni.ReadString('Options', 'RVersion', '-99');
strRDir := RegIni.ReadString('Options', 'RDirectory', '');
//showmessage(strrver);
{with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('\Software\R-core\R', False) then
begin
strRVer := ReadString('Current Version');
strRDir := ReadString('InstallPath');
CloseKey;
end;
except
;
end; }
blnRDCOM := False;
if (Length(strRDir) = 0) or (strRVer = '-99') or (Length(strRVer) = 0) then
begin
strRDir := RegIni.ReadString('Options', 'XposeDir', '');
regEx := TPerlRegEx.Create;
regEx.RegEx := '(R-\d*\.\d*\.\d*)';
regEx.Subject := strRDir;
if RegEx.Match then
strRVer := Copy(regEx.MatchedText, 3, 50);
//showmessage(strRVer);
regEx.Free;
end;
//ShowMessage(RegIni.ReadString('Options', 'XposeDir', ''));
//ShowMessage(Copy(RegIni.ReadString('Options', 'XposeDir', ''), Length(RegIni.ReadString('Options', 'XposeDir', ''))-4, 200));
if (Length(strRDir) > 0) then
begin
blnR := True;
blnXpose := True;
end;
{if blnR then
// Xpose in Program Files R library folder?
if FileExists(strRDir + '\library\xpose4\DESCRIPTION') then
begin
blnXpose := True;
strXpose := TStringList.Create;
strXpose.LoadFromFile(strRDir + '\library\xpose4\DESCRIPTION');
for n := 0 to strXpose.Count - 1 do
begin
if Pos('Version:', strXpose[n]) > 0 then
strXposeVer := Copy(strXpose[n], 10, 100);
if Pos('Date:', strXpose[n]) > 0 then
strXposeDate := Copy(strXpose[n], 7, 100);
end;
end
else
// Xpose in My Documents R library folder?
begin
if FileExists(GetSpecialFolderPath(CSIDL_PERSONAL) +
'\R\win-library\' + Copy(strRVer, 1, Length(strRVer) - 2) + '\xpose4\DESCRIPTION') then
begin
blnXpose := True;
strXpose := TStringList.Create;
strXpose.LoadFromFile(GetSpecialFolderPath(CSIDL_PERSONAL) +
'\R\win-library\' + Copy(strRVer, 1, Length(strRVer) - 2) + '\xpose4\DESCRIPTION');
for n := 0 to strXpose.Count - 1 do
begin
if Pos('Version:', strXpose[n]) > 0 then
strXposeVer := Copy(strXpose[n], 10, 100);
if Pos('Date:', strXpose[n]) > 0 then
strXposeDate := Copy(strXpose[n], 7, 100);
end;
end;
end; }
if (blnR = False) then
if regIni.ReadBool('Options', 'ShowXposeWarning', True) then
begin
if not Assigned(frmXposeGet) then
frmXposeGet := TfrmXposeGet.Create(Application);
frmXposeGet.ShowModal;
end;
//ShowMessage(StringReplace(strXposeVer, '.', '', [rfReplaceAll]));
{if StrToInt(StringReplace(strXposeVer, '.', '', [rfReplaceAll])) < 410 then
if regIni.ReadBool('Options', 'ShowXposeWarning', True) then
begin
if not Assigned(frmXposeGet) then
frmXposeGet := TfrmXposeGet.Create(Application);
frmXposeGet.ShowModal;
end; }
appUpdate.Version := strVersion;
if RegIni.ReadBool('Options', 'CheckUpdates', False) then
appUpdate.Execute;
// set external app options
RegIni.WriteString('Options', 'PerlVersion', strPerlVer);
RegIni.WriteString('Options', 'PerlDirectory', strPerlDir);
RegIni.WriteBool('Options', 'PerlInstalled', blnPerl);
RegIni.WriteString('Options', 'PsNVersion', strPsNVer);
RegIni.WriteString('Options', 'PsNDirectory', strPsNDir);
RegIni.WriteBool('Options', 'PsNInstalled', blnPsN);
RegIni.WriteBool('Options', 'XposeInstalled', blnXpose);
RegIni.WriteString('Options', 'XposeVersion', strXposeVer);
RegIni.WriteString('Options', 'XposeDate', strXposeDate);
RegIni.WriteBool('Options', 'RInstalled', blnR);
//RegIni.WriteBool('Options', 'RDCOMInstalled', blnRDCOM);
RegIni.WriteString('Options', 'RVersion', strRVer);
RegIni.WriteString('Options', 'RDirectory', strRDir);
RegIni.Free;
// Get logged on user
txtUser := GetLoginName;
//ShowMessage('Zap');
if not Assigned(frmR) then
frmR := TfrmR.Create(Application);
btnR.Down := False;
//frmR.Show;
end;
// ********************************************************************
// About form
// ********************************************************************
procedure TfrmNMRun.AboutNMRun1Click(Sender: TObject);
begin
if not Assigned(AboutBox) then
AboutBox := TAboutBox.Create(Application);
AboutBox.ShowModal;
end;
// ********************************************************************
// Switch views
// ********************************************************************
procedure TfrmNMRun.loBarItemClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
begin
if Index = 0 then
begin
pnlMain.Visible := True;
pnlFiles.Visible := False;
pnlCompare.Visible := False;
RefreshTree;
end;
if Index = 2 then
begin
if (tblRuns.Active) then
begin
pnlMain.Visible := False;
pnlFiles.Visible := True;
pnlCompare.Visible := False;
CtlOpen;
LstOpen;
end;
end;
if Index = 1 then
begin
if (tblRuns.Active) then
begin
pnlMain.Visible := False;
pnlFiles.Visible := False;
pnlCompare.Visible := True;
RefreshCompare;
end;
end;
end;
// ********************************************************************
// Load control stream
// ********************************************************************
procedure TfrmNMRun.CtlOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCtl.Value) then
begin
synCtl.Lines.LoadFromFile(tblRunsCtl.Value);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCtl.Value);
if (tblRunsCtlMD5.Value <> txtMD5) and (tblRunsCtlMD5.Value <> '') then
MessageDlg('The control stream for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsCtlMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open data file
// ********************************************************************
procedure TfrmNMRun.DataOpen;
var
n, m: Integer;
txtMD5: string;
begin
if (FileExists(tblRunsData.Value)) and (grdData.Tag <> tblRunsiRunNo.Value) then
begin
grdData.Tag := tblRunsiRunNo.Value;
if not Assigned(frmDataSelect) then
frmDataSelect := TfrmDataSelect.Create(Application);
frmDataSelect.ShowModal;
if Assigned(frmDataSelect) then
frmDataSelect.Close;
if grdSdtab.Tag = 0 then // CSV
begin
try
grdData.LoadFromCSV(tblRunsData.Value, ',');
except
MessageDlg('An error occurred and the file could not ' +
'be loaded.', mtError, [mbOK], 0);
for n := 0 to grdData.RowCount - 1 do
for m := 0 to grdData.ColCount - 1 do
grdData.Cells[m, n] := '';
end;
end
else
if grdSdtab.Tag = 1 then // Spaces
begin
try
TabDataLoad(tblRunsData.Value);
except
MessageDlg('An error occurred and the file could not ' +
'be loaded.', mtError, [mbOK], 0);
for n := 0 to grdData.RowCount - 1 do
for m := 0 to grdData.ColCount - 1 do
grdData.Cells[m, n] := '';
end;
end
else
if grdSdtab.Tag = -1 then
MessageDlg('The data file has not been loaded. If this is because ' +
'its format is unrecognized by Census, please report this issue ' +
'to the developers.', mtWarning, [mbOK], 0);
end
else
begin
//MessageDlg('This file does not appear to exist. Has it been ' +
// 'moved, or has a network drive been disconnected?', mtError, [mbOK], 0);
end;
if FileExists(tblRunsData.Value) then
begin
if blnMD5 then
begin
txtMD5 := MD5(tblRunsData.Value);
if (tblRunsDataMD5.Value <> txtMD5) and (tblRunsDataMD5.Value <> '') then
MessageDlg('The data file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsDataMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Close data file
// ********************************************************************
procedure TfrmNMRun.DataClose;
var
n, m: Integer;
begin
for n := 0 to grdData.RowCount - 1 do
for m := 0 to grdData.ColCount - 1 do
grdData.Cells[m, n] := '';
end;
// ********************************************************************
// Close database
// ********************************************************************
procedure TfrmNMRun.Close1Click(Sender: TObject);
begin
DisconnectFile;
end;
// ********************************************************************
// Open NONMEM report
// ********************************************************************
procedure TfrmNMRun.LstOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsLst.Value) then
begin
LoadMemo(tblRunsLst, memLst);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsLst.Value);
if (tblRunsLstMD5.Value <> txtMD5) and (tblRunsLstMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsLstMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open sdtab
// ********************************************************************
procedure TfrmNMRun.sdtabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsSdtab.Value) then
begin
if NMGridLoad(grdSdtab, tblRunsSdtab.Value, 1) = False then
MessageDlg('There was an error loading patab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsSdtab.Value);
if (tblRunsSdtabMD5.Value <> txtMD5) and (tblRunsSdtabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsSdtabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Generic load routine for unstructured text files
// ********************************************************************
procedure TfrmNMRun.LoadMemo(nmFile: TStringField; nmMemo:
TMemo);
begin
if FileExists(nmFile.Value) then
nmMemo.Lines.LoadFromFile(nmFile.Value);
end;
// ********************************************************************
// Open patab
// ********************************************************************
procedure TfrmNMRun.PatabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsPatab.Value) then
begin
if NMGridLoad(grdPatab, tblRunsPatab.Value, 1) = False then
MessageDlg('There was an error loading patab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsPatab.Value);
if (tblRunsPatabMD5.Value <> txtMD5) and (tblRunsPatabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsPatabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Display MSF binary
// ********************************************************************
procedure TfrmNMRun.MsfOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsMsf.Value) then
begin
memMsf.FileName := tblRunsMsf.Value;
memMsf.IsOpen := True;
if blnMD5 then
begin
txtMD5 := MD5(tblRunsMsf.Value);
if (tblRunsMsfMD5.Value <> txtMD5) and (tblRunsMsfMD5.Value <> '') then
MessageDlg('The MSF for this run has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsMsfMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open mutab
// ********************************************************************
procedure TfrmNMRun.MultipleRunReport1Click(Sender: TObject);
begin
MessageDlg('Not yet implemented!', mtInformation, [mbOK], 0);
end;
procedure TfrmNMRun.MutabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsMutab.Value) then
begin
if NMGridLoad(grdMutab, tblRunsMutab.Value, 1) = False then
MessageDlg('There was an error loading mutab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsMutab.Value);
if (tblRunsMutabMD5.Value <> txtMD5) and (tblRunsMutabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsMutabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open catab
// ********************************************************************
procedure TfrmNMRun.CatabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCatab.Value) then
begin
if NMGridLoad(grdCatab, tblRunsCatab.Value, 1) = False then
MessageDlg('There was an error loading catab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCatab.Value);
if (tblRunsCatabMD5.Value <> txtMD5) and (tblRunsCatabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsCatabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open cotab
// ********************************************************************
procedure TfrmNMRun.CotabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCotab.Value) then
begin
if NMGridLoad(grdCotab, tblRunsCotab.Value, 1) = False then
MessageDlg('There was an error loading cotab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCotab.Value);
if (tblRunsCotabMD5.Value <> txtMD5) and (tblRunsCotabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsCotabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Getfiles
// ********************************************************************
procedure TfrmNMRun.GetFiles(DirStr: string; filelist: TStrings; rec: Boolean);
var
DirInfo: TSearchRec;
r: Integer;
pattern: string;
blnRecurse: Boolean;
begin
pattern := ExtractFileName(DirStr);
if Pos('*', pattern) > 0 then
DirStr := ExtractFilePath(DirStr)
else
pattern := '*.*';
if DirStr[Length(DirStr)] <> '\' then
DirStr := DirStr + '\';
if SetCurrentDir((DirStr)) then
begin
r := FindFirst(pattern, FaAnyfile, DirInfo);
while r = 0 do
begin
if (DirInfo.Attr and faDirectory) = 0 then
filelist.Add(DirStr + DirInfo.Name);
r := FindNext(DirInfo);
end;
FindClose(DirInfo);
if rec then
begin
r := FindFirst('*.*', FaAnyfile, DirInfo);
while r = 0 do
begin
if (DirInfo.Attr and faDirectory) <> 0 then
if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then
GetFiles(DirStr + DirInfo.Name + '\' + pattern, filelist, True);
r := FindNext(DirInfo);
end;
end;
FindClose(DirInfo);
end;
end;
// ********************************************************************
// New database
// ********************************************************************
procedure TfrmNMRun.btnNewDBClick(Sender: TObject);
begin
//DisconnectFile;
//nmDatabase.AliasName := 'C:\Users\Administrator\test2';
//CreateDataTables;
if dlgNewDB.Execute then
begin
{embRuns.DataSaveToFile(dlgNewDB.Directory + '\Runs.ff2');
embTheta.DataSaveToFile(dlgNewDB.Directory + '\Thetas.ff2');
embEta.DataSaveToFile(dlgNewDB.Directory + '\Etas.ff2');
embSigma.DataSaveToFile(dlgNewDB.Directory + '\Sigmas.ff2');
embData.DataSaveToFile(dlgNewDB.Directory + '\PlotData.ff2');
embTrans.DataSaveToFile(dlgNewDB.Directory + '\Trans.ff2');
embFFSTRAN.DataSaveToFile(dlgNewDB.Directory + '\FFSTRAN.CFG'); }
DisconnectFile;
nmDatabase.AliasName := dlgNewDB.Directory;
CreateDataTables;
btnNewDB.Tag := 1; // set create record flag
ConnectFile;
end;
end;
// ********************************************************************
// Pack database
// ********************************************************************
procedure TfrmNMRun.PackTables1Click(Sender: TObject);
var
TaskID: LongInt;
TaskStatus: TffRebuildStatus;
Done: Boolean;
crScreen: TCursor;
begin
crScreen := Screen.Cursor;
try
Screen.Cursor := crHourglass;
barPrg.Visible := True;
// Transactions
Check(tblTrans.PackTable(TaskID));
Check(tblTrans.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblTrans.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
// Runs
Check(tblRuns.PackTable(TaskID));
Check(tblRuns.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblRuns.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
// Thetas
Check(tblThetas.PackTable(TaskID));
Check(tblThetas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblThetas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
// Etas
Check(tblEtas.PackTable(TaskID));
Check(tblEtas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblEtas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
// Sigmas
Check(tblSigmas.PackTable(TaskID));
Check(tblSigmas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblSigmas.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
// Data
Check(tblPlotData.PackTable(TaskID));
Check(tblPlotData.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
while not Done do
begin
barPrg.Position := Round(TaskStatus.rsPercentDone);
Check(tblPlotData.Session.GetTaskStatus(TaskID, Done,
TaskStatus));
end;
barPrg.Position := 100;
finally
Screen.Cursor := crScreen;
barPrg.Visible := False;
end;
end;
// ********************************************************************
// Open mytab
// ********************************************************************
procedure TfrmNMRun.MytabOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsMytab.Value) then
begin
if NMGridLoad(grdMytab, tblRunsMytab.Value, 1) = False then
MessageDlg('There was an error loading mytab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsMytab.Value);
if (tblRunsMytabMD5.Value <> txtMD5) and (tblRunsMytabMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsMytabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open cwtab.est
// ********************************************************************
procedure TfrmNMRun.CwtabEstOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCwtabEst.Value) then
begin
if NMGridLoad(grdCwtabEst, tblRunsCwtabEst.Value, 1) = False then
MessageDlg('There was an error loading cwtab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCwtabEst.Value);
if (tblRunsCwtabEstMD5.Value <> txtMD5) and (tblRunsCwtabEstMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsCwtabMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open cwtab.deriv
// ********************************************************************
procedure TfrmNMRun.CwtabDerivOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCwtabDeriv.Value) then
begin
if NMGridLoad(grdCwtabDeriv, tblRunsCwtabDeriv.Value, 1) = False then
MessageDlg('There was an error loading cwtab.', mtError,
[mbOK], 0);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCwtabDeriv.Value);
if (tblRunsCwtabDerivMD5.Value <> txtMD5) and (tblRunsCwtabDerivMD5.Value <> '') then
MessageDlg('This output table has been changed since it was added to ' +
'the database!#10#13#10#13Recorded MD5:#9' + tblRunsCwtabDerivMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Edit run
// ********************************************************************
procedure TfrmNMRun.EditCurrentRun1Click(Sender: TObject);
begin
if not Assigned(frmEdit) then
frmEdit := TfrmEdit.Create(Application);
try
frmEdit.ShowModal;
finally
RefreshTree;
end;
end;
// ********************************************************************
// Convert numbers function
// ********************************************************************
function TfrmNMRun.NumConv(strNo: string): string;
begin
if Pos('NAN', strNo) = 0 then
try
Result := FloatToStr(StrToFloat(strNo), fs);
except
MessageDlg('There was a problem converting a '
+ 'number to decimal format (' + strNo + ').', mtError,
[mbOK], 0);
Result := '0';
end
else
Result := '0';
end;
procedure TfrmNMRun.oNLINEhELP1Click(Sender: TObject);
begin
if FileExists(ExtractFilePath(Application.Exename) + 'Census Help.chm') then
ShellExecute(Application.Handle, PChar('open'), PChar(ExtractFilePath(Application.Exename) + 'Census Help.chm'),
PChar(''), nil, SW_NORMAL)
else
MessageDlg('Online Help is missing. Please reinstall Census.', mtError,
[mbOK], 0);
end;
// ********************************************************************
// Generic grid loader
// ********************************************************************
function TfrmNMRun.NMGridLoad(Grid: TJvStringGrid;
FileName: string; FileType: Integer): Boolean;
var
n, m: Integer;
lstFitFile: TStrings;
begin
// Filetype = 1 : NONMEM table file
// Filetype = 2 : NONMEM 7 special table
Result := True;
if FileExists(FileName) then
begin
lstFitFile := TStringList.Create;
try
lstFitFile.LoadFromFile(FileName);
except
on E: EFOpenError do
begin
MessageDlg('Error opening file (' + FileName + ')!' + #10#13#10#13 + E.Message, mtError,
[mbOK], 0);
Exit;
end;
end;
if lstFitFile.Count = 0 then
begin
Grid.RowCount := 1;
Grid.ColCount := 1;
Grid.Cells[0,0] := 'Empty';
Exit;
end;
lstFitFile.Delete(0);
if Grid.RowCount <> lstFitFile.Count then
Grid.RowCount := lstFitFile.Count;
for n := 0 to lstFitFile.Count - 1 do
begin
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BreakString := ' ';
brkUpp.BaseString := lstFitFile[n];
brkUpp.BreakApart;
if Grid.ColCount <> brkUpp.StringList.Count then
Grid.ColCount := brkUpp.StringList.Count;
if (FileType = 1) then
begin // NONMEM tables
try
for m := 0 to brkUpp.StringList.Count - 1 do
if n = 0 then
Grid.Cells[m, n] := brkUpp.StringList[m]
else
Grid.Cells[m, n] := NumConv(brkUpp.StringList[m]);
except
Result := False;
end;
end
else
begin // NONMEM 7 special tables
try
for m := 0 to brkUpp.StringList.Count - 1 do
if ((n = 0) or (m = 0)) then
Grid.Cells[m, n] := brkUpp.StringList[m]
else
Grid.Cells[m, n] := NumConv(brkUpp.StringList[m]);
except
Result := False;
end;
end;
end;
lstFitFile.Free;
if Grid.ColCount < 2 then
Grid.FixedCols := 0
else
Grid.FixedCols := 1;
Grid.FixedRows := 1;
{try
grdFit.LoadFromCSV(tblRunsFit.Value, ' ');
except
MessageDlg('An error occurred and the file could not ' +
'be loaded.', mtError, [mbOK], 0);
for n := 0 to grdFit.RowCount - 1 do
for m := 0 to grdFit.ColCount - 1 do
grdFit.Cells[m,n] := '';
end; }
end;
{else
MessageDlg('This file (' + FileName + ') does not appear to exist. Has it been ' +
'moved, or has a network drive been disconnected?', mtError, [mbOK], 0); }
end;
function TfrmNMRun.NMCapData(Table: TffTable;
FileName: string): Boolean;
var
n, m, intTimeCount: Integer;
intTimeDep, intDep, intIDDep: Double;
lstFitFile: TStrings;
intID, intTIME, intIWRE, intIPRE, intDV,
intPRED, intRES, intWRES, intOCC: Integer;
begin
Result := True;
intID := -1;
intTIME := -1;
intIPRE := -1;
intIWRE := -1;
intDV := -1;
intPRED := -1;
intRES := -1;
intWRES := -1;
intOCC := -1;
intTimeCount := 0;
intTimeDep := -1;
intDep := -1;
intIDDep := -1;
if FileExists(FileName) then
begin
lstFitFile := TStringList.Create;
try
lstFitFile.LoadFromFile(FileName);
except
on E: EFOpenError do
begin
MessageDlg('Error opening file (' + FileName + ')!' + #10#13#10#13 + E.Message, mtError,
[mbOK], 0);
Exit;
end;
end;
lstFitFile.Delete(0);
//if Grid.RowCount <> lstFitFile.Count then
// Grid.RowCount := lstFitFile.Count;
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BreakString := ' ';
brkUpp.BaseString := lstFitFile[0];
brkUpp.BreakApart;
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if brkUpp.StringList[m] = 'ID' then
intID := m;
if brkUpp.StringList[m] = 'TIME' then
intTIME := m;
if brkUpp.StringList[m] = 'IPRE' then
intIPRE := m;
if brkUpp.StringList[m] = 'IWRE' then
intIWRE := m;
if brkUpp.StringList[m] = 'DV' then
intDV := m;
if brkUpp.StringList[m] = 'PRED' then
intPRED := m;
if brkUpp.StringList[m] = 'RES' then
intRES := m;
if brkUpp.StringList[m] = 'WRES' then
intWRES := m;
if brkUpp.StringList[m] = 'OCC' then
intOCC := m;
end;
if ((intID = -1)
or (intTIME = -1)
or (intIPRE = -1)
or (intIWRE = -1)
or (intDV = -1)
or (intPRED = -1)
or (intRES = -1)
or (intWRES = -1)) then
begin
MessageDlg('An essential data item seems to be missing from the ' +
'standard fit (sdtab) file (' + FileName + '). Please make sure that it ' +
'contains the ID, TIME, DV, PRED, IPRE, IWRE, RES and WRES ' +
'columns! Plots will be unavailable unless all of these are present.',
mtError, [mbOK], 0);
Result := False;
ShowPlots := False;
Exit;
end;
dlgProg.InitValues(0, lstFitFile.Count - 1, 1, 1, 'Working...', 'Capturing plot data...');
dlgProg.Show;
for n := 1 to lstFitFile.Count - 1 do
begin
brkUpp.AllowEmptyString := False;
brkUpp.StringList.Clear;
brkUpp.BreakString := ' ';
brkUpp.BaseString := lstFitFile[n];
brkUpp.BreakApart;
//if Grid.ColCount <> brkUpp.StringList.Count then
// Grid.ColCount := brkUpp.StringList.Count;
try
try
if Pos('TABLE NO.', lstFitFile[n]) = 0 then
begin
tblPlotData.Insert;
tblPlotDataRunNo.Value := tblRunsRunNo.Value;
tblPlotDataSID.Value := StrToFloat(brkUpp.StringList[intID]);
tblPlotDataTIME.Value := StrToFloat(brkUpp.StringList[intTIME]);
// Check for dupe times
if (intTimeDep = -1) and (StrToFloat(brkUpp.StringList[intTIME]) <> 0) then
begin
intTimeDep := StrToFloat(brkUpp.StringList[intTIME]);
intDep := StrToFloat(brkUpp.StringList[intWRES]);
intIDDep := StrToFloat(brkUpp.StringList[intID]);
intTimeCount := 1;
end
else
if (intTimeDep = StrToFloat(brkUpp.StringList[intTIME])) and
(intDep <> StrToFloat(brkUpp.StringList[intWRES])) and
(intIDDep = StrToFloat(brkUpp.StringList[intID])) then
intTimeCount := intTimeCount + 1;
tblPlotDataIPRE.Value := StrToFloat(brkUpp.StringList[intIPRE]);
tblPlotDataIWRE.Value := StrToFloat(brkUpp.StringList[intIWRE]);
tblPlotDataDV.Value := StrToFloat(brkUpp.StringList[intDV]);
tblPlotDataPRED.Value := StrToFloat(brkUpp.StringList[intPRED]);
if intOCC > -1 then
tblPlotDataOCC.Value := StrToFloat(brkUpp.StringList[intOCC]);
tblPlotDataRES.Value := StrToFloat(brkUpp.StringList[intRES]);
tblPlotDataWRES.Value := StrToFloat(brkUpp.StringList[intWRES]);
end;
finally
if tblPlotData.State in [dsInsert, dsEdit] then
tblPlotData.Post;
dlgProg.Position := n;
end;
except
Result := False;
end;
end;
lstFitFile.Free;
dlgProg.Hide;
if (intOCC = -1) and (intTimeCount > 1) then
MessageDlg('No occasion (OCC) variable was located in the ' +
'standard fit (sdtab) file (' + FileName + '). Census requires ' +
'an OCC variable to differentiate between sampling occasions and will ' +
'superimpose duplicate times otherwise.#10#13#10#13' +
'Note that occasion functionality is not in place yet! A workaround ' +
'is to use sequential times reflecting the entire analytical period ' +
'rather than repeating times.',
mtWarning, [mbOK], 0);
//Grid.FixedRows := 1;
//Grid.FixedCols := 1;
{try
grdFit.LoadFromCSV(tblRunsFit.Value, ' ');
except
MessageDlg('An error occurred and the file could not ' +
'be loaded.', mtError, [mbOK], 0);
for n := 0 to grdFit.RowCount - 1 do
for m := 0 to grdFit.ColCount - 1 do
grdFit.Cells[m,n] := '';
end; }
end
else
MessageDlg('This file (' + FileName + ') does not appear to exist. Has it been ' +
'moved, or has a network drive been disconnected?', mtError, [mbOK], 0);
end;
// ********************************************************************
// MRU list
// ********************************************************************
procedure TfrmNMRun.mnuMainPopPopup(Sender: TObject);
begin
if tblRunsKeyRun.Value = True then
Keyrun1.Caption := 'Not a key run'
else
Keyrun1.Caption := 'Key run'
end;
procedure TfrmNMRun.mruFilesMRUItemClick(Sender: TObject;
AFilename: string);
begin
end;
// ********************************************************************
// Display individual plots
// ********************************************************************
procedure TfrmNMRun.btnPlotsdtabClick(Sender: TObject);
begin
end;
// ********************************************************************
// Post changes to Notes field
// ********************************************************************
procedure TfrmNMRun.memPrdErrExit(Sender: TObject);
begin
if tblRuns.State in [dsEdit, dsInsert] then
tblRuns.Post;
end;
// ********************************************************************
// Prepare Notes field for changes
// ********************************************************************
procedure TfrmNMRun.memPrdErrEnter(Sender: TObject);
begin
if not (tblRuns.State in [dsEdit, dsInsert]) then
tblRuns.Edit;
end;
// ********************************************************************
// Display individual plots
// ********************************************************************
procedure TfrmNMRun.IndividualPlots1Click(Sender: TObject);
var
oldCursor: TCursor;
strT: string;
regIni: TRegIniFile;
begin
ShowPlots := True;
regIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
if (RegIni.ReadBool('Options', 'XposeInstalled', False)) and
(RegIni.ReadBool('Options', 'RInstalled', False)) and
(blnXpose) {and
(RegIni.ReadBool('Options', 'RDCOMInstalled', False))} then
begin
if FileExists(RegIni.ReadString('Options', 'XposeDir', '')) = False then
begin
MessageDlg('The location specified for R seems to be incorrect. ' +
'Please verify that this information is properly specified in ' +
'the Options dialog.', mtWarning, [mbOK], 0);
RegIni.Free;
Exit;
end;
if Length(tblRunssdtab.Value) = 0 then
begin
MessageDlg('There is no sdtab file associated with this run! Plots are unavailable.',
mtError, [mbOK], 0);
Exit;
end;
if FileExists(tblRunssdtab.Value) = False then
begin
MessageDlg('At least one critical table file associated with this run (' +
tblRunssdtab.Value + ') is missing! Plots are unavailable.',
mtError, [mbOK], 0);
Exit;
end;
if blnXpose then
begin
if not Assigned(frmXpose) then
frmXpose := TfrmXpose.Create(Application);
frmXpose.ShowModal;
end;
end
else
begin
if regIni.ReadBool('Options', 'AltPlotFile', False) = False then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourglass;
tblPlotData.MasterFields := '';
tblPlotData.Active := False;
tblPlotData.Active := True;
if tblPlotData.RecordCount > 0 then
tblPlotData.IndexName := 'runno';
if tblPlotData.FindKey([tblRunsRunNo.Value]) = False then
try
begin
if FileExists(tblRunsSdtab.Value) then
if NMCapData(tblPlotData, tblRunsSdtab.Value) = False then
MessageDlg('There was an error capturing the plot data.', mtError,
[mbOK], 0);
end;
finally
tblPlotData.IndexName := 'runno';
tblPlotData.MasterFields := 'RunNo';
tblPlotData.Active := False;
tblPlotData.Active := True;
end;
tblPlotData.Active := False;
tblPlotData.Active := True;
if tblPlotData.RecordCount > 0 then
tblPlotData.IndexName := 'runno';
finally
if tblPlotData.FindKey([tblRunsRunNo.Value]) = True then
begin
if not Assigned(frmPlot) then
frmPlot := TfrmPlot.Create(Application);
frmPlot.ShowModal;
Screen.Cursor := oldCursor;
end
else
if FileExists(tblRunssdtab.Value) then
begin
try
sdtabOpen;
finally
if ShowPlots then
begin
if not Assigned(frmPlot) then
frmPlot := TfrmPlot.Create(Application);
frmPlot.ShowModal;
end;
Screen.Cursor := oldCursor;
end;
end
else
begin
MessageDlg('No standard table file (sdtab) is associated with this run! Make sure ' +
'that file options are correctly set.', mtError, [mbOK], 0);
Screen.Cursor := oldCursor;
end;
end;
end
else
try
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
strT := regIni.ReadString('Options', 'AltPlotTemplate', 'run{R}.plt');
strT := StringReplace(strT, '{R}', tblRunsRunNo.Value, [rfReplaceAll]);
//NMGridLoad(grdPlot, ExtractFilePath(tblRunssdtab.Value) + strT);
finally
if FileExists(ExtractFilePath(tblRunssdtab.Value) + strT) then
begin
if not Assigned(frmPlot) then
frmPlot := TfrmPlot.Create(Application);
frmPlot.ShowModal;
end
else
MessageDlg('Unable to locate an input file matching the defined ' +
'template (' + ExtractFilePath(tblRunssdtab.Value) + strT +
'). Please check that the template is correctly set ' +
'in the Options screen.', mtError, [mbOK], 0);
Screen.Cursor := oldCursor;
end;
end;
regIni.Free;
end;
// ********************************************************************
// Copy run files to SPLUS
// ********************************************************************
procedure TfrmNMRun.CopyRunFilestoSPLUS1Click(Sender: TObject);
var
RegIni: TRegIniFile;
XposePath: string;
OldCursor: TCursor;
begin
OldCursor := Screen.Cursor;
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
XposePath := RegIni.ReadString('Options', 'XposeDir', '');
RegIni.Free;
if XposePath <> '' then
begin
if MessageDlg('This will copy the relevant files relating to the ' +
'current run (' + tblRunsRunNo.Value + ') to your Xpose working ' +
'directory. Any files bearing the same name in the destination '
+ 'folder will be overwritten. Continue?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
begin
try
if not Assigned(dlgProg) then
dlgProg := TJvProgressDialog.Create(Self);
dlgProg.Execute;
// Control stream
if FileExists(tblRunsCtl.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunsCtl.Value) + '...';
try
Screen.Cursor := crHourGlass;
{jvFileOp.SourceFiles.Clear;
jvFileOp.DestFiles.Clear;
jvFileOp.SourceFiles.Add(tblRunsCtl.Value);
jvFileOp.DestFiles.Add(XposePath + '\' + ExtractFileName(tblRunsCtl.Value));
jvFileOp.Execute; }
if FileExists(XposePath + '\' + ExtractFileName(tblRunsCtl.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunsCtl.Value));
//CopyFile(tblRunsCtl.Value, XposePath + '\' + ExtractFileName(tblRunsCtl.Value));
CopySP(tblRunsCtl.Value, XposePath + '\'
+ ExtractFileName(tblRunsCtl.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 1;
Application.ProcessMessages;
end;
end;
// NONMEM output
if FileExists(tblRunsLst.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunsLst.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunsLst.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunsLst.Value));
//CopyFile(tblRunsLst.Value, XposePath + '\' + ExtractFileName(tblRunsLst.Value));
CopySP(tblRunsLst.Value, XposePath + '\'
+ ExtractFileName(tblRunsLst.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 2;
Application.ProcessMessages;
end;
end;
// Fit file
if FileExists(tblRunsFit.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunsFit.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunsFit.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunsFit.Value));
//CopyFile(tblRunsFit.Value, XposePath + '\' + ExtractFileName(tblRunsFit.Value));
CopySP(tblRunsFit.Value, XposePath + '\'
+ ExtractFileName(tblRunsFit.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 3;
Application.ProcessMessages;
end;
end;
// sdtab
if FileExists(tblRunssdtab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunssdtab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunssdtab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunssdtab.Value));
//CopyFile(tblRunssdtab.Value, XposePath + '\' + ExtractFileName(tblRunssdtab.Value));
CopySP(tblRunssdtab.Value, XposePath + '\'
+ ExtractFileName(tblRunssdtab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 4;
Application.ProcessMessages;
end;
end;
// patab
if FileExists(tblRunspatab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunspatab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunspatab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunspatab.Value));
//CopyFile(tblRunspatab.Value, XposePath + '\' + ExtractFileName(tblRunspatab.Value));
CopySP(tblRunspatab.Value, XposePath + '\'
+ ExtractFileName(tblRunspatab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 5;
Application.ProcessMessages;
end;
end;
// cotab
if FileExists(tblRunscotab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunscotab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunscotab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunscotab.Value));
//CopyFile(tblRunscotab.Value, XposePath + '\' + ExtractFileName(tblRunscotab.Value));
CopySP(tblRunscotab.Value, XposePath + '\'
+ ExtractFileName(tblRunscotab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 6;
Application.ProcessMessages;
end;
end;
// catab
if FileExists(tblRunscatab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunscatab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunscatab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunscatab.Value));
//CopyFile(tblRunscatab.Value, XposePath + '\' + ExtractFileName(tblRunscatab.Value));
CopySP(tblRunscatab.Value, XposePath + '\'
+ ExtractFileName(tblRunscatab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 7;
Application.ProcessMessages;
end;
end;
// mutab
if FileExists(tblRunsmutab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunsmutab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunsmutab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunsmutab.Value));
//CopyFile(tblRunsmutab.Value, XposePath + '\' + ExtractFileName(tblRunsmutab.Value));
CopySP(tblRunsmutab.Value, XposePath + '\'
+ ExtractFileName(tblRunsmutab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 8;
Application.ProcessMessages;
end;
end;
// mytab
if FileExists(tblRunsmytab.Value) then
begin
dlgProg.Text := 'Copying ' + ExtractFileName(tblRunsmytab.Value) + '...';
try
Screen.Cursor := crHourGlass;
if FileExists(XposePath + '\' + ExtractFileName(tblRunsmytab.Value)) then
DeleteFile(XposePath + '\' + ExtractFileName(tblRunsmytab.Value));
//CopyFile(tblRunsmytab.Value, XposePath + '\' + ExtractFileName(tblRunsmytab.Value));
CopySP(tblRunsmytab.Value, XposePath + '\'
+ ExtractFileName(tblRunsmytab.Value), FO_COPY, FOF_ALLOWUNDO);
finally
dlgProg.Position := 9;
Application.ProcessMessages;
Screen.Cursor := OldCursor;
end;
end;
finally
tblTrans.InsertRecord([Null, 'copy run files to SPLUS', tblRunsRunNo.Value, Now, txtUser]);
dlgProg.Destroy;
Screen.Cursor := OldCursor;
end;
end;
end
else
if MessageDlg('You haven''t defined a path for your S-PLUS/Xpose ' +
'working directory. Would you like to do so now?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
begin
if not Assigned(frmOptions) then
frmOptions := TfrmOptions.Create(Application);
frmOptions.ShowModal;
end;
end;
// ********************************************************************
// Display options dialog
// ********************************************************************
procedure TfrmNMRun.Options1Click(Sender: TObject);
begin
if not Assigned(frmOptions) then
frmOptions := TfrmOptions.Create(Application);
try
frmOptions.ShowModal;
finally
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
// Read in file extensions
extCtl := RegIni.ReadString('Options', 'ExtCtl', '.mod');
extLst := RegIni.ReadString('Options', 'ExtLst', '.lst');
extXpose := RegIni.ReadString('Options', 'ExtXpose', '.');
extFit := RegIni.ReadString('Options', 'ExtFit', '.fit');
extMsf := RegIni.ReadString('Options', 'ExtMsf', '.msf');
runPrefix := RegIni.ReadString('Options', 'RunPrefix', 'run');
blnAsk := RegIni.ReadBool('Options', 'AskNonNumeric', False);
blnMD5 := RegIni.ReadBool('Options', 'MD5', False);
// Set open dialog correctly
dlgOpen.DefaultExt := extLst;
dlgOpen.Filter := 'NONMEM Output Files (*' + extLst + ')|*' + extLst +
'|All files (*.*)|*.*';
RegIni.Free;
end;
end;
// ********************************************************************
// Create data tables
// ********************************************************************
procedure TfrmNMRun.CreateDataTables;
begin
nmDatabase.Connected := True;
// Initialize dictionaries
try
DefDictRuns;
DefDictThetas;
DefDictEtas;
DefDictSigmas;
DefDictData;
DefDictTrans;
DefDictVPC;
Check(nmDatabase.CreateTable(True, 'Runs', DictRuns));
Check(nmDatabase.CreateTable(True, 'Thetas', DictThetas));
Check(nmDatabase.CreateTable(True, 'Etas', DictEtas));
Check(nmDatabase.CreateTable(True, 'Sigmas', DictSigmas));
Check(nmDatabase.CreateTable(True, 'PlotData', DictData));
Check(nmDatabase.CreateTable(True, 'Trans', DictTrans));
Check(nmDatabase.CreateTable(True, 'VPC', DictVPC));
finally
DictRuns.Clear;
DictThetas.Clear;
DictEtas.Clear;
DictSigmas.Clear;
DictData.Clear;
DictTrans.Clear;
DictVPC.Clear;
end;
end;
// ********************************************************************
// Restructure database
// ********************************************************************
procedure TfrmNMRun.RestructureRuns;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblRuns.Active := False;
tblThetas.Active := False;
tblEtas.Active := False;
tblSigmas.Active := False;
tblPlotData.Active := False;
if not Assigned(DictRuns) then
DefDictRuns;
FieldMap.Clear;
for n := 0 to DictRuns.FieldCount - 1 do
FieldMap.Add(DictRuns.FieldName[n] + '=' +
DictRuns.FieldName[n]);
try
Check(nmDatabase.RestructureTable('Runs', DictRuns, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictRuns) then
DictRuns.Clear;
barPrg.Visible := False;
end;
end;
// ********************************************************************
// Restructure Theta table
// ********************************************************************
procedure TfrmNMRun.RestructureThetas;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
//ShowMessage('Restructuring theta');
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblThetas.Active := False;
if not Assigned(DictThetas) then
DefDictThetas;
FieldMap.Clear;
for n := 0 to DictThetas.FieldCount - 1 do
FieldMap.Add(DictThetas.FieldName[n] + '=' +
DictThetas.FieldName[n]);
try
Check(nmDatabase.RestructureTable('Thetas', DictThetas, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictThetas) then
DictThetas.Clear;
barPrg.Visible := False;
end;
end;
// ********************************************************************
// Restructure Eta table
// ********************************************************************
procedure TfrmNMRun.RestructureEtas;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
//ShowMessage('Restructuring eta');
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblEtas.Active := False;
if not Assigned(DictEtas) then
DefDictEtas;
FieldMap.Clear;
for n := 0 to DictEtas.FieldCount - 1 do
FieldMap.Add(DictEtas.FieldName[n] + '=' +
DictEtas.FieldName[n]);
try
Check(nmDatabase.RestructureTable('Etas', DictEtas, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictEtas) then
DictEtas.Clear;
barPrg.Visible := False;
end;
end;
// ********************************************************************
// Restructure Sigma table
// ********************************************************************
procedure TfrmNMRun.RestructureSigmas;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblSigmas.Active := False;
if not Assigned(DictSigmas) then
DefDictSigmas;
FieldMap.Clear;
for n := 0 to DictSigmas.FieldCount - 1 do
FieldMap.Add(DictSigmas.FieldName[n] + '=' +
DictSigmas.FieldName[n]);
try
Check(nmDatabase.RestructureTable('Sigmas', DictSigmas, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictSigmas) then
DictSigmas.Clear;
barPrg.Visible := False;
end;
end;
// ********************************************************************
// Restructure Data table
// ********************************************************************
procedure TfrmNMRun.RestartR1Click(Sender: TObject);
begin
//if frmR.RCommand.Active = True then
try
frmR.RCommand.Stop;
finally
GoR;
end;
//else
// GoR;
end;
procedure TfrmNMRun.RestructureData;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblPlotData.Active := False;
if not Assigned(DictData) then
DefDictData;
FieldMap.Clear;
for n := 0 to DictData.FieldCount - 1 do
FieldMap.Add(DictData.FieldName[n] + '=' +
DictData.FieldName[n]);
try
Check(nmDatabase.RestructureTable('PlotData', DictData, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictData) then
DictData.Clear;
barPrg.Visible := False;
end;
end;
procedure TfrmNMRun.RestructureVPC;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
lstTables: TStrings;
begin
lstTables := TStringList.Create;
nmDatabase.Connected := True;
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblVPC.Active := False;
if not Assigned(DictVPC) then
DefDictVPC;
FieldMap.Clear;
for n := 0 to DictVPC.FieldCount - 1 do
FieldMap.Add(DictVPC.FieldName[n] + '=' +
DictVPC.FieldName[n]);
try
nmDatabase.GetTableNames(lstTables);
if Pos('VPC', lstTables.Text) = 0 then
Check(nmDatabase.CreateTable(True, 'VPC', DictVPC));
//ShowMessage(lstTables.Text);
Check(nmDatabase.RestructureTable('VPC', DictVPC, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
lstTables.Free;
if Assigned(DictVPC) then
DictVPC.Clear;
barPrg.Visible := False;
end;
end;
procedure TfrmNMRun.RestructureTrans;
var
FieldMap: TStrings;
TaskID: LongInt;
n: Integer;
Done: Boolean;
TaskStatus: TffRebuildStatus;
begin
nmDatabase.Connected := True;
FieldMap := TStringList.Create;
barPrg.Max := 100;
barPrg.Position := 0;
barPrg.Visible := True;
try
tblTrans.Active := False;
if not Assigned(DictTrans) then
DefDictTrans;
FieldMap.Clear;
for n := 0 to DictTrans.FieldCount - 1 do
FieldMap.Add(DictTrans.FieldName[n] + '=' +
DictTrans.FieldName[n]);
try
Check(nmDatabase.RestructureTable('Trans', DictTrans, FieldMap,
TaskID));
Done := False;
while not Done do
begin
Check(nmDatabase.Session.GetTaskStatus(TaskID,
Done, TaskStatus));
barPrg.Position := TaskStatus.rsPercentDone;
Application.ProcessMessages;
end;
finally
FieldMap.Clear;
end;
finally
FieldMap.Free;
if Assigned(DictTrans) then
DictTrans.Clear;
barPrg.Visible := False;
end;
end;
procedure TfrmNMRun.rgCovMatrixClick(Sender: TObject);
begin
end;
// ********************************************************************
// Define Runs data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictRuns;
begin
if not Assigned(DictRuns) then
DictRuns := TffDataDictionary.Create(8192);
DictRuns.Clear;
try
with DictRuns do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('RunNo', '', fftShortString, 30,
0, False, nil); { 1 }
AddField('iRunNo', '', fftInt32, 0, 0,
False, nil); { 2 }
AddField('Comment', '', fftShortString, 250, 0,
False, nil); { 3 }
AddField('ObsRecs', '', fftInt32, 0, 0,
False, nil); { 4 }
AddField('Individuals', '', fftInt32, 0, 0,
False, nil); { 5 }
AddField('MinShort', '', fftShortString, 50, 0,
False, nil); { 6 }
AddField('Minimization', '', fftBLOBMemo, 0,
0, False, nil); { 7 }
AddField('FnEvals', '', fftInt32, 0, 0,
False, nil); { 8 }
AddField('SigDigits', '', fftShortString, 50, 0,
False, nil); { 9 }
AddField('Obj', '', fftDouble, 0, 0,
False, nil); { 10 }
AddField('CovStep', '', fftBLOBMemo, 0, 0,
False, nil); { 11 }
AddField('CovShort', '', fftShortString, 250, 0,
False, nil); { 12 }
AddField('CondEst', '', fftBoolean, 0,
0, False, nil); { 13 }
AddField('CenteredEta', '', fftBoolean, 0, 0,
False, nil); { 14 }
AddField('Interaction', '', fftBoolean, 0, 0,
False, nil); { 15 }
AddField('Laplacian', '', fftBoolean, 0, 0,
False, nil); { 16 }
AddField('Model', '', fftShortString, 250, 0,
False, nil); { 17 }
AddField('patab', '', fftShortString, 250, 0,
False, nil); { 18 }
AddField('sdtab', '', fftShortString, 250, 0,
False, nil); { 19 }
AddField('catab', '', fftShortString, 250, 0,
False, nil); { 20 }
AddField('cotab', '', fftShortString, 250, 0,
False, nil); { 21 }
AddField('mutab', '', fftShortString, 250, 0,
False, nil); { 22 }
AddField('mytab', '', fftShortString, 250, 0,
False, nil); { 23 }
AddField('Ctl', '', fftShortString, 250, 0,
False, nil); { 24 }
AddField('Data', '', fftShortString, 250, 0,
False, nil); { 25 }
AddField('Lst', '', fftShortString, 250, 0,
False, nil); { 26 }
AddField('Msf', '', fftShortString, 250, 0,
False, nil); { 27 }
AddField('Fit', '', fftShortString, 250, 0,
False, nil); { 28 }
AddField('Comments', '', fftBLOBMemo, 0, 0,
False, nil); { 29 }
AddField('OmegaInitMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 30 }
AddField('SigmaInitMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 31 }
AddField('OmegaMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 32 }
AddField('SigmaMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 33 }
AddField('OmegaSEMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 34 }
AddField('SigmaSEMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 35 }
AddField('CovMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 36 }
AddField('CorrMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 37 }
AddField('InvCovMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 38 }
AddField('Eigenvalues', '', fftBLOBMemo, 0, 0,
False, nil); { 39 }
AddField('ConditionNumber', '', fftDouble, 0, 0,
False, nil); { 40 }
AddField('Warnings', '', fftShortString, 250, 0,
False, nil); { 41 }
AddField('ParentNo', '', fftShortString, 30,
0, False, nil); { 42 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 43 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 44 }
AddField('KeyRun', '', fftBoolean, 0, 0,
False, nil); { 45 }
AddField('dOFV', '', fftDouble, 0, 0,
False, nil); { 46 }
// Add MD5 hashes
AddField('ModelMD5', '', fftShortString, 32, 0,
False, nil); { 47 }
AddField('patabMD5', '', fftShortString, 32, 0,
False, nil); { 48 }
AddField('sdtabMD5', '', fftShortString, 32, 0,
False, nil); { 49 }
AddField('catabMD5', '', fftShortString, 32, 0,
False, nil); { 50 }
AddField('cotabMD5', '', fftShortString, 32, 0,
False, nil); { 51 }
AddField('mutabMD5', '', fftShortString, 32, 0,
False, nil); { 52 }
AddField('mytabMD5', '', fftShortString, 32, 0,
False, nil); { 53 }
AddField('CtlMD5', '', fftShortString, 32, 0,
False, nil); { 54 }
AddField('DataMD5', '', fftShortString, 32, 0,
False, nil); { 55 }
AddField('LstMD5', '', fftShortString, 32, 0,
False, nil); { 56 }
AddField('MsfMD5', '', fftShortString, 32, 0,
False, nil); { 57 }
AddField('FitMD5', '', fftShortString, 32, 0,
False, nil); { 58 }
// Add CWRES support
AddField('cwtab', '', fftShortString, 250, 0,
False, nil); { 59 }
AddField('cwtabMD5', '', fftShortString, 32, 0,
False, nil); { 60 }
AddField('cwtabEst', '', fftShortString, 250, 0,
False, nil); { 61 }
AddField('cwtabEstMD5', '', fftShortString, 32, 0,
False, nil); { 62 }
AddField('cwtabDeriv', '', fftShortString, 250, 0,
False, nil); { 63 }
AddField('cwtabDerivMD5', '', fftShortString, 32, 0,
False, nil); { 64 }
// Add NONMEM 7 support
AddField('coi', '', fftShortString, 250, 0,
False, nil); { 65 }
AddField('cor', '', fftShortString, 250, 0,
False, nil); { 66 }
AddField('ext', '', fftShortString, 250, 0,
False, nil); { 67 }
AddField('phi', '', fftShortString, 250, 0,
False, nil); { 68 }
AddField('cov', '', fftShortString, 250, 0,
False, nil); { 69 }
AddField('coiMD5', '', fftShortString, 32, 0,
False, nil); { 70 }
AddField('corMD5', '', fftShortString, 32, 0,
False, nil); { 71 }
AddField('covMD5', '', fftShortString, 32, 0,
False, nil); { 72 }
AddField('phiMD5', '', fftShortString, 32, 0,
False, nil); { 73 }
AddField('extMD5', '', fftShortString, 32, 0,
False, nil); { 74 }
AddField('EpsilonShrinkage', '', fftDouble, 0, 0,
False, nil); { 75 }
AddField('Method', '', fftShortString, 250, 0,
False, nil); { 76 }
AddField('EstTime', '', fftDouble, 0, 0,
False, nil); { 77 }
AddField('CovTime', '', fftDouble, 0, 0,
False, nil); { 78 }
AddField('StructuralModel', '', fftBLOBMemo, 0,
0, False, nil); { 79 }
AddField('CovariateModel', '', fftBLOBMemo, 0,
0, False, nil); { 80 }
AddField('IIV', '', fftBLOBMemo, 0,
0, False, nil); { 81 }
AddField('IOV', '', fftBLOBMemo, 0,
0, False, nil); { 82 }
AddField('RV', '', fftBLOBMemo, 0,
0, False, nil); { 83 }
AddField('Estimation', '', fftBLOBMemo, 0,
0, False, nil); { 84 }
AddField('Description', '', fftBLOBMemo, 0,
0, False, nil); { 85 }
AddField('Label', '', fftShortString, 250,
0, False, nil); { 86 }
AddField('MethFO', '', fftBoolean, 0, 0,
False, nil); { 87 }
AddField('MethFOCE', '', fftBoolean, 0, 0,
False, nil); { 88 }
AddField('MethSAEM', '', fftBoolean, 0, 0,
False, nil); { 89 }
AddField('MethImp', '', fftBoolean, 0, 0,
False, nil); { 90 }
AddField('MethImpMap', '', fftBoolean, 0, 0,
False, nil); { 91 }
AddField('MethBayes', '', fftBoolean, 0, 0,
False, nil); { 92 }
AddField('MethITS', '', fftBoolean, 0, 0,
False, nil); { 93 }
AddField('XML', '', fftShortString, 250, 0,
False, nil); { 94 }
AddField('XMLMD5', '', fftShortString, 32, 0,
False, nil); { 95 }
FldArray[0] := 0; { Field #0 }
{Use default index helpers}
IdxHelpers[0] := '';
AddIndex('PrimaryKey', '', 0, 1, FldArray,
IdxHelpers, False, True, True);
AddIndex('ID', 'by ID', 0, 1, FldArray,
IdxHelpers, False, True, True);
FldArray[0] := 2;
FldArray[1] := 1;
AddIndex('runno', 'by RunNo', 0, 2, FldArray,
IdxHelpers, True, True, True);
AddIndex('irunno', 'by iRunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
FldArray[0] := 1;
AddIndex('runno2', 'exclusively by RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
;
end;
end;
// ********************************************************************
// Define Thetas data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictThetas;
begin
if not Assigned(DictThetas) then
DictThetas := TffDataDictionary.Create(4096);
DictThetas.Clear;
try
with DictThetas do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('RunNo', '', fftShortString, 50,
0, False, nil); { 1 }
AddField('Theta', '', fftInt32, 0, 0,
False, nil); { 2 }
AddField('ThetaLabel', '', fftShortString, 30, 0,
False, nil); { 3 }
AddField('ThetaValue', '', fftDouble, 0, 0,
False, nil); { 4 }
AddField('ThetaSE', '', fftDouble, 0, 0,
False, nil); { 5 }
AddField('Lower', '', fftDouble, 0, 0,
False, nil); { 6 }
AddField('Initial', '', fftDouble, 0,
0, False, nil); { 7 }
AddField('Upper', '', fftDouble, 0, 0,
False, nil); { 8 }
AddField('ThetaRSE', '', fftDouble, 0, 0,
False, nil); { 9 }
AddField('Model', '', fftShortString, 50, 0,
False, nil); { 10 }
AddField('ThetaMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 11 }
AddField('ThetaSigDig', '', fftDouble, 0, 0,
False, nil); { 12 }
AddField('ThetaCIs', '', fftShortString, 50, 0,
False, nil); { 13 }
AddField('ThetaCIUpper', '', fftDouble, 0, 0,
False, nil); { 14 }
AddField('ThetaCILower', '', fftDouble, 0, 0,
False, nil); { 15 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 16 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 17 }
FldArray[0] := 0; { Field #0 }
{Use default index helpers}
IdxHelpers[0] := '';
AddIndex('PrimaryKey', '', 0, 1, FldArray,
IdxHelpers, False, True, True);
AddIndex('ID', 'by ID', 0, 1, FldArray,
IdxHelpers, False, True, True);
FldArray[0] := 2;
AddIndex('theta', 'by Theta', 0, 1, FldArray,
IdxHelpers, True, True, True);
FldArray[0] := 1;
AddIndex('runno', 'by RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
//ShowMessage('Theta dict created');
end;
end;
// ********************************************************************
// Define Etas data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictEtas;
begin
if not Assigned(DictEtas) then
DictEtas := TffDataDictionary.Create(4096);
DictEtas.Clear;
try
with DictEtas do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('RunNo', '', fftShortString, 30,
0, False, nil); { 1 }
AddField('Eta', '', fftInt32, 0, 0,
False, nil); { 2 }
AddField('EtaValue', '', fftDouble, 50, 0,
False, nil); { 3 }
AddField('EtaBar', '', fftDouble, 0, 0,
False, nil); { 4 }
AddField('EtaBarSE', '', fftDouble, 0, 0,
False, nil); { 5 }
AddField('EtaPVal', '', fftDouble, 0, 0,
False, nil); { 6 }
AddField('EtaInit', '', fftDouble, 0, 0,
False, nil); { 7 }
AddField('EtaSE', '', fftDouble, 0,
0, False, nil); { 8 }
AddField('EtaLabel', '', fftShortString, 50, 0,
False, nil); { 9 }
AddField('EtaRSE', '', fftDouble, 0, 0,
False, nil); { 10 }
AddField('Model', '', fftShortString, 50, 0,
False, nil); { 11 }
AddField('EtaMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 12 }
AddField('EtaSigDig', '', fftDouble, 0, 0,
False, nil); { 13 }
AddField('Blocks', '', fftBoolean, 0, 0,
False, nil); { 14 }
AddField('EtaCIs', '', fftShortString, 50, 0,
False, nil); { 15 }
AddField('EtaCIUpper', '', fftDouble, 0, 0,
False, nil); { 16 }
AddField('EtaCILower', '', fftDouble, 0, 0,
False, nil); { 17 }
AddField('EtaPerc', '', fftDouble, 0, 0,
False, nil); { 18 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 19 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 20 }
AddField('EtaShrinkage', '', fftDouble, 0, 0,
False, nil); { 6 }
FldArray[0] := 0; { Field #0 }
{Use default index helpers}
IdxHelpers[0] := '';
AddIndex('PrimaryKey', '', 0, 1, FldArray,
IdxHelpers, False, True, True);
AddIndex('ID', 'by ID', 0, 1, FldArray,
IdxHelpers, False, True, True);
FldArray[0] := 2;
AddIndex('eta', 'by Eta', 0, 1, FldArray,
IdxHelpers, True, True, True);
FldArray[0] := 1;
AddIndex('runno', 'by RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
//ShowMessage('Eta dict created');
end;
end;
// ********************************************************************
// Define Sigmas data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictSigmas;
begin
if not Assigned(DictSigmas) then
DictSigmas := TffDataDictionary.Create(4096);
DictSigmas.Clear;
try
with DictSigmas do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('RunNo', '', fftShortString, 30,
0, False, nil); { 1 }
AddField('Sigma', '', fftInt32, 0, 0,
False, nil); { 2 }
AddField('SigmaValue', '', fftDouble, 50, 0,
False, nil); { 3 }
AddField('SigmaInit', '', fftDouble, 0, 0,
False, nil); { 4 }
AddField('SigmaSE', '', fftDouble, 0,
0, False, nil); { 5 }
AddField('SigmaRSE', '', fftDouble, 0, 0,
False, nil); { 6 }
AddField('SigmaMatrix', '', fftBLOBMemo, 0, 0,
False, nil); { 7 }
AddField('SigmaSigDig', '', fftDouble, 0, 0,
False, nil); { 8 }
AddField('Blocks', '', fftBoolean, 0, 0,
False, nil); { 9 }
AddField('SigmaCIs', '', fftShortString, 50, 0,
False, nil); { 10 }
AddField('SigmaCIUpper', '', fftDouble, 0, 0,
False, nil); { 11 }
AddField('SigmaCILower', '', fftDouble, 0, 0,
False, nil); { 12 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 13 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 14 }
AddField('SigmaShrinkage', '', fftDouble, 0, 0,
False, nil); { 15 }
FldArray[0] := 0; { Field #0 }
{Use default index helpers}
IdxHelpers[0] := '';
AddIndex('PrimaryKey', '', 0, 1, FldArray,
IdxHelpers, False, True, True);
AddIndex('ID', 'by ID', 0, 1, FldArray,
IdxHelpers, False, True, True);
FldArray[0] := 2;
AddIndex('sigma', 'by Sigma', 0, 1, FldArray,
IdxHelpers, True, True, True);
FldArray[0] := 1;
AddIndex('runno', 'by RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
;
end;
end;
// ********************************************************************
// Define Data data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictData;
begin
if not Assigned(DictData) then
DictData := TffDataDictionary.Create(4096);
DictData.Clear;
// showmessage('execute');
try
with DictData do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('SID', '', fftDouble, 0, 0,
False, nil); { 1 }
AddField('TIME', '', fftDouble, 0, 0,
False, nil); { 2 }
AddField('IPRE', '', fftDouble, 0, 0,
False, nil); { 3 }
AddField('IWRE', '', fftDouble, 0, 0,
False, nil); { 4 }
AddField('DV', '', fftDouble, 0, 0,
False, nil); { 5 }
AddField('PRED', '', fftDouble, 0, 0,
False, nil); { 6 }
AddField('RES', '', fftDouble, 0, 0,
False, nil); { 7 }
AddField('WRES', '', fftDouble, 0, 0,
False, nil); { 8 }
AddField('OCC', '', fftDouble, 0, 0,
False, nil); { 9 }
AddField('RunNo', '', fftShortString, 30,
0, False, nil); { 10 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 11 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 12 }
FldArray[0] := 1;
FldArray[1] := 2;
IdxHelpers[0] := '';
IdxHelpers[1] := '';
AddIndex('Standard', 'Standard', 0, 2, FldArray,
IdxHelpers, True, True, True);
FldArray[0] := 10;
IdxHelpers[0] := '';
AddIndex('RunNo', 'RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
//ShowMessage('Theta dict created');
end;
end;
// ********************************************************************
// Define Transactions data dictionary
// ********************************************************************
procedure TfrmNMRun.DefDictTrans;
begin
if not Assigned(DictTrans) then
DictTrans := TffDataDictionary.Create(4096);
DictTrans.Clear;
// showmessage('execute');
try
with DictTrans do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('Action', '', fftShortString, 20, 0,
False, nil); { 1 }
AddField('RunNo', '', fftShortString, 30, 0,
False, nil); { 2 }
AddField('Timestamp', '', fftDateTime, 0, 0,
False, nil); { 3 }
AddField('User', '', fftShortString, 50, 0,
False, nil); { 4 }
FldArray[0] := 3;
FldArray[1] := 2;
IdxHelpers[0] := '';
IdxHelpers[1] := '';
AddIndex('main', 'main', 0, 2, FldArray,
IdxHelpers, True, True, True);
end;
finally
//ShowMessage('Theta dict created');
end;
end;
procedure TfrmNMRun.DefDictVPC;
begin
if not Assigned(DictVPC) then
DictVPC := TffDataDictionary.Create(4096);
DictVPC.Clear;
try
with DictVPC do begin
AddField('ID', '', fftAutoInc, 10, 0,
True, nil); { 0 }
AddField('RunNo', '', fftShortString, 30,
0, False, nil); { 1 }
AddField('vpcName', '', fftShortString, 30,
0, False, nil); { 1 }
AddField('vpcRoot', '', fftShortString, 250, 0,
False, nil); { 2 }
AddField('vpcTab', '', fftShortString, 250, 0,
False, nil); { 3 }
AddField('vpcResults', '', fftShortString, 250, 0,
False, nil); { 4 }
AddField('vpcOptions', '', fftBLOBMemo, 0, 0,
False, nil); { 5 }
AddField('PsNVersion', '', fftShortString, 10,
0, False, nil); { 6 }
FldArray[0] := 0; { Field #0 }
{Use default index helpers}
IdxHelpers[0] := '';
AddIndex('PrimaryKey', '', 0, 1, FldArray,
IdxHelpers, False, True, True);
AddIndex('ID', 'by ID', 0, 1, FldArray,
IdxHelpers, False, True, True);
FldArray[0] := 2;
FldArray[0] := 1;
AddIndex('runno', 'by RunNo', 0, 1, FldArray,
IdxHelpers, True, True, True);
end;
finally
//ShowMessage('VPC dict created');
end;
end;
// ********************************************************************
// Find initial estimates if we used an MSF
// ********************************************************************
procedure TfrmNMRun.AddThetaMSFInits(str: string; lstInit,
lstLower, lstUpper: TStrings);
var
strTemp: string;
begin
// kill comment
if Pos(';', str) > 0 then
strTemp := Copy(str, 1, Pos(';', str));
// lose $THETA
StringReplace(strTemp, '$THETA', '', [rfReplaceAll]);
if Pos('(', strTemp) > 0 then
strTemp := Copy(strTemp, Pos('(', strTemp),
Pos(')', strTemp) - Pos('(', strTemp));
strTemp := StringReplace(strTemp, '(', '', [rfReplaceAll]);
if Pos(',', strTemp) > 0 then
begin
lstInit.Add(StringReplace(BrkUp(',', strTemp, 1), '(', '',
[rfReplaceAll]));
lstLower.Add(StringReplace(BrkUp(',', strTemp, 0), '(', '',
[rfReplaceAll]));
try
lstUpper.Add(StringReplace(BrkUp(',', strTemp, 2), '(', '',
[rfReplaceAll]));
except
lstUpper.Add('1000000');
end;
end
else
begin
lstInit.Add(Trim(StringReplace(strTemp, '(', '', [rfReplaceAll])));
lstLower.Add('-1000000');
lstUpper.Add('1000000');
end;
end;
// ********************************************************************
// Cut
// ********************************************************************
procedure TfrmNMRun.Cut2Click(Sender: TObject);
begin
synCtl.CutToClipboard;
end;
// ********************************************************************
// Copy
// ********************************************************************
procedure TfrmNMRun.Copy2Click(Sender: TObject);
begin
synCtl.CopyToClipboard;
end;
// ********************************************************************
// Paste
// ********************************************************************
procedure TfrmNMRun.Paste2Click(Sender: TObject);
begin
synCtl.PasteFromClipboard;
end;
// ********************************************************************
// Select all
// ********************************************************************
procedure TfrmNMRun.SelectAll1Click(Sender: TObject);
begin
synCtl.SelectAll;
end;
// ********************************************************************
// Activate SynEdit controls
// ********************************************************************
procedure TfrmNMRun.synCtlEnter(Sender: TObject);
begin
Cut2.Enabled := True;
Cut1.Enabled := True;
Copy1.Enabled := True;
Copy2.Enabled := True;
Paste1.Enabled := True;
Paste2.Enabled := True;
SelectAll1.Enabled := True;
SelectAll2.Enabled := True;
end;
// ********************************************************************
// Deactivate synedit controls
// ********************************************************************
procedure TfrmNMRun.synCtlExit(Sender: TObject);
begin
Cut2.Enabled := False;
Cut1.Enabled := False;
Copy1.Enabled := False;
Copy2.Enabled := False;
Paste1.Enabled := False;
Paste2.Enabled := False;
SelectAll1.Enabled := False;
SelectAll2.Enabled := False;
end;
// ********************************************************************
// Generic matrix loader
// ********************************************************************
procedure TfrmNMRun.LoadMatrix(DataField: TMemoField; Grid: TKStringGrid);
var
lstMatrix: TStrings;
strmData: TMemoryStream;
n, m: Integer;
begin
Grid.Columns.Clear;
Grid.RowCount := 0;
if DataField.BlobSize = 0 then
Exportcovariancematrix1.Enabled := False
else
Exportcovariancematrix1.Enabled := True;
if DataField.BlobSize > 0 then
begin
brkUpp.AllowEmptyString := True;
strmData := TMemoryStream.Create;
lstMatrix := TStringList.Create;
DataField.SaveToStream(strmData);
strmData.Position := 0;
lstMatrix.LoadFromStream(strmData);
//dlgLog.Lines.Assign(lstMatrix);
//dlgLog.Execute;
strmData.Free;
Grid.RowCount := lstMatrix.Count - 1;
//Grid.ColCount := lstMatrix.Count;
if Grid.Columns.Count <> lstMatrix.Count then
begin
Grid.Columns.Clear;
for n := 0 to lstMatrix.Count - 1 do
begin
Grid.Columns.Add;
end;
end;
with Grid do
begin
FixedCols := 1;
ActiveFixedFont.Name := 'Tahoma';
ActiveFixedFont.Style := [];
HeaderFont.Name := 'Tahoma';
HeaderFont.Style := [];
FixedFont.Name := 'Tahoma';
FixedFont.Style := [];
ActiveHeaderFont.Name := 'Tahoma';
ActiveHeaderFont.Style := [];
end;
for n := 0 to lstMatrix.Count - 1 do
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrix[n];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if n > 0 then
for m := 0 to brkUpp.StringList.Count - 1 do
Grid.Cells[m, n - 1] := brkUpp.StringList[m]
else
for m := 0 to brkUpp.StringList.Count - 1 do
Grid.Columns[m].Caption := brkUpp.StringList[m];
end;
lstMatrix.Free;
end;
end;
// ********************************************************************
// Load matrices
// ********************************************************************
procedure TfrmNMRun.nbOmegaPageChanged(Sender: TObject; Index: Integer);
begin
if Index = 1 then
LoadMatrix(tblRunsOmegaInitMatrix, grdOmInit);
if Index = 2 then
LoadMatrix(tblRunsOmegaMatrix, grdOmMatrix);
if Index = 3 then
LoadMatrix(tblRunsOmegaSEMatrix, grdOmSE);
end;
// ********************************************************************
// Change eta labels
// ********************************************************************
procedure TfrmNMRun.ParameterLabel1Click(Sender: TObject);
begin
tblEtas.Edit;
try
tblEtasEtaLabel.Value := InputBox('ETA(' + tblEtasEta.AsString +
')', 'Enter a new label for ETA(' + tblEtasEta.AsString +
')', tblEtasEtaLabel.Value);
finally
tblEtas.Post;
end;
end;
// ********************************************************************
// Change theta labels
// ********************************************************************
procedure TfrmNMRun.MenuItem1Click(Sender: TObject);
begin
tblThetas.Edit;
try
tblThetasThetaLabel.Value := InputBox('THETA(' + tblThetasTheta.AsString +
')', 'Enter a new label for THETA(' + tblThetasTheta.AsString +
')', tblThetasThetaLabel.Value);
finally
tblThetas.Post;
end;
end;
// ********************************************************************
// Export
// ********************************************************************
procedure TfrmNMRun.btnExportClick(Sender: TObject);
//var
//n, m: Integer;
begin
{ // Populate memtable
memData.Active := True;
memData.EmptyTable;
tblRuns.First;
for n := 0 to tblRuns.RecordCount - 1 do
begin
memData.Insert;
memDataRunNo.Value := tblRunsRunNo.Value;
if Pos('ADVAN2', tblRunsModel.Value) > 0 then
memDataADVAN.Value := '2';
if Pos('ADVAN4', tblRunsModel.Value) > 0 then
memDataADVAN.Value := '4';
if Pos('ADVAN6', tblRunsModel.Value) > 0 then
memDataADVAN.Value := '6';
memDataData.Value := ExtractFileName(tblRunsData.Value);
memDataObj.Value := tblRunsObj.Value;
memDataComments.Value := tblRunsComments.Value;
tblThetas.First;
for m := 0 to tblThetas.RecordCount - 1 do
begin
if Pos('CL', tblThetasThetaLabel.Value) > 0 then
memDataCL.Value := tblThetasThetaValue.Value;
if Pos('V', tblThetasThetaLabel.Value) > 0 then
memDataV.Value := tblThetasThetaValue.Value;
if Pos('KA', tblThetasThetaLabel.Value) > 0 then
memDataKA.Value := tblThetasThetaValue.Value;
if Pos('ALAG', tblThetasThetaLabel.Value) > 0 then
memDataALAG.Value := tblThetasThetaValue.Value;
if Pos('V2', tblThetasThetaLabel.Value) > 0 then
memDataV2.Value := tblThetasThetaValue.Value;
if Pos('V3', tblThetasThetaLabel.Value) > 0 then
memDataV3.Value := tblThetasThetaValue.Value;
if Pos('Q', tblThetasThetaLabel.Value) > 0 then
memDataQ.Value := tblThetasThetaValue.Value;
if Pos('ADD', tblThetasThetaLabel.Value) > 0 then
memDataResAdd.Value := tblThetasThetaValue.Value;
if Pos('EXP', tblThetasThetaLabel.Value) > 0 then
memDataResCCV.Value := tblThetasThetaValue.Value;
tblThetas.Next;
end;
tblEtas.First;
for m := 0 to tblEtas.RecordCount - 1 do
begin
if Pos('CL', tblEtasEtaLabel.Value) > 0 then
memDataEtaCL.Value := tblEtasEtaValue.Value;
if Pos('V', tblEtasEtaLabel.Value) > 0 then
memDataEtaV.Value := tblEtasEtaValue.Value;
if Pos('KA', tblEtasEtaLabel.Value) > 0 then
memDataEtaKA.Value := tblEtasEtaValue.Value;
if Pos('ALAG', tblEtasEtaLabel.Value) > 0 then
memDataEtaALAG.Value := tblEtasEtaValue.Value;
if Pos('V2', tblEtasEtaLabel.Value) > 0 then
memDataEtaV2.Value := tblEtasEtaValue.Value;
if Pos('V3', tblEtasEtaLabel.Value) > 0 then
memDataEtaV3.Value := tblEtasEtaValue.Value;
if Pos('Q', tblEtasEtaLabel.Value) > 0 then
memDataEtaQ.Value := tblEtasEtaValue.Value;
tblEtas.Next;
end;
try
if memDataCL.Value > 0 then
memDataPercEtaCL.Value := (memDataEtaCL.Value /
memDataCL.Value) * 100;
except
end;
try
if memDataV.Value > 0 then
memDataPercEtaV.Value := (memDataEtaV.Value /
memDataV.Value) * 100;
except
end;
try
if memDataKA.Value > 0 then
memDataPercEtaKA.Value := (memDataEtaKA.Value /
memDataKA.Value) * 100;
except
end;
try
if memDataALAG.Value > 0 then
memDataPercEtaALAG.Value := (memDataEtaALAG.Value /
memDataALAG.Value) * 100;
except
end;
try
if memDataV2.Value > 0 then
memDataPercEtaV2.Value := (memDataEtaV2.Value /
memDataV2.Value) * 100;
except
end;
try
if memDataV3.Value > 0 then
memDataPercEtaV3.Value := (memDataEtaV3.Value /
memDataV3.Value) * 100;
except
end;
try
if memDataQ.Value > 0 then
memDataPercEtaQ.Value := (memDataEtaQ.Value /
memDataQ.Value) * 100;
except
end;
memData.Post;
tblRuns.Next;
end;
memData.First;
if dlgSave.Execute then
ekRTF.OutFile := dlgSave.FileName;
try
ekRTF.ExecuteOpen([memData], SW_SHOW);
finally
memData.EmptyTable;
memData.Close;
end; }
end;
procedure TfrmNMRun.btnExportCompareClick(Sender: TObject);
var
n, m, intThetas, intEtas, intEpsilons, p: Integer;
lstExport: TStrings;
strExport, strExportSE: string;
oldCursor: TCursor;
ListSeparator: string;
FormatSettings: TFormatSettings;
begin
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FormatSettings);
ListSeparator := string(FormatSettings.ListSeparator);
if dlgSaveCompare.Execute then
begin
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
try
lstExport := TStringList.Create;
if tblRuns.Active then
begin
// Disconnect DB tables
rvwThetas.DataSource := nil;
rvwEtas.DataSource := nil;
rvwSigmas.DataSource := nil;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Theta) FROM Thetas;');
sqlParent.Active := True;
intThetas := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Eta) FROM Etas;');
sqlParent.Active := True;
intEtas := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT MAX(Sigma) FROM Sigmas;');
sqlParent.Active := True;
intEpsilons := sqlParent.Fields[0].AsInteger;
sqlParent.Active := False;
strExport := '"RunNo","Label","OFV","dOFV","Parent","CondNo","Notes","Minimization","Warnings","Problem",' +
'"StructuralModel","CovariateModel","IIV","IOV","RV","Estimation","Description",';
strExport := StringReplace(strExport,',',ListSeparator,[rfReplaceAll]);
for n := 1 to intThetas do
strExport := strExport + '"Th' + IntToStr(n) + '"' + ListSeparator;
for n := 1 to intEtas do
strExport := strExport + '"Om' + IntToStr(n) + '"' + ListSeparator;
for n := 1 to intEpsilons do
strExport := strExport + '"Si' + IntToStr(n) + '"' + ListSeparator;
for n := 1 to intThetas do
strExport := strExport + '"Th' + IntToStr(n) + 'SE' + '"' + ListSeparator;
for n := 1 to intEtas do
strExport := strExport + '"Om' + IntToStr(n) + 'SE' + '"' + ListSeparator;
for n := 1 to intEpsilons do
strExport := strExport + '"Si' + IntToStr(n) + 'SE' + '"' + ListSeparator;
lstExport.Add(strExport);
strExport := '';
tblRuns.First;
for n := 1 to tblRuns.RecordCount do
begin
strExport := '';
strExport := strExport + tblRunsRunNo.Value + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsLabel.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
if FloatToStr(tblRunsObj.Value) <> '0' then
strExport := strExport + FloatToStr(tblRunsObj.Value) + ListSeparator
else
strExport := strExport + ListSeparator;
if FloatToStr(tblRunsdOFV.Value) <> '0' then
strExport := strExport + FloatToStr(tblRunsdOFV.Value) + ListSeparator
else
strExport := strExport + ListSeparator;
if tblRunsParentNo.Value <> '' then
strExport := strExport + tblRunsParentNo.Value + ListSeparator
else
strExport := strExport + ListSeparator;
if FloatToStr(tblRunsConditionNumber.Value) <> '0' then
strExport := strExport + FloatToStr(tblRunsConditionNumber.Value) + ListSeparator
else
strExport := strExport + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsComments.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsMinShort.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsWarnings.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsComment.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsStructuralModel.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsCovariateModel.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsIIV.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsIOV.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsRV.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsEstimation.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExport := strExport + '"' + StringReplace(tblRunsDescription.Value, ListSeparator, #10#13, [rfReplaceAll]) + '"' + ListSeparator;
strExportSE := '';
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Theta, ThetaValue, ThetaSE, ThetaRSE');
sqlParent.SQL.Add('FROM Thetas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Theta;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
for m := 0 to intThetas - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
strExportSE := strExportSE + FloatToStr(sqlParent.Fields[2].AsFloat) + ListSeparator
else
strExportSE := strExportSE + ListSeparator;
strExport := strExport + FloatToStr(sqlParent.Fields[1].AsFloat) + ListSeparator;
end
else
begin
strExport := strExport + ListSeparator;
strExportSE := strExportSE + ListSeparator;
end;
p := p + 1;
sqlParent.Next;
end;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Eta, EtaValue, EtaSE, EtaRSE');
sqlParent.SQL.Add('FROM Etas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Eta;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
for m := 0 to intEtas - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
strExportSE := strExportSE + FloatToStr(sqlParent.Fields[2].AsFloat) + ListSeparator
else
strExportSE := strExportSE + ListSeparator;
strExport := strExport + FloatToStr(sqlParent.Fields[1].AsFloat) + ListSeparator;
end
else
begin
strExport := strExport + ListSeparator;
strExportSE := strExportSE + ListSeparator;
end;
p := p + 1;
sqlParent.Next;
end;
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Sigma, SigmaValue, SigmaSE, SigmaRSE');
sqlParent.SQL.Add('FROM Sigmas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Sigma;');
sqlParent.Active := True;
sqlParent.First;
p := 0;
for m := 0 to intEpsilons - 1 do
begin
if p < sqlParent.RecordCount then
begin
if FloatToStr(sqlParent.Fields[2].AsFloat) <> '0' then
strExportSE := strExportSE + FloatToStr(sqlParent.Fields[2].AsFloat) + ListSeparator
else
strExportSE := strExportSE + ListSeparator;
strExport := strExport + FloatToStr(sqlParent.Fields[1].AsFloat) + ListSeparator;
end
else
begin
strExport := strExport + ListSeparator;
strExportSE := strExportSE + ListSeparator;
end;
p := p + 1;
sqlParent.Next;
end;
lstExport.Add(strExport + strExportSE);
tblRuns.Next;
end;
end;
lstExport.SaveToFile(dlgSaveCompare.FileName);
finally
lstExport.Free;
// Reconnect DB tables
rvwThetas.DataSource := srcThetas;
rvwEtas.DataSource := srcEtas;
rvwSigmas.DataSource := srcSigmas;
Screen.Cursor := oldCursor;
end;
end;
end;
// ********************************************************************
// RTF export
// ********************************************************************
{procedure TfrmNMRun.ekRTFScanRecord(ScanInfo: TEkScanInfo);
begin
if ScanInfo.Number = 1 then
begin
ekRTF.VarList[0] := 'DataFile=' + ExtractFileName(tblRunsData.Value);
ekRTF.VarList[1] := 'Model=2';
if Pos('ADVAN4', tblRunsModel.Value) > 0 then
ekRTF.VarList[1] := 'Model=4';
if Pos('ADVAN6', tblRunsModel.Value) > 0 then
ekRTF.VarList[1] := 'Model=6';
end;
if ScanInfo.Number = 3 then
begin
ekRTF.VarList[2] := 'EtaPerc=' + FormatFloat('#.##', (tblEtasEtaValue.Value /
tblThetasThetaValue.Value) * 100);
end;
end; }
// ********************************************************************
// Dunno
// ********************************************************************
function TfrmNMRun.TabDataLoad(FileName: string): Boolean;
var
n, m: Integer;
lstFile: TStrings;
begin
Result := True;
if FileExists(FileName) then
begin
lstFile := TStringList.Create;
lstFile.LoadFromFile(FileName);
if grdData.RowCount <> lstFile.Count then
grdData.RowCount := lstFile.Count;
if Pos('#', lstFile[0]) = 1 then
lstFile[0] := StringReplace(lstFile[0], '#', '', []);
for n := 0 to lstFile.Count - 1 do
begin
brkUpp.StringList.Clear;
brkUpp.BreakString := ' ';
brkUpp.BaseString := Trim(lstFile[n]);
brkUpp.BreakApart;
if grdData.ColCount <> brkUpp.StringList.Count then
grdData.ColCount := brkUpp.StringList.Count;
try
for m := 0 to brkUpp.StringList.Count - 1 do
if n = 0 then
grdData.Cells[m, n] := brkUpp.StringList[m]
else
if (Pos(':', brkUpp.StringList[m]) = 0) and
(ContainsChar(brkUpp.StringList[m]) = False) then
grdData.Cells[m, n] := NumConv(brkUpp.StringList[m])
else
grdData.Cells[m, n] := brkUpp.StringList[m];
except
Result := False;
end;
end;
lstFile.Free;
end
else
MessageDlg('This file does not appear to exist. Has it been ' +
'moved, or has a network drive been disconnected?', mtError, [mbOK], 0);
end;
procedure TfrmNMRun.btnNMusersClick(Sender: TObject);
begin
if not Assigned(frmSearch) then
frmSearch := TfrmSearch.Create(Application);
frmSearch.ShowModal;
end;
function TfrmNMRun.CaseConvert(strIn: string): string;
var
x: integer;
s: string;
begin
s := LowerCase(strIn);
if s = '' then
begin
result := s;
exit;
end;
for x := 1 to Length(s) do
begin
if (x = 1) then s[x] := UpCase(s[x]) else
if not (s[x - 1] in ['a'..'z', 'A'..'Z', '''']) then s[x] := UpCase(s[x]);
end;
s := StringReplace(s, 'Advan', 'ADVAN', [rfReplaceAll]);
result := s;
end; { of function CaseConvert }
procedure TfrmNMRun.CopySP(const source, dest: string;
op, flags: Integer);
var
shf: TSHFileOpStruct;
s1, s2: string;
begin
FillChar(shf, SizeOf(shf), #0);
s1 := source + #0#0;
s2 := dest + #0#0;
shf.Wnd := 0;
shf.wFunc := op;
shf.pFrom := PCHAR(s1);
shf.pTo := PCHAR(s2);
shf.fFlags := flags;
SHFileOperation(shf);
end;
procedure TfrmNMRun.nbMatricesPageChanged(Sender: TObject;
Index: Integer);
begin
Application.ProcessMessages;
if Index = 0 then
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
if Index = 1 then
LoadMatrix(tblRunsCorrMatrix, grdCorrMatrix);
if Index = 2 then
LoadMatrix(tblRunsInvCovMatrix, grdInvCovMatrix);
if Index = 3 then
LoadMatrix(tblRunsEigenvalues, grdEigenvalues);
end;
procedure TfrmNMRun.pgcMainChange(Sender: TObject);
begin
if pgcMain.ActivePageIndex = 3 then
begin
Application.ProcessMessages;
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
end;
if pgcMain.ActivePage = tabOmega then
begin
if nbOmega.PageIndex = 1 then
LoadMatrix(tblRunsOmegaInitMatrix, grdOmInit);
if nbOmega.PageIndex = 2 then
LoadMatrix(tblRunsOmegaMatrix, grdOmMatrix);
if nbOmega.PageIndex = 3 then
LoadMatrix(tblRunsOmegaSEMatrix, grdOmSE);
end;
if pgcMain.ActivePage = tabMatrices then
begin
if nbMatrices.PageIndex = 0 then
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
if nbMatrices.PageIndex = 1 then
LoadMatrix(tblRunsCorrMatrix, grdCorrMatrix);
if nbMatrices.PageIndex = 2 then
LoadMatrix(tblRunsInvCovMatrix, grdInvCovMatrix);
if nbMatrices.PageIndex = 3 then
LoadMatrix(tblRunsEigenvalues, grdEigenvalues);
//ShowMessage(tblRunsEigenvalues.Value);
end;
end;
procedure TfrmNMRun.grdEigenvaluesDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
S: string;
begin
if (StrToFloat(grdEigenvalues.Cells[ACol, ARow]) > 1000)
and (ACol <> 0) then
with grdEigenvalues.Canvas do
begin
Brush.Color := clInfoBk;
Font.Color := clInfoText;
Font.Style := [];
Font.Height := 13;
Font.Name := 'Tahoma';
FillRect(Rect);
S := grdEigenvalues.Cells[ACol, ARow];
TextOut(Rect.Left + 2, Rect.Top + 2, S);
end;
end;
procedure TfrmNMRun.grdCompareDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
strTrunc: string;
begin
TJvgStringGrid(Sender).DoubleBuffered := True;
if ARow <> 0 then
begin
if TJvgStringGrid(Sender).Cells[ACol, ARow] = 'Terminated' then
TJvgStringGrid(Sender).Font.Color := clRed
else
TJvgStringGrid(Sender).Font.Color := clWindowText;
end;
if GetTextWidth(TJvgStringGrid(Sender),
TJvgStringGrid(Sender).Cells[ACol, ARow],
TJvgStringGrid(Sender).Font) >= Rect.Right - Rect.Left then
begin
strTrunc := TJvgStringGrid(Sender).Cells[ACol, ARow];
while GetTextWidth(TJvgStringGrid(Sender), strTrunc + '... ',
TJvgStringGrid(Sender).Font) >= Rect.Right - Rect.Left do
strTrunc := Copy(strTrunc, 1, Length(strTrunc) - 1);
TJvgStringGrid(Sender).Cells[ACol, ARow] := strTrunc + '... ';
end;
if (state = [gdSelected]) then
with TJvgStringGrid(Sender), Canvas do
begin
Brush.Color := clInfoBk;
FillRect(Rect);
TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]);
end;
end;
procedure TfrmNMRun.grdCompareSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
{if (tblRuns.Active) and (ARow <> 0) then
with tblRuns do
begin
tblRuns.IndexName := 'runno2';
tblRuns.Refresh;
tblRuns.FindKey([grdCompare.Cells[0, ARow]]);
tblRuns.IndexName := 'irunno';
tblRuns.Refresh;
end; }
end;
procedure TfrmNMRun.grdCorrMatrixDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
S: string;
begin
if ACol <> 0 then
if (grdCorrMatrix.Cells[ACol, ARow] <> '') and
(grdCorrMatrix.Cells[ACol, ARow] <> '......') then
if (Abs(StrToFloat(grdCorrMatrix.Cells[ACol, ARow])) > 0.95) then
with grdCorrMatrix.Canvas do
begin
Brush.Color := clInfoBk;
Font.Color := clInfoText;
Font.Style := [];
Font.Height := 13;
Font.Name := 'Tahoma';
FillRect(Rect);
S := grdCorrMatrix.Cells[ACol, ARow];
TextOut(Rect.Left + 2, Rect.Top + 2, S);
end;
end;
// ********************************************************************
// Construct a bootstrap a la WFN
// ********************************************************************
procedure TfrmNMRun.RunaBootstrap1Click(Sender: TObject);
var
lstCtl: TStringList;
lstData: TStringList;
lstSubjects: TStringList;
m, n, intID: Integer;
blnInput: Boolean;
strT, strIgnore: string;
begin
// Detect perl
if Pos('perl\bin',
LowerCase(GetRegistryValue('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\',
'Path'))) < 1 then
if MessageDlg('Perl not detected. Census''s bootstrap function will not ' +
'work without it.' + #10#13 + #10#13 + 'Would you like to download ' +
'the latest version? (This may not be required if the bootstrap is to be run on another ' +
'computer.)', mtInformation, [mbYes, mbNo], 0) = mrYes then
ShellExecute(0, nil,
PChar('http://www.perl.org/get.html'), nil, nil, SW_SHOWNORMAL);
// Get baseline bootstrap details
lstData := TStringList.Create;
lstCtl := TStringList.Create;
lstSubjects := TStringList.Create;
blnInput := False;
strT := '';
strIgnore := '';
if FileExists(tblRunsData.Value) then
lstData.LoadFromFile(tblRunsData.Value)
else
begin
MessageDlg('Unable to load data file (' + tblRunsData.Value
+ ') - has it been moved?', mtError, [mbOK], 0);
lstData.Free;
lstCtl.Free;
Exit;
end;
if FileExists(tblRunsCtl.Value) then
lstCtl.LoadFromFile(tblRunsCtl.Value)
else
begin
MessageDlg('Unable to load control stream (' + tblRunsCtl.Value
+ ') - has it been moved?', mtError, [mbOK], 0);
lstData.Free;
lstCtl.Free;
Exit;
end;
// Find ID record
for n := 0 to lstCtl.Count - 1 do
begin
if Pos('$INPUT', lstCtl[n]) > 0 then
blnInput := True;
if (Pos('$', lstCtl[n]) > 0) and
(Pos('$INPUT', lstCtl[n]) = 0) then
blnInput := False;
if blnInput then
strT := strT + lstCtl[n];
// IGNORE character
if Pos('IGNORE=', lstCtl[n]) > 0 then
begin
m := Pos('IGNORE=', lstCtl[n]) + 7;
while lstCtl[n][m] <> ' ' do
begin
if (lstCtl[n][m] <> '"') and
(lstCtl[n][m] <> '''') then
strIgnore := strIgnore + lstCtl[n][m];
m := m + 1;
end;
end;
end;
strIgnore := Trim(strIgnore);
strT := StringReplace(strT, '$INPUT', '', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
intId := -1;
for n := 0 to brkUpp.StringList.Count - 1 do
if brkUpp.StringList[n] = 'ID' then
intId := n;
if intID = -1 then
begin
MessageDlg('There doesn''t seem to be an ID column defined in ' +
'$INPUT in your control stream!', mtError, [mbOK], 0);
Exit;
end;
// Read total number of subjects
try
for n := 0 to lstData.Count - 1 do
begin
if (lstData[n][1] <> strIgnore) and
(not (lstData[n][1] in ['a'..'z'])) and
(not (lstData[n][1] in ['A'..'Z'])) then
begin
with brkUpp do
begin
StringList.Clear;
AllowEmptyString := False;
BaseString := lstData[n];
BreakString := ' ';
if (Pos(',', lstData[n]) > 0) then
BreakString := ',';
if (Pos(#8, lstData[n]) > 0) then
BreakString := #8;
BreakApart;
end;
if lstSubjects.IndexOf(brkUpp.StringList[intID]) = -1 then
lstSubjects.Add(brkUpp.StringList[intID]);
end;
end;
finally
ShowMessage(IntToStr(lstSubjects.Count));
end;
// Finally
lstData.Free;
lstCtl.Free;
lstSubjects.Free;
end;
function TfrmNMRun.GetRegistryValue(KeyName: string; Key: string): string;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create(KEY_READ);
try
Registry.RootKey := HKEY_LOCAL_MACHINE;
// False because we do not want to create it if it doesn't exist
Registry.OpenKey(KeyName, False);
Result := Registry.ReadString(Key);
finally
Registry.Free;
end;
end;
// ********************************************************************
// Alphabetical characters?
// ********************************************************************
function TfrmNMRun.NoAlpha(strIn: string): Boolean;
var
n: Integer;
begin
Result := True;
for n := 1 to Length(strIn) do
begin
if strIn[n] in ['a'..'z'] then
Result := False;
if (strIn[n] in ['A'..'D']) or
(strIn[n] in ['F'..'Z']) then
Result := False;
end;
end;
// ********************************************************************
// Move to another record
// ********************************************************************
procedure TfrmNMRun.tblRunsAfterRefresh(DataSet: TDataSet);
begin
if pnlMain.Visible then
begin
// Refresh current view
if pgcMain.ActivePageIndex = 1 then
begin
if nbOmega.PageIndex = 1 then
LoadMatrix(tblRunsOmegaInitMatrix, grdOmInit);
if nbOmega.PageIndex = 2 then
LoadMatrix(tblRunsOmegaMatrix, grdOmMatrix);
if nbOmega.PageIndex = 3 then
LoadMatrix(tblRunsOmegaSEMatrix, grdOmSE);
end;
if pgcMain.ActivePageIndex = 2 then
begin
if nbSigma.PageIndex = 1 then
LoadMatrix(tblRunsSigmaInitMatrix, grdSigInit);
if nbSigma.PageIndex = 2 then
LoadMatrix(tblRunsSigmaMatrix, grdSigMatrix);
end;
if pgcMain.ActivePageIndex = 3 then
begin
if nbMatrices.PageIndex = 0 then
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
if nbMatrices.PageIndex = 1 then
LoadMatrix(tblRunsCorrMatrix, grdCorrMatrix);
if nbMatrices.PageIndex = 2 then
LoadMatrix(tblRunsInvCovMatrix, grdInvCovMatrix);
if nbMatrices.PageIndex = 3 then
LoadMatrix(tblRunsEigenvalues, grdEigenvalues);
end;
end;
if pnlFiles.Visible then
begin
CtlClose;
DataClose;
//grdFit.ColCount := 0;
//grdFit.RowCount := 0;
//grdSdtab.ColCount := 0;
//grdSdtab.RowCount := 0;
grdPatab.ColCount := 0;
grdPatab.RowCount := 0;
grdMytab.ColCount := 0;
grdMytab.RowCount := 0;
grdMutab.ColCount := 0;
grdMutab.RowCount := 0;
grdCotab.ColCount := 0;
grdCotab.RowCount := 0;
grdCatab.ColCount := 0;
grdCatab.RowCount := 0;
memMsf.IsOpen := False;
pgcFilesChange(nil);
end;
if tblRuns.State in [dsEdit, dsInsert] then
tblRuns.Post;
end;
procedure TfrmNMRun.CtlClose;
begin
synCtl.Lines.Clear;
end;
procedure TfrmNMRun.pgcFilesChange(Sender: TObject);
var
oldCursor: TCursor;
begin
oldCursor := Screen.Cursor;
if pnlFiles.Visible then
try
Screen.Cursor := crHourglass;
case pgcFiles.ActivePageIndex of
0: CtlOpen;
1: LstOpen;
2: ExtOpen;
3: DataOpen;
4: PhiOpen;
5: CovOpen;
6: CorOpen;
7: CoiOpen;
8: sdtabOpen;
9: patabOpen;
10: cotabOpen;
11: catabOpen;
12: cwtabEstOpen;
13: cwtabDerivOpen;
14: mutabOpen;
15: mytabOpen;
16: MsfOpen;
end;
finally
Screen.Cursor := oldCursor;
end;
end;
// ********************************************************************
// Open additional output
// ********************************************************************
procedure TfrmNMRun.ExtOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsExt.Value) then
begin
NMGridLoad(grdExt, tblRunsExt.Value, 2);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsExt.Value);
if (tblRunsExtMD5.Value <> txtMD5) and (tblRunsExtMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsExtMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open phi table
// ********************************************************************
procedure TfrmNMRun.PhiOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsPhi.Value) then
begin
NMGridLoad(grdPhi, tblRunsPhi.Value, 2);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsPhi.Value);
if (tblRunsPhiMD5.Value <> txtMD5) and (tblRunsPhiMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsPhiMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
procedure TfrmNMRun.Properties1Click(Sender: TObject);
begin
if not Assigned(frmProperties) then
frmProperties := TfrmProperties.Create(Application);
frmProperties.ShowModal;
end;
// ********************************************************************
// Open covariance table
// ********************************************************************
procedure TfrmNMRun.CovOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCov.Value) then
begin
NMGridLoad(grdCov, tblRunsCov.Value, 2);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCov.Value);
if (tblRunsCovMD5.Value <> txtMD5) and (tblRunsCovMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsCovMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open Cor table
// ********************************************************************
procedure TfrmNMRun.CorOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCor.Value) then
begin
NMGridLoad(grdCor, tblRunsCor.Value, 2);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCor.Value);
if (tblRunsCorMD5.Value <> txtMD5) and (tblRunsCorMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsCorMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
// ********************************************************************
// Open coi table
// ********************************************************************
procedure TfrmNMRun.CoiOpen;
var
txtMD5: string;
begin
if FileExists(tblRunsCoi.Value) then
begin
NMGridLoad(grdCoi, tblRunsCoi.Value, 2);
if blnMD5 then
begin
txtMD5 := MD5(tblRunsCoi.Value);
if (tblRunsCoiMD5.Value <> txtMD5) and (tblRunsCoiMD5.Value <> '') then
MessageDlg('The output file for this run has been changed since it was added to ' +
'this database!#10#13#10#13Recorded MD5:#9' + tblRunsCoiMD5.Value +
'#10#13Current MD5:#9' + txtMD5, mtWarning, [mbOK], 0);
end;
end;
end;
procedure TfrmNMRun.SimpleRunSummary1Click(Sender: TObject);
begin
if not Assigned(frmReport) then
frmReport := TfrmReport.Create(Application);
frmReport.ShowModal;
end;
procedure TfrmNMRun.PackageRuns1Click(Sender: TObject);
begin
if not Assigned(frmPackage) then
frmPackage := TfrmPackage.Create(Application);
frmPackage.ShowModal;
end;
procedure TfrmNMRun.PackandGo1Click(Sender: TObject);
var
strNewLoc: string;
begin
// Prompt for new location
if dlgNewDB.Execute then
begin
if nmDatabase.Connected then
try
tblTrans.InsertRecord([Null, 'move', '---', Now, txtUser]);
except
MessageDlg('Transaction table failed to update!', mtError, [mbOK], 0);
end;
strNewLoc := dlgNewDB.Directory;
srcRuns.DataSet := nil;
DisconnectFile;
// Disconnect
// Move files
// Reconnect
end;
end;
procedure TfrmNMRun.LogLikelihoodProfiling1Click(Sender: TObject);
begin
if not Assigned(frmLLP) then
frmLLP := TfrmLLP.Create(Application);
frmLLP.ShowModal;
end;
procedure TfrmNMRun.nbSigmaPageChanged(Sender: TObject; Index: Integer);
begin
if Index = 1 then
LoadMatrix(tblRunsSigmaInitMatrix, grdSigInit);
if Index = 2 then
LoadMatrix(tblRunsSigmaMatrix, grdSigMatrix);
if Index = 3 then
LoadMatrix(tblRunsSigmaSEMatrix, grdSigSE);
end;
procedure TfrmNMRun.BatchRuns1Click(Sender: TObject);
begin
if not Assigned(frmBatch) then
frmBatch := TfrmBatch.Create(Application);
frmBatch.ShowModal;
end;
function TfrmNMRun.RunProg(Cmd, WorkDir: string): string;
var
tsi: TStartupInfo;
tpi: TProcessInformation;
nRead: DWORD;
aBuf: array[0..101] of char;
sa: TSecurityAttributes;
hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
hInputWrite, hErrorWrite: THandle;
FOutput: string;
begin
FOutput := '';
sa.nLength := SizeOf(TSecurityAttributes);
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True;
CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(),
@hErrorWrite, 0, true, DUPLICATE_SAME_ACCESS);
CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);
// Create new output read handle and the input write handle. Set
// the inheritance properties to FALSE. Otherwise, the child inherits
// the these handles; resulting in non-closeable handles to the pipes
// being created.
DuplicateHandle(GetCurrentProcess(), hOutputReadTmp, GetCurrentProcess(),
@hOutputRead, 0, false, DUPLICATE_SAME_ACCESS);
DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(),
@hInputWrite, 0, false, DUPLICATE_SAME_ACCESS);
CloseHandle(hOutputReadTmp);
CloseHandle(hInputWriteTmp);
FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
tsi.hStdInput := hInputRead;
tsi.hStdOutput := hOutputWrite;
tsi.hStdError := hErrorWrite;
CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil, PChar(WorkDir),
tsi, tpi);
CloseHandle(hOutputWrite);
CloseHandle(hInputRead);
CloseHandle(hErrorWrite);
Application.ProcessMessages;
repeat
if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then
Break
else
MessageDlg('Pipe read error, could not execute file!', mtError, [mbOK], 0);
end;
aBuf[nRead] := #0;
FOutput := FOutput + PChar(@aBuf[0]);
Application.ProcessMessages;
until False;
Result := FOutput;
//GetExitCodeProcess(tpi.hProcess, nRead) = True;
end;
procedure TfrmNMRun.StartNONMEMRun1Click(Sender: TObject);
begin
// Stuff
end;
procedure TfrmNMRun.MyExceptionHandler(Sender: TObject; E: Exception);
begin
ShowMessage('Error: ' + E.Message);
end;
{procedure TfrmNMRun.ovcMruClick(Sender: TObject; const ItemText: string;
var Action: TOvcMRUClickAction);
begin
if (FileExists(ItemText + '\Runs.FF2'))
and (FileExists(ItemText + '\Thetas.FF2'))
and (FileExists(ItemText + '\Etas.FF2'))
and (FileExists(ItemText + '\Sigmas.FF2')) then
begin
DisconnectFile;
if FileExists(ItemText + '\PlotData.FF2') = False then
embData.DataSaveToFile(ItemText + '\PlotData.FF2');
if FileExists(ItemText + '\Trans.FF2') = False then
embTrans.DataSaveToFile(ItemText + '\Trans.FF2');
nmDatabase.AliasName := ItemText;
ConnectFile;
end
else
MessageDlg('That is not a valid database directory.',
mtError, [mbOK], 0);
end; }
procedure TfrmNMRun.tblEtasCalcFields(DataSet: TDataSet);
begin
if tblEtasEtaValue.Value > 0 then
tblEtasEtaCV.Value := Round(sqrt(tblEtasEtaValue.Value)*1000)/10;
end;
procedure TfrmNMRun.tblPlotDataCalcFields(DataSet: TDataSet);
begin
tblPlotDataAbsIWRE.Value := Abs(tblPlotDataIWRE.Value);
end;
procedure TfrmNMRun.FormActivate(Sender: TObject);
var
n: Integer;
mnuItem: TMenuItem;
begin
{for n := 0 to ovcMRU.Items.Count - 1 do
begin
//ShowMessage(ovcMRU.Items[n]);
mnuItem := TMenuItem.Create(mnuPopMru);
mnuItem.Caption := ovcMru.Items[n];
mnuItem.OnClick := MRUGo;
end;
btnOpenDB.DropdownMenu := mnuPopMru; }
end;
procedure TfrmNMRun.MRUGo(Sender: TObject);
begin
dlgOpenDB.Directory := (Sender as TMenuItem).Caption;
if (FileExists(dlgOpenDB.Directory + '\Runs.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Thetas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Etas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Sigmas.FF2')) then
begin
DisconnectFile;
nmDatabase.AliasName := dlgOpenDB.Directory;
ConnectFile;
end
else
MessageDlg('That is not a valid database directory.',
mtError, [mbOK], 0);
end;
procedure TfrmNMRun.mruManagerClick(Sender: TObject; const RecentName,
Caption: string; UserData: Integer);
begin
dlgOpenDB.Directory := RecentName;
if (FileExists(dlgOpenDB.Directory + '\Runs.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Thetas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Etas.FF2'))
and (FileExists(dlgOpenDB.Directory + '\Sigmas.FF2')) then
begin
DisconnectFile;
nmDatabase.AliasName := dlgOpenDB.Directory;
ConnectFile;
end
else
MessageDlg('That is not a valid database directory.',
mtError, [mbOK], 0);
end;
procedure TfrmNMRun.RunDosInMemo(DosApp: string; AMemo: TMemo);
const
ReadBuffer = 2400;
var
Security: TSecurityAttributes;
ReadPipe, WritePipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: Pchar;
BytesRead: DWord;
Apprunning: DWord;
begin
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe(ReadPipe, WritePipe,
@Security, 0) then begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar(DosApp),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
repeat
Apprunning := WaitForSingleObject
(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
repeat
BytesRead := 0;
ReadFile(ReadPipe, Buffer[0],
ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
AMemo.Text := AMemo.text + string(Buffer);
until (BytesRead < ReadBuffer);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
procedure TfrmNMRun.Execute1Click(Sender: TObject);
begin
{if not Assigned(frmExecute) then
frmExecute := TfrmExecute.Create(Application);
frmExecute.ShowModal;
RunDosInMemo('perl -V', frmExecute.memOutput); }
NotImplemented;
end;
function TfrmNMRun.StripBlanks(lstIn: TStrings): TStrings;
var
n: Integer;
lstOut: TStrings;
begin
lstOut := TStringList.Create;
for n := 0 to lstIn.Count - 1 do
if Length(Trim(lstIn[n])) > 0 then
lstOut.Add(lstIn[n]);
Result := lstOut;
end;
procedure TfrmNMRun.BlastRun;
var
OldCursor: TCursor;
n: Integer;
strWD, strSuffix, strObject: string;
begin
{sqlDel.DatabaseName := 'nmDatabase';
// Thetas
sqlDel.Active := False;
sqlDel.SQL.Clear;
sqlDel.SQL.Add('DELETE FROM Thetas WHERE RunNo = ' + tblRunsRunNo.Value
+ ';');
try
//sqlDel.Active := True;
ShowMessage(sqlDel.SQL.Text);
sqlDel.ExecSQL;
except
on EffDatabaseError do ;
end; }
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
try
dlgProg.Caption := 'Deleting...';
dlgProg.Text := 'Please wait, clearing run records...';
dlgProg.Min := 0;
dlgProg.Max := 5;
dlgProg.Show;
try
rvwThetas.DataSource := nil;
tblThetas.First;
for n := 0 to tblThetas.RecordCount - 1 do
begin
if tblThetasRunNo.Value = tblRunsRunNo.Value then
tblThetas.Delete;
tblThetas.Next;
end;
finally
rvwThetas.DataSource := srcThetas;
dlgProg.Position := 1;
end;
// Etas
{ sqlDel.Active := False;
sqlDel.SQL.Clear;
sqlDel.SQL.Add('DELETE FROM Etas WHERE RunNo = ''' + tblRunsRunNo.Value +
'''');
try
//sqlDel.Active := True;
sqlDel.ExecSQL;
except
on EffDatabaseError do ;
end; }
try
rvwEtas.DataSource := nil;
tblEtas.First;
for n := 0 to tblEtas.RecordCount - 1 do
begin
if tblEtasRunNo.Value = tblRunsRunNo.Value then
tblEtas.Delete;
tblEtas.Next;
end;
finally
rvwEtas.DataSource := srcEtas;
dlgProg.Position := 2;
end;
// Sigmas
{ sqlDel.Active := False;
sqlDel.SQL.Clear;
sqlDel.SQL.Add('DELETE FROM Sigmas WHERE RunNo = ''' + tblRunsRunNo.Value +
'''');
try
//sqlDel.Active := True;
sqlDel.ExecSQL;
except
on EffDatabaseError do ;
end; }
try
rvwSigmas.DataSource := nil;
tblSigmas.First;
for n := 0 to tblSigmas.RecordCount - 1 do
begin
if tblSigmasRunNo.Value = tblRunsRunNo.Value then
tblSigmas.Delete;
tblSigmas.Next;
end;
finally
rvwSigmas.DataSource := srcSigmas;
dlgProg.Position := 3;
end;
// Data
{ sqlDel.Active := False;
sqlDel.SQL.Clear;
sqlDel.SQL.Add('DELETE FROM PlotData WHERE RunNo = ''' + tblRunsRunNo.Value +
'''');
try
//sqlDel.Active := True;
sqlDel.ExecSQL;
except
on EffDatabaseError do ;
end; }
try
//grdSdtab.DataSource := nil;
tblPlotData.First;
for n := 0 to tblPlotData.RecordCount - 1 do
begin
if tblPlotDataRunNo.Value = tblRunsRunNo.Value then
tblPlotData.Delete;
tblPlotData.Next;
end;
finally
//grdSdtab.DataSource := srcPlotData;
dlgProg.Position := 4;
end;
finally
// Runs
tblTrans.InsertRecord([Null, 'delete', tblRunsRunNo.Value, Now, txtUser]);
{ if Length(Trim(tblRunsParentNo.Value)) > 0 then
begin
// remove all parent references
sqlParent.SQL.Clear;
sqlParent.SQL.Add('UPDATE Runs SET ParentNo = NULL');
sqlParent.SQL.Add('WHERE ParentNo = ' + tblRunsParentNo.Value + ';');
try
try
sqlParent.ExecSQL;
except
;
end;
finally
sqlParent.Active := False;
end;
end; }
try
// nuke R object, if it exists
strWD := ExtractFilePath(frmNMRun.tblRunssdtab.Value);
strWD := StringReplace(strWD, '\', '/', [rfReplaceAll]);
strWD := Copy(strWD, 1, Length(strWD) - 1);
// get number for import
strRunNo := frmNMRun.tblRunsRunNo.Value;
// get Xpose object name
strObject := 'xpdb' + strRunNo;
frmR.RCommand.SendLine('try(setwd("' + strWD + '"))', True);
frmR.RCommand.SendLine('if(exists("' + strObject + '")) { ' +
'rm(' + strObject + ') }', True);
finally
;
end;
tblRuns.Delete;
dlgProg.Hide;
RefreshTree;
Screen.Cursor := oldCursor;
end;
end;
procedure TfrmNMRun.RunReport1Click(Sender: TObject);
var
oldCursor: TCursor;
strT: string;
regIni: TRegIniFile;
begin
ShowPlots := True;
CopyFilestoXpose1.Tag := 1;
regIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
if (RegIni.ReadBool('Options', 'XposeInstalled', False)) and
(RegIni.ReadBool('Options', 'RInstalled', False)) and
(RegIni.ReadBool('Options', 'RDCOMInstalled', False)) then
begin
if not Assigned(frmXpose) then
frmXpose := TfrmXpose.Create(Application);
frmXpose.ShowModal;
end
else
MessageDlg('Xpose plots are not available. Please make sure R and Xpose have been properly installed.', mtWarning, [mbOK], 0);
end;
procedure TfrmNMRun.RunReportOld1Click(Sender: TObject);
var
rtfIn, rtfTemp, Rscript: TStrings;
n, m: Integer;
strT1, strT2, strRVer, strRDir, strWD, strTRunNo, strT, strObject, strSuffix: string;
blnX: Boolean;
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
ExecuteFile, ParamString, StartInString: string;
P: PChar;
Curs: TCursor;
RegIni: TRegIniFile;
begin
{if not Assigned(frmBigReport) then
frmBigReport := TfrmBigReport.Create(Application);
frmBigReport.Show; }
MessageDlg('HTML reports are currently not available, but will be restored in' +
' the final release of Census 1.1.', mtInformation, [mbOK], 0);
Exit;
rtfOut := TstringList.Create;
rtfIn := TstringList.Create;
rtfTemp := TstringList.Create;
Curs := Screen.Cursor;
dlgSaveRtf.FileName := tblRunsCtl.Value + '.html';
if dlgSaveRtf.Execute then
if FileExists(dlgSaveRtf.FileName) then
if MessageDlg('A file with this name already exists. Would you like to overwrite it?',
mtWarning, [mbYes, mbNo], 0) = mrNo then
Exit;
try
if (FileExists(ExtractFilePath(Application.ExeName) + '\census_report_template.Rnw') = False) then
frmNMRun.embReport.DataSaveToFile(ExtractFilePath(Application.ExeName) + '\census_report_template.Rnw');
// if (FileExists(ExtractFilePath(Application.ExeName) + '\census_report_template.Rnw') = False) then
// embReport.DataSaveToFile(ExtractFilePath(Application.ExeName) + '\census_report_template.Rnw');
rtfIn.LoadFromFile(ExtractFilePath(Application.ExeName) + '\census_report_template.Rnw');
for n := 0 to rtfIn.Count - 1 do
begin
blnX := False;
if Pos('~census.xpose.loadcode~', rtfIn[n]) > 0 then
begin
blnX := True;
if FileExists(frmNMRun.tblRunssdtab.Value) then
begin
if blnXpose then
begin
// get working directory
strWD := ShortDir(ExtractFilePath(frmNMRun.tblRunssdtab.Value));
strWD := StringReplace(strWD, '\', '/', [rfReplaceAll]);
//strWD := Copy(strWD, 1, Length(strWD) - 1);
// get number for import
strTRunNo := frmNMRun.tblRunsRunNo.Value;
// get Windows temp folder
//strT := StringReplace(GetTempDirectory, '\', '/', [rfReplaceAll]);
if DirectoryExists(dlgSaveRtf.FileName + '.plots') = False then
CreateDir(dlgSaveRtf.FileName + '.plots');
strT := ExtractFileName(dlgSaveRtf.FileName) + '.plots/';
// get table suffix
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
strSuffix := RegIni.ReadString('Options', 'ExtXpose', '.');
RegIni.Free;
RtfOut.Add('<<echo=F>>=');
RtfOut.Add('library(xpose4)');
RtfOut.Add('setwd("' + strWD + '")');
RtfOut.Add('xptmp <- xpose.data("' + strTRunNo + '", tab.suffix="' + strSuffix + '")');
RtfOut.Add('@');
end
else
RtfOut.Add('');
end
else
RtfOut.Add('');
end;
if Pos('~gofplots~', rtfIn[n]) > 0 then
begin
if FileExists(frmNMRun.tblRunssdtab.Value) then
begin
if blnXpose then
begin
if DirectoryExists(dlgSaveRtf.FileName + '.plots') = False then
CreateDir(dlgSaveRtf.FileName + '.plots');
strT := ExtractFileName(dlgSaveRtf.FileName) + '.plots/';
// get table suffix
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
strSuffix := RegIni.ReadString('Options', 'ExtXpose', '.');
RegIni.Free;
Rscript := TStringlist.Create;
with Rscript do
begin
Add('library(xpose4)');
Add('setwd("' + strWD + '")');
Add('');
Add('xptmp <- xpose.data("' + strTRunNo + '", tab.suffix="' + strSuffix + '")');
Add('');
Add('jpeg(filename = "' + strT + 'dvvspred.300.jpg", width = 300, height = 300,');
Add(' bg = "white", quality = 100)');
Add('dv.vs.pred(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'dvvsipred.300.jpg", width = 300, height = 300,');
Add(' bg = "white", quality = 100)');
Add('dv.vs.ipred(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'wresvsidv.300.jpg", width = 300, height = 300,');
Add(' bg = "white", quality = 100)');
Add('wres.vs.idv(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'absiwresvsipred.300.jpg", width = 300, height = 300,');
Add(' bg = "white", quality = 100)');
Add('absval.iwres.vs.ipred(xptmp, col="black", smcol="black", cex=0.5, main="")');
Add('dev.off()');
// Add('xptmp <- xpose.data(' + strTRunNo + ')');
Add('');
Add('jpeg(filename = "' + strT + 'dvvspred.1200.jpg", width = 1200, height = 1200,');
Add(' bg = "white", quality = 100)');
Add('dv.vs.pred(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'dvvsipred.1200.jpg", width = 1200, height = 1200,');
Add(' bg = "white", quality = 100)');
Add('dv.vs.ipred(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'wresvsidv.1200.jpg", width = 1200, height = 1200,');
Add(' bg = "white", quality = 100)');
Add('wres.vs.idv(xptmp, col="black", smcol="black", pch=26, lty=2, main="")');
Add('dev.off()');
Add('');
Add('jpeg(filename = "' + strT + 'absiwresvsipred.1200.jpg", width = 1200, height = 1200,');
Add(' bg = "white", quality = 100)');
Add('absval.iwres.vs.ipred(xptmp, col="black", smcol="black", cex=0.5, main="")');
Add('dev.off()');
SaveToFile(dlgSaveRtf.FileName + '.plots\plots.R');
end;
Rscript.Free;
//ShowMessage(dlgSaveRtf.FileName + '.plots\plots.R');
try
if not Assigned(frmWait) then
frmWait := TfrmWait.Create(Application);
frmWait.Show;
frmWait.Label1.Caption := 'Running R, please wait...';
frmWait.Repaint;
if FileExists(ExtractFilePath(Application.ExeName) +
'\aero_working.ani') then
begin
P := PChar(ExtractFilePath(Application.ExeName) +
'\aero_working.ani');
Screen.Cursors[1] := LoadCursorFromFile(P);
Screen.Cursor := 1;
end
else
Screen.Cursor := crHourglass;
//ExecuteFile := strRDir + '\bin\Rcmd.exe';
ExecuteFile := strRDir;
strObject := 'xpdb' + tblRunsRunNo.Value;
// set absolute path
strT := StringReplace(dlgSaveRtf.FileName, '\', '/', [rfReplaceAll]) + '.plots/';
try
frmR.RCommand.SendLine('if(!exists("' + strObject + '")) { ' +
strObject + ' <- xpose.data("' + tblRunsRunNo.Value + '", tab.suffix="' + strSuffix + '") }', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'dvvspred.300.jpg", width = 300, height = 300,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('dv.vs.pred(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'dvvsipred.300.jpg", width = 300, height = 300,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('dv.vs.ipred(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'wresvsidv.300.jpg", width = 300, height = 300,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('wres.vs.idv(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'absiwresvsipred.300.jpg", width = 300, height = 300,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('absval.iwres.vs.ipred(' + strObject + ', col="black", smcol="black", cex=0.5, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
// Add('xptmp <- xpose.data(' + strTRunNo + ')');
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'dvvspred.1200.jpg", width = 1200, height = 1200,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('dv.vs.pred(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'dvvsipred.1200.jpg", width = 1200, height = 1200,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('dv.vs.ipred(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'wresvsidv.1200.jpg", width = 1200, height = 1200,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('wres.vs.idv(' + strObject + ', col="black", smcol="black", pch=26, lty=2, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
frmR.RCommand.SendLine('jpeg(filename = "' + strT + 'absiwresvsipred.1200.jpg", width = 1200, height = 1200,'
+ ' bg = "white", quality = 100)', True);
frmR.RCommand.SendLine('absval.iwres.vs.ipred(' + strObject + ', col="black", smcol="black", cex=0.5, main="")', True);
frmR.RCommand.SendLine('dev.off()', True);
finally
frmWait.Close;
Screen.Cursor := Curs;
end;
{ ParamString := 'BATCH ' + strWD + '/'
+ ExtractFileName(dlgSaveRtf.FileName) + '.plots/plots.R';
//ShowMessage('BATCH ' + strWD + '/'
// + ExtractFileName(dlgSaveRtf.FileName) + '.plots/plots.R');
StartInString := strT;
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
try
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(ExecuteFile);
lpParameters := PChar(ParamString);
lpDirectory := PChar(StartInString);
nShow := SW_SHOWMINIMIZED;
end;
if ShellExecuteEx(@SEInfo) then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
until
(ExitCode <> STILL_ACTIVE) or Application.Terminated;
end;
finally
frmWait.Close;
Screen.Cursor := Curs;
end; }
//ShellExecute(Handle, 'open', PChar(strRDir + '\bin\Rcmd.exe'), PChar('BATCH ' + strT + 'censusReport.R'), nil, SW_SHOW);
// add GOF plots
rtfOut.Add('<table border="0" cellpadding="2" cellspacing="2" width="620">');
rtfOut.Add(' <tbody>');
rtfOut.Add(' <tr>');
rtfOut.Add(' <td align="center" width="310">');
// + '<a href="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/dvvspred.1200.jpg"><img alt="DV vs PRED" '
// + 'src="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/dvvspred.300.jpg" border="0" height="300" width="300"></a>');
rtfOut.Add(' <<fig=T>>=');
rtfOut.Add(' print(dv.vs.pred(xptmp, col="black", smcol="black", pch=26, lty=2, main=""))' );
rtfOut.Add(' @');
rtfOut.Add(' </td>');
rtfOut.Add(' <td align="center" width="310">');
// + '<a href="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/dvvsipred.1200.jpg"><img alt="DV vs IPRED" '
// + 'src="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/dvvsipred.300.jpg" border="0" height="300" width="300"></a>');
rtfOut.Add(' <<fig=T>>=');
rtfOut.Add(' print(dv.vs.ipred(xptmp, col="black", smcol="black", pch=26, lty=2, main=""))' );
rtfOut.Add(' @');
rtfOut.Add(' </td>');
rtfOut.Add(' </tr>');
rtfOut.Add(' <tr>');
rtfOut.Add(' <td align="center" width="310">' );
// + '<a href="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/wresvsidv.1200.jpg"><img alt="WRES vs IDV" '
// + 'src="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/wresvsidv.300.jpg" border="0" height="300" width="300"></a>');
rtfOut.Add(' <<fig=T>>=');
rtfOut.Add(' print(wres.vs.idv(xptmp, col="black", smcol="black", pch=26, lty=2, main=""))' );
rtfOut.Add(' @');
rtfOut.Add(' </td>');
rtfOut.Add(' <td align="center" width="310">' );
// + '<a href="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/absiwresvsipred.1200.jpg"><img alt="abs(IWRES) vs IPRED" '
// + 'src="' + StringReplace(ExtractFileName(dlgSaveRtf.FileName), ' ', '%20', [rfReplaceAll])
// + '.plots/absiwresvsipred.300.jpg" border="0" height="300" width="300"></a>');
rtfOut.Add(' <<fig=T>>=');
rtfOut.Add(' print(absval.iwres.vs.ipred(xptmp, col="black", smcol="black", cex=0.5, main=""))' );
rtfOut.Add(' @');
rtfOut.Add(' </td>');
rtfOut.Add(' </tr>');
rtfOut.Add(' </tbody>');
rtfOut.Add('</table>');
except
;
end;
end
else
begin
rtfOut.Add(StringReplace(rtfIn[n], '~gofplots~', 'Xpose plots are not available.', [rfReplaceAll, rfIgnoreCase]));
end;
end
else
begin
rtfOut.Add(StringReplace(rtfIn[n], '~gofplots~', 'No plot data (sdtab) available for goodness-of-fit plots.', [rfReplaceAll, rfIgnoreCase]));
end;
blnX := True;
end;
if Pos('~filename~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~filename~', ExtractFileName(frmNMRun.tblRunsCtl.Value), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~comment~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~comment~', frmNMRun.tblRunsComment.Value, [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~obs~', rtfIn[n]) > 0 then
begin
if IntToStr(frmNMRun.tblRunsObsRecs.Value) <> '0' then
rtfOut.Add(StringReplace(rtfIn[n], '~obs~', IntToStr(frmNMRun.tblRunsObsRecs.Value), [rfReplaceAll, rfIgnoreCase]))
else
rtfOut.Add(StringReplace(rtfIn[n], '~obs~', 'Not available', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~ind~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~ind~', IntToStr(frmNMRun.tblRunsIndividuals.Value), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~cond~', rtfIn[n]) > 0 then
begin
if FloatToStr(frmNMRun.tblRunsConditionNumber.Value) <> '0' then
rtfOut.Add(StringReplace(rtfIn[n], '~cond~', FloatToStr(frmNMRun.tblRunsConditionNumber.Value), [rfReplaceAll, rfIgnoreCase]))
else
rtfOut.Add(StringReplace(rtfIn[n], '~cond~', 'Not available', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~model_type~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~model_type~', frmNMRun.tblRunsModel.Value, [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~minimization~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~minimization~', frmNMRun.tblRunsMinShort.Value, [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~covariance~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~covariance~', frmNMRun.tblRunsCovStep.Value, [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~model~', rtfIn[n]) > 0 then
begin
//strT1 := '';
//strT2 := '';
blnX := True;
rtfTemp.LoadFromFile(frmNMRun.tblRunsCtl.Value);
//for m := 1 to Pos('~model~', rtfIn[n]) - 1 do
// strT1 := strT1 + rtfIn[n][m];
//for m := Pos('~model~', rtfIn[n]) + 7 to Length(rtfIn[n]) do
// strT2 := strT2 + rtfIn[n][m];
rtfOut.Add('<code>');
for m := 0 to rtfTemp.Count - 1 do
rtfOut.Add(StringReplace(rtfTemp[m], ' ', ' ', [rfReplaceAll]) + '<br>');
rtfOut.Add('</code>');
end;
if Pos('~theta~', rtfIn[n]) > 0 then
begin
blnX := True;
//strT1 := '';
//strT2 := '';
//for m := 1 to Pos('~theta~', rtfIn[n]) - 1 do
// strT1 := strT1 + rtfIn[n][m];
//for m := Pos('~theta~', rtfIn[n]) + 7 to Length(rtfIn[n]) do
// strT2 := strT2 + rtfIn[n][m];
//rtfOut.Add(strT1 + '\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3');
rtfOut.Add('<table border="0" cellpadding="2" cellspacing="2" width="100%">');
rtfOut.Add(' <tbody>');
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Theta</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Value</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">SE (RSE)</font></small></b></td>');
rtfOut.Add(' </tr>');
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Theta, ThetaLabel, ThetaValue, ThetaSE, ThetaRSE');
sqlParent.SQL.Add('FROM Thetas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Theta;');
sqlParent.Active := True;
sqlParent.First;
for m := 0 to sqlParent.RecordCount - 1 do
begin
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[1].AsString + ' (Th' + sqlParent.Fields[0].AsString + ')</font></small></td>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[2].AsString + '</font></small></td>');
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[3].AsString + ' (' + sqlParent.Fields[4].AsString + ')</font></small></td>')
else
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[3].AsString + '</font></small></td>');
rtfOut.Add(' </tr>');
{if m < sqlParent.RecordCount - 1 then
begin
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Th' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' ('
+ sqlParent.Fields[4].AsString
+ ')\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3')
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Th' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' '
+ sqlParent.Fields[4].AsString
+ '\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3');
end
else
begin
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Th' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' ('
+ sqlParent.Fields[4].AsString
+ ')\cell\row\pard\nowidctlpar\sb120' + strT2)
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Th' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' '
+ sqlParent.Fields[4].AsString
+ '\cell\row\pard\nowidctlpar\sb120' + strT2)
end; }
sqlParent.Next;
end;
rtfOut.Add(' </tbody>');
rtfOut.Add('</table>');
end;
if Pos('~omega~', rtfIn[n]) > 0 then
begin
blnX := True;
//strT1 := '';
//strT2 := '';
//for m := 1 to Pos('~omega~', rtfIn[n]) - 1 do
// strT1 := strT1 + rtfIn[n][m];
//for m := Pos('~omega~', rtfIn[n]) + 7 to Length(rtfIn[n]) do
// strT2 := strT2 + rtfIn[n][m];
rtfOut.Add('<table border="0" cellpadding="2" cellspacing="2" width="100%">');
rtfOut.Add(' <tbody>');
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Eta</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Value</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">SE (RSE)</font></small></b></td>');
rtfOut.Add(' </tr>');
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Eta, EtaLabel, EtaValue, EtaSE, EtaRSE');
sqlParent.SQL.Add('FROM Etas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Eta;');
sqlParent.Active := True;
sqlParent.First;
for m := 0 to sqlParent.RecordCount - 1 do
begin
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[1].AsString + ' (Eta' + sqlParent.Fields[0].AsString + ')</font></small></td>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[2].AsString + '</font></small></td>');
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[3].AsString + ' (' + sqlParent.Fields[4].AsString + ')</font></small></td>')
else
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[3].AsString + '</font></small></td>');
rtfOut.Add(' </tr>');
//rtfOut.Add(strT1 + '\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3');
{ for m := 0 to sqlParent.RecordCount - 1 do
begin
if m < sqlParent.RecordCount - 1 then
begin
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Eta' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' ('
+ sqlParent.Fields[4].AsString
+ ')\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3')
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Eta' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' '
+ sqlParent.Fields[4].AsString
+ '\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3')
end
else
begin
if Length(Trim(sqlParent.Fields[3].AsString)) > 0 then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Eta' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' ('
+ sqlParent.Fields[4].AsString
+ ')\cell\row\pard\nowidctlpar\sb120' + strT2)
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ sqlParent.Fields[1].AsString + ' (Eta' + sqlParent.Fields[0].AsString + ')\cell '
+ sqlParent.Fields[2].AsString
+ '\cell ' + sqlParent.Fields[3].AsString + ' '
+ sqlParent.Fields[4].AsString
+ '\cell\row\pard\nowidctlpar\sb120' + strT2);
end; }
sqlParent.Next;
end;
rtfOut.Add(' </tbody>');
rtfOut.Add('</table>');
end;
if Pos('~sigma~', rtfIn[n]) > 0 then
begin
blnX := True;
//strT1 := '';
//strT2 := '';
//for m := 1 to Pos('~sigma~', rtfIn[n]) - 1 do
// strT1 := strT1 + rtfIn[n][m];
//for m := Pos('~sigma~', rtfIn[n]) + 7 to Length(rtfIn[n]) do
// strT2 := strT2 + rtfIn[n][m];
//rtfOut.Add(strT1 + '\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3');
rtfOut.Add('<table border="0" cellpadding="2" cellspacing="2" width="100%">');
rtfOut.Add(' <tbody>');
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Epsilon</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">Value</font></small></b></td>');
rtfOut.Add(' <td width="33%"><b><small><font face="Helvetica, Arial, sans-serif">SE (RSE)</font></small></b></td>');
rtfOut.Add(' </tr>');
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Sigma, SigmaValue, SigmaSE, SigmaRSE');
sqlParent.SQL.Add('FROM Sigmas');
sqlParent.SQL.Add('WHERE RunNo = ''' + tblRunsRunNo.Value + '''');
sqlParent.SQL.Add('ORDER BY Sigma;');
sqlParent.Active := True;
sqlParent.First;
for m := 0 to sqlParent.RecordCount - 1 do
begin
rtfOut.Add(' <tr>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
'Eps' + sqlParent.Fields[0].AsString + '</font></small></td>');
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[1].AsString + '</font></small></td>');
if (Length(Trim(sqlParent.Fields[3].AsString)) > 0) and
(Trim(sqlParent.Fields[2].AsString) <> '0') then
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[2].AsString + ' (' + sqlParent.Fields[3].AsString + ')</font></small></td>')
else
rtfOut.Add(' <td width="33%"><small><font face="Helvetica, Arial, sans-serif">' +
sqlParent.Fields[2].AsString + '</font></small></td>');
rtfOut.Add(' </tr>');
{for m := 0 to sqlParent.RecordCount - 1 do
begin
if m < sqlParent.RecordCount - 1 then
begin
if (Length(Trim(sqlParent.Fields[3].AsString)) > 0) and
(Trim(sqlParent.Fields[2].AsString) <> '0') then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ 'Eps' + sqlParent.Fields[0].AsString + '\cell '
+ sqlParent.Fields[1].AsString
+ '\cell ' + sqlParent.Fields[2].AsString + ' ('
+ sqlParent.Fields[3].AsString
+ ')\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3')
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ 'Eps' + sqlParent.Fields[0].AsString + '\cell '
+ sqlParent.Fields[1].AsString
+ '\cell ' + sqlParent.Fields[2].AsString + ' '
+ sqlParent.Fields[3].AsString
+ '\cell\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3')
end
else
begin
if (Length(Trim(sqlParent.Fields[3].AsString)) > 0) and
(Trim(sqlParent.Fields[2].AsString) <> '0') then
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ 'Eps' + sqlParent.Fields[0].AsString + '\cell '
+ sqlParent.Fields[1].AsString
+ '\cell ' + sqlParent.Fields[2].AsString + ' ('
+ sqlParent.Fields[3].AsString
+ ')\cell\row\pard\nowidctlpar\sb120' + strT2)
else
rtfOut.Add('\cellx2844\cellx5796\cellx8748\pard\intbl\nowidctlpar\sb120\ '
+ 'Eps' + sqlParent.Fields[0].AsString + '\cell '
+ sqlParent.Fields[1].AsString
+ '\cell ' + sqlParent.Fields[2].AsString + ' '
+ sqlParent.Fields[3].AsString
+ '\cell\row\pard\nowidctlpar\sb120' + strT2);
end; }
sqlParent.Next;
end;
rtfOut.Add(' </tbody>');
rtfOut.Add('</table>');
sqlParent.Active := False;
end;
if Pos('~warnings~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~warnings~', frmNMRun.tblRunsWarnings.Value, [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~ofv~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~ofv~', FloatToStr(frmNMRun.tblRunsObj.Value), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~fn_eval~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~fn_eval~', IntToStr(frmNMRun.tblRunsFnEvals.Value), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~sig_digits~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~sig_digits~', FloatToStr(frmNMRun.tblRunsSigDigits.AsFloat), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~timestamp~', rtfIn[n]) > 0 then
begin
rtfOut.Add(StringReplace(rtfIn[n], '~timestamp~', DateTimeToStr(Now), [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~cov_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsCovMatrix, rtfOut, '~cov_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~cov_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~inv_cov_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsInvCovMatrix, rtfOut, '~inv_cov_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~inv_cov_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~correlation_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsCorrMatrix, rtfOut, '~correlation_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~correlation_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~omega_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsOmegaMatrix, rtfOut, '~omega_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~omega_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~sigma_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsSigmaMatrix, rtfOut, '~sigma_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~sigma_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~omega_se_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsOmegaSEMatrix, rtfOut, '~omega_se_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~omega_se_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if Pos('~sigma_se_matrix~', rtfIn[n]) > 0 then
begin
//InsertMatrix(frmNMRun.tblRunsSigmaSEMatrix, rtfOut, '~sigma_se_matrix~', rtfIn[n]);
rtfOut.Add(StringReplace(rtfIn[n], '~sigma_se_matrix~', 'Support coming in a future release!', [rfReplaceAll, rfIgnoreCase]));
blnX := True;
end;
if blnX = False then
rtfOut.Add(rtfIn[n]);
end;
finally
rtfOut.SaveToFile(dlgSaveRtf.FileName);
tblTrans.InsertRecord([Null, 'run report', frmNMRun.tblRunsRunNo.Value, Now, txtUser]);
rtfOut.Free;
rtfIn.Free;
rtfTemp.Free;
frmNMRun.tblThetas.First;
frmNMRun.tblEtas.First;
frmNMRun.tblSigmas.First;
{if ShellExecute(frmNMRun.Handle, nil,
PChar(dlgSaveRtf.FileName), nil, nil, SW_SHOW) <= 32 then
Application.MessageBox('Couldn''t display the report!',
'Error', MB_ICONEXCLAMATION); }
ShellExecute(frmNMRun.Handle, nil,
PChar(dlgSaveRtf.FileName), nil, nil, SW_SHOW);
end;
end;
procedure TfrmNMRun.tblRunsCalcFields(DataSet: TDataSet);
begin
tblRunsLookupTitle.Value := tblRunsRunNo.Value + ' - ' +
tblRunsComment.Value;
end;
procedure TfrmNMRun.tblSigmasCalcFields(DataSet: TDataSet);
begin
if tblSigmasSigmaValue.Value > 0 then
tblSigmasSigmaCV.Value := Round(sqrt(tblSigmasSigmaValue.Value)*1000)/10;
end;
procedure TfrmNMRun.vstMainClick(Sender: TObject);
var
RunRecord: PRunRec;
begin
if vstMain.RootNodeCount > 0 then
if vstMain.SelectedCount > 0 then
begin
RunRecord := vstMain.GetNodeData(vstMain.GetFirstSelected);
with tblRuns do
begin
//Filtered := True;
//Filter := 'RunNo = ' + #39 + RunRecord.RunNo + #39;
tblRuns.IndexName := 'runno2';
tblRuns.Refresh;
tblRuns.FindKey([RunRecord.RunNo]);
tblRuns.IndexName := 'irunno';
tblRuns.Refresh;
end;
end;
Application.ProcessMessages;
if pgcMain.ActivePage = tabOmega then
begin
if nbOmega.PageIndex = 1 then
LoadMatrix(tblRunsOmegaInitMatrix, grdOmInit);
if nbOmega.PageIndex = 2 then
LoadMatrix(tblRunsOmegaMatrix, grdOmMatrix);
if nbOmega.PageIndex = 3 then
LoadMatrix(tblRunsOmegaSEMatrix, grdOmSE);
end;
if pgcMain.ActivePage = tabMatrices then
begin
if nbMatrices.PageIndex = 0 then
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
if nbMatrices.PageIndex = 1 then
LoadMatrix(tblRunsCorrMatrix, grdCorrMatrix);
if nbMatrices.PageIndex = 2 then
LoadMatrix(tblRunsInvCovMatrix, grdInvCovMatrix);
if nbMatrices.PageIndex = 3 then
LoadMatrix(tblRunsEigenvalues, grdEigenvalues);
end;
end;
procedure TfrmNMRun.vstMainDblClick(Sender: TObject);
begin
if nmDatabase.Connected then
begin
if not Assigned(frmEdit) then
frmEdit := TfrmEdit.Create(Application);
frmEdit.ShowModal;
if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
end;
end;
procedure TfrmNMRun.vstMainDragAllowed(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := Node <> Sender.GetFirst;
end;
procedure TfrmNMRun.vstMainDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
AttachMode: TVTNodeAttachMode;
i: integer;
RunRecord: PRunRec;
begin
if Sender.DropTargetNode = Sender.GetFirst then
Exit;
for i := Low(Formats) to High(Formats) do
begin
if Formats[i] = CF_VIRTUALTREE then
begin
case Mode of
dmAbove: AttachMode := amInsertBefore;
dmOnNode:
begin
AttachMode := amAddChildLast;
Include(Sender.DropTargetNode.States, vsExpanded);
end;
dmBelow: AttachMode := amInsertAfter;
else
if Assigned(Source) and (Source is TBaseVirtualTree) and
(Sender <> Source) then
AttachMode := amInsertBefore
else
AttachMode := amNowhere;
end;
// This line actually process all actions we prepared.
Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect,
Attachmode);
// Update data
if vstMain.GetNodeLevel(vstMain.FocusedNode) <> 0 then
begin
RunRecord := Sender.GetNodeData(vstMain.FocusedNode.Parent);
// ShowMessage(RunRecord.RunNo);
tblRuns.Edit;
if Length(RunRecord.RunNo) > 0 then
begin
tblRunsParentNo.Value := RunRecord.RunNo;
tblRunsdOFV.Value := RoundD(tblRunsObj.Value - StrToFloat(RunRecord.OFV), 3);
end
else
tblRunsParentNo.Clear;
tblRuns.Post;
end
else
begin
tblRuns.Edit;
tblRunsParentNo.Clear;
tblRunsdOFV.Clear;
tblRuns.Post;
end;
RefreshTree;
end;
end;
end;
procedure TfrmNMRun.vstMainDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
begin
if Sender.DropTargetNode = Sender.GetFirst then
Accept := false
else Accept := true;
end;
procedure TfrmNMRun.vstMainFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
RunRecord: PRunRec;
begin
RunRecord := Sender.GetNodeData(Node);
if Assigned(RunRecord) then
Finalize(RunRecord^);
end;
procedure TfrmNMRun.vstMainGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
RunRecord: PRunRec;
begin
RunRecord := Sender.GetNodeData(Node);
if (Column = 1) then
if RunRecord.Key then
ImageIndex := 17
else
ImageIndex := -1;
end;
procedure TfrmNMRun.vstMainGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var
RunRecord: PRunRec;
begin
RunRecord := Sender.GetNodeData(Node);
case Column of
0: CellText := RunRecord.RunNo;
1: CellText := '';
2: CellText := RunRecord.Lbl;
3: CellText := RunRecord.OFV;
4: CellText := RunRecord.dOFV;
5: CellText := RunRecord.MinShort;
6: CellText := RunRecord.CondNo;
7: CellText := RunRecord.Warnings;
8: CellText := RunRecord.EstTime;
9: CellText := RunRecord.CovTime;
10: CellText := RunRecord.SigDigits;
11: CellText := RunRecord.Inds;
12: CellText := RunRecord.Observations;
13: CellText := RunRecord.FnEvals;
14: CellText := RunRecord.Description;
15: CellText := ExtractFileName(RunRecord.Data);
16: CellText := RunRecord.StructuralModel;
17: CellText := RunRecord.CovariateModel;
18: CellText := RunRecord.IIV;
19: CellText := RunRecord.IOV;
20: CellText := RunRecord.RV;
21: CellText := RunRecord.Estimation;
end;
if Column > 21 then
CellText := '';
if (Length(RunRecord.Lbl) = 0) and (Column = 2) then
CellText := RunRecord.Problem;
//ShowMessage(Pad(RunRecord.iRunNo));
//ShowMessage(Runrecord.Data);
end;
function TfrmNMRun.Pad(RunNo: string): WideString;
var
strResult: WideString;
intLength, n: Integer;
begin
strResult := RunNo;
intLength := Length(strResult);
for n := 1 to (15 - intLength) do
strResult := '0' + strResult;
Result := strResult;
end;
procedure TfrmNMRun.vstMainInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
RunRecord: PRunRec;
begin
RunRecord := Sender.GetNodeData(Node);
Initialize(RunRecord^);
RunRecord.RunNo := tblRunsRunNo.Value;
RunRecord.Problem := tblRunsComment.Value;
RunRecord.Lbl := tblRunsLabel.Value;
RunRecord.OFV := tblRunsObj.AsWideString;
RunRecord.dOFV := tblRunsdOFV.AsWideString;
RunRecord.CondNo := tblRunsConditionNumber.AsWideString;
RunRecord.Inds := tblRunsIndividuals.AsWideString;
RunRecord.MinShort := tblRunsMinShort.Value;
RunRecord.FnEvals := tblRunsFnEvals.AsWideString;
RunRecord.SigDigits := tblRunsSigDigits.AsWideString;
RunRecord.Observations := tblRunsObsRecs.AsWideString;
RunRecord.Description := tblRunsDescription.AsWideString;
RunRecord.Parent := tblRunsParentNo.AsWideString;
RunRecord.Key := tblRunsKeyRun.Value;
RunRecord.Warnings := tblRunsWarnings.Value;
RunRecord.iRunNo := Pad(tblRunsiRunNo.AsWideString);
RunRecord.Data := tblRunsData.Value;
RunRecord.EstTime := tblRunsEstTime.AsWideString;
RunRecord.CovTime := tblRunsCovTime.AsWideString;
RunRecord.StructuralModel := tblRunsStructuralModel.AsWideString;
RunRecord.CovariateModel := tblRunsCovariateModel.AsWideString;
RunRecord.IIV := tblRunsIIV.AsWideString;
RunRecord.IOV := tblRunsIOV.AsWideString;
RunRecord.RV := tblRunsRV.AsWideString;
RunRecord.Estimation := tblRunsEstimation.AsWideString;
//ShowMessage(RunRecord.iRunNo);
if Length(RunRecord.Parent) > 0 then
begin
strSrc.Strings.Add(RunRecord.RunNo);
strDest.Strings.Add(RunRecord.Parent);
end;
if not tblRuns.Eof then
tblRuns.Next;
end;
procedure TfrmNMRun.vstMainKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
RunRecord: PRunRec;
begin
if vstMain.RootNodeCount > 0 then
if vstMain.SelectedCount > 0 then
begin
RunRecord := vstMain.GetNodeData(vstMain.GetFirstSelected);
with tblRuns do
begin
//Filtered := True;
//Filter := 'RunNo = ' + #39 + RunRecord.RunNo + #39;
tblRuns.IndexName := 'runno2';
tblRuns.Refresh;
tblRuns.FindKey([RunRecord.RunNo]);
tblRuns.IndexName := 'irunno';
tblRuns.Refresh;
end;
Application.ProcessMessages;
if pgcMain.ActivePage = tabOmega then
begin
if nbOmega.PageIndex = 1 then
LoadMatrix(tblRunsOmegaInitMatrix, grdOmInit);
if nbOmega.PageIndex = 2 then
LoadMatrix(tblRunsOmegaMatrix, grdOmMatrix);
if nbOmega.PageIndex = 3 then
LoadMatrix(tblRunsOmegaSEMatrix, grdOmSE);
end;
if pgcMain.ActivePage = tabMatrices then
begin
if nbMatrices.PageIndex = 0 then
LoadMatrix(tblRunsCovMatrix, grdCovMatrix);
if nbMatrices.PageIndex = 1 then
LoadMatrix(tblRunsCorrMatrix, grdCorrMatrix);
if nbMatrices.PageIndex = 2 then
LoadMatrix(tblRunsInvCovMatrix, grdInvCovMatrix);
if nbMatrices.PageIndex = 3 then
LoadMatrix(tblRunsEigenvalues, grdEigenvalues);
end;
end;
end;
procedure TfrmNMRun.vstMainPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
RunRecord: PRunRec;
begin
RunRecord := Sender.GetNodeData(Node);
if Column = 5 then
begin
if RunRecord.MinShort = 'Terminated' then
TargetCanvas.Font.Color := clRed;
if RunRecord.MinShort = 'Successful' then
TargetCanvas.Font.Color := clGreen;
end;
if Column = 6 then
if Length(RunRecord.CondNo) > 0 then
if StrToFloat(RunRecord.CondNo) > 1000 then
TargetCanvas.Font.Color := clRed;
if Column = 10 then
if RunRecord.SigDigits = 'Unreportable' then
TargetCanvas.Font.Color := clRed;
end;
procedure TfrmNMRun.InsertMatrix(DataField: TMemoField; RTF: TStrings;
strMarker, strMain: string);
var
lstMatrix: TStrings;
strmData: TMemoryStream;
n, m, p, intCell, intSpacer, intTotal: Integer;
strT, strT1, strT2, strHead: string;
begin
if DataField.BlobSize > 0 then
begin
brkUpp.AllowEmptyString := True;
strmData := TMemoryStream.Create;
lstMatrix := TStringList.Create;
DataField.SaveToStream(strmData);
strmData.Position := 0;
lstMatrix.LoadFromStream(strmData);
strmData.Free;
for p := 1 to Pos(strMarker, strMain) - 1 do
strT1 := strT1 + strMain[p];
for p := Pos(strMarker, strMain) + Length(strMarker) to Length(strMain) do
strT2 := strT2 + strMain[p];
intCell := 589;
intSpacer := 108;
intTotal := 0;
strHead := '';
// intCtr := 0;
for p := 0 to brkUpp.StringList.Count - 1 do
begin
if p > 0 then
intTotal := intTotal + intCell + (2 * intSpacer)
else
intTotal := intTotal + intCell + intSpacer;
strHead := strHead + '\cellx' + IntToStr(intTotal);
end;
strHead := strHead + '\pard\intbl\sb120\lang1033\b0\fs16';
for n := 0 to lstMatrix.Count - 1 do
begin
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrix[n];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
strT1 := '';
strT2 := '';
strT := '';
{for m := 0 to brkUpp.StringList.Count - 1 do
begin
intCtr := lstMatrix.Count - m - 1;
end; }
for m := 0 to brkUpp.StringList.Count - 1 do
begin
strT := strT + strHead;
for p := 0 to brkUpp.StringList.Count - 1 do
strT := strT + brkUpp.StringList[p] + '\cell ';
if n < lstMatrix.Count - 1 then
strT := strT + '\row\trowd\trgaph108\trleft-108\trpaddl108\trpaddr108\trpaddfl3\trpaddfr3'
else
strT := strT + '\row\pard\nowidctlpar\sb120\lang2057\fs20';
end;
if n = lstMatrix.Count - 1 then
strT := strT + strT2;
RTF.Add(strT);
strT := '';
end;
lstMatrix.Free;
end;
//RTF.Add('Support coming in a later release!');
end;
function TfrmNMRun.ContainsChar(strIn: string): Boolean;
var
x: integer;
b: Boolean;
begin
b := False;
for x := 1 to Length(strIn) do
if not (StrIn[x] in ['E', 'e', '-', '+', '.', '0'..'9']) then
b := True;
result := b;
end;
// ********************************************************************
// Xpose
// ********************************************************************
{procedure TfrmNMRun.RunXpose(strPlot: string);
var
strWD, strRunNo, strXpose, strObject, strOut: string;
blnDBExists: Boolean;
memOutput: TStrings;
begin
blnDBExists := False;
if XposeReleased then
begin
if (Length(tblRunssdtab.Value) <= 1) or (FileExists(tblRunssdtab.Value) = False) then
begin
MessageDlg('No standard table file located for this run. For Xpose ' +
'functionality to be enabled, at least one Xpose-format table file (sdtab' +
tblRunsRunNo.Value + ') must be available.', mtWarning, [mbOK], 0);
Exit;
end;
// get working directory
strWD := ExtractFilePath(tblRunssdtab.Value);
strWD := StringReplace(strWD, '\', '/', [rfReplaceAll]);
strWD := Copy(strWD, 1, Length(strWD) - 1);
memOutput := TStringList.Create;
// Add all necessary crap
memOutput.Add('library(lattice)');
memOutput.Add('attach("C:/Documents and Settings/justin/My Documents/xpose/xpose4/xpose4/xpose4data/.RData")');
memOutput.Add('attach("C:/Documents and Settings/justin/My Documents/xpose/xpose4/xpose4/xpose4generic/.RData")');
memOutput.Add('attach("C:/Documents and Settings/justin/My Documents/xpose/xpose4/xpose4/xpose4specific/.RData")');
// get number for import
strRunNo := tblRunsRunNo.Value;
// check if exists
strXpose := 'exists(paste("xpdb", ' + strRunNo + ', sep=""))';
try
blnDBExists := StatConnector1.Evaluate(strXpose);
except
MessageDlg('Xpose: Error testing for existence of data object!' + #10#13#10#13 +
strXpose, mtError, [mbOK], 0);
dlgLog.Lines.Assign(memOutput);
dlgLog.Execute;
Exit;
end;
strObject := 'xpdb' + strRunNo;
// set up
memOutput.Add('setwd("' + strWD + '")');
try
StatConnector1.EvaluateNoReturn('setwd("' + strWD + '")');
except
MessageDlg('Xpose: Error changing to new working directory!' + #10#13#10#13 +
'setwd("' + strWD + '")', mtError, [mbOK], 0);
dlgLog.Lines.Assign(memOutput);
dlgLog.Execute;
Exit;
end;
if blnDBExists = False then
begin
strXpose := strObject + ' <- xpose.data(' + strRunNo + ')';
memOutput.Add('createXposeClasses()');
memOutput.Add(strXpose);
try
StatConnector1.EvaluateNoReturn(strXpose);
except
MessageDlg('Xpose: Error importing data!' + #10#13#10#13 +
strXpose, mtError, [mbOK], 0);
dlgLog.Lines.Assign(memOutput);
dlgLog.Execute;
Exit;
end;
end;
// execute
strXpose := strPlot + '(' + strObject + ')';
memOutput.Add(strXpose);
try
StatConnector1.EvaluateNoReturn(strXpose);
except
MessageDlg('Xpose: Error executing Xpose function!' + #10#13#10#13 +
strXpose, mtError, [mbOK], 0);
dlgLog.Lines.Assign(memOutput);
dlgLog.Execute;
memOutput.SaveToFile(ExtractFilePath(Application.ExeName) + 'go.R');
RunProg('R CMD BATCH go.R', ExtractFilePath(Application.ExeName));
Exit;
end;
memOutput.SaveToFile(ExtractFilePath(Application.ExeName) + 'go.R');
//RunProg('R CMD BATCH go.R', ExtractFilePath(Application.ExeName));
memOutput.Free;
end
else
begin
MessageDlg('Xpose 4 has not yet been released.',
mtInformation, [mbOK], 0);
end;
end;
procedure TfrmNMRun.Basicgoodnessoffitplots1Click(Sender: TObject);
begin
RunXpose('basic.gof');
end;
procedure TfrmNMRun.DVvsPRED1Click(Sender: TObject);
begin
RunXpose('dv.vs.pred.ipred');
end;
procedure TfrmNMRun.PREDvsIDV1Click(Sender: TObject);
begin
RunXpose('dv.preds.vs.idv');
end;
procedure TfrmNMRun.Individualplots3Click(Sender: TObject);
begin
RunXpose('ind.plots');
end; }
procedure TfrmNMRun.NotImplemented;
begin
MessageDlg('PsN features are not yet implemented.',
mtInformation, [mbOK], 0);
end;
{procedure TfrmNMRun.Prepare1Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.InterpretResults1Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.Prepare4Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.InterpretResults4Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.Prepare2Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.InterpretResults2Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.Prepare3Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.InterpretResults3Click(Sender: TObject);
begin
NotImplemented;
end;
procedure TfrmNMRun.Wizard1Click(Sender: TObject);
begin
if XposeReleased then
begin
;
end
else
begin
MessageDlg('Xpose 4 has not yet been released.',
mtInformation, [mbOK], 0);
end;
end;
procedure TfrmNMRun.PREDvsDVIDV1Click(Sender: TObject);
begin
RunXpose('pred.vs.dv.by.idv');
end;
procedure TfrmNMRun.IPREDvsDVIDV1Click(Sender: TObject);
begin
RunXpose('ipred.vs.dv.by.idv');
end;
procedure TfrmNMRun.WRESvsIDV1Click(Sender: TObject);
begin
RunXpose('wres.vs.idv');
end;
procedure TfrmNMRun.WRESvsIDVBW1Click(Sender: TObject);
begin
RunXpose('wres.vs.idv.bw');
end;
procedure TfrmNMRun.WRESvsPRED1Click(Sender: TObject);
begin
RunXpose('wres.vs.pred');
end;
procedure TfrmNMRun.WRESvsPREDbw1Click(Sender: TObject);
begin
RunXpose('wres.vs.pred.bw');
end;
procedure TfrmNMRun.PREDvsDVCovariates1Click(Sender: TObject);
begin
RunXpose('pred.vs.dv.by.cov');
end;
procedure TfrmNMRun.IPREDvsDVCovariates1Click(Sender: TObject);
begin
RunXpose('ipred.vs.dv.by.cov');
end;
procedure TfrmNMRun.DistributionofWRES1Click(Sender: TObject);
begin
RunXpose('distr.wres');
end;
procedure TfrmNMRun.IndividualdistributionsofWRES1Click(Sender: TObject);
begin
RunXpose('ind.distr.wres');
end;
procedure TfrmNMRun.WRESvsPRED2Click(Sender: TObject);
begin
RunXpose('abs.res.vs.pred');
end;
procedure TfrmNMRun.CovariatesvsWRES1Click(Sender: TObject);
begin
RunXpose('cov.vs.wres');
end;
procedure TfrmNMRun.WRESvsPREDCovariates1Click(Sender: TObject);
begin
RunXpose('wres.vs.pred.by.cov');
end;
procedure TfrmNMRun.IWRESvsIPREDCovariates1Click(Sender: TObject);
begin
RunXpose('iwres.vs.ipred.by.cov');
end; }
procedure TfrmNMRun.Keyrun1Click(Sender: TObject);
begin
if tblRuns.Active then
begin
tblRuns.Edit;
if tblRunsKeyRun.Value = True then
tblRunsKeyRun.Value := False
else
tblRunsKeyRun.Value := True;
tblRuns.Post;
if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
end;
end;
procedure TfrmNMRun.Keyruns1Click(Sender: TObject);
begin
MessageDlg('Not yet implemented!', mtInformation, [mbOK], 0);
end;
{procedure TfrmNMRun.AutocorrelationofWRES1Click(Sender: TObject);
begin
RunXpose('wres.autocorrelation');
end;
procedure TfrmNMRun.Numericallysummarizetheparameters1Click(
Sender: TObject);
begin
RunXpose('num.sum');
end;
procedure TfrmNMRun.DistributionofparametersQQplots1Click(Sender: TObject);
begin
RunXpose('distr.params.qq');
end;
procedure TfrmNMRun.Distributionofparametershistograms1Click(
Sender: TObject);
begin
RunXpose('distr.params.hist');
end;
procedure TfrmNMRun.Scatterplotmatrixofparameters1Click(Sender: TObject);
begin
RunXpose('splom.params');
end;
procedure TfrmNMRun.Parametervsparameter1Click(Sender: TObject);
begin
RunXpose('param.vs.param');
end;
procedure TfrmNMRun.Randomeffectsvstypicalparametervalues1Click(
Sender: TObject);
begin
RunXpose('rnd.vs.tv');
end;
procedure TfrmNMRun.Parametersvscovariates1Click(Sender: TObject);
begin
RunXpose('param.vs.cov');
end;
procedure TfrmNMRun.Parametersvscovariatesmodelprediction1Click(
Sender: TObject);
begin
RunXpose('param.vs.cov.inc.pred');
end;
procedure TfrmNMRun.WRESvscovariates1Click(Sender: TObject);
begin
RunXpose('wres.vs.cov');
end;
procedure TfrmNMRun.GAM1Click(Sender: TObject);
begin
RunXpose('gam');
end;
procedure TfrmNMRun.BootstrapoftheGAM1Click(Sender: TObject);
begin
RunXpose('bs.gam');
end;
procedure TfrmNMRun.ree1Click(Sender: TObject);
begin
RunXpose('tree');
end;
procedure TfrmNMRun.Basicmodelcomparisons1Click(Sender: TObject);
begin
RunXpose('basic.comparison');
end;
procedure TfrmNMRun.Additionalmodelcomparisons1Click(Sender: TObject);
begin
RunXpose('additional.comparison');
end;
procedure TfrmNMRun.DeltaPREDIPREDWRESvscovariates1Click(Sender: TObject);
begin
RunXpose('delta.pred.ipred.wres.vs.cov');
end; }
function TfrmNMRun.GetLoginName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetUserName(buffer, size) then
Result := buffer
else
Result := 'Unknown';
end;
function TfrmNMRun.GetTempDirectory: string;
var
tempFolder: array[0..MAX_PATH] of Char;
begin
GetTempPath(MAX_PATH, @tempFolder);
result := StrPas(tempFolder);
end;
// Convert Bitmap to RTF Code
function TfrmNMRun.BitmapToRTF(pict: TBitmap): string;
// by D3k
var
bi, bb, rtf: string;
bis, bbs: Cardinal;
achar: ShortString;
hexpict: string;
I: Integer;
begin
GetDIBSizes(pict.Handle, bis, bbs);
SetLength(bi, bis);
SetLength(bb, bbs);
GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
//rtf := '{\rtf1 {\pict\dibitmap ';
rtf := '';
SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
I := 2;
for bis := 1 to Length(bi) do
begin
achar := Format('%x', [Integer(bi[bis])]);
if Length(achar) = 1 then
achar := '0' + achar;
hexpict[I - 1] := achar[1];
hexpict[I] := achar[2];
Inc(I, 2);
end;
for bbs := 1 to Length(bb) do
begin
achar := Format('%x', [Integer(bb[bbs])]);
if Length(achar) = 1 then
achar := '0' + achar;
hexpict[I - 1] := achar[1];
hexpict[I] := achar[2];
Inc(I, 2);
end;
rtf := rtf + hexpict; // + ' }}';
Result := rtf;
end;
function TfrmNMRun.ShortDir(Dir: string): string;
var
SearchRec: TSearchRec;
Ok: Integer;
Ind: Integer;
Name: string;
TmpDir: string;
DirDst: string;
begin
if Copy(Dir, Length(Dir), 1) = '\' then
Dir := Copy(Dir, 1, Length(Dir) - 1);
TmpDir := Dir;
while Length(TmpDir) > 3 do begin
Ok := FindFirst(TmpDir, faDirectory, SearchRec);
FindClose(SearchRec);
if Ok = 0 then begin
if SearchRec.FindData.cAlternateFileName[0] = #0 then begin
Name := SearchRec.Name;
end else begin
Ind := 0;
Name := '';
while Ind < 14 do begin
if (SearchRec.FindData.cAlternateFileName[Ind] = #0) then
Ind := 14
else
Name := Name +
SearchRec.FindData.cAlternateFileName[Ind];
Inc(Ind);
end;
end;
DirDst := Name + '\' + DirDst;
end;
TmpDir := ExtractFileDir(TmpDir);
end;
DirDst := TmpDir + DirDst;
if Copy(DirDst, Length(DirDst), 1) = '\' then
DirDst := Copy(DirDst, 1, Length(DirDst) - 1);
Result := DirDst;
end;
function TfrmNMRun.GetSpecialFolderPath(folder : integer) : string;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0..MAX_PATH] of char;
begin
if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then
Result := path
else
Result := '';
end;
function TfrmNMRun.IsStrANumber(const S: string): Boolean;
var
P: PChar;
begin
P := PChar(S);
Result := False;
while P^ <> #0 do
begin
if not (P^ in ['0'..'9']) then Exit;
Inc(P);
end;
Result := True;
end;
function TfrmNMRun.IsStrAFloat(const S: string): Boolean;
begin
Result := True;
try
StrToFloat(S);
except
Result := False;
end;
end;
function TfrmNMRun.MD5(const fileName: string) : string;
var
idmd5 : TIdHashMessageDigest5;
fs : TFileStream;
hash : T4x4LongWordRecord;
Cursor: TCursor;
begin
if FileExists(fileName) then
begin
Cursor := Screen.Cursor;
Screen.Cursor := crHourglass;
if not Assigned(frmMD5) then
frmMD5 := TfrmMD5.Create(Application);
frmMD5.lblFile.Caption := ExtractFileName(fileName);
frmMD5.Show;
Application.ProcessMessages;
idmd5 := TIdHashMessageDigest5.Create;
fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite) ;
try
result := idmd5.HashStreamAsHex(fs) ;
finally
fs.Free;
idmd5.Free;
frmMD5.Close;
Screen.Cursor := Cursor;
end;
end
else
begin
MessageDlg(fileName + ' does not seem to exist. No MD5 fingerprint has ' +
'been captured.', mtWarning, [mbOK], 0);
result := '';
end;
end;
procedure TfrmNMRun.GoR;
var
RegIni: TRegIniFile;
lstIni: TStringList;
blnXpose, blnR: Boolean;
strTemp, strXposeVer, strXposeDate, strRVer, strRDir: string;
begin
if FileExists(nmDatabase.AliasName + '\census.ini') then
begin
lstIni := TStringList.Create;
lstIni.LoadFromFile(nmDatabase.AliasName + '\census.ini');
strTemp := StringReplace(Trim(lstIni.Text), 'WorkingDirectory=', '', []);
if DirectoryExists(strTemp) then
dlgOpen.InitialDir := strTemp;
lstIni.Free;
end;
RestartR1.Enabled := True;
// Start R process
if not Assigned(frmR) then
frmR := TfrmR.Create(Application);
if btnR.Down then
begin
frmR.Show;
SetFocus;
end;
frmR.memR.Lines.Clear;
frmR.RCommand.Stop;
// Is R available? If so, start DosCommand process
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
blnXpose := RegIni.ReadBool('Options', 'XposeInstalled', False);
strXposeVer := RegIni.ReadString('Options', 'XposeVersion', '');
strXposeDate := RegIni.ReadString('Options', 'XposeDate', '');
blnR := RegIni.ReadBool('Options', 'RInstalled', False);
strRVer := RegIni.ReadString('Options', 'RVersion', '');
strRDir := RegIni.ReadString('Options', 'RDirectory', '');
RegIni.Free;
if blnR = False then
begin
frmR.memR.Lines.Add('R is not installed.');
MessageDlg('R does not appear to be installed (' + strRDir + ').', mtError,
[mbOK], 0);
btnR.Enabled := False;
RestartR1.Enabled := False;
Exit;
end
else
begin
frmR.memR.Lines.Add('R is installed at ' + ExtractFilePath(strRDir) + '. Attempting ' +
'to start.');
if blnXpose = False then
frmR.memR.Lines.Add('Xpose is not available.');
{if StrToFloat(Copy(strRVer, 1, Length(strRVer) - 2)) >= 2.11 then
begin
frmR.memR.Lines.Add('Xpose is not currently supported by R 2.11+.');
MessageDlg('Xpose is not supported by R 2.11.x.', mtError,
[mbOK], 0);
blnXpose := False;
frmR.Close;
btnR.Enabled := False;
RestartR1.Enabled := False;
Exit;
end; }
if Assigned(frmR) then
begin
frmR.RCommand.CommandLine := strRDir + ' --vanilla';
//showmessage(strRDir + ' --vanilla');
try
frmR.RCommand.Execute;
except
;
end;
end;
// Is Xpose available? If so, load.
if blnXpose then
frmR.RCommand.SendLine('library(xpose4)', True);
// Set working folder
if length(strTemp) > 0 then
begin
if (DirectoryExists(strTemp)) then
begin
frmR.RCommand.SendLine('setwd("' +
StringReplace(strTemp, '\', '/', [rfReplaceAll]) + '")', True);
frmR.RCommand.SendLine('getwd()', True);
end
else
begin
MessageDlg('The working folder for this project does not appear to ' +
'exist. Please select another one.', mtWarning, [mbOK], 0);
if not Assigned(frmProperties) then
frmProperties := TfrmProperties.Create(Application);
frmProperties.ShowModal;
end;
end;
end;
end;
procedure TfrmNMRun.CaptureRun7(nmFile: string);
var
strComment, strMin, strFnEval, strSigDig, strModel,
strObsRecs, strInds, strCondEst, strCentEta, strInter,
strLaplacian, strCov, strObj, strObj2, strMinFull, strRun, strParent, strTemp,
strBOTicker, strLastMethod: string;
strList, strOmegaList, strSigmaList: TStrings;
n, m, p, q, r, intTheta, intOmega, intOmegaBlk, intSigma, intSigmaBlk, intRun, intBOCount,
intBO2, intBSCount, intBS2, intLines, intT2L, intHessian, intOmegaRatio: Integer;
ThLabel, ThLower, ThInit, ThUpper, ThValue, ThSE: TStrings;
OmInit, SigInit, EtaBar, EtaP, EtaBarSE, Eta, Eps, SigSE, OmSE: TStrings;
lstLog, lstMinTerm, lstCovSum, lstBlockOmega, lstBlockSigma: TStrings;
EtaLabel, EtaShrinkage, EpsShrinkage, ThetaModel, PKParams, lstMatrixOmega, lstMatrixSigma,
lstMatrixOmegaInit, lstMatrixSigmaInit, lstLargeSEs, lstZeroCIs,
lstMatrixOmegaSE, lstMatrixSigmaSE, lstScratch, lstTemp, lstTemp2,
lstCovMatrix, lstCorrMatrix, lstInvCovMatrix, lstEigen, lstPsNRunRec: TStrings;
lstOmegaBlkVars, lstSigmaBlkVars, lstNotes, lstOmegaIndex, lstSigmaIndex: TStrings;
swFP, swSE, swMinTerm, swCovSum, blnDebug, swBlockOmega,
swBlockSigma, blnLT, blnGoodRun, blnInlineCtl, blnOFVSeen, blnOFVWarn,
blnNM7Run, blnNMQualRun: Boolean;
strModFile, strDataFile, strEtaL, strEtaL2, strT, strT2, strWFN: string;
RegIni: TRegIniFile;
btnPK, blnARun, blnBOInit, blnBSInit, blnCovStep, blnEtaBlocks,
blnSigmaBlocks, blnThetasOn, blnEtasOn, blnZeroGradients, btnSub, blnPriors,
blnFZeroGradients, blnLargeSEs, blnBoundaries, blnZeroCIs, blnPrdErr,
blnEtaBar, blnCap, blnFO, blnFOCE, blnBayes, blnSAEM, blnITS, blnImp, blnImpMap,
blnLaplacian: Boolean;
arSigDig: array of string;
fltCondNo, fltEigenUpper, fltEigenLower, fltEpsShrinkage, fltEstTime, fltCovTime: Double;
intEtCt, intFixedOmegas, intFixedSigmas, intBNo, intZeroGradients: Integer;
PsNRunRec: TPsNRunRec;
regEx, regExI: TPerlRegEx;
begin
// ********************************************************************
// Go to safe page
// ********************************************************************
pgcMain.ActivePageIndex := 0;
// ********************************************************************
// Initialize variables
// ********************************************************************
//tblRuns.Filtered := False;
intEtCt := 0; // Eta count
brkUpp.AllowEmptyString := False;
strList := TStringList.Create; // Main output file
lstLog := TStringList.Create; // Log file
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
swFP := True; // Final parameters switch
swSE := False; // Standard errors switch
swCovSum := False; // Covariance summary switch
swMinTerm := False; // MINIMIZATION TERMINATED switch
swBlockOmega := False; // Block OMEGA switch
swBlockSigma := False; // Block SIGMA switch
blnPrdErr := False; // errors in PRDERR
blnDebug := False; // Debug mode
if pgcMain.ActivePageIndex = 3 then
pgcMain.ActivePageIndex := 0;
ThLabel := TStringList.Create; // List of THETA labels
strOmegaList := TStringList.Create; // List of OMEGA labels
strSigmaList := TStringList.Create; // List of SIGMA labels
ThLower := TStringList.Create; // List of THETA lower bounds
ThInit := TStringList.Create; // List of THETA initial estimates
ThUpper := TStringList.Create; // List of THETA upper bounds
ThValue := TStringList.Create; // List of THETA estimates
ThSE := TStringList.Create; // List of THETA standard errors
OmInit := TStringList.Create; // List of OMEGA initial estimates
OmSE := TStringList.Create; // List of OMEGA standard errors
SigInit := TStringList.Create; // List of SIGMA initial estimates
SigSE := TStringList.Create; // List of SIGMA standard errors
EtaBar := TStringList.Create; // List of ETABARs
EtaBarSE := TStringList.Create; // List of ETABAR SEs
EtaP := TStringList.Create; // List of ETABAR P values
EtaShrinkage := TStringList.Create; // List of ETA shrinkage values
EtaLabel := TStringList.Create; // List of ETA labels
Eta := TStringList.Create; // List of ETA estimates
Eps := TStringList.Create; // List of EPS estimates
EpsShrinkage := TStringList.Create; // List of EPS shrinkage values
lstCovSum := TStringList.Create; // Covariance summary
lstPsNRunRec := TStringList.Create; // PsN runrecord
lstMinTerm := TStringList.Create; // MINIMIZATION TERMINATED message
lstBlockOmega := TStringList.Create; // BLOCK OMEGA section
lstOmegaBlkVars := TStringList.Create; // List of BLOCK OMEGA vars
lstSigmaBlkVars := TStringList.Create; // List of BLOCK SIGMA vars
lstOmegaIndex := TStringList.Create;
lstSigmaIndex := TStringList.Create;
lstBlockSigma := TStringList.Create; // BLOCK SIGMA section
lstMatrixOmega := TStringList.Create; // OMEGA matrix
lstMatrixSigma := TStringList.Create; // SIGMA matrix
lstMatrixOmegaSE := TStringList.Create; // OMEGA matrix SEs
lstMatrixSigmaSE := TStringList.Create; // SIGMA matrix SEs
lstMatrixOmegaInit := TStringList.Create; // OMEGA matrix initial estimates
lstMatrixSigmaInit := TStringList.Create; // SIGMA matrix initial estimates
lstCovMatrix := TStringList.Create; // Covariance matrix
lstCorrMatrix := TStringList.Create; // Correlation matrix
lstInvCovMatrix := TStringList.Create; // Inverse covariance matrix
lstEigen := TStringList.Create; // Eigenvalues
lstScratch := TStringList.Create; // Scratch area
lstTemp := TStringList.Create; // Another temp list
lstTemp2 := TStringList.Create; // Another temp list
lstZeroCIs := TStringList.Create; // Zero CIs
lstLargeSEs := TStringList.Create; // Large SEs
lstNotes := TStringList.Create; // Notes
blnInlineCtl := False; // Inline control stream?
blnOFVSeen := False; // OFV present?
strEtaL := '';
strEtaL2 := '';
blnOFVWarn := False;
blnARun := False;
blnBOInit := False;
blnBSInit := False;
blnCovStep := True;
blnAsk := RegIni.ReadBool('Options', 'AskNonNumeric', False);
blnMD5 := RegIni.ReadBool('Options', 'MD5', False);
blnCap := False;
strInter := 'NO';
strLaplacian := 'NO';
strCondEst := 'NO';
strCentEta := 'NO';
blnEtaBlocks := False;
blnSigmaBlocks := False;
blnZeroGradients := False;
blnFZeroGradients := False;
blnLargeSEs := False;
blnBoundaries := False;
blnZeroCIs := False;
intOmega := 0;
fltEpsShrinkage := 0;
fltEstTime := 0;
fltCovTime := 0;
intOmegaBlk := 0;
intTheta := 0;
intSigma := 0;
intSigmaBlk := 0;
intRun := 0;
intBOCount := 0;
intBSCount := 0;
intZeroGradients := 0;
strSigDig := '';
strT := '';
strT2 := '';
intLines := 0;
intT2L := 0;
intHessian := 0;
intFixedOmegas := 0;
intFixedSigmas := 0;
strParent := '';
blnGoodRun := False;
blnNMQualRun := False;
blnEtaBar := True;
strBOTicker := '';
intBNo := 0;
blnFO := False;
blnFOCE := False;
blnSAEM := False;
blnBayes := False;
blnITS := False;
blnImp := False;
blnImpMap := False;
blnLaplacian := False;
strLastMethod := '';
//blnDebug := True;
// ********************************************************************
// Load output file into strList
// ********************************************************************
if FileExists(nmFile) = False then
begin
MessageDlg('The specified file does not exist.', mtError, [mbOK], 0);
Exit;
end;
if FileExists(nmFile) then
begin
try
strList.LoadFromFile(nmFile);
// Check for valid input - can be anywhere in the file
for n := 0 to strList.Count - 1 do
begin
if (Pos('ORIGINALLY DEVELOPED BY STUART BEAL, LEWIS SHEINER, AND ALISON BOECKMANN', strList[n]) > 0) then
blnGoodRun := True;
if (Pos('<identifier>This log was generated by nmqual.pl', strList[n]) > 0) then
blnNMQualRun := True;
end;
if (blnGoodRun = False) then
begin
if MessageDlg('The specified file (' + ExtractFileName(nmFile) +
') does not appear to be a valid ' +
'NONMEM output stream. Would you like to attempt to capture it' +
' anyway?', mtError, [mbYes, mbNo], 0) = mrNo then
Exit;
end;
lstLog.Add('Opened ' + nmFile + '...');
lstLog.Add('-----------------------------------------');
strRun := StringReplace(ExtractFileName(nmFile), runPrefix, '', [rfReplaceAll]);
strRun := StringReplace(strRun, extLst, '', [rfReplaceAll]);
lstLog.Add('Length of filename... ' + IntToStr(Length(strRun)));
for n := 1 to Length(strRun) do
if not (strRun[n] in ['0'..'9']) then
blnARun := True;
intRun := ExtractNumberInString(ExtractFileName(nmFile));
if (blnARun) and (blnAsk) {strRun <> IntToStr(intRun)} then
strRun := InputBox('Please confirm your run number... [' +
nmFile + ']', 'Run Number', strRun);
lstLog.Add('Run number... ' + strRun);
try
tblRuns.IndexName := 'runno2';
// ********************************************************************
// Does run exist? If so then replace
// ********************************************************************
if tblRuns.FindKey([strRun]) then
begin
lstLog.Add('Run exists!');
if MessageDlg('This run (' + strRun + ') may already be present in the database. Would you '
+ 'like to replace it?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if MessageDlg('This will delete the current run record (' +
tblRunsRunNo.Value + '), and cannot be ' +
'reversed. Your original run files will not be ' +
'removed. Do you wish to continue?', mtWarning,
[mbYes, mbNo], 0) = mrYes then
begin
lstLog.Add('Replacing run...');
BlastRun;
end;
end
else
begin
if MessageDlg('Would you like to add this run with a different ' +
'number?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
strRun := InputBox('Please enter the new run number... [' +
nmFile + ']', 'Run Number', strRun)
else
Exit;
lstLog.Add('New run number... ' + strRun);
end;
end;
finally
tblRuns.IndexName := 'irunno';
end;
lstLog.Add('Length of output file... ' + IntToStr(strList.Count));
regEx := TPerlRegEx.Create;
regEx.Subject := strList.Text;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= #OBJV:\*{44})[ ]*-?\d+\.\d+[ ]*(?=(\*{50}))';
if (regEx.Match) then
begin
blnOFVSeen := True;
strObj := regEx.MatchedText;
while regEx.MatchAgain do
strObj := regEx.MatchedText; // last reported OFV/likelihood is taken
end;
if blnOFVSeen = False then
begin
if not Assigned(frmScanDialog) then
MessageDlg('This run seems to have terminated prematurely, ' +
'or contains no estimation step. No objective function value ' +
'appears to be present. Import cancelled.', mtError, [mbOK], 0);
Exit;
end;
regEx.RegEx := 'THERE ARE ERROR MESSAGES IN FILE PRDERR';
if (regEx.Match) then
begin
blnPrdErr := True;
lstLog.Add('Errors in PRDERR...');
end;
// TODO: hessian resets
regEx.RegEx := '^\s*\$PROB';
if (regEx.Match) then
begin
blnInlineCtl := True;
lstLog.Add('Inline control stream found...');
end;
regEx.RegEx := 'COVARIANCE STEP ABORTED';
if (regEx.Match) then
begin
blnCovStep := False;
lstLog.Add('Covariance step aborted...');
//ShowMessage('Standard Errors on');
end;
regEx.RegEx := '(?<=\*{20}[ ]{26}COVARIANCE MATRIX OF ESTIMATE[ ]{25}\*{20}).*(?=(^1))';
if (regEx.Match) then
begin
swFP := False;
swSE := False;
lstLog.Add('Covariance matrix detected...');
//ShowMessage(regEx.MatchedExpression);
end;
// TODO: T matrix
// TODO: covariance step terminated
regEx.RegEx := '(?<= PROBLEM NO.:[ ]{9}1).*(?=(0DATA CHECKOUT RUN:))';
if (regEx.Match) then
begin
strComment := Trim(regEx.MatchedText);
lstLog.Add('Comment... ' + strComment);
end;
// ********************************************************************
// Read no of observations
// ********************************************************************
strObsRecs := OneLineRegEx(strList.Text, '(?<=TOT. NO. OF OBS RECS:).*?\r?\n', False);
lstLog.Add('Observation Records... ' + strObsRecs);
// ********************************************************************
// Read no of individuals
// ********************************************************************
strInds := OneLineRegEx(strList.Text, '(?<=TOT. NO. OF INDIVIDUALS:).*?\r?\n', False);
lstLog.Add('Individuals... ' + strInds);
// ********************************************************************
// Count THETAs
// ********************************************************************
intTheta := StrToInt(OneLineRegEx(strList.Text, '(?<=LENGTH OF THETA:).*?\r?\n', False));
lstLog.Add('THETAs... ' + IntToStr(intTheta));
// ********************************************************************
// PRIORS?
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := 'PRIOR SUBROUTINE USER-SUPPLIED';
if (regEx.Match) then
begin
lstLog.Add('Priors detected...');
blnPriors := True;
//ShowMessage('priors');
end;
// ********************************************************************
// Count OMEGAs (simple diagonal)
// ********************************************************************
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=OMEGA HAS SIMPLE DIAGONAL FORM WITH DIMENSION:).*?\r?\n';
if (regEx.Match) then
begin
lstLog.Add('OMEGAs: Simple diagonal');
intOmega := StrToInt(Trim(regEx.MatchedText));
lstLog.Add('OMEGAs... ' + IntToStr(intOmega));
//ShowMessage(IntToStr(intOmega));
end;
// ********************************************************************
// Count OMEGAs (block)
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=OMEGA HAS BLOCK FORM:).*(?=(^0))';
if (regEx.Match) then
begin
lstLog.Add('OMEGAs: Block');
swBlockOmega := True;
blnEtaBlocks := True;
intBOCount := 0;
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
lstOmegaBlkVars.Assign(lstTemp);
//ShowMessage(IntToStr(lstOmegaBlkVars.Count));
//ShowMessage(lstOmegaBlkVars.Text);
brkUpp.AllowEmptyString := False;
//ShowMessage(lstTemp.Text);
brkUpp.BaseString := StringReplace(StringReplace(lstTemp.Text, #10, '', [rfReplaceAll]), #13, '', [rfReplaceAll]);
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(brkUpp.StringList[brkUpp.StringList.Count - 1]);
intOmegaBlk := StrToInt(brkUpp.StringList[brkUpp.StringList.Count - 1]);
for n := 1 to 200 do
begin
if ((n*n) + n)/2 = brkUpp.StringList.Count then
intOmega := n;
end;
//ShowMessage(intToStr(intOmega));
lstLog.Add('OMEGAs: ' + IntToStr(intOmega));
lstLog.Add('OMEGA blocks: ' + IntToStr(intOmegaBlk));
for n := 1 to intOmega do
begin
strOmegaList.Add(Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]));
//lstOmegaBlkVars.Add(Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]));
lstLog.Add('Adding ' + Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]) +
' to OMEGA block...');
end;
end;
// ********************************************************************
// Count SIGMAs (simple diagonal)
// ********************************************************************
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=SIGMA HAS SIMPLE DIAGONAL FORM WITH DIMENSION:).*?\r?\n';
if (regEx.Match) then
begin
lstLog.Add('SIGMAs: Simple diagonal');
intSigma := StrToInt(Trim(regEx.MatchedText));
lstLog.Add('SIGMAs... ' + IntToStr(intSigma));
//ShowMessage(IntToStr(intSigma));
end;
// ********************************************************************
// Count SIGMAs (block)
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=SIGMA HAS BLOCK FORM:).*(?=(^0))';
if (regEx.Match) then
begin
lstLog.Add('SIGMAs: Block');
swBlockSigma := True;
blnSigmaBlocks := True;
intBOCount := 0;
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
lstSigmaBlkVars.Assign(lstTemp);
//ShowMessage(IntToStr(lstSigmaBlkVars.Count));
//ShowMessage(lstSigmaBlkVars.Text);
brkUpp.AllowEmptyString := False;
//ShowMessage(lstTemp.Text);
brkUpp.BaseString := StringReplace(StringReplace(lstTemp.Text, #10, '', [rfReplaceAll]), #13, '', [rfReplaceAll]);
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(brkUpp.StringList[brkUpp.StringList.Count - 1]);
intSigmaBlk := StrToInt(brkUpp.StringList[brkUpp.StringList.Count - 1]);
for n := 1 to 200 do
begin
if ((n*n) + n)/2 = brkUpp.StringList.Count then
intSigma := n;
end;
//ShowMessage(intToStr(intOmega));
lstLog.Add('SIGMAs: ' + IntToStr(intSigma));
lstLog.Add('SIGMA blocks: ' + IntToStr(intSigmaBlk));
for n := 1 to intSigma do
begin
strSigmaList.Add(Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]));
//lstSigmaBlkVars.Add(Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]));
lstLog.Add('Adding ' + Trim(brkUpp.StringList[Round((((n*n) + n)/2)-1)]) +
' to SIGMA block...');
end;
end;
// ********************************************************************
// Initial estimates & bounds of THETA
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=INITIAL ESTIMATE OF THETA:).*(?=(0INITIAL ESTIMATE OF OMEGA:))';
if (regEx.Match) then
begin
lstLog.Add('Starting THETA initial estimates...');
//ShowMessage(regEx.MatchedText);
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
if (Pos('LOWER', lstTemp.Text) > 0) then
begin
for m := 1 to intTheta do
begin
ThLower.Add(BrkUp(' ', lstTemp[m+1], 0));
lstLog.Add('THETA(' + IntToStr(m) + ') Lower Bound... ' +
BrkUp(' ', lstTemp[m+1], 0));
ThInit.Add(BrkUp(' ', lstTemp[m+1], 1));
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', lstTemp[m+1], 1));
ThUpper.Add(BrkUp(' ', lstTemp[m+1], 2));
lstLog.Add('THETA(' + IntToStr(m) + ') Upper Bound... ' +
BrkUp(' ', lstTemp[m+1], 2));
end;
end
else
begin
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := Trim(lstTemp.Text);
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
// ShowMessage(brkUpp.StringList.Text);
for m := 1 to intTheta do
begin
ThLower.Add('-100000');
ThInit.Add(brkUpp.StringList[m-1]);
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
brkUpp.StringList[m-1]);
ThUpper.Add('100000');
end;
end;
//ShowMessage(ThLower.Text);
//ShowMessage(ThInit.Text);
//ShowMessage(ThUpper.Text);
end;
// ********************************************************************
// Initial estimates of OMEGA
// ********************************************************************
regEx.RegEx := '(?<=^0INITIAL ESTIMATE OF OMEGA:).*(?=(0INITIAL ESTIMATE OF SIGMA:))';
if (regEx.Match) then
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
//ShowMessage(lstTemp.Text);
lstTemp2.Clear;
with regEx do
begin
regEx := '-?\d\.\d+E[\+|-]\d{2}'; // match scientific number
Subject := lstTemp.Text;
if Match then
begin
n := 1;
OmInit.Add(MatchedText);
while MatchAgain do
begin
OmInit.Add(MatchedText);
n := n + 1;
end;
end;
end;
lstTemp2.Text := lstOmegaBlkVars.Text;
if OmInit.Count = intOmegaBlk then // easy
begin
for n := 1 to OmInit.Count do
lstTemp2.Text := StringReplace(lstTemp2.Text, ' ' + IntToStr(n), ' ' + OmInit[n-1],
[rfReplaceAll]);
lstOmegaBlkVars.Text := lstTemp2.Text;
end
else // don't match, might be mixed blocks and SAMEs
begin
for n := 0 to lstOmegaBlkVars.Count - 1 do
begin
// TODO
end;
end;
// Update OmInit
end;
//ShowMessage(lstTemp2.Text);
// Read from control stream instead
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '^ *\$PROB.*1NONLINEAR MIXED EFFECTS MODEL PROGRAM';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('$OMEGA', lstTemp[n]) > 0 then
blnCap := True;
if (Pos('$', lstTemp[n]) > 0) and (Pos('$OMEGA', lstTemp[n]) = 0) then
if (Pos(';', lstTemp[n]) = 0) or (Pos(';', lstTemp[n]) > Pos('$', lstTemp[n])) then
blnCap := False;
if blnCap then
lstTemp2.Add(lstTemp[n]);
end;
//ShowMessage(lstTemp2.Text);
// Get rid of comments
lstTemp.Clear;
for n := 0 to lstTemp2.Count - 1 do
if Pos(';', lstTemp2[n]) > 0 then
lstTemp.Add(Copy(lstTemp2[n], 1, Pos(';', lstTemp2[n])-1))
else
lstTemp.Add(lstTemp2[n]);
//ShowMessage(lstTemp.Text);
// get rid of $OMEGAs and FIXes
lstTemp.Text := StringReplace(lstTemp.Text, '$OMEGA', '', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'FIX', '', [rfReplaceAll]);
// deal with BLOCKs
lstTemp2.Clear;
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('BLOCK', lstTemp[n]) > 0 then
lstTemp2.Add(Copy(lstTemp[n], Pos(')', lstTemp[n]), 500))
else
lstTemp2.Add(lstTemp[n]);
end;
lstTemp2.Text := StringReplace(lstTemp2.Text, '(', '', [rfReplaceAll]);
lstTemp2.Text := StringReplace(lstTemp2.Text, ')', '', [rfReplaceAll]);
//ShowMessage(lstTemp2.Text);
// deal with SAME and starting .'s
strTemp := '';
lstTemp.Clear;
for n := 0 to lstTemp2.Count - 1 do
begin
if Pos('.', Trim(lstTemp2[n])) = 1 then
begin
lstTemp.Add('0' + Trim(lstTemp2[n]));
strTemp := '0' + Trim(lstTemp2[n]);
end
else
if Pos('SAME', Trim(lstTemp2[n])) > 0 then
lstTemp.Add(strTemp)
else
if Length(lstTemp2[n]) > 0 then
begin
lstTemp.Add(Trim(lstTemp2[n]));
strTemp := Trim(lstTemp2[n]);
end;
end;
//ShowMessage(lstTemp.Text);
OmInit.Text := StringReplace(lstTemp.Text, ' ', #13, [rfReplaceAll]);
//ShowMessage(OmInit.Text);
end;
// ********************************************************************
// Initial estimates of SIGMA
// ********************************************************************
//ShowMessage('start');
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=^0INITIAL ESTIMATE OF SIGMA:).*(?=(^0))';
regEx.Subject := strList.Text;
if (regEx.Match) then
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
//ShowMessage(lstTemp.Text);
lstTemp2.Clear;
with regEx do
begin
regEx := '-?\d\.\d+E[\+|-]\d{2}'; // match scientific number
Subject := lstTemp.Text;
if Match then
begin
n := 1;
SigInit.Add(MatchedText);
while MatchAgain do
begin
SigInit.Add(MatchedText);
n := n + 1;
end;
end;
end;
lstTemp2.Text := lstSigmaBlkVars.Text;
if SigInit.Count = intSigmaBlk then // easy
begin
for n := 1 to SigInit.Count do
lstTemp2.Text := StringReplace(lstTemp2.Text, ' ' + IntToStr(n), ' ' + SigInit[n-1],
[rfReplaceAll]);
lstSigmaBlkVars.Text := lstTemp2.Text;
end
else // don't match, might be mixed blocks and SAMEs
begin
for n := 0 to lstSigmaBlkVars.Count - 1 do
begin
// TODO
end;
end;
end;
//ShowMessage(SigInit.Text);
// Read from control stream instead
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '^ *\$PROB.*1NONLINEAR MIXED EFFECTS MODEL PROGRAM';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('$SIGMA', lstTemp[n]) > 0 then
blnCap := True;
if (Pos('$', lstTemp[n]) > 0) and (Pos('$SIGMA', lstTemp[n]) = 0) then
if (Pos(';', lstTemp[n]) = 0) or (Pos(';', lstTemp[n]) > Pos('$', lstTemp[n])) then
blnCap := False;
if blnCap then
lstTemp2.Add(lstTemp[n]);
end;
//ShowMessage(lstTemp2.Text);
// Get rid of comments
lstTemp.Clear;
for n := 0 to lstTemp2.Count - 1 do
if Pos(';', lstTemp2[n]) > 0 then
lstTemp.Add(Copy(lstTemp2[n], 1, Pos(';', lstTemp2[n])-1))
else
lstTemp.Add(lstTemp2[n]);
//ShowMessage(lstTemp.Text);
// get rid of $OMEGAs and FIXes
lstTemp.Text := StringReplace(lstTemp.Text, '$SIGMA', '', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'FIX', '', [rfReplaceAll]);
// deal with BLOCKs
lstTemp2.Clear;
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('BLOCK', lstTemp[n]) > 0 then
lstTemp2.Add(Copy(lstTemp[n], Pos(')', lstTemp[n]), 500))
else
lstTemp2.Add(lstTemp[n]);
end;
lstTemp2.Text := StringReplace(lstTemp2.Text, '(', '', [rfReplaceAll]);
lstTemp2.Text := StringReplace(lstTemp2.Text, ')', '', [rfReplaceAll]);
//ShowMessage(lstTemp2.Text);
// deal with SAME and starting .'s
strTemp := '';
lstTemp.Clear;
for n := 0 to lstTemp2.Count - 1 do
begin
if Pos('.', Trim(lstTemp2[n])) = 1 then
begin
lstTemp.Add('0' + Trim(lstTemp2[n]));
strTemp := '0' + Trim(lstTemp2[n]);
end
else
if Pos('SAME', Trim(lstTemp2[n])) > 0 then
lstTemp.Add(strTemp)
else
if Length(lstTemp2[n]) > 0 then
begin
lstTemp.Add(Trim(lstTemp2[n]));
strTemp := Trim(lstTemp2[n]);
end;
end;
//ShowMessage(lstTemp.Text);
SigInit.Text := StringReplace(lstTemp.Text, ' ', #13, [rfReplaceAll]);
//ShowMessage(SigInit.Text);
end;
// ********************************************************************
// FOCE
// ********************************************************************
strCondEst := OneLineRegEx(strList.Text, '(?<=CONDITIONAL ESTIMATES USED:).*?\r?\n', False);
if Length(strCondEst) < 1 then
strCondEst := 'NO';
lstLog.Add('Conditional Estimates... ' + strCondEst);
// ********************************************************************
// Centered ETA
// ********************************************************************
strCentEta := OneLineRegEx(strList.Text, '(?<=CENTERED ETA:).*?\r?\n', False);
lstLog.Add('Centered Eta... ' + strCentEta);
// ********************************************************************
// INTERACTION
// ********************************************************************
strInter := OneLineRegEx(strList.Text, '(?<=EPS-ETA INTERACTION:).*?\r?\n', False);
lstLog.Add('Eps-Eta Interaction... ' + strInter);
// ********************************************************************
// Laplacian
// ********************************************************************
strLaplacian := OneLineRegEx(strList.Text, '(?<=LAPLACIAN OBJ. FUNC.:).*?\r?\n', False);
lstLog.Add('Laplacian Obj Fn... ' + strLaplacian);
// ********************************************************************
// Method
// ********************************************************************
// TODO: FO
// TODO: Imp
// TODO: ImpMap
// TODO: Laplacian
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=#METH: ).*?\r?\n';
regEx.Subject := strList.Text;
if regEx.Match then
begin
strTemp := Trim(regEx.MatchedText);
lstLog.Add('Method... ' + strTemp);
if Pos('First Order Conditional Estimation', strTemp) > 0 then
begin
blnFOCE := True;
strLastMethod := 'FOCE';
end;
if Pos('Stochastic Approximation Expectation-Maximization', strTemp) > 0 then
begin
blnSAEM := True;
strLastMethod := 'SAEM';
end;
if Pos('MCMC Bayesian Analysis', strTemp) > 0 then
begin
blnBayes := True;
strLastMethod := 'Bayes';
end;
if Pos('Laplacian Conditional Estimation', strTemp) > 0 then
begin
blnLaplacian := True;
strLastMethod := 'Laplacian';
end;
while regEx.MatchAgain do
begin
strTemp := Trim(regEx.MatchedText);
lstLog.Add('Method... ' + strTemp);
if Pos('First Order Conditional Estimation', strTemp) > 0 then
begin
blnFOCE := True;
strLastMethod := 'FOCE';
end;
if Pos('Stochastic Approximation Expectation-Maximization', strTemp) > 0 then
begin
blnSAEM := True;
strLastMethod := 'SAEM';
end;
if Pos('MCMC Bayesian Analysis', strTemp) > 0 then
begin
blnBayes := True;
strLastMethod := 'Bayes';
end;
if Pos('Laplacian Conditional Estimation', strTemp) > 0 then
begin
blnLaplacian := True;
strLastMethod := 'Laplacian';
end;
end;
end;
//ShowMessage(strLastMethod);
// ********************************************************************
// Check zero gradients and hessian resets
// ********************************************************************
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=MONITORING OF SEARCH:).*(?=( Elapsed estimation time))';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
strTemp := '';
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('GRADIENT', lstTemp[n]) > 0 then
blnCap := True;
if Pos('ITERATION NO.', lstTemp[n]) > 0 then
begin
blnCap := False;
if Length(strTemp) > 0 then
lstTemp2.Add(strTemp);
strTemp := '';
end;
if blnCap then
strTemp := strTemp + lstTemp[n];
end;
if Length(strTemp) > 0 then
lstTemp2.Add(strTemp);
if Pos('0.0000E+00', strTemp) > 0 then
begin
blnFZeroGradients := True;
lstLog.Add('Zero gradients detected in final iteration...');
end;
// count zero gradients
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '0.0000E+00';
regExI.Subject := lstTemp2.Text;
if regExI.Match then
begin
intZeroGradients := 1;
blnZeroGradients := True;
while regExI.MatchAgain do
begin
intZeroGradients := intZeroGradients + 1;
end;
end;
lstLog.Add(IntToStr(intZeroGradients) + ' zero gradients detected...');
regExI.Free;
// count Hessian resets
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := 'RESET HESSIAN';
regExI.Subject := lstTemp.Text;
if regExI.Match then
begin
intHessian := 1;
lstLog.Add('Hessian reset detected...');
while regExI.MatchAgain do
begin
intHessian := intHessian + 1;
lstLog.Add('Hessian reset detected...');
end;
end;
lstLog.Add(IntToStr(intZeroGradients) + ' Hessian resets detected...');
regExI.Free;
end;
//ShowMessage(lstTemp2.Text);
// ********************************************************************
// Check minimization step (2 steps)
// ********************************************************************
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=#TERM:).*(?=( #TERE:))';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstMinTerm.Add(regEx.MatchedText);
while regEx.MatchAgain do
begin
lstMinTerm.Add('-------------------------');
lstMinTerm.Add(regEx.MatchedText);
end;
end;
// now analyse the last seen
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=#TERM:).*(?=( #TERE:))';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
while regEx.MatchAgain do
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
end;
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
if Pos('MINIMIZATION SUCCESSFUL', lstTemp.Text) > 0 then
strMin := 'Successful';
if Pos('MINIMIZATION TERMINATED', lstTemp.Text) > 0 then
begin
strMin := 'Terminated';
swMinTerm := True;
blnCovStep := False;
end;
lstLog.Add('Minimization... ' + strMin);
end;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=NO. OF FUNCTION EVALUATIONS USED:).*?\r?\n';
if regEx.Match then
begin
strFnEval := Trim(regEx.MatchedText);
lstLog.Add('Fn Evals... ' + strFnEval);
//ShowMessage(strInter);
end;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=NO. OF SIG. DIGITS IN FINAL EST.:).*?\r?\n';
if regEx.Match then
strSigDig := Trim(regEx.MatchedText)
else
strSigDig := 'UNREPORTABLE';
lstLog.Add('Significant digits... ' + strSigDig);
// ********************************************************************
// ETABAR
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := 'SUBMODEL';
regEx.Subject := strList.Text;
if regEx.Match then
begin
blnEtaBar := False;
lstLog.Add('Submodels detected - ETABAR turned OFF');
end
else
blnEtaBar := True;
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= ETABAR:).*(?=( SE:))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaBar.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaBar.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBars added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaBar.Text);
// ********************************************************************
// ETABAR SE
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= SE:).*(?=( P VAL.:))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaBarSE.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaBarSE.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBar SEs added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaBarSE.Text);
// ********************************************************************
// ETABAR P value
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= P VAL.:).*(?=( ETAshrink\(%\):))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaP.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaP.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBar P-values added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaP.Text);
// ********************************************************************
// ETA shrinkage
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= ETAshrink\(%\):).*(?=( EPSshrink\(%\):))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaShrinkage.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaShrinkage.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('Eta shrinkages added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaShrinkage.Text);
// ********************************************************************
// EPS shrinkage
// ********************************************************************
//ShowMessage(lstTemp.Text);
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
// fltEpsShrinkage := StrToFloat(OneLineRegEx(strList.Text, '(?<= EPSshrink\(%\):).*?\r?\n', False));
// lstLog.Add('Epsilon shrinkage... ' + FloatToStr(fltEpsShrinkage));
regEx.Options := [preMultiLine,preSingleLine];
regEx.RegEx := '(?<= EPSshrink\(%\):).*?\r?\n';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EpsShrinkage.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EpsShrinkage.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('Eta shrinkages added... ' + IntToStr(n));
regExI.Free;
end;
if EpsShrinkage.Count > 0 then
fltEpsShrinkage := StrToFloat(EpsShrinkage[0]);
end;
//ShowMessage(EpsShrinkage.Text);
lstTemp.Clear;
// ********************************************************************
// Elapsed estimation time
// ********************************************************************
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=Elapsed estimation time in seconds:).*?\r?\n';
regEx.Subject := strList.Text;
if regEx.Match then
begin
fltEstTime := StrToFloat(Trim(regEx.MatchedText));
lstLog.Add('Estimation time... ' + FloatToStr(fltEstTime));
while regEx.MatchAgain do
begin
fltEstTime := fltEstTime + StrToFloat(Trim(regEx.MatchedText));
lstLog.Add('Estimation time... ' + Trim(regEx.MatchedText));
end;
end
else
fltEstTime := 0;
// ********************************************************************
// Elapsed covariance time
// ********************************************************************
strTemp := OneLineRegEx(strList.Text, '(?<=Elapsed covariance time in seconds:).*?\r?\n', False);
if Length(strTemp) > 0 then
fltCovTime := StrToFloat(strTemp)
else
fltCovTime := 0;
lstLog.Add('Covariance time... ' + FloatToStr(fltCovTime));
// ********************************************************************
// Read THETA & ETA & EPS estimates
// ********************************************************************
// grab whole FP block and put in lstTemp
// we only take the last one in case several steps have been run
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
if fltCovTime > 0 then
regEx.RegEx := '(?<=FINAL PARAMETER ESTIMATE).*(?=(1\r?\n? \*{120}))'
else
begin
regEx.RegEx := '(?<=FINAL PARAMETER ESTIMATE).*'; // nothing after this point, no cov step
regEx.Options := [preMultiLine,preSingleLine];
end;
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
while regEx.MatchAgain do
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
end;
//ShowMessage(lstTemp.Text);
// get Thetas
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=THETA - VECTOR OF FIXED EFFECTS PARAMETERS \*{9}).*(?=(OMEGA))';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
ThValue.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
ThValue.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//Showmessage(ThValue.Text);
// get Etas
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*(?=SIGMA)';
//Showmessage(lstTemp.Text);
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
// Sometimes SIGMAs are not present
if length(Trim(lstTemp2.Text)) = 0 then
begin
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
end;
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
// checking again in case of priors
for n := 1 to 200 do
begin
if ((n*n) + n)/2 = lstScratch.Count then
intOmega := n;
end;
//ShowMessage(inttostr(intomega));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intOmega - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
Eta.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixOmega.Add(strTemp);
strTemp := '';
end;
//Showmessage(Eta.Text);
//showmessage(lstMatrixOmega.Text);
// get Epsilons
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS \*{4}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//lstTemp.SaveToFile('C:\Users\Administrator\Documents\Delphi\Census\svn\lstTemp.txt');
//showmessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage('sigmas');
//ShowMessage(inttostr(intSigma));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intSigma - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
Eps.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixSigma.Add(strTemp);
strTemp := '';
end;
//Showmessage(Eps.Text);
//showmessage(lstMatrixSigma.Text);
end;
// ********************************************************************
// Read THETA & ETA & EPS SEs
// ********************************************************************
// grab whole SE block and put in lstTemp
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=STANDARD ERROR OF ESTIMATE).*(?=(1\r?\n? \*{120}))';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
// replace dots with placeholders
lstTemp.Text := StringReplace(lstTemp.Text, '.........', '9.99E+99', [rfReplaceAll]);
// correct line breaks
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
while regEx.MatchAgain do
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
end;
// get Thetas
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=THETA - VECTOR OF FIXED EFFECTS PARAMETERS \*{9}).*(?=(OMEGA))';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
regExI.Subject := regExI.MatchedText;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
ThSE.Add('...')
else
ThSE.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
ThSE.Add('...')
else
ThSE.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//Showmessage(ThSE.Text);
// get Etas
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*(?=SIGMA)';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//showmessage(lstTemp.Text);
// Sometimes SIGMAs are not present
if length(Trim(lstTemp2.Text)) = 0 then
begin
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
end;
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage(inttostr(intomega));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intOmega - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
OmSE.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixOmegaSE.Add(strTemp);
strTemp := '';
end;
//Showmessage(OmSE.Text);
//showmessage(lstMatrixOmegaSE.Text);
// get Epsilons
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS \*{4}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//lstTemp.SaveToFile('C:\Users\Administrator\Documents\Delphi\Census\svn\lstTemp.txt');
//showmessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage(inttostr(intSigma));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intSigma - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
SigSE.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixSigmaSE.Add(strTemp);
strTemp := '';
end;
//Showmessage(SigSE.Text);
//showmessage(lstMatrixSigmaSE.Text);
end;
// ********************************************************************
// Proper estimation? OFV present?
// ********************************************************************
for n := 0 to strList.Count - 1 do
begin
// ********************************************************************
// Covariance matrix
// ********************************************************************
{ if Pos(' ******************** COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting covariance matrix...');
//ShowMessage('Starting Cov matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
// Nick's exception
if (Pos('Optimality', strList[n + p]) = 0) and
(Pos('Optimality', strList[n + p - 1]) = 0) and
(Pos('Optimality', strList[n + p - 2]) = 0) and
(Pos('Optimality', strList[n + p - 3]) = 0) and
(Pos('Optimality', strList[n + p - 4]) = 0) and
(Pos('Optimality', strList[n + p - 5]) = 0) then
// On with the show
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCovMatrix.Add(strT)
else
if lstCovMatrix.Count = 0 then
lstCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCovMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Correlation matrix
// ********************************************************************
if Pos(' ******************** CORRELATION MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting correlation matrix...');
//ShowMessage('Starting Corr matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCorrMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCorrMatrix.Add(strT)
else
if lstCorrMatrix.Count = 0 then
lstCorrMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate correlation matrix
// ********************************************************************
begin
lstLog.Add('Alternate correlation matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCorrMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCorrMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Inverse covariance matrix
// ********************************************************************
if Pos(' ******************** INVERSE COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting inverse covariance matrix...');
//ShowMessage('Starting InvCov matrix');
p := 5;
lstScratch.Clear;
while (n + p <= strList.Count - 1) and // FIX
(Pos('***************', strList[n + p]) = 0) do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstInvCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstInvCovMatrix.Add(strT)
else
if lstInvCovMatrix.Count = 0 then
lstInvCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate inverse covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate inverse covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstInvCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstInvCovMatrix.Add(strT);
q := q + m;
end;
end;
end; }
// ********************************************************************
// Eigenvalues
// ********************************************************************
if Pos(' ******************** EIGENVALUES OF COR MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting eigenvalues...');
lstScratch.Clear;
strT := '';
if (Pos('E', strList[n + 5]) >= 1) then
strT := Trim(strList[n + 5]);
if (Pos('E', strList[n + 6]) >= 1) then
strT := strT + strList[n + 6];
//ShowMessage(strT);
if (n + 7 <= strList.Count - 1) and
(NoAlpha(strList[n + 7])) and
(Pos('****', strList[n + 7]) = 0) and
(Pos('E', strList[n + 7]) >= 1) then
strT := strT + strList[n + 7];
if (n + 8 <= strList.Count - 1) then
if (Length(Trim(strList[n + 8])) > 0) and
(NoAlpha(strList[n + 8])) and
(Pos('****', strList[n + 8]) = 0) and
(Pos('E', strList[n + 8]) >= 1) then
strT := strT + strList[n + 8];
if (n + 9 <= strList.Count - 1) then
if (Length(Trim(strList[n + 9])) > 0) and
(NoAlpha(strList[n + 9])) and
(Pos('****', strList[n + 9]) = 0) and
(Pos('E', strList[n + 9]) >= 1) then
strT := strT + strList[n + 9];
if (n + 10 <= strList.Count - 1) then
if (Length(Trim(strList[n + 10])) > 0) and
(NoAlpha(strList[n + 10])) and
(Pos('****', strList[n + 10]) = 0) and
(Pos('E', strList[n + 10]) >= 1) then
strT := strT + strList[n + 10];
if (n + 11 <= strList.Count - 1) then
if (Length(Trim(strList[n + 11])) > 0) and
(NoAlpha(strList[n + 11])) and
(Pos('****', strList[n + 11]) = 0) and
(Pos('E', strList[n + 11]) >= 1) then
strT := strT + strList[n + 11];
if (n + 12 <= strList.Count - 1) then
if (Length(Trim(strList[n + 12])) > 0) and
(NoAlpha(strList[n + 12])) and
(Pos('****', strList[n + 12]) = 0) and
(Pos('E', strList[n + 12]) >= 1) then
strT := strT + strList[n + 12];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strT := '';
//showmessage(brkUpp.StringList.Text);
//ShowMessage(IntToStr(Round((brkUpp.StringList.Count/2)) - 1));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
lstEigen.Add(strT);
SetRoundMode(rmNearest);
//ShowMessage(strT);
//ShowMessage(brkUpp.StringList.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
begin
strT := FloatToStr(StrToFloat(brkUpp.StringList[m]));
for p := 0 to brkUpp.StringList.Count - 1 do
begin
strT := strT + ',' + FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
end;
//ShowMessage(strT);
lstEigen.Add(strT);
end;
end;
{ for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
strT := FloatToStr(StrToFloat(brkUpp.StringList[m], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' +
FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
lstEigen.Add(strT);
end; }
lstLog.Add('Starting condition number...');
// ********************************************************************
// Condition number
// ********************************************************************
fltEigenUpper := 0.00000000001;
fltEigenLower := 100000000000;
fltCondNo := 0;
//ShowMessage(brkUpp.StringList.Text);
//ShowMessage(lstEigen.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
//ShowMessage(IntToStr(m) + ' ' + brkUpp.StringList[m]);
if (StrToFloat(brkUpp.StringList[m], fs) > fltEigenUpper) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenUpper := StrToFloat(brkUpp.StringList[m], fs);
if (StrToFloat(brkUpp.StringList[m], fs) < fltEigenLower) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenLower := StrToFloat(brkUpp.StringList[m], fs);
end;
fltCondNo := Abs(RoundTo(fltEigenUpper / fltEigenLower, -2));
end;
end;
except
on E: Exception do
// ********************************************************************
// Exception message
// ********************************************************************
begin
MessageDlg('An error has occurred while processing the NONMEM output file. ' +
'Please check to make sure that the output file being read is ' +
'correctly structured.' + #10#13#10#13 + 'If it seems correct, please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtWarning, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
lstLog.SaveToFile(ExtractFilePath(Application.Exename) + 'run' +
strRun + '_error.log');
dlgLog.Execute;
end;
end;
end;
// ********************************************************************
// Free strList
// ********************************************************************
strList.Free;
lstLog.Add('Completed output file...');
strT := '';
//dlgLog.Lines.Assign(lstLog);
//dlgLog.Execute;
//Showmessage('parsing done');
// ********************************************************************
// Read model specification file
// ********************************************************************
lstLog.Add('Starting model specification file...');
strModFile := StringReplace(nmFile, extLst, extCtl,
[rfIgnoreCase]);
// showmessage(strModFile);
if not FileExists(strModFile) then
begin
if FileExists(StringReplace(strModFile, '.mod', '.ctl',
[rfIgnoreCase])) then
strModFile := StringReplace(strModFile, '.mod', '.ctl',
[rfIgnoreCase]);
if FileExists(StringReplace(strModFile, '.ctl', '.mod',
[rfIgnoreCase])) then
strModFile := StringReplace(strModFile, '.ctl', '.mod',
[rfIgnoreCase]);
end;
if not FileExists(strModFile) then
begin
lstLog.Add('No control stream found');
if blnInlineCtl then
strModFile := nmFile
else
if MessageDlg('No likely control stream file (ideally looking for ' +
strModFile + ') was located for ' +
'this run (' + strRun + '). ' +
'Would you like to select one?', mtConfirmation, [mbYes,
mbNo], 0) = mrYes then
begin
if dlgOpenMod.Execute then
strModFile := dlgOpenMod.FileName;
end
else
strModFile := '';
end;
lstLog.Add('-----------------------------------------');
lstLog.Add('Control stream... ' + strModFile);
lstLog.Add('Attempting to open...');
lstLog.Add('-----------------------------------------');
// ********************************************************************
// Open control stream
// ********************************************************************
if strModFile <> '' then
if FileExists(strModFile) then
begin
strList := TStringList.Create;
ThetaModel := TStringList.Create;
strList.LoadFromFile(strModFile);
PKParams := TStringList.Create;
blnPriors := False;
for n := 0 to strList.Count - 1 do
begin
try
//ShowMessage(strList[n]);
// ********************************************************************
// Read ;;;C Parent
// ********************************************************************
if (Pos(';;;C Parent=', strList[n]) > 0) then
strParent := Trim(StringReplace(strList[n], ';;;C Parent=', '', [rfReplaceAll]));
// ********************************************************************
// Notes
// ********************************************************************
if ((Pos(';;', strList[n]) > 0) and (Pos(';;;C', strList[n]) = 0)) then
lstNotes.Add(Trim(StringReplace(strList[n], ';;', '', [rfReplaceAll])));
// ********************************************************************
// PsN runrecord annotation
// ********************************************************************
if ((Pos(';;', strList[n]) > 0) and (Pos(';;;C', strList[n]) = 0)) then
lstPsNRunRec.Add(Trim(strList[n]));
// ********************************************************************
// $SUBROUTINE block on/off
// ********************************************************************
if ((Pos('$SUBS', strList[n]) > 0) or (Pos('$SUBROUTINES', strList[n]) > 0)) then
begin
btnSub := True;
//ShowMessage('Subs on');
end;
if (Pos('$', strList[n]) > 0) and
((Pos('$SUBS', strList[n]) = 0) and (Pos('$SUBROUTINES', strList[n]) = 0)) then
begin
btnSub := False;
end;
// ********************************************************************
// Check for priors
// ********************************************************************
if btnSub then
if Pos('PRIOR', strList[n]) > 0 then
begin
//ShowMessage('Priors on');
blnPriors := True;
end;
// ********************************************************************
// Check for priors
// ********************************************************************
if Pos('$PRIOR', strList[n]) > 0 then
begin
//ShowMessage('Priors on');
blnPriors := True;
end;
// ********************************************************************
// $PK block on/off
// ********************************************************************
if Pos('$PK', strList[n]) > 0 then
btnPK := True;
if (Pos('$', strList[n]) > 0) and
(Pos('$PK', strList[n]) = 0) then
btnPK := False;
// ********************************************************************
// Read $PK block
// ********************************************************************
if btnPK then
PKParams.Add(strList[n]);
// ********************************************************************
// Read $DATA block
// ********************************************************************
if Pos('$DATA', strList.Strings[n]) > 0 then
begin
strDataFile := BrkUp(' ', strList.Strings[n], 1);
//ShowMessage(strDatafile);
strDataFile := StringReplace(strDataFile, '"', '', [rfReplaceall]);
strDataFile := StringReplace(strDataFile, '''', '', [rfReplaceall]);
strDataFile := StringReplace(strDataFile, '/', '\', [rfReplaceall]);
if Pos(':', strDataFile) = 0 then
strDataFile := ExtractFilePath(nmFile) + strDataFile;
lstLog.Add('Datafile... ' + strDataFile);
//ShowMessage(strDatafile);
end;
// ********************************************************************
// Read $THETA block
// ********************************************************************
if (Pos('$THETA', strList.Strings[n]) = 0) and
(Pos('$', Trim(strList.Strings[n])) = 1) then
blnThetasOn := False;
if Pos('$THETA', strList.Strings[n]) > 0 then
begin
blnThetasOn := True;
if ThInit.Count <> intTheta then
AddThetaMSFInits(strList[n], ThInit, ThLower, ThUpper);
if Pos(';', strList[n]) > 0 then
begin
ThLabel.Add(BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Theta Label... ' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage(BrkUp(';', strList.Strings[n], 1) + ' one');
end
else
begin
ThLabel.Add(' ');
lstLog.Add('Theta Label... None!');
end;
end;
// In a block
if (blnThetasOn) and (Pos(';', strList[n]) > 0) and
(Pos(';', Trim(strList[n])) > 1) and (Pos('$THETA', strList.Strings[n]) = 0) then
begin
ThLabel.Add(BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Theta Label... ' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage(BrkUp(';', strList.Strings[n], 1) + ' two');
end;
// ********************************************************************
// Read ETA labels
// ********************************************************************
if Pos('$OMEGA', strList.Strings[n]) > 0 then
begin
// Is it commented out?
//Showmessage('on');
if Pos(';', strList.Strings[n]) > Pos('$OMEGA', strList.Strings[n]) then
blnEtasOn := True;
// No comment?
if Pos(';', strList.Strings[n]) = 0 then
blnEtasOn := True;
end;
if (Pos('$OMEGA', strList.Strings[n]) = 0) and
(Pos('$', Trim(strList.Strings[n])) = 1) then
begin
blnEtasOn := False;
lstTemp.Clear;
// If populated, process ETA labels
// If bars are present, assume done and skip
if (EtaLabel.Count > 0) and (Pos('|', EtaLabel.Text) = 0) then
begin
for p := 0 to EtaLabel.Count - 1 do
begin
// Is there a comment?
if Pos(';', EtaLabel[p]) > 0 then
// Is there text before the comment?
if Pos(';', Trim(EtaLabel[p])) > 1 then
lstTemp.Add(EtaLabel[p]);
end;
EtaLabel.Clear;
for p := 0 to lstTemp.Count - 1 do
begin
EtaLabel.Add(IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
lstLog.Add('Eta Label... ' + IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
//ShowMessage('Eta Label... ' + IntToStr(p+1) + '|' + BrkUp(';', lstTemp[p], 1));
end;
(EtaLabel as TStringList).Sorted := True; // changed 11/10/05
(EtaLabel as TStringList).Duplicates := dupIgnore;
//ShowMessage(EtaLabel.Text);
end;
end;
// Collect lines with $OMEGA records
if blnEtasOn then
EtaLabel.Add(strList[n]);
{if Pos('$OMEGA', strList.Strings[n]) > 0 then
begin
blnEtasOn := True;
if (Pos('BLOCK', strList[n]) > 0)
and (Pos('BLOCK(1)', StringReplace(strList[n], ' ', '', [rfReplaceAll])) = 0) then
begin
for m := Pos('(', strList[n]) + 1 to Pos(')', strList[n]) - 1 do
strT := strT + strList[n][m];
r := 0;
try
r := StrToInt(strT);
except
ShowMessage('An error has occurred reading the number of ' +
'dimensions in an $OMEGA BLOCK structure.' + #10#13#10#13 +
'Control stream line: ' + IntToStr(n) + '; Block dimension: ' + strT);
end;
//ShowMessage(IntToStr(r));
for m := n + 1 to r do
begin
if Pos(';', Trim(strList[n])) > 1 then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
end;
end;
end
else
if (Pos(';', strList[n]) > 0) and (Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
//ShowMessage('Eta Label... ' + IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
end
else
if (Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + ' ');
lstLog.Add('Eta Label... None!');
if RegIni.ReadBool('Options', 'PromptEtaLabels', True) then
begin
if not Assigned(frmEtaLabels) then
frmEtaLabels := TfrmEtaLabels.Create(Application);
frmEtaLabels.ShowModal;
end;
end;
end; }
// In a block
{ if (blnEtasOn) and (Pos(';', strList[n]) > 0) and
(Pos(';', Trim(strList[n])) > 1) then
begin
intEtCt := intEtCt + 1;
EtaLabel.Add(IntToStr(intEtCt) + '|' + BrkUp(';', strList.Strings[n], 1));
lstLog.Add('Eta Label... ' + BrkUp(';', strList.Strings[n], 1));
// ShowMessage(BrkUp(';', strList.Strings[n], 1));
end; }
// ********************************************************************
// Read $DATA block
// ********************************************************************
if (Pos('ETA(', strList.Strings[n]) > 0) then
begin
end;
except
on EStringListError do
MessageDlg('Error parsing model control ' +
'stream at line ' + IntToStr(n + 1) + ' (' +
strList[n] + ').', mtError, [mbOK], 0);
end;
end;
end
else
lstLog.Add('No Control stream found!');
// ********************************************************************
// Sort ETA list
// ********************************************************************
//ShowMessage('Start sort');
//ShowMessage(EtaLabel.Text);
lstTemp2.Clear;
for n := 0 to EtaLabel.Count - 1 do
begin
strT := EtaLabel[n];
if Pos('|', strT) = 2 then
strT := '0' + strT;
lstTemp2.Add(strT);
end;
EtaLabel.Clear;
for n := 0 to lstTemp2.Count - 1 do
EtaLabel.Add(lstTemp2[n]);
lstTemp2.Clear;
//ShowMessage('Presort');
(EtaLabel as TStringList).Sort;
//ShowMessage('Postsort');
{for n := 0 to EtaLabel.Count - 1 do
begin
strT := EtaLabel[n];
if Pos('|', EtaLabel[n]) > 0 then
EtaLabel[n] := Copy(EtaLabel[n], Pos('|', EtaLabel[n]), 500);
end; }
//ShowMessage('Checxkpoint');
regEx.Subject := lstPsNRunRec.Text;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
//ShowMessage(regEx.Subject);
// 1 based on
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Based on:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.BasedOn := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Based on: ' + PsNRunRec.BasedOn);
end;
// 2 description
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Description:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.Description := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Description: ' + PsNRunRec.Description);
end;
// 3 label
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Label:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.PsNLabel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Label: ' + PsNRunRec.PsNLabel);
end;
// 4 structural model
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Structural model:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.StructuralModel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Structural model: ' + PsNRunRec.StructuralModel);
end;
// 5 covariate model
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Covariate model:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.CovariateModel := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Covariate model: ' + PsNRunRec.CovariateModel);
end;
// 6 iiv
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Inter-individual variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.InterIndividualVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('IIV: ' + PsNRunRec.InterIndividualVariability);
end;
// 7 iov
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Inter-occasion variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.InterOccasionVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('IOV: ' + PsNRunRec.InterOccasionVariability);
end;
// 8 residual
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Residual variability:).*(?=(;;[ | | | | | ]\d\.))';
if (regEx.Match) then
begin
PsNRunRec.ResidualVariability := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('RV: ' + PsNRunRec.ResidualVariability);
end;
regEx.Options := [preMultiLine,preSingleLine];
// 9 estimation
regEx.RegEx := '(?<=^;;[ | | | | | ]\d\.[ | | | | | ]Estimation:).*';
if (regEx.Match) then
begin
PsNRunRec.Estimation := StripSpaces(Trim(StringReplace(regEx.MatchedText, ';;', '', [rfReplaceAll])));
//ShowMessage('Estimation: ' + PsNRunRec.Estimation);
end;
regEx.Options := [];
// ********************************************************************
// Insert into RUNS table
// ********************************************************************
//dlgLog.Lines.Assign(lstLog);
//dlgLog.Execute;
//Showmessage(strCondEst);
lstLog.Add('-----------------------------------------');
lstLog.Add('Inserting into database...');
lstLog.Add('-----------------------------------------');
try
if Length(strCondEst) > 0 then // strCondEst?
try
try
tblRuns.Insert;
tblRunsUser.Value := txtUser;
tblRunsTimestamp.Value := Now;
lstLog.Add('Inserting into Runs table...');
tblRunsRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblRunsiRunNo.Value := intRun;
lstLog.Add('iRunNo...');
tblRunsComment.Value := strComment;
lstLog.Add('Comment...');
if RegIni.ReadBool('Options', 'PromptComment', False) then
if dlgComment.Execute then
tblRunsComments.Assign(dlgComment.Lines);
lstLog.Add('Long comment...');
tblRunsObsRecs.Value := StrToInt(strObsRecs);
lstLog.Add('ObsRecs...');
tblRunsIndividuals.Value := StrToInt(strInds);
lstLog.Add('Inds...');
tblRunsMinShort.Value := CaseConvert(strMin);
if Length(strMin) < 1 then
tblRunsMinShort.Value := 'No minimization step';
lstLog.Add('MinShort...');
tblRunsEstTime.Value := fltEstTime;
lstLog.Add('EstTime...');
tblRunsCovTime.Value := fltCovTime;
lstLog.Add('CovTime...');
tblRunsEpsilonShrinkage.Value := fltEpsShrinkage;
lstLog.Add('EpsilonShrinkage...');
//showmessage(lstMinTerm.Text);
{if lstMinTerm.Count > 0 then
if Pos('NO. OF FUNCTION EVALUATIONS USED:',
lstMinTerm[lstMinTerm.Count - 1]) > 0 then
lstMinTerm.Delete(lstMinTerm.Count - 1);
if lstMinTerm.Count > 0 then
if Pos('#TERE',
lstMinTerm[lstMinTerm.Count - 1]) > 0 then
lstMinTerm.Delete(lstMinTerm.Count - 1); }
tblRunsMinimization.Assign(lstMinTerm);
lstLog.Add('MinFull...');
if strFnEval <> '' then
tblRunsFnEvals.Value := StrToInt(strFnEval);
lstLog.Add('FnEval...');
tblRunsSigDigits.Value := CaseConvert(strSigDig);
lstLog.Add('SigDigits...');
if strObj <> '' then
tblRunsObj.Value := StrToFloat(strObj, fs);
lstLog.Add('Obj...');
tblRunsModel.Value := CaseConvert(strModel);
lstLog.Add('Model...');
tblRunsCovStep.Assign(lstCovSum);
lstLog.Add('CovStep...');
tblRunsCondEst.Value := False;
if strCondEst = 'YES' then
tblRunsCondEst.Value := True;
lstLog.Add('CondEst...');
if strCentEta = 'YES' then
tblRunsCenteredEta.Value := True
else
tblRunsCenteredEta.Value := False;
lstLog.Add('CenteredEta...');
if strInter = 'YES' then
tblRunsInteraction.Value := True
else
tblRunsInteraction.Value := False;
lstLog.Add('Interaction...');
if strLaplacian = 'YES' then
tblRunsLaplacian.Value := True
else
tblRunsLaplacian.Value := False;
lstLog.Add('Laplacian...');
tblRunsComments.Assign(lstNotes);
lstLog.Add('Notes...');
tblRunsMethFO.Value := blnFO;
tblRunsMethFOCE.Value := blnFOCE;
tblRunsMethSAEM.Value := blnSAEM;
tblRunsMethBayes.Value := blnBayes;
tblRunsMethImp.Value := blnImp;
tblRunsMethImpMap.Value := blnImpMap;
tblRunsMethITS.Value := blnITS;
// PsN runrecord
tblRunsIIV.Value := PsNRunRec.InterIndividualVariability;
tblRunsIOV.Value := PsNRunRec.InterOccasionVariability;
tblRunsLabel.Value := PsNRunRec.PsNLabel;
tblRunsStructuralModel.Value := PsNRunRec.StructuralModel;
tblRunsCovariateModel.Value := PsNRunRec.CovariateModel;
tblRunsRV.Value := PsNRunRec.ResidualVariability;
tblRunsEstimation.Value := PsNRunRec.Estimation;
tblRunsDescription.Value := PsNRunRec.Description;
// Warnings
strT2 := '';
lstLog.Add('Warnings - OFV...');
if blnOFVWarn then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'OFV carried over from final iteration';
end;
lstLog.Add('Warnings - Covariance step...');
if ThSE.Count = 0 then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'No covariance step';
end;
lstLog.Add('Warnings - Algorithmically singular S matrix...');
if (Pos('ALGORITHMICALLY SINGULAR', lstCovSum.Text) > 0) and
(Pos('S MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'S matrix algorithmically singular';
end;
lstLog.Add('Warnings - Algorithmically singular R matrix...');
if (Pos('ALGORITHMICALLY SINGULAR', lstCovSum.Text) > 0) and
(Pos('R MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'R matrix algorithmically singular';
end;
lstLog.Add('Warnings - Non-positive-semidefinite S matrix...');
if (Pos('NON-POSITIVE-SEMIDEFINITE', lstCovSum.Text) > 0) and
(Pos('S MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'S matrix non-positive-semidefinite';
end;
lstLog.Add('Warnings - Non-positive-semidefinite R matrix...');
if (Pos('NON-POSITIVE-SEMIDEFINITE', lstCovSum.Text) > 0) and
(Pos('R MATRIX', lstCovSum.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'R matrix non-positive-semidefinite';
end;
lstLog.Add('Warnings - Rounding errors...');
if (Pos('ROUNDING ERRORS', lstMinTerm.Text) > 0) and
(Pos('R MATRIX', lstMinTerm.Text) > 0) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Rounding errors';
end;
lstLog.Add('Warnings - Hessian count...');
if intHessian > 0 then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
if intHessian = 1 then
strT2 := strT2 + IntToStr(intHessian) + ' hessian reset'
else
strT2 := strT2 + IntToStr(intHessian) + ' hessian resets';
end;
lstLog.Add('Warnings - Zero gradients...');
if blnZeroGradients then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Zero gradients';
end;
lstLog.Add('Warnings - Condition number...');
if fltCondNo > RegIni.ReadInteger('Options', 'CondLimit', 1000) then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'High condition number';
end;
lstLog.Add('Warnings - Final zero gradients...');
if blnFZeroGradients then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Final zero gradients';
end;
// Check standard errors
lstLog.Add('Warnings - Polling THETAs...');
if ThSE.Count > 0 then
begin
//Showmessage(IntTostr(intTheta));
for m := 1 to ThValue.Count do
begin
lstLog.Add('Warnings - THETA large SEs (' + IntToStr(m) + ')...');
if Pos('..', ThSE[m - 1]) = 0 then
if (StrToFloat(FloatToStrF(Abs(StrToFloat(ThSE[m - 1], fs) /
StrToFloat(ThValue[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'ThetaCVLimit', '0.3'))) then
begin
blnLargeSEs := True;
//ShowMessage(RegIni.ReadString('Options', 'ThetaCVLimit', '0.3'));
lstLargeSEs.Add('Th ' + IntToStr(m));
end;
lstLog.Add('Warnings - THETA zero CIs (' + IntToStr(m) + ')...');
if Pos('..', ThSE[m - 1]) = 0 then
if ((StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) -
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) < 0) and
(StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) +
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) > 0)) or
((StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) -
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) > 0) and
(StrToFloat(FloatToStrF(StrToFloat(ThValue[m - 1], fs) +
(1.96 * StrToFloat(ThSE[m - 1], fs)), ffGeneral, 3, 0)) < 0)) then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Th ' + IntToStr(m));
end;
end;
end;
if OmSE.Count > 0 then
begin
for m := 1 to Eta.Count do
begin
lstLog.Add('Warnings - OMEGA large SEs (' + IntToStr(m) + ')...');
if Pos('...', OmSE[m - 1]) = 0 then
try
if StrToFloat(FloatToStrF(Abs(StrToFloat(OmSE[m - 1], fs) /
StrToFloat(Eta[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'OmegaCVLimit', '0.5')) then
begin
blnLargeSEs := True;
lstLargeSEs.Add('Om ' + IntToStr(m));
end;
except
;
end;
lstLog.Add('Warnings - OMEGA zero CIs (' + IntToStr(m) + ')...');
if Pos('...', OmSE[m - 1]) = 0 then
try
if StrToFloat(FloatToStrF(StrToFloat(Eta[m - 1], fs) -
(1.96 * StrToFloat(OmSE[m - 1], fs)), ffGeneral, 3, 0)) < 0 then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Om ' + IntToStr(m));
end;
except
;
end;
end;
end;
if SigSE.Count > 0 then
begin
for m := 1 to Eps.Count do
begin
lstLog.Add('Warnings - SIGMA large SEs (' + IntToStr(m) + ')...');
if Pos('..', SigSE[m - 1]) = 0 then
if StrToFloat(Eps[m - 1], fs) <> 0 then
if StrToFloat(FloatToStrF(Abs(StrToFloat(SigSE[m - 1], fs) /
StrToFloat(Eps[m - 1], fs)), ffGeneral, 3, 0)) >
StrToFloat(RegIni.ReadString('Options', 'SigmaCVLimit', '0.3')) then
begin
blnLargeSEs := True;
lstLargeSEs.Add('Sg ' + IntToStr(m));
end;
lstLog.Add('Warnings - SIGMA zero CIs (' + IntToStr(m) + ')...');
if Pos('..', SigSE[m - 1]) = 0 then
if StrToFloat(FloatToStrF(StrToFloat(Eps[m - 1], fs) -
(1.96 * StrToFloat(SigSE[m - 1], fs)), ffGeneral, 3, 0)) < 0 then
begin
blnZeroCIs := True;
lstZeroCIs.Add('Sg ' + IntToStr(m));
end;
end;
end;
lstLog.Add('Warnings - Large SEs...');
if blnLargeSEs then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Large SEs (';
for m := 0 to lstLargeSEs.Count - 1 do
begin
strT2 := strT2 + lstLargeSEs[m];
if m < lstLargeSEs.Count - 1 then
strT2 := strT2 + ', ';
end;
strT2 := strT2 + ')';
end;
lstLog.Add('Warnings - Errors in PRDERR...');
if blnPrdErr then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'Prediction errors (PRDERR)';
//pgcNotes.ActivePage := tabPrdErr;
//pgcMain.ActivePage := tabMisc;
end;
lstLog.Add('Warnings - Zero CIs...');
if blnZeroCIs then
begin
if Length(strT2) <> 0 then
strT2 := strT2 + '; ';
strT2 := strT2 + 'CIs overlap zero (';
for m := 0 to lstZeroCIs.Count - 1 do
begin
strT2 := strT2 + lstZeroCIs[m];
if m < lstZeroCIs.Count - 1 then
strT2 := strT2 + ', ';
end;
strT2 := strT2 + ')';
end;
tblRunsWarnings.Value := strT2;
strT2 := '';
// WFN prefix
strWFN := ExtractFilePath(nmFile) + StringReplace(ExtractFileName(nmFile),
ExtLst, '', [rfReplaceAll]) + '.';
// Xpose structure
if (FileExists(ExtractFilePath(nmFile) + 'patab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'patab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'patab' + strRun + extXpose))}then
begin
tblRunspatab.Value := ExtractFilePath(nmFile) +
'patab' + strRun + extXpose;
if blnMD5 then
tblRunspatabMD5.Value := MD5(ExtractFilePath(nmFile) +
'patab' + strRun + extXpose);
lstLog.Add('patab...' + tblRunspatab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'sdtab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'sdtab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'sdtab' + strRun + extXpose))}then
begin
tblRunssdtab.Value := ExtractFilePath(nmFile) +
'sdtab' + strRun + extXpose;
if blnMD5 then
tblRunssdtabMD5.Value := MD5(ExtractFilePath(nmFile) +
'sdtab' + strRun + extXpose);
lstLog.Add('sdtab...' + tblRunssdtab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'catab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'catab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'catab' + strRun + extXpose))}then
begin
tblRunscatab.Value := ExtractFilePath(nmFile) +
'catab' + strRun + extXpose;
if blnMD5 then
tblRunscatabMD5.Value := MD5(ExtractFilePath(nmFile) +
'catab' + strRun + extXpose);
lstLog.Add('catab...' + tblRunscatab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cotab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'cotab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'cotab' + strRun + extXpose))}then
begin
tblRunscotab.Value := ExtractFilePath(nmFile) +
'cotab' + strRun + extXpose;
if blnMD5 then
tblRunscotabMD5.Value := MD5(ExtractFilePath(nmFile) +
'cotab' + strRun + extXpose);
lstLog.Add('cotab...' + tblRunscotab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'mutab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mutab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mutab' + strRun + extXpose)) }then
begin
tblRunsmutab.Value := ExtractFilePath(nmFile) +
'mutab' + strRun + extXpose;
if blnMD5 then
tblRunsmutabMD5.Value := MD5(ExtractFilePath(nmFile) +
'mutab' + strRun + extXpose);
lstLog.Add('mutab...' + tblRunsmutab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'mytab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunsmytab.Value := ExtractFilePath(nmFile) +
'mytab' + strRun + extXpose;
if blnMD5 then
tblRunsmytabMD5.Value := MD5(ExtractFilePath(nmFile) +
'mytab' + strRun + extXpose);
lstLog.Add('mytab...' + tblRunsmytab.Value);
end;
// CWRES
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + extXpose)) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtab.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + extXpose;
if blnMD5 then
tblRunscwtabMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + extXpose);
lstLog.Add('cwtab...' + tblRunscwtab.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + '.est')) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtabEst.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + '.est';
if blnMD5 then
tblRunscwtabEstMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + '.est');
lstLog.Add('cwtab.est...' + tblRunscwtabEst.Value);
end;
if (FileExists(ExtractFilePath(nmFile) + 'cwtab' +
strRun + '.deriv')) {or (FileExists(strWFN + 'g77' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ivf' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'df' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'wc' +
'mytab' + strRun + extXpose)) or (FileExists(strWFN + 'ms' +
'mytab' + strRun + extXpose)) }then
begin
tblRunscwtabDeriv.Value := ExtractFilePath(nmFile) +
'cwtab' + strRun + '.deriv';
if blnMD5 then
tblRunscwtabDerivMD5.Value := MD5(ExtractFilePath(nmFile) +
'cwtab' + strRun + '.deriv');
lstLog.Add('cwtab.deriv...' + tblRunscwtabDeriv.Value);
end;
tblRunsLst.Value := nmFile;
if blnMD5 then
tblRunsLstMD5.Value := MD5(nmFile);
lstLog.Add('lst...' + nmFile);
tblRunsData.Value := strDataFile;
if blnMD5 then
tblRunsDataMD5.Value := MD5(strDataFile);
lstLog.Add('dat...' + strDataFile);
if FileExists(strModFile) then
begin
tblRunsCtl.Value := strModFile;
if blnMD5 then
tblRunsCtlMD5.Value := MD5(strModFile);
lstLog.Add('ctl...' + strModFile);
end;
if FileExists(StringReplace(nmFile, extLst, extMsf,
[rfIgnoreCase])) then
begin
tblRunsMsf.Value := StringReplace(nmFile, extLst,
extMSF, [rfIgnoreCase]);
if blnMD5 then
tblRunsMsfMD5.Value := MD5(StringReplace(nmFile, extLst,
extMSF, [rfIgnoreCase]));
lstLog.Add('MSF...' + tblRunsMsf.Value);
end;
if FileExists(StringReplace(nmFile, extLst, '.ext',
[rfIgnoreCase])) then
begin
tblRunsExt.Value := StringReplace(nmFile, extLst,
'.ext', [rfIgnoreCase]);
if blnMD5 then
tblRunsExtMD5.Value := MD5(StringReplace(nmFile, extLst,
'.ext', [rfIgnoreCase]));
lstLog.Add('Ext...' + tblRunsExt.Value);
end;
if FileExists(StringReplace(nmFile, extLst, '.phi',
[rfIgnoreCase])) then
begin
tblRunsPhi.Value := StringReplace(nmFile, extLst,
'.phi', [rfIgnoreCase]);
if blnMD5 then
tblRunsPhiMD5.Value := MD5(StringReplace(nmFile, extLst,
'.phi', [rfIgnoreCase]));
lstLog.Add('Phi...' + tblRunsPhi.Value);
end;
if FileExists(StringReplace(nmFile, extLst, '.cov',
[rfIgnoreCase])) then
begin
tblRunsCov.Value := StringReplace(nmFile, extLst,
'.cov', [rfIgnoreCase]);
if blnMD5 then
tblRunsCovMD5.Value := MD5(StringReplace(nmFile, extLst,
'.cov', [rfIgnoreCase]));
lstLog.Add('Cov...' + tblRunsCov.Value);
end;
if FileExists(StringReplace(nmFile, extLst, '.cor',
[rfIgnoreCase])) then
begin
tblRunsCor.Value := StringReplace(nmFile, extLst,
'.cor', [rfIgnoreCase]);
if blnMD5 then
tblRunsCorMD5.Value := MD5(StringReplace(nmFile, extLst,
'.cor', [rfIgnoreCase]));
lstLog.Add('Cor...' + tblRunsCor.Value);
end;
if FileExists(StringReplace(nmFile, extLst, '.coi',
[rfIgnoreCase])) then
begin
tblRunsCoi.Value := StringReplace(nmFile, extLst,
'.coi', [rfIgnoreCase]);
if blnMD5 then
tblRunsCoiMD5.Value := MD5(StringReplace(nmFile, extLst,
'.coi', [rfIgnoreCase]));
lstLog.Add('Coi...' + tblRunsCoi.Value);
end;
if FileExists(StringReplace(nmFile, extLst, extFit,
[rfIgnoreCase])) then
begin
tblRunsFit.Value := StringReplace(nmFile, extLst,
extFit, [rfIgnoreCase]);
if blnMD5 then
tblRunsFitMD5.Value := MD5(StringReplace(nmFile, extLst,
extFit, [rfIgnoreCase]));
lstLog.Add('fit...' + tblRunsFit.Value);
end;
{if FileExists(ExtractFilePath(nmFile) + '\PRDERR') then
tblRunsPrdErr.LoadFromFile(ExtractFilePath(nmFile) + '\PRDERR');
lstLog.Add('PRDERR...'); }
if fltCondNo <> 0 then
tblRunsConditionNumber.Value := fltCondNo;
if Length(PsNRunRec.BasedOn) > 0 then
begin
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Obj FROM Runs');
if IsStrANumber(PsNRunRec.BasedOn) then
sqlParent.SQL.Add('WHERE RunNo = ' + PsNRunRec.BasedOn + ';')
else
sqlParent.SQL.Add('WHERE RunNo = ''' + PsNRunRec.BasedOn + ''';');
try
sqlParent.Active := True;
if sqlParent.RecordCount > 0 then
begin
tblRunsParentNo.Value := PsNRunRec.BasedOn;
tblRunsdOFV.Value := RoundD(tblRunsObj.Value - sqlParent.Fields[0].AsFloat, 3);
end
else
if Length(strParent) > 0 then
begin
sqlParent.Active := False;
sqlParent.SQL.Clear;
sqlParent.SQL.Add('SELECT Obj FROM Runs');
if IsStrANumber(strParent) then
sqlParent.SQL.Add('WHERE RunNo = ' + strParent + ';')
else
sqlParent.SQL.Add('WHERE RunNo = ''' + strParent + ''';');
try
sqlParent.Active := True;
if sqlParent.RecordCount > 0 then
begin
tblRunsParentNo.Value := strParent;
tblRunsdOFV.Value := RoundD(tblRunsObj.Value - sqlParent.Fields[0].AsFloat, 3);
end;
finally
sqlParent.Active := False;
end;
end;
finally
sqlParent.Active := False;
end;
end;
lstLog.Add('Condition Number...' + FloatToStr(tblRunsConditionNumber.Value));
// ********************************************************************
// OMEGA initial estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixOmegaInit.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmegaInit[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmegaInit[n - 1] := '0,' + lstMatrixOmegaInit[n - 1];
end;
for n := 1 to lstMatrixOmegaInit.Count do
lstMatrixOmegaInit[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmegaInit[n - 1];
lstMatrixOmegaInit.Insert(0, strT);
tblRunsOmegaInitMatrix.Value := lstMatrixOmegaInit.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// OMEGA final estimates matrix
// ********************************************************************
strT := '';
//ShowMessage(IntToStr(lstMatrixOmega.Count));
for n := 1 to lstMatrixOmega.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmega[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmega[n - 1] := '0,' + lstMatrixOmega[n - 1];
end;
for n := 1 to lstMatrixOmega.Count do
lstMatrixOmega[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmega[n - 1];
lstMatrixOmega.Insert(0, strT);
tblRunsOmegaMatrix.Value := lstMatrixOmega.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// OMEGA standard errors matrix
// ********************************************************************
strT := '';
//ShowMessage(IntToStr(lstMatrixOmegaSE.Count));
for n := 1 to lstMatrixOmegaSE.Count do
begin
strT := strT + ', ETA(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixOmegaSE[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixOmegaSE[n - 1] := '0,' + lstMatrixOmegaSE[n - 1];
end;
for n := 1 to lstMatrixOmegaSE.Count do
lstMatrixOmegaSE[n - 1] := ' ETA(' + IntToStr(n) + '),' + lstMatrixOmegaSE[n - 1];
lstMatrixOmegaSE.Insert(0, strT);
tblRunsOmegaSEMatrix.Value := lstMatrixOmegaSE.Text;
// ********************************************************************
// SIGMA initial estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigmaInit.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigmaInit[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigmaInit[n - 1] := '0,' + lstMatrixSigmaInit[n - 1];
end;
for n := 1 to lstMatrixSigmaInit.Count do
lstMatrixSigmaInit[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigmaInit[n - 1];
lstMatrixSigmaInit.Insert(0, strT);
tblRunsSigmaInitMatrix.Value := lstMatrixSigmaInit.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// SIGMA final estimates matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigma.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigma[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigma[n - 1] := '0,' + lstMatrixSigma[n - 1];
end;
for n := 1 to lstMatrixSigma.Count do
lstMatrixSigma[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigma[n - 1];
lstMatrixSigma.Insert(0, strT);
tblRunsSigmaMatrix.Value := lstMatrixSigma.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
// ********************************************************************
// SIGMA standard errors matrix
// ********************************************************************
strT := '';
for n := 1 to lstMatrixSigmaSE.Count do
begin
strT := strT + ', EPS(' + IntToStr(n) + ')';
brkUpp.StringList.Clear;
brkUpp.BaseString := lstMatrixSigmaSE[n - 1];
brkUpp.BreakString := ',';
brkUpp.BreakApart;
if brkUpp.StringList.Count < n then
for m := 1 to (n - brkUpp.StringList.Count) do
//Insert('0,', lstMatrixOmegaInit[n - 1], 1);
lstMatrixSigmaSE[n - 1] := '0,' + lstMatrixSigmaSE[n - 1];
end;
for n := 1 to lstMatrixSigmaSE.Count do
lstMatrixSigmaSE[n - 1] := ' EPS(' + IntToStr(n) + '),' + lstMatrixSigmaSE[n - 1];
lstMatrixSigmaSE.Insert(0, strT);
tblRunsSigmaSEMatrix.Value := lstMatrixSigmaSE.Text;
{dlgLog.Lines.Assign(lstMatrixOmegaInit);
dlgLog.Execute; }
//dlgLog.Lines.Assign(lstCovMatrix);
//dlgLog.Execute;
//dlgLog.Lines.Assign(lstCorrMatrix);
//dlgLog.Execute;
//dlgLog.Lines.Assign(lstEigen);
//dlgLog.Execute;
// ********************************************************************
// Covariance, correlation, inv cov matrix
// ********************************************************************
tblRunsCovMatrix.Value := lstCovMatrix.Text;
tblRunsCorrMatrix.Value := lstCorrMatrix.Text;
tblRunsInvCovMatrix.Value := lstInvCovMatrix.Text;
tblRunsEigenvalues.Value := lstEigen.Text;
except
// ********************************************************************
// Exception block
// ********************************************************************
on E: Exception do
begin
MessageDlg('An error has occurred while processing results into the RUN table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblRuns.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the RUNS table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblRuns.Cancel;
end;
end;
end;
// ********************************************************************
// Insert into THETAS table
// ********************************************************************
//ShowMessage(ThValue.Text);
ThLabel := StripBlanks(ThLabel);
if blnPriors then
begin
if RegIni.ReadBool('Options', 'WarnPriors', True) then
begin
if MessageDlg('Use of the PRIOR subroutine has been detected. Since this means ' +
'that more parameter records will be present than expected, the number of ' +
'parameter variables captured will be limited to those reported by the NONMEM ' +
'output file (THETAs: ' + intToStr(ThValue.Count) + ', ETAs: ' +
intToStr(Eta.Count) + ', EPSILONs: ' + intToStr(Eps.Count) + ').' + #10#13#10#13 +
'Full PRIOR functionality will follow in a later release.' + #10#13#10#13 +
'Do you wish to see this warning again?', mtWarning, [mbYes, mbNo], 0) = mrYes then
RegIni.WriteBool('Options', 'WarnPriors', True)
else
RegIni.WriteBool('Options', 'WarnPriors', False);
end;
intTheta := ThValue.Count;
end;
//ShowMessage(Inttostr(intTheta));
for m := 1 to intTheta do
begin
try
try
tblThetas.Insert;
lstLog.Add('Inserting into Theta table...');
tblThetasUser.Value := txtUser;
tblThetasTimestamp.Value := Now;
tblThetasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblThetasTheta.Value := m;
lstLog.Add('Theta...' + IntToStr(m));
// ShowMessage(IntToStr(intTheta));
// ShowMessage(IntToStr(ThLabel.Count));
// ShowMessage(ThLabel.Text);
for n := 0 to ThLabel.Count - 1 do
if Length(Trim(ThLabel[n])) = 0 then
ThLabel.Delete(n);
// ShowMessage(ThLabel.Text);
if (ThLabel.Count = intTheta) or ((blnPriors = True)
and (ThLabel.Count >= intTheta)) then
begin
tblThetasThetaLabel.Value := ThLabel[m - 1];
lstLog.Add(' Label...' + ThLabel[m - 1]);
//showmessage(' Label...' + ThLabel[m - 1]);
end;
if ThValue.Count = intTheta then
begin
tblThetasThetaValue.Value := StrToFloat(ThValue[m - 1], fs);
lstLog.Add(' Value...' + ThValue[m - 1]);
//showmessage(' Value...' + ThValue[m - 1]);
end;
if (ThLower.Count = intTheta) or ((blnPriors = True)
and (ThLower.Count >= intTheta)) then
begin
tblThetasLower.Value := StrToFloat(ThLower[m - 1], fs);
lstLog.Add(' Lower...' + ThLower[m - 1]);
//showmessage(' Lower...' + ThLower[m - 1]);
end;
if (ThInit.Count = intTheta) or ((blnPriors = True)
and (ThInit.Count >= intTheta)) then
begin
tblThetasInitial.Value := StrToFloat(Trim(ThInit[m - 1]), fs);
lstLog.Add(' InitEst...' + ThInit[m - 1]);
//showmessage(' InitEst...' + ThInit[m - 1]);
end;
if (ThUpper.Count = intTheta) or ((blnPriors = True)
and (ThUpper.Count >= intTheta)) then
begin
tblThetasUpper.Value := StrToFloat(ThUpper[m - 1], fs);
lstLog.Add(' Upper...' + ThUpper[m - 1]);
//showmessage(' Upper...' + ThUpper[m - 1]);
end;
if (ThSE.Count = intTheta) or ((blnPriors = True)
and (ThSE.Count >= intTheta)) then
if Pos('...', ThSE[m - 1]) = 0 then
begin
tblThetasThetaSE.Value := StrToFloat(ThSE[m - 1], fs);
lstLog.Add(' SE...' + ThSE[m - 1]);
if tblThetasThetaValue.Value <> 0 then
tblThetasThetaRSE.Value := StrToFloat(FloatToStrF(Abs(tblThetasThetaSE.Value /
tblThetasThetaValue.Value) * 100, ffGeneral, 3, 0));
lstLog.Add(' RSE...' + FloatToStr(tblThetasThetaRSE.Value));
if (tblThetasThetaValue.Value <> 0) and
(tblThetasThetaSE.Value <> 0) then
begin
tblThetasThetaCIUpper.Value := StrToFloat(FloatToStrF(tblThetasThetaValue.Value +
(1.96 * tblThetasThetaSE.Value), ffGeneral, 3, 0));
tblThetasThetaCILower.Value := StrToFloat(FloatToStrF(tblThetasThetaValue.Value -
(1.96 * tblThetasThetaSE.Value), ffGeneral, 3, 0));
tblThetasThetaCIs.Value := FloatToStr(tblThetasThetaCILower.Value) +
' ... ' + FloatToStr(tblThetasThetaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblThetasThetaCIs.Value);
end;
end;
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing data into the THETA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblThetas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the THETAS table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblThetas.Cancel;
end;
end;
end;
end;
// ********************************************************************
// Insert into ETAS table
// ********************************************************************
{dlgLog.Lines.Assign(Eta);
dlgLog.Execute; }
intOmega := lstMatrixOmega.Count - 1;
//ShowMessage(EtaLabel.Text);
EtaLabel := StripBlanks(EtaLabel);
//ShowMessage(EtaLabel.Text);
{ShowMessage('intOmega ' + IntToStr(intOmega));
ShowMessage('OmSE ' + IntToStr(OmSE.Count));
ShowMessage('Eta ' + IntToStr(Eta.Count));
ShowMessage(OMSE.Text);
ShowMessage(Eta.Text); }
for m := 0 to EtaLabel.Count - 1 do
begin
if (CharIsDigit(EtaLabel[m][2]) = False) and
(CharIsDigit(EtaLabel[m][1]) = True) and
(intOmega > 9) then
EtaLabel[m] := '0' + EtaLabel[m];
EtaLabel[m] := EtaLabel[m] + '§§';
end;
(EtaLabel as TStringList).Sort;
for m := 1 to intOmega do
begin
try
try
tblEtas.Insert;
lstLog.Add('Inserting into OMEGA table...');
tblEtasUser.Value := txtUser;
tblEtasTimestamp.Value := Now;
tblEtasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblEtasEta.Value := m;
lstLog.Add('Eta...' + IntToStr(m));
if EtaLabel.Count = intOmega then
begin
//Showmessage(EtaLabel[m - 1]);
tblEtasEtaLabel.Value := Copy(EtaLabel[m - 1],
0, Pos('§§', EtaLabel[m - 1]) - 1);
{tblEtasEtaLabel.Value := StringReplace(tblEtasEtaLabel.Value,
'|', '', [rfReplaceAll]); }
tblEtasEtaLabel.Value := Copy(tblEtasEtaLabel.Value,
Pos('|', tblEtasEtaLabel.Value) + 1, 500);
lstLog.Add(' Label...' + EtaLabel[m - 1]);
tblEtasModel.Value := Copy(EtaLabel[m - 1],
Pos('§§', EtaLabel[m - 1]) + 1, 50);
end;
if (Eta.Count = intOmega) and (Eta.Count > 0) then
begin
//ShowMessage(IntToStr(Eta.Count));
tblEtasEtaValue.Value := StrToFloat(Eta[m - 1], fs);
lstLog.Add(' Value...' + Eta[m - 1]);
end;
//showmessage(OmInit.Text);
//ShowMessage(IntToStr(intOmega));
if (OmInit.Count = intOmega) and (OmInit.Count > 0) then
begin
tblEtasEtaInit.Value := StrToFloat(OmInit[m - 1], fs);
lstLog.Add(' InitEst...' + OmInit[m - 1]);
end;
if EtaBar.Count = intOmega then
begin
if Pos('E', EtaBar[m - 1]) > 0 then
begin
tblEtasEtaBar.Value := StrToFloat(EtaBar[m - 1], fs);
end
else
tblEtasEtaBar.Value :=
StrToFloat(StringReplace(EtaBar[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' EtaBar...' + FloatToStr(tblEtasEtaBar.Value));
if EtaBarSE.Count = intOmega then
begin
if Pos('E', EtaBarSE[m - 1]) > 0 then
begin
tblEtasEtaBarSE.Value := StrToFloat(EtaBarSE[m - 1], fs);
end
else
tblEtasEtaBarSE.Value :=
StrToFloat(StringReplace(EtaBarSE[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' EtaBarSE...' + FloatToStr(tblEtasEtaBarSE.Value));
if EtaP.Count = intOmega then
if Pos('E', EtaP[m - 1]) > 0 then
tblEtasEtaPVal.Value := StrToFloat(EtaP[m - 1], fs)
else
tblEtasEtaPVal.Value :=
StrToFloat(StringReplace(EtaP[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
lstLog.Add(' EtaBarPVal...' + FloatToStr(tblEtasEtaPVal.Value));
if EtaShrinkage.Count = intOmega then
begin
if Pos('E', EtaShrinkage[m - 1]) > 0 then
begin
tblEtasEtaShrinkage.Value := StrToFloat(EtaShrinkage[m - 1], fs);
end
else
tblEtasEtaShrinkage.Value :=
StrToFloat(StringReplace(EtaShrinkage[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' Shrinkage...' + FloatToStr(tblEtasEtaShrinkage.Value));
//ShowMessage(IntToStr(OmSE.Count) + ',' + IntToStr(intOmega));
if OmSE.Count = intOmega then
begin
if (Pos('...', OmSE[m - 1]) = 0) and (OmSE[m - 1] <> '0') then
tblEtasEtaSE.Value := StrToFloat(OmSE[m - 1], fs);
{ShowMessage(lstMatrixOmegaSE[m]);
ShowMessage(brkUp(',', lstMatrixOmegaSE[m], m));
tblEtasEtaSE.Value := StrToFloat(brkUp(',', lstMatrixOmegaSE[m], m), fs); }
lstLog.Add(' SE...' + OmSE[m - 1]);
if (tblEtasEtaValue.Value <> 0) and
(tblEtasEtaSE.Value <> 0) then
tblEtasEtaRSE.Value := StrToFloat(FloatToStrF((tblEtasEtaSE.Value /
tblEtasEtaValue.Value) * 100, ffGeneral, 3, 0));
lstLog.Add(' RSE...' + FloatToStr(tblEtasEtaRSE.Value));
if (tblEtasEtaValue.Value <> 0) and
(tblEtasEtaSE.Value <> 0) then
begin
tblEtasEtaCIUpper.Value := StrToFloat(FloatToStrF(tblEtasEtaValue.Value +
(1.96 * tblEtasEtaSE.Value), ffGeneral, 3, 0));
tblEtasEtaCILower.Value := StrToFloat(FloatToStrF(tblEtasEtaValue.Value -
(1.96 * tblEtasEtaSE.Value), ffGeneral, 3, 0));
tblEtasEtaCIs.Value := FloatToStr(tblEtasEtaCILower.Value) +
' ... ' + FloatToStr(tblEtasEtaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblEtasEtaCIs.Value);
end;
tblEtasBlocks.Value := blnEtaBlocks;
end;
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing data into the OMEGA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblEtas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the OMEGA table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblEtas.Cancel;
end;
end;
end;
end;
// ********************************************************************
// Insert into SIGMAS table
// ********************************************************************
// Fix initial estimates
intSigma := Eps.Count;
//lstTemp.Clear;
if Eps.Count > SigInit.Count then
for m := 0 to Eps.Count - 1 do
begin
if m <= SigInit.Count - 1 then
strTemp := SigInit[m];
if m = 0 then
;
if (m > 0) then
begin
if (Eps[m] = Eps[m - 1]) then
SigInit.Insert(m, strTemp);
end;
end;
//ShowMessage(Eps.Text);
//ShowMessage(SigInit.Text);
//ShowMessage(SigSE.Text);
for m := 1 to intSigma do
begin
try
try
tblSigmas.Insert;
lstLog.Add('Inserting into Sigma table...');
tblSigmasUser.Value := txtUser;
tblSigmasTimestamp.Value := Now;
tblSigmasRunNo.Value := strRun;
lstLog.Add('RunNo...');
tblSigmasSigma.Value := m;
lstLog.Add('Sigma...' + IntToStr(m));
if Eps.Count = intSigma then
begin
tblSigmasSigmaValue.Value := StrToFloat(Eps[m - 1], fs);
lstLog.Add('Value...' + Eps[m - 1]);
end;
if SigInit.Count = intSigma then
begin
tblSigmasSigmaInit.Value := StrToFloat(SigInit[m - 1], fs);
lstLog.Add('Init Est...' + SigInit[m - 1]);
end;
if SigSE.Count = intSigma then
if Pos('...', SigSE[m - 1]) = 0 then
begin
tblSigmasSigmaSE.Value := StrToFloat(SigSE[m - 1], fs);
lstLog.Add(' SE...' + SigSE[m - 1]);
if (tblSigmasSigmaValue.Value <> 0) and
(tblSigmasSigmaSE.Value <> 0) then
tblSigmasSigmaRSE.Value := StrToFloat(FloatToStrF((tblSigmasSigmaSE.Value /
tblSigmasSigmaValue.Value) * 100, ffGeneral, 3, 0));
if (tblSigmasSigmaValue.Value <> 0) and
(tblSigmasSigmaSE.Value <> 0) then
begin
tblSigmasSigmaCIUpper.Value := StrToFloat(FloatToStrF(tblSigmasSigmaValue.Value +
(1.96 * tblSigmasSigmaSE.Value), ffGeneral, 3, 0));
tblSigmasSigmaCILower.Value := StrToFloat(FloatToStrF(tblSigmasSigmaValue.Value -
(1.96 * tblSigmasSigmaSE.Value), ffGeneral, 3, 0));
tblSigmasSigmaCIs.Value := FloatToStr(tblSigmasSigmaCILower.Value) +
' ... ' + FloatToStr(tblSigmasSigmaCIUpper.Value);
lstLog.Add(' 95% CI...' + tblSigmasSigmaCIs.Value);
end;
lstLog.Add(' RSE...' + FloatToStr(tblSigmasSigmaRSE.Value));
end;
tblSigmasBlocks.Value := blnSigmaBlocks;
if EpsShrinkage.Count = intSigma then
begin
if Pos('E', EpsShrinkage[m - 1]) > 0 then
begin
tblSigmasSigmaShrinkage.Value := StrToFloat(EpsShrinkage[m - 1], fs);
end
else
tblSigmasSigmaShrinkage.Value :=
StrToFloat(StringReplace(EpsShrinkage[m - 1], '-', 'E-',
[rfIgnoreCase]), fs);
end;
lstLog.Add(' Shrinkage...' + FloatToStr(tblSigmasSigmaShrinkage.Value));
except
on E: Exception do
begin
MessageDlg('An error has occurred while processing the SIGMA table. ' + #10#13#10#13 +
'Please email Justin Wilkins at justin.wilkins@exprimo.com with ' +
'a description of the error and a copy of the file you were ' +
'trying to load (' + nmFile + ').' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
end;
finally
try
tblSigmas.Post;
except
on E: Exception do
begin
MessageDlg('An error has occurred while updating the SIGMA table and'
+ ' changes were not saved.' + #10#13#10#13 + E.ClassName + ': ' + E.Message, mtError, [mbOK], 0);
tblSigmas.Cancel;
end;
end;
end;
end;
finally
tblTrans.InsertRecord([Null, 'add', strRun, Now, txtUser]);
if tblTrans.Active = False then
tblTrans.Active := True;
if tblRuns.Active = False then
tblRuns.Active := True;
if tblThetas.Active = False then
tblThetas.Active := True;
if tblEtas.Active = False then
tblEtas.Active := True;
if tblSigmas.Active = False then
tblSigmas.Active := True;
if tblPlotData.Active = False then
tblPlotData.Active := True;
//if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
//tblRuns.Filtered := True;
end;
// ********************************************************************
// Debug info
// ********************************************************************
if blnDebug then
begin
lstLog.Add(#10#13);
lstLog.Add('Done!');
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
lstLog.SaveToFile(ExtractFilePath(Application.Exename) + 'run' +
strRun + '_error.log');
// ********************************************************************
// Free all variables
// ********************************************************************
if Assigned(PKParams) then
PKParams.Free;
ThLabel.Free;
ThLower.Free;
ThInit.Free;
ThUpper.Free;
ThValue.Free;
ThSE.Free;
SigInit.Free;
OmInit.Free;
EtaBar.Free;
EtaBarSE.Free;
EtaP.Free;
Eta.Free;
Eps.Free;
OmSE.Free;
SigSE.Free;
EtaLabel.Free;
EtaShrinkage.Free;
EpsShrinkage.Free;
lstLog.Free;
lstCovSum.Free;
lstMinTerm.Free;
lstBlockOmega.Free;
lstOmegaBlkVars.Free;
lstSigmaBlkVars.Free;
lstOmegaIndex.Free;
lstSigmaIndex.Free;
lstBlockSigma.Free;
lstMatrixOmega.Free;
lstMatrixSigma.Free;
lstMatrixOmegaInit.Free;
lstMatrixSigmaInit.Free;
lstMatrixOmegaSE.Free;
lstMatrixSigmaSE.Free;
lstCovMatrix.Free;
lstCorrMatrix.Free;
lstInvCovMatrix.Free;
lstScratch.Free;
lstTemp.Free;
lstTemp2.Free;
strOmegaList.Free;
strSigmaList.Free;
lstLargeSEs.Free;
lstZeroCIs.Free;
lstPsNRunRec.Free;
lstNotes.Free;
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
brkUpp.BreakString := '';
RegIni.Free;
regEx.Free;
end;
procedure TfrmNMRun.CaptureRun72(nmFile: string);
var
strComment, strMin, strFnEval, strSigDig, strModel, strMethods,
strObsRecs, strInds, strCondEst, strCentEta, strInter, strSlow, strSecDeriv,
strLaplacian, strCov, strObj, strObj2, strMinFull, strRun, strParent, strTemp,
strBOTicker, strLastMethod: string;
strList, strOmegaList, strSigmaList: TStrings;
n, m, p, q, r, s, intTheta, intOmega, intOmegaBlk, intSigma, intSigmaBlk, intRun, intBOCount,
intBO2, intBSCount, intBS2, intLines, intT2L, intHessian, intOmegaRatio, intEst: Integer;
ThLabel, ThLower, ThInit, ThUpper, ThValue, ThSE: TStrings;
OmInit, SigInit, EtaBar, EtaP, EtaBarSE, Eta, Eps, SigSE, OmSE: TStrings;
lstLog, lstMinTerm, lstCovSum, lstBlockOmega, lstBlockSigma: TStrings;
EtaLabel, EtaShrinkage, EpsShrinkage, ThetaModel, PKParams, lstMatrixOmega, lstMatrixSigma,
lstMatrixOmegaInit, lstMatrixSigmaInit, lstLargeSEs, lstZeroCIs,
lstMatrixOmegaSE, lstMatrixSigmaSE, lstScratch, lstTemp, lstTemp2,
lstCovMatrix, lstCorrMatrix, lstInvCovMatrix, lstEigen, lstPsNRunRec: TStrings;
lstOmegaBlkVars, lstSigmaBlkVars, lstNotes, lstOmegaIndex, lstSigmaIndex: TStrings;
swFP, swSE, swMinTerm, swCovSum, blnDebug, swBlockOmega,
swBlockSigma, blnLT, blnGoodRun, blnInlineCtl, blnOFVSeen, blnOFVWarn,
blnNM7Run, blnNMQualRun: Boolean;
strModFile, strDataFile, strEtaL, strEtaL2, strT, strT2, strWFN, strLst: string;
RegIni: TRegIniFile;
btnPK, blnARun, blnBOInit, blnBSInit, blnCovStep, blnEtaBlocks,
blnSigmaBlocks, blnThetasOn, blnEtasOn, blnSigmasOn, blnZeroGradients, btnSub, blnPriors,
blnFZeroGradients, blnLargeSEs, blnBoundaries, blnZeroCIs, blnPrdErr,
blnEtaBar, blnCap, blnFO, blnFOCE, blnBayes, blnSAEM, blnITS, blnImp, blnImpMap,
blnLaplacian: Boolean;
arSigDig: array of string;
fltCondNo, fltEigenUpper, fltEigenLower, fltEpsShrinkage, fltEstTime, fltCovTime: Double;
intEtCt, intFixedOmegas, intFixedSigmas, intBNo, intZeroGradients: Integer;
PsNRunRec: TPsNRunRec;
regEx, regExI: TPerlRegEx;
begin
// ********************************************************************
// Go to safe page
// ********************************************************************
pgcMain.ActivePageIndex := 0;
// ********************************************************************
// Initialize variables
// ********************************************************************
//tblRuns.Filtered := False;
intEtCt := 0; // Eta count
brkUpp.AllowEmptyString := False;
strList := TStringList.Create; // Main output file
lstLog := TStringList.Create; // Log file
RegIni := TRegIniFile.Create('Software\Arrhythmia\Drumsticks');
swFP := True; // Final parameters switch
swSE := False; // Standard errors switch
swCovSum := False; // Covariance summary switch
swMinTerm := False; // MINIMIZATION TERMINATED switch
swBlockOmega := False; // Block OMEGA switch
swBlockSigma := False; // Block SIGMA switch
blnPrdErr := False; // errors in PRDERR
blnDebug := False; // Debug mode
if pgcMain.ActivePageIndex = 3 then
pgcMain.ActivePageIndex := 0;
ThLabel := TStringList.Create; // List of THETA labels
strOmegaList := TStringList.Create; // List of OMEGA labels
strSigmaList := TStringList.Create; // List of SIGMA labels
ThLower := TStringList.Create; // List of THETA lower bounds
ThInit := TStringList.Create; // List of THETA initial estimates
ThUpper := TStringList.Create; // List of THETA upper bounds
ThValue := TStringList.Create; // List of THETA estimates
ThSE := TStringList.Create; // List of THETA standard errors
OmInit := TStringList.Create; // List of OMEGA initial estimates
OmSE := TStringList.Create; // List of OMEGA standard errors
SigInit := TStringList.Create; // List of SIGMA initial estimates
SigSE := TStringList.Create; // List of SIGMA standard errors
EtaBar := TStringList.Create; // List of ETABARs
EtaBarSE := TStringList.Create; // List of ETABAR SEs
EtaP := TStringList.Create; // List of ETABAR P values
EtaShrinkage := TStringList.Create; // List of ETA shrinkage values
EtaLabel := TStringList.Create; // List of ETA labels
Eta := TStringList.Create; // List of ETA estimates
Eps := TStringList.Create; // List of EPS estimates
EpsShrinkage := TStringList.Create; // List of EPS shrinkage values
lstCovSum := TStringList.Create; // Covariance summary
lstPsNRunRec := TStringList.Create; // PsN runrecord
lstMinTerm := TStringList.Create; // MINIMIZATION TERMINATED message
lstBlockOmega := TStringList.Create; // BLOCK OMEGA section
lstOmegaBlkVars := TStringList.Create; // List of BLOCK OMEGA vars
lstSigmaBlkVars := TStringList.Create; // List of BLOCK SIGMA vars
lstOmegaIndex := TStringList.Create;
lstSigmaIndex := TStringList.Create;
lstBlockSigma := TStringList.Create; // BLOCK SIGMA section
lstMatrixOmega := TStringList.Create; // OMEGA matrix
lstMatrixSigma := TStringList.Create; // SIGMA matrix
lstMatrixOmegaSE := TStringList.Create; // OMEGA matrix SEs
lstMatrixSigmaSE := TStringList.Create; // SIGMA matrix SEs
lstMatrixOmegaInit := TStringList.Create; // OMEGA matrix initial estimates
lstMatrixSigmaInit := TStringList.Create; // SIGMA matrix initial estimates
lstCovMatrix := TStringList.Create; // Covariance matrix
lstCorrMatrix := TStringList.Create; // Correlation matrix
lstInvCovMatrix := TStringList.Create; // Inverse covariance matrix
lstEigen := TStringList.Create; // Eigenvalues
lstScratch := TStringList.Create; // Scratch area
lstTemp := TStringList.Create; // Another temp list
lstTemp2 := TStringList.Create; // Another temp list
lstZeroCIs := TStringList.Create; // Zero CIs
lstLargeSEs := TStringList.Create; // Large SEs
lstNotes := TStringList.Create; // Notes
blnInlineCtl := False; // Inline control stream?
blnOFVSeen := False; // OFV present?
strEtaL := '';
strEtaL2 := '';
blnOFVWarn := False;
blnARun := False;
blnBOInit := False;
blnBSInit := False;
blnCovStep := True;
blnAsk := RegIni.ReadBool('Options', 'AskNonNumeric', False);
blnMD5 := RegIni.ReadBool('Options', 'MD5', False);
blnCap := False;
strInter := 'NO';
strLaplacian := 'NO';
strCondEst := 'NO';
strCentEta := 'NO';
blnEtaBlocks := False;
blnSigmaBlocks := False;
blnZeroGradients := False;
blnFZeroGradients := False;
blnLargeSEs := False;
blnBoundaries := False;
blnZeroCIs := False;
intOmega := 0;
fltEpsShrinkage := 0;
fltEstTime := 0;
fltCovTime := 0;
intOmegaBlk := 0;
intTheta := 0;
intSigma := 0;
intSigmaBlk := 0;
intRun := 0;
intBOCount := 0;
intBSCount := 0;
intZeroGradients := 0;
strSigDig := '';
strT := '';
strT2 := '';
intLines := 0;
intT2L := 0;
intHessian := 0;
intFixedOmegas := 0;
intFixedSigmas := 0;
strParent := '';
blnGoodRun := False;
blnNMQualRun := False;
blnEtaBar := True;
strBOTicker := '';
intBNo := 0;
blnFO := False;
blnFOCE := False;
blnSAEM := False;
blnBayes := False;
blnITS := False;
blnImp := False;
blnImpMap := False;
blnLaplacian := False;
strLastMethod := '';
//blnDebug := True;
// ********************************************************************
// Load output file into strList
// ********************************************************************
//ShowMessage(StringReplace(nmFile, extLst, '.xml',
// [rfIgnoreCase]));
strLst := nmFile;
if FileExists(StringReplace(nmFile, extLst, '.xml',
[rfIgnoreCase])) = False then
begin
MessageDlg('An XML file is required for parsing of NONMEM 7.2+ runs. The file ''' + #10 + #13 +
StringReplace(nmFile, extLst, '.xml', [rfIgnoreCase]) + '''' + #10 + #13 + ' does not exist.',
mtError, [mbOK], 0);
Exit;
end;
if FileExists(StringReplace(nmFile, extLst, '.xml',
[rfIgnoreCase])) then
begin
try
nmFile := StringReplace(nmFile, extLst, '.xml',
[rfIgnoreCase]);
//xmlDoc.LoadFromFile(StringReplace(nmFile, extLst, '.xml',
// [rfIgnoreCase]));
//xmlDoc.Active := True;
XMLIn := Loadoutput(nmFile);
except
;
end;
try
strList.Assign(LineBreaks(XMLIn.Nonmem.Problem.Items[0].Problem_information));
//ShowMessage(strList.Text);
lstLog.Add('Opened ' + nmFile + '...');
lstLog.Add('-----------------------------------------');
strRun := StringReplace(ExtractFileName(nmFile), runPrefix, '', [rfReplaceAll]);
strRun := StringReplace(strRun, '.xml', '', [rfReplaceAll]);
lstLog.Add('Length of filename... ' + IntToStr(Length(strRun)));
for n := 1 to Length(strRun) do
if not (strRun[n] in ['0'..'9']) then
blnARun := True;
intRun := ExtractNumberInString(ExtractFileName(nmFile));
if (blnARun) and (blnAsk) {strRun <> IntToStr(intRun)} then
strRun := InputBox('Please confirm your run number... [' +
nmFile + ']', 'Run Number', strRun);
lstLog.Add('Run number... ' + strRun);
try
tblRuns.IndexName := 'runno2';
// ********************************************************************
// Does run exist? If so then replace
// ********************************************************************
if tblRuns.FindKey([strRun]) then
begin
lstLog.Add('Run exists!');
if MessageDlg('This run (' + strRun + ') may already be present in the database. Would you '
+ 'like to replace it?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if MessageDlg('This will delete the current run record (' +
tblRunsRunNo.Value + '), and cannot be ' +
'reversed. Your original run files will not be ' +
'removed. Do you wish to continue?', mtWarning,
[mbYes, mbNo], 0) = mrYes then
begin
lstLog.Add('Replacing run...');
BlastRun;
end;
end
else
begin
if MessageDlg('Would you like to add this run with a different ' +
'number?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
strRun := InputBox('Please enter the new run number... [' +
nmFile + ']', 'Run Number', strRun)
else
Exit;
lstLog.Add('New run number... ' + strRun);
end;
end;
finally
tblRuns.IndexName := 'irunno';
end;
lstLog.Add('Length of problem block... ' + IntToStr(strList.Count));
//ShowMessage(strRun);
// get number of estimation steps
intEst := XMLIn.Nonmem.Problem[0].Estimation.Count;
// OFV of final estimation step
strObj := FloatToStr(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].final_objective_function);
blnInlineCtl := True;
regEx := TPerlRegEx.Create;
regEx.Subject := XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
// TODO: hessian resets
// TODO: PREDERR
if XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Covariance_status.Error = 0 then
begin
blnCovStep := True;
lstLog.Add('Covariance step successful...');
end
else
begin
blnCovStep := False;
lstLog.Add('Covariance step aborted...');
end;
strComment := XMLIn.Nonmem.Problem[0].Problem_title;
lstLog.Add('Comment... ' + strComment);
regEx.Subject := XMLIn.Nonmem.Problem[0].Problem_information;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
// ********************************************************************
// Read no of observations
// ********************************************************************
strObsRecs := OneLineRegEx(strList.Text, '(?<=TOT. NO. OF OBS RECS:).*?\r?\n', False);
lstLog.Add('Observation Records... ' + strObsRecs);
// ********************************************************************
// Read no of individuals
// ********************************************************************
strInds := OneLineRegEx(strList.Text, '(?<=TOT. NO. OF INDIVIDUALS:).*?\r?\n', False);
lstLog.Add('Individuals... ' + strInds);
// ********************************************************************
// Count THETAs
// ********************************************************************
intTheta := StrToInt(OneLineRegEx(strList.Text, '(?<=LENGTH OF THETA:).*?\r?\n', False));
lstLog.Add('THETAs... ' + IntToStr(intTheta));
// ********************************************************************
// PRIORS?
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := 'PRIOR SUBROUTINE USER-SUPPLIED';
if (regEx.Match) then
begin
lstLog.Add('Priors detected...');
blnPriors := True;
//ShowMessage('priors');
end;
// ********************************************************************
// Count OMEGAs
// ********************************************************************
intOmega := XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Omega.ChildNodes.Count;
//ShowMessage(IntToStr(intOmega));
lstLog.Add('OMEGAs... ' + IntToStr(intOmega));
// ********************************************************************
// Count SIGMAs
// ********************************************************************
intSigma := XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Sigma.ChildNodes.Count;
//ShowMessage(IntToStr(intOmega));
lstLog.Add('SIGMAs... ' + IntToStr(intSigma));
// ********************************************************************
// Initial estimates & bounds of THETA
// ********************************************************************
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=INITIAL ESTIMATE OF THETA:).*(?=(0INITIAL ESTIMATE OF OMEGA:))';
if (regEx.Match) then
begin
lstLog.Add('Starting THETA initial estimates...');
//ShowMessage(regEx.MatchedText);
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
if (Pos('LOWER', lstTemp.Text) > 0) then
begin
for m := 1 to intTheta do
begin
ThLower.Add(BrkUp(' ', lstTemp[m+1], 0));
lstLog.Add('THETA(' + IntToStr(m) + ') Lower Bound... ' +
BrkUp(' ', lstTemp[m+1], 0));
ThInit.Add(BrkUp(' ', lstTemp[m+1], 1));
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
BrkUp(' ', lstTemp[m+1], 1));
ThUpper.Add(BrkUp(' ', lstTemp[m+1], 2));
lstLog.Add('THETA(' + IntToStr(m) + ') Upper Bound... ' +
BrkUp(' ', lstTemp[m+1], 2));
end;
end
else
begin
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := Trim(lstTemp.Text);
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
// ShowMessage(brkUpp.StringList.Text);
for m := 1 to intTheta do
begin
ThLower.Add('-100000');
ThInit.Add(brkUpp.StringList[m-1]);
lstLog.Add('THETA(' + IntToStr(m) + ') Initial Est... ' +
brkUpp.StringList[m-1]);
ThUpper.Add('100000');
end;
end;
//ShowMessage(ThLower.Text);
//ShowMessage(ThInit.Text);
//ShowMessage(ThUpper.Text);
end;
// ********************************************************************
// Initial estimates of OMEGA
// ********************************************************************
lstTemp.Assign(LineBreaks(XMLIn.Control_stream));
lstTemp2.Clear;
blnEtasOn := False;
for m := 0 to lstTemp.Count - 1 do
begin
//if (Pos('$OMEGA', lstTemp[m]) > 0) and (Pos(';', lstTemp[m]) > Pos('$OMEGA', lstTemp[m])) then
if (Pos('$OMEGA', lstTemp[m]) > 0) then
blnEtasOn := True;
//if (Pos(';', lstTemp[m]) = 0) or (Pos(';', lstTemp[m]) > Pos('$OMEGA', lstTemp[m])) then
if (Pos('$OMEGA', lstTemp[m]) = 0) and (Pos('$', lstTemp[m]) > 0) then
if (Pos(';', lstTemp[m]) = 0) or (Pos(';', lstTemp[m]) > Pos('$', lstTemp[m])) then
blnEtasOn := False;
if blnEtasOn then
if (Pos(';', lstTemp[m]) = 0) then
lstTemp2.Add(lstTemp[m])
else
lstTemp2.Add(Copy(lstTemp[m], 1, Pos(';', lstTemp[m])-1));
end;
//ShowMessage(lstTemp2.Text);
strTemp := StringReplace(StringReplace(StringReplace(StringReplace(lstTemp2.Text, '(', ' ', [rfReplaceAll]), ')', ' ', [rfReplaceAll]), 'FIX', '', [rfReplaceAll]), '$OMEGA', '', [rfReplaceAll]);
brkUpp.BaseString := StringReplace(StringReplace(strTemp, #10, ' ', [rfReplaceAll]), #13, ' ', [rfReplaceAll]);
brkUpp.BreakString := ' ';
brkUpp.AllowEmptyString := False;
brkUpp.BreakApart;
//ShowMessage(brkUpp.StringList.Text);
blnEtasOn := True;
OmInit.Clear;
s := -1;
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if (Pos('BLOCK', brkUpp.StringList[m]) > 0) and (blnEtasOn) and (m > s) then
begin
p := StrToInt(brkUpp.StringList[m+1]); // number of dimensions
r := 0;
for q := 1 to p do
begin
OmInit.Add(brkUpp.StringList[m + 1 + q + r]);
//ShowMessage('Active');
r := r + q;
if OmInit.Count = intOmega then
blnEtasOn := False;
end;
s := m + 1 + p;
end
else
begin
if OmInit.Count = intOmega then
blnEtasOn := False;
if (blnEtasOn) and (m > s) then
OmInit.Add(brkUpp.StringList[m]);
end;
end;
//ShowMessage(OmInit.Text);
// ********************************************************************
// Initial estimates of SIGMA
// ********************************************************************
lstTemp.Assign(LineBreaks(XMLIn.Control_stream));
lstTemp2.Clear;
blnSigmasOn := False;
for m := 0 to lstTemp.Count - 1 do
begin
if (Pos('$SIGMA', lstTemp[m]) > 0) then
blnSigmasOn := True;
if (Pos('$SIGMA', lstTemp[m]) = 0) and (Pos('$', lstTemp[m]) > 0) then
if (Pos(';', lstTemp[m]) = 0) or (Pos(';', lstTemp[m]) > Pos('$', lstTemp[m])) then
blnSigmasOn := False;
if blnSigmasOn then
if (Pos(';', lstTemp[m]) = 0) then
lstTemp2.Add(lstTemp[m])
else
lstTemp2.Add(Copy(lstTemp[m], 1, Pos(';', lstTemp[m])-1));
end;
//ShowMessage(lstTemp2.Text);
strTemp := StringReplace(StringReplace(StringReplace(StringReplace(lstTemp2.Text, '(', ' ', [rfReplaceAll]), ')', ' ', [rfReplaceAll]), 'FIX', '', [rfReplaceAll]), '$SIGMA', '', [rfReplaceAll]);
brkUpp.BaseString := StringReplace(StringReplace(strTemp, #10, ' ', [rfReplaceAll]), #13, ' ', [rfReplaceAll]);
brkUpp.BreakString := ' ';
brkUpp.AllowEmptyString := False;
brkUpp.BreakApart;
//ShowMessage(brkUpp.StringList.Text);
blnSigmasOn := True;
SigInit.Clear;
s := -1;
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if (Pos('BLOCK', brkUpp.StringList[m]) > 0) and (blnSigmasOn) and (m > s) then
begin
p := StrToInt(brkUpp.StringList[m+1]); // number of dimensions
r := 0;
for q := 1 to p do
begin
SigInit.Add(brkUpp.StringList[m + 1 + q + r]);
//ShowMessage('Active');
r := r + q;
if SigInit.Count = intSigma then
blnSigmasOn := False;
end;
s := m + 1 + p;
end
else
begin
if SigInit.Count = intSigma then
blnSigmasOn := False;
if (blnSigmasOn) and (m > s) then
SigInit.Add(brkUpp.StringList[m]);
end;
end;
//ShowMessage(SigInit.Text);
// ********************************************************************
// FOCE
// ********************************************************************
regEx.Subject := XMLIn.Nonmem.Problem[0].Problem_information;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
strCondEst := OneLineRegExAgain(strList.Text, '(?<=CONDITIONAL ESTIMATES USED:).*?\r?\n', False);
if Length(strCondEst) < 1 then
strCondEst := 'NO';
lstLog.Add('Conditional Estimates... ' + strCondEst);
//ShowMessage(strCondEst);
// ********************************************************************
// Centered ETA
// ********************************************************************
strCentEta := OneLineRegExAgain(strList.Text, '(?<=CENTERED ETA:).*?\r?\n', False);
lstLog.Add('Centered Eta... ' + strCentEta);
// ********************************************************************
// INTERACTION
// ********************************************************************
strInter := OneLineRegExAgain(strList.Text, '(?<=EPS-ETA INTERACTION:).*?\r?\n', False);
lstLog.Add('Eps-Eta Interaction... ' + strInter);
// ********************************************************************
// Laplacian
// ********************************************************************
strLaplacian := OneLineRegExAgain(strList.Text, '(?<=LAPLACIAN OBJ. FUNC.:).*?\r?\n', False);
lstLog.Add('Laplacian Obj Fn... ' + strLaplacian);
// ********************************************************************
// Numerical second derivatives
// ********************************************************************
strSecDeriv := OneLineRegExAgain(strList.Text, '(?<=NUMERICAL 2ND DERIVATIVES:).*?\r?\n', False);
lstLog.Add('Numerical Second Derivatives... ' + strSecDeriv);
// ********************************************************************
// Slow gradient method
// ********************************************************************
strSlow := OneLineRegExAgain(strList.Text, '(?<=SLOW GRADIENT METHOD USED:).*?\r?\n', False);
lstLog.Add('Slow Gradient Method... ' + strSlow);
// ********************************************************************
// Methods
// ********************************************************************
strMethods := '';
for m := 0 to intEst - 1 do
begin
if m > 0 then
strMethods := strMethods + ', ';
strMethods := strMethods + XMLIn.Nonmem.Problem[0].Estimation[m].Estimation_method;
end;
strLastMethod := XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Estimation_title;
//ShowMessage(strMethods);
//showmessage(strLastMethod);
// ********************************************************************
// Check zero gradients and hessian resets
// ********************************************************************
lstTemp.Clear;
lstTemp2.Clear;
lstScratch.Clear;
lstScratch.LoadFromFile(strLst);
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=MONITORING OF SEARCH:).*(?=( Elapsed estimation time))';
regEx.Subject := lstScratch.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
strTemp := '';
for n := 0 to lstTemp.Count - 1 do
begin
if Pos('GRADIENT', lstTemp[n]) > 0 then
blnCap := True;
if Pos('ITERATION NO.', lstTemp[n]) > 0 then
begin
blnCap := False;
if Length(strTemp) > 0 then
lstTemp2.Add(strTemp);
strTemp := '';
end;
if blnCap then
strTemp := strTemp + lstTemp[n];
end;
if Length(strTemp) > 0 then
lstTemp2.Add(strTemp);
if Pos('0.0000E+00', strTemp) > 0 then
begin
blnFZeroGradients := True;
lstLog.Add('Zero gradients detected in final iteration...');
end;
// count zero gradients
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '0.0000E+00';
regExI.Subject := lstTemp2.Text;
if regExI.Match then
begin
intZeroGradients := 1;
blnZeroGradients := True;
while regExI.MatchAgain do
begin
intZeroGradients := intZeroGradients + 1;
end;
end;
lstLog.Add(IntToStr(intZeroGradients) + ' zero gradients detected...');
regExI.Free;
// count Hessian resets
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := 'RESET HESSIAN';
regExI.Subject := lstTemp.Text;
if regExI.Match then
begin
intHessian := 1;
lstLog.Add('Hessian reset detected...');
while regExI.MatchAgain do
begin
intHessian := intHessian + 1;
lstLog.Add('Hessian reset detected...');
end;
end;
lstLog.Add(IntToStr(intZeroGradients) + ' Hessian resets detected...');
regExI.Free;
end;
//ShowMessage(lstTemp2.Text);
// ********************************************************************
// Check minimization
// ********************************************************************
lstMinTerm.Clear;
for m := 0 to intEst - 1 do
begin
lstMinTerm.Add(XMLIn.Nonmem.Problem[0].Estimation[m].Estimation_title +
' (' + XMLIn.Nonmem.Problem[0].Estimation[m].Estimation_method + ', ' +
IntToStr(XMLIn.Nonmem.Problem[0].Estimation[m].Termination_status) + ')');
lstMinTerm.Add('-------------------------');
lstMinTerm.AddStrings(LineBreaks(XMLIn.Nonmem.Problem[0].Estimation[m].Termination_information));
lstMinTerm.Add('-------------------------');
end;
//showmessage(lstMinTerm.Text);
if Pos('MINIMIZATION SUCCESSFUL', XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information) > 0 then
strMin := 'Successful';
if Pos('MINIMIZATION TERMINATED', XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information) > 0 then
begin
strMin := 'Terminated';
swMinTerm := True;
blnCovStep := False;
end;
if Pos('COMPLETED', XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information) > 0 then
strMin := 'Completed';
if Pos('NOT COMPLETED', XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information) > 0 then
strMin := 'Not Completed';
if (Pos('TERMINATED', lstMinTerm.Text) > 0) or (Pos('NOT COMPLETED', lstMinTerm.Text) > 0) then
if (strMin = 'Completed') or (strMin = 'Successful') then
strMin := 'Partial';
lstLog.Add('Minimization... ' + strMin);
regEx.Subject := XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Termination_information;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=NO. OF FUNCTION EVALUATIONS USED:).*?\r?\n';
if regEx.Match then
begin
strFnEval := Trim(regEx.MatchedText);
lstLog.Add('Fn Evals... ' + strFnEval);
//ShowMessage(strInter);
end;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=NO. OF SIG. DIGITS IN FINAL EST.:).*?\r?\n';
if regEx.Match then
strSigDig := Trim(regEx.MatchedText)
else
strSigDig := 'UNREPORTABLE';
lstLog.Add('Significant digits... ' + strSigDig);
// ********************************************************************
// ETABAR
// ********************************************************************
//ShowMessage(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Etabar.Row.Items[0].Col[0].Cname);
ShowMessage(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Etabar.Row.Items[0].Col[0].ChildNodes[0].Text);
if XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Etabar.ChildNodes.Count = 1 then
begin
for m := 0 to intOmega - 1 do
begin
EtaBar.Add(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].Etabar.Row.Items[0].Col[m].ChildNodes[0].Text);
EtaBarSE.Add(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].EtabarSE.Row.Items[0].Col[m].ChildNodes[0].Text);
EtaP.Add(XMLIn.Nonmem.Problem[0].Estimation[intEst-1].EtabarPval.Row.Items[0].Col[m].ChildNodes[0].Text);
end;
end;
ShowMessage(EtaBar.Text);
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := 'SUBMODEL';
regEx.Subject := strList.Text;
if regEx.Match then
begin
blnEtaBar := False;
lstLog.Add('Submodels detected - ETABAR turned OFF');
end
else
blnEtaBar := True;
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= ETABAR:).*(?=( SE:))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaBar.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaBar.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBars added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaBar.Text);
// ********************************************************************
// ETABAR SE
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= SE:).*(?=( P VAL.:))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaBarSE.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaBarSE.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBar SEs added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaBarSE.Text);
// ********************************************************************
// ETABAR P value
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= P VAL.:).*(?=( ETAshrink\(%\):))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaP.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaP.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('EtaBar P-values added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaP.Text);
// ********************************************************************
// ETA shrinkage
// ********************************************************************
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<= ETAshrink\(%\):).*(?=( EPSshrink\(%\):))';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EtaShrinkage.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EtaShrinkage.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('Eta shrinkages added... ' + IntToStr(n));
regExI.Free;
end;
end;
//ShowMessage(EtaShrinkage.Text);
// ********************************************************************
// EPS shrinkage
// ********************************************************************
//ShowMessage(lstTemp.Text);
if (blnEtaBar) and (strLastMethod <> 'Bayes') then
begin
// fltEpsShrinkage := StrToFloat(OneLineRegEx(strList.Text, '(?<= EPSshrink\(%\):).*?\r?\n', False));
// lstLog.Add('Epsilon shrinkage... ' + FloatToStr(fltEpsShrinkage));
regEx.Options := [preMultiLine,preSingleLine];
regEx.RegEx := '(?<= EPSshrink\(%\):).*?\r?\n';
regEx.Subject := lstTemp.Text;
if regEx.Match then
begin
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine,preUnGreedy];
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
regExI.Subject := regEx.MatchedText;
if regExI.Match then
begin
n := 1;
EpsShrinkage.Add(RegExI.MatchedText);
while regExI.MatchAgain do
begin
EpsShrinkage.Add(RegExI.MatchedText);
n := n + 1;
end;
end;
lstLog.Add('Eta shrinkages added... ' + IntToStr(n));
regExI.Free;
end;
if EpsShrinkage.Count > 0 then
fltEpsShrinkage := StrToFloat(EpsShrinkage[0]);
end;
//ShowMessage(EpsShrinkage.Text);
lstTemp.Clear;
// ********************************************************************
// Elapsed estimation time
// ********************************************************************
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := '(?<=Elapsed estimation time in seconds:).*?\r?\n';
regEx.Subject := strList.Text;
if regEx.Match then
begin
fltEstTime := StrToFloat(Trim(regEx.MatchedText));
lstLog.Add('Estimation time... ' + FloatToStr(fltEstTime));
while regEx.MatchAgain do
begin
fltEstTime := fltEstTime + StrToFloat(Trim(regEx.MatchedText));
lstLog.Add('Estimation time... ' + Trim(regEx.MatchedText));
end;
end
else
fltEstTime := 0;
// ********************************************************************
// Elapsed covariance time
// ********************************************************************
strTemp := OneLineRegEx(strList.Text, '(?<=Elapsed covariance time in seconds:).*?\r?\n', False);
if Length(strTemp) > 0 then
fltCovTime := StrToFloat(strTemp)
else
fltCovTime := 0;
lstLog.Add('Covariance time... ' + FloatToStr(fltCovTime));
// ********************************************************************
// Read THETA & ETA & EPS estimates
// ********************************************************************
// grab whole FP block and put in lstTemp
// we only take the last one in case several steps have been run
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
if fltCovTime > 0 then
regEx.RegEx := '(?<=FINAL PARAMETER ESTIMATE).*(?=(1\r?\n? \*{120}))'
else
begin
regEx.RegEx := '(?<=FINAL PARAMETER ESTIMATE).*'; // nothing after this point, no cov step
regEx.Options := [preMultiLine,preSingleLine];
end;
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
while regEx.MatchAgain do
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
end;
//ShowMessage(lstTemp.Text);
// get Thetas
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=THETA - VECTOR OF FIXED EFFECTS PARAMETERS \*{9}).*(?=(OMEGA))';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
ThValue.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
ThValue.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//Showmessage(ThValue.Text);
// get Etas
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*(?=SIGMA)';
//Showmessage(lstTemp.Text);
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
// Sometimes SIGMAs are not present
if length(Trim(lstTemp2.Text)) = 0 then
begin
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
end;
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
// checking again in case of priors
for n := 1 to 200 do
begin
if ((n*n) + n)/2 = lstScratch.Count then
intOmega := n;
end;
//ShowMessage(inttostr(intomega));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intOmega - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
Eta.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixOmega.Add(strTemp);
strTemp := '';
end;
//Showmessage(Eta.Text);
//showmessage(lstMatrixOmega.Text);
// get Epsilons
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS \*{4}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//lstTemp.SaveToFile('C:\Users\Administrator\Documents\Delphi\Census\svn\lstTemp.txt');
//showmessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage('sigmas');
//ShowMessage(inttostr(intSigma));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intSigma - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
Eps.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixSigma.Add(strTemp);
strTemp := '';
end;
//Showmessage(Eps.Text);
//showmessage(lstMatrixSigma.Text);
end;
// ********************************************************************
// Read THETA & ETA & EPS SEs
// ********************************************************************
// grab whole SE block and put in lstTemp
lstTemp.Clear;
lstTemp2.Clear;
regEx.Options := [preMultiLine,preSingleLine,preUnGreedy];
regEx.RegEx := '(?<=STANDARD ERROR OF ESTIMATE).*(?=(1\r?\n? \*{120}))';
regEx.Subject := strList.Text;
if regEx.Match then
begin
lstTemp.Add(regEx.MatchedText);
// replace dots with placeholders
lstTemp.Text := StringReplace(lstTemp.Text, '.........', '9.99E+99', [rfReplaceAll]);
// correct line breaks
lstTemp.Text := StringReplace(StringReplace(lstTemp.Text, #10, '£', [rfReplaceAll]), #13, 'ç', [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£ç',#13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, '£', #13, [rfReplaceAll]);
lstTemp.Text := StringReplace(lstTemp.Text, 'ç', #13, [rfReplaceAll]);
while regEx.MatchAgain do
begin
lstTemp.Clear;
lstTemp.Add(regEx.MatchedText);
end;
// get Thetas
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=THETA - VECTOR OF FIXED EFFECTS PARAMETERS \*{9}).*(?=(OMEGA))';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
regExI.Subject := regExI.MatchedText;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
ThSE.Add('...')
else
ThSE.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
ThSE.Add('...')
else
ThSE.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//Showmessage(ThSE.Text);
// get Etas
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*(?=SIGMA)';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//showmessage(lstTemp.Text);
// Sometimes SIGMAs are not present
if length(Trim(lstTemp2.Text)) = 0 then
begin
regExI.RegEx := '(?<=OMEGA - COV MATRIX FOR RANDOM EFFECTS - ETAS \*{8}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
end;
//ShowMessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage(inttostr(intomega));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intOmega - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
OmSE.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixOmegaSE.Add(strTemp);
strTemp := '';
end;
//Showmessage(OmSE.Text);
//showmessage(lstMatrixOmegaSE.Text);
// get Epsilons
lstTemp2.Clear;
lstScratch.Clear;
regExI := TPerlRegEx.Create;
regExI.Options := [preMultiLine,preSingleLine];
regExI.RegEx := '(?<=SIGMA - COV MATRIX FOR RANDOM EFFECTS - EPSILONS \*{4}).*';
regExI.Subject := lstTemp.Text;
if regExI.Match then
lstTemp2.Add(regExI.MatchedText);
//lstTemp.SaveToFile('C:\Users\Administrator\Documents\Delphi\Census\svn\lstTemp.txt');
//showmessage(lstTemp2.Text);
regExI.Subject := lstTemp2.Text;
regExI.RegEx := '-?\d\.\d+E[\+|-]\d{2}';
if regExI.Match then
begin
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
while regExI.MatchAgain do
if regExI.MatchedText = '9.99E+99' then
lstScratch.Add('...')
else
lstScratch.Add(FloatToStr(StrToFloat(RegExI.MatchedText)*1));
end;
regExI.Free;
//ShowMessage(inttostr(intSigma));
//showmessage(lstScratch.Text);
strTemp := '';
p := 0; // row
q := 0; // index
r := 0;
for n := 0 to intSigma - 1 do
begin
for m := r to q do
begin
if m < q then
strTemp := strTemp + lstScratch[m] + ','
else
begin
strTemp := strTemp + lstScratch[m];
SigSE.Add(lstScratch[m]);
end;
end;
//showmessage(strTemp);
//showmessage(inttostr(r) + ' to ' + inttostr(q));
p := p + 1;
r := r + p;
q := q + p + 1; // correct
lstMatrixSigmaSE.Add(strTemp);
strTemp := '';
end;
//Showmessage(SigSE.Text);
//showmessage(lstMatrixSigmaSE.Text);
end;
// ********************************************************************
// Proper estimation? OFV present?
// ********************************************************************
for n := 0 to strList.Count - 1 do
begin
// ********************************************************************
// Covariance matrix
// ********************************************************************
{ if Pos(' ******************** COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting covariance matrix...');
//ShowMessage('Starting Cov matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
// Nick's exception
if (Pos('Optimality', strList[n + p]) = 0) and
(Pos('Optimality', strList[n + p - 1]) = 0) and
(Pos('Optimality', strList[n + p - 2]) = 0) and
(Pos('Optimality', strList[n + p - 3]) = 0) and
(Pos('Optimality', strList[n + p - 4]) = 0) and
(Pos('Optimality', strList[n + p - 5]) = 0) then
// On with the show
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCovMatrix.Add(strT)
else
if lstCovMatrix.Count = 0 then
lstCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCovMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Correlation matrix
// ********************************************************************
if Pos(' ******************** CORRELATION MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting correlation matrix...');
//ShowMessage('Starting Corr matrix');
p := 5;
lstScratch.Clear;
while Pos('***************', strList[n + p]) = 0 do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstCorrMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstCorrMatrix.Add(strT)
else
if lstCorrMatrix.Count = 0 then
lstCorrMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate correlation matrix
// ********************************************************************
begin
lstLog.Add('Alternate correlation matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstCorrMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstCorrMatrix.Add(strT);
q := q + m;
end;
end;
end;
// ********************************************************************
// Inverse covariance matrix
// ********************************************************************
if Pos(' ******************** INVERSE COVARIANCE MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting inverse covariance matrix...');
//ShowMessage('Starting InvCov matrix');
p := 5;
lstScratch.Clear;
while (n + p <= strList.Count - 1) and // FIX
(Pos('***************', strList[n + p]) = 0) do
begin
lstScratch.Add(strList[n + p]);
p := p + 1;
end;
if Pos('|', lstScratch.Text) = 0 then
begin
strT := '';
for m := 0 to lstScratch.Count - 1 do
begin
// Parse line
if Length(Trim(lstScratch[m])) > 0 then
strT := strT + ' ' + Trim(lstScratch[m]);
// Convert and add
if Length(Trim(lstScratch[m])) = 0 then
begin
strT := StringReplace(strT, '+', '', [rfReplaceAll]);
strT := StringReplace(strT, ' -', ' -', [rfReplaceAll]);
strT := StringReplace(strT, ' .........', ' .........',
[rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
if lstInvCovMatrix.Count = 0 then
strT := ','
else
strT := '';
for p := 0 to brkUpp.StringList.Count - 1 do
if (Pos('TH', brkUpp.StringList[p]) = 0) and
(Pos('OM', brkUpp.StringList[p]) = 0) and
(Pos('SG', brkUpp.StringList[p]) = 0) and
(Pos('...', brkUpp.StringList[p]) = 0) then
brkUpp.StringList[p] := FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if p = brkUpp.StringList.Count - 1 then
strT := strT + Trim(brkUpp.StringList[p])
else
strT := strT + Trim(brkUpp.StringList[p]) + ',';
strT := StringReplace(strT, ',.........', ',......',
[rfReplaceAll]);
strT := Trim(strT);
if (Length(strT) > 1) then
begin
if (Pos('TH 1,TH 2', strT) = 0) then
lstInvCovMatrix.Add(strT)
else
if lstInvCovMatrix.Count = 0 then
lstInvCovMatrix.Add(strT);
end;
//ShowMessage(strT);
strT := '';
end;
end;
end
else
// ********************************************************************
// Alternate inverse covariance matrix
// ********************************************************************
begin
lstLog.Add('Alternate inverse covariance matrix structure detected...');
strT := '';
lstTemp.Clear;
for m := 0 to lstScratch.Count - 1 do
if Pos('|', lstScratch[m]) > 0 then
strT := strT + lstScratch[m];
strT := StringReplace(strT, '|', ' ', [rfReplaceAll]);
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
for m := 0 to brkUpp.StringList.Count - 1 do
if lstTemp.IndexOf(Trim(brkUpp.StringList[m])) = -1 then
lstTemp.Add(Trim(brkUpp.StringList[m]));
//ShowMessage(IntToStr(lstTemp.Count));
strT := '';
for m := 0 to lstTemp.Count - 1 do
strT := strT + ',' + lstTemp[m];
lstInvCovMatrix.Add(strT);
lstTemp2.Clear;
strT := '';
for m := 0 to lstScratch.Count - 1 do
if (Pos('|', lstScratch[m]) = 0) and
(Pos('1', lstScratch[m]) <> 1) then
strT := strT + lstScratch[m];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
//ShowMessage(IntToStr(brkUpp.StringList.Count));
q := 0;
for m := 0 to lstTemp.Count - 1 do
begin
strT := lstTemp[m];
for p := m + q to m + q + m do
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
//ShowMessage(strT);
lstInvCovMatrix.Add(strT);
q := q + m;
end;
end;
end; }
// ********************************************************************
// Eigenvalues
// ********************************************************************
if Pos(' ******************** EIGENVALUES OF COR MATRIX OF ESTIMATE', strList.Strings[n]) > 0 then
begin
lstLog.Add('Starting eigenvalues...');
lstScratch.Clear;
strT := '';
if (Pos('E', strList[n + 5]) >= 1) then
strT := Trim(strList[n + 5]);
if (Pos('E', strList[n + 6]) >= 1) then
strT := strT + strList[n + 6];
//ShowMessage(strT);
if (n + 7 <= strList.Count - 1) and
(NoAlpha(strList[n + 7])) and
(Pos('****', strList[n + 7]) = 0) and
(Pos('E', strList[n + 7]) >= 1) then
strT := strT + strList[n + 7];
if (n + 8 <= strList.Count - 1) then
if (Length(Trim(strList[n + 8])) > 0) and
(NoAlpha(strList[n + 8])) and
(Pos('****', strList[n + 8]) = 0) and
(Pos('E', strList[n + 8]) >= 1) then
strT := strT + strList[n + 8];
if (n + 9 <= strList.Count - 1) then
if (Length(Trim(strList[n + 9])) > 0) and
(NoAlpha(strList[n + 9])) and
(Pos('****', strList[n + 9]) = 0) and
(Pos('E', strList[n + 9]) >= 1) then
strT := strT + strList[n + 9];
if (n + 10 <= strList.Count - 1) then
if (Length(Trim(strList[n + 10])) > 0) and
(NoAlpha(strList[n + 10])) and
(Pos('****', strList[n + 10]) = 0) and
(Pos('E', strList[n + 10]) >= 1) then
strT := strT + strList[n + 10];
if (n + 11 <= strList.Count - 1) then
if (Length(Trim(strList[n + 11])) > 0) and
(NoAlpha(strList[n + 11])) and
(Pos('****', strList[n + 11]) = 0) and
(Pos('E', strList[n + 11]) >= 1) then
strT := strT + strList[n + 11];
if (n + 12 <= strList.Count - 1) then
if (Length(Trim(strList[n + 12])) > 0) and
(NoAlpha(strList[n + 12])) and
(Pos('****', strList[n + 12]) = 0) and
(Pos('E', strList[n + 12]) >= 1) then
strT := strT + strList[n + 12];
brkUpp.StringList.Clear;
brkUpp.BaseString := strT;
brkUpp.BreakString := ' ';
brkUpp.BreakApart;
strT := '';
//showmessage(brkUpp.StringList.Text);
//ShowMessage(IntToStr(Round((brkUpp.StringList.Count/2)) - 1));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' + FloatToStr(StrToFloat(brkUpp.StringList[p], fs));
lstEigen.Add(strT);
SetRoundMode(rmNearest);
//ShowMessage(strT);
//ShowMessage(brkUpp.StringList.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
begin
strT := FloatToStr(StrToFloat(brkUpp.StringList[m]));
for p := 0 to brkUpp.StringList.Count - 1 do
begin
strT := strT + ',' + FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
end;
//ShowMessage(strT);
lstEigen.Add(strT);
end;
end;
{ for m := 0 to brkUpp.StringList.Count - 1 do
begin
if Pos('E', brkUpp.StringList[m]) >= 1 then
strT := FloatToStr(StrToFloat(brkUpp.StringList[m], fs));
for p := 0 to brkUpp.StringList.Count - 1 do
if Pos('E', brkUpp.StringList[p]) >= 1 then
strT := strT + ',' +
FloatToStr(RoundTo(StrToFloat(brkUpp.StringList[m], fs) /
StrToFloat(brkUpp.StringList[p], fs), -4));
lstEigen.Add(strT);
end; }
lstLog.Add('Starting condition number...');
// ********************************************************************
// Condition number
// ********************************************************************
fltEigenUpper := 0.00000000001;
fltEigenLower := 100000000000;
fltCondNo := 0;
//ShowMessage(brkUpp.StringList.Text);
//ShowMessage(lstEigen.Text);
for m := 0 to brkUpp.StringList.Count - 1 do
begin
//ShowMessage(IntToStr(m) + ' ' + brkUpp.StringList[m]);
if (StrToFloat(brkUpp.StringList[m], fs) > fltEigenUpper) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenUpper := StrToFloat(brkUpp.StringList[m], fs);
if (StrToFloat(brkUpp.StringList[m], fs) < fltEigenLower) and
(Pos('E', brkUpp.StringList[m]) >= 1) then
fltEigenLower := StrToFloat(brkUpp.StringList[m], fs);
end;
fltCondNo := Abs(RoundTo(fltEigenUpper / fltEigenLower, -2));
end;
end;
// ********************************************************************
// Free strList
// ********************************************************************
strList.Free;
lstLog.Add('Completed output file...');
strT := '';
//dlgLog.Lines.Assign(lstLog);
//dlgLog.Execute;
//Showmessage('parsing done');
Exit;
finally
end;
//if not Assigned(frmXML) then
// frmXML := TfrmXML.Create(Application);
//try
// Cursor := Screen.Cursor;
// Screen.Cursor := crHourglass;
// DOMShow(frmXML.tvXML, xmlDoc.DocumentElement, nil);
// frmXML.tvXML.FullExpand;
//finally
// Screen.Cursor := Cursor;
// frmXML.Show;
//end;
if pnlMain.Visible then
RefreshTree;
if pnlCompare.Visible then
RefreshCompare;
//tblRuns.Filtered := True;
end;
// ********************************************************************
// Debug info
// ********************************************************************
if blnDebug then
begin
lstLog.Add(#10#13);
lstLog.Add('Done!');
dlgLog.Lines.Assign(lstLog);
dlgLog.Execute;
end;
lstLog.SaveToFile(ExtractFilePath(Application.Exename) + 'run' +
strRun + '_error.log');
// ********************************************************************
// Free all variables
// ********************************************************************
if Assigned(PKParams) then
PKParams.Free;
ThLabel.Free;
ThLower.Free;
ThInit.Free;
ThUpper.Free;
ThValue.Free;
ThSE.Free;
SigInit.Free;
OmInit.Free;
EtaBar.Free;
EtaBarSE.Free;
EtaP.Free;
Eta.Free;
Eps.Free;
OmSE.Free;
SigSE.Free;
EtaLabel.Free;
EtaShrinkage.Free;
EpsShrinkage.Free;
lstLog.Free;
lstCovSum.Free;
lstMinTerm.Free;
lstBlockOmega.Free;
lstOmegaBlkVars.Free;
lstSigmaBlkVars.Free;
lstOmegaIndex.Free;
lstSigmaIndex.Free;
lstBlockSigma.Free;
lstMatrixOmega.Free;
lstMatrixSigma.Free;
lstMatrixOmegaInit.Free;
lstMatrixSigmaInit.Free;
lstMatrixOmegaSE.Free;
lstMatrixSigmaSE.Free;
lstCovMatrix.Free;
lstCorrMatrix.Free;
lstInvCovMatrix.Free;
lstScratch.Free;
lstTemp.Free;
lstTemp2.Free;
strOmegaList.Free;
strSigmaList.Free;
lstLargeSEs.Free;
lstZeroCIs.Free;
lstPsNRunRec.Free;
lstNotes.Free;
brkUpp.StringList.Clear;
brkUpp.AllowEmptyString := False;
brkUpp.BaseString := '';
brkUpp.BreakString := '';
RegIni.Free;
regEx.Free;
end;
function TfrmNMRun.StripSpaces(st: string): string;
var
p: Integer;
begin
p := pos(' ', st);
while p <> 0 do begin
st := StringReplace(st, ' ', ' ', [rfReplaceAll]);
p := pos(' ', st);
end;
Result := st;
end;
function TfrmNMRun.OneLineRegEx(strIn: string; strRegEx: string; blnMsg: Boolean): string;
var
regEx: TPerlRegEx;
begin
regEx := TPerlRegEx.Create;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := strRegEx;
regEx.Subject := strIn;
if regEx.Match then
begin
if blnMsg then
ShowMessage(Trim(regEx.MatchedText));
Result := Trim(regEx.MatchedText);
end
else
Result := '';
regEx.Free;
end;
function TfrmNMRun.OneLineRegExAgain(strIn: string; strRegEx: string; blnMsg: Boolean): string;
var
regEx: TPerlRegEx;
begin
regEx := TPerlRegEx.Create;
regEx.Options := [preMultiLine,preUnGreedy];
regEx.RegEx := strRegEx;
regEx.Subject := strIn;
if regEx.Match then
begin
if blnMsg then
ShowMessage(Trim(regEx.MatchedText));
Result := Trim(regEx.MatchedText);
while regEx.MatchAgain do
begin
Result := Trim(regEx.MatchedText);
if blnMsg then
ShowMessage(Trim(regEx.MatchedText));
end;
end
else
Result := '';
regEx.Free;
end;
function TfrmNMRun.RndSig (Number: Extended; Sig: Word; Direction: Boolean): Extended;
// from http://www.tek-tips.com/viewthread.cfm?qid=215607&page=308
var
Whole: Boolean;
begin
if (Number = int(Number)) then
Whole := True
else
Whole := False;
if (Whole) then
begin
Number := Number / power( 10, Sig - 1 );
{ Round Up }
if (Direction) then
Number := Int( Number + 0.5 )
{ Round Down }
else
Number := Int( Number - 0.5 );
Result := Number * power( 10, Sig - 1 );
end
else
begin
Number := Number * power( 10, Sig - 1 );
{ Round Up }
if (Direction) then
Number := Int( Number + 0.5 )
{ Round Down }
else
Number := Int( Number - 0.5 );
Result := Number / power( 10, Sig - 1 );
end;
end;
function TfrmNMRun.RoundD(x: Extended; d: Integer): Extended;
// RoundD(123.456, 0) = 123.00
// RoundD(123.456, 2) = 123.46
// RoundD(123456, -3) = 123000
var
n: Extended;
begin
n := IntPower(10, d);
x := x * n;
Result := (Int(x) + Int(Frac(x) * 2)) / n;
end;
procedure TfrmNMRun.DOMShow(ATree: TTreeView; Anode: IXMLNode; TNode: TTreeNode);
var
I: Integer;
NTNode: TTreeNode;
NText: string;
AttrNode: IXMLNode;
begin
if not (Anode.NodeType = ntElement) then
//if not (Anode.NodeType = ntCdata) then
Exit;
NText := '<' + UpperCase(Anode.NodeName) + '>';
if Anode.IsTextElement then
NText := NText + ' = ' + Anode.NodeValue;
NTNode := ATree.Items.AddChild(TNode, NText);
// NTNode.ImageIndex := 190;
for I := 0 to Anode.AttributeNodes.Count - 1 do
begin
Application.ProcessMessages;
AttrNode := Anode.AttributeNodes.Nodes[I];
// NTNode.ImageIndex := 188;
ATree.Items.AddChild(NTNode,
// AttrNode.NodeName + ‘ = “‘ + AttrNode.Text + ‘”‘);
AttrNode.Text);
end;
if Anode.HasChildNodes then
for I := 0 to Anode.ChildNodes.Count - 1 do begin
Application.ProcessMessages;
DOMShow(Atree, Anode.ChildNodes.Nodes [I], NTNode);
end;
Atree.FullExpand;
end;
function TfrmNMRun.GetNodeByText
(ATree : TTreeView; AValue:String;
AVisible: Boolean): TTreeNode;
var
Node: TTreeNode;
begin
Result := nil;
if ATree.Items.Count = 0 then Exit;
Node := ATree.Items[0];
while Node <> nil do
begin
if UpperCase(Node.Text) = UpperCase(AValue) then
begin
Result := Node;
if AVisible then
Result.MakeVisible;
Break;
end;
Node := Node.GetNext;
end;
end;
function TfrmNMRun.LineBreaks(inTxt: WideString): TStringList;
begin
brkUpp.BaseString := inTxt;
brkUpp.BaseString := StringReplace(StringReplace(brkUpp.BaseString, #10, 'ççç', [rfReplaceAll]), #13, 'ççç', [rfReplaceAll]);
brkUpp.BreakString := 'ççç';
brkUpp.AllowEmptyString := False;
brkUpp.BreakApart;
Result := brkUpp.StringList;
end;
function TfrmNMRun.SigDig(inFlt: Double; Prec: Integer): Double;
var
intTemp: Integer;
begin
intTemp := Round(IntPower(10, Prec));
Result := intTemp / IntPower(10, Prec);
end;
end.