Skip to content

Commit 0aec17c

Browse files
author
Oleksiy Penkov
committedJul 31, 2023
Fixed:
 - Poly Fitting - Shake (k2 error) - "Paired" check-box behaviour - Deleting exp. curve - Decimal separator mismatch - Main graph scaling - Refactoring (dcc32 warnings) Reworked - Defalt Shake LFPSO parameters
·
3.1.23.0.4.415
1 parent de1e4be commit 0aec17c

14 files changed

+152
-93
lines changed
 

‎LFPSO/unit_LFPSO_Base.pas

+13-15
Original file line numberDiff line numberDiff line change
@@ -120,9 +120,6 @@ TLFPSO_BASE = class
120120
MaxC = 10;
121121
a = 0.5;
122122
eps = 1;
123-
c1m = 1.412;
124-
c2m = 1.412;
125-
126123

127124
implementation
128125

@@ -300,12 +297,12 @@ procedure TLFPSO_BASE.ApplyCFactor(var c1, c2: single);
300297
begin
301298
if FFitParams.AdaptVel and (CFactor > 0) then
302299
begin
303-
c1 := c1m * CFactor;
304-
c2 := c2m * CFactor;
300+
c1 := CFactor;
301+
c2 := CFactor;
305302
end else
306303
begin
307-
c1 := c1m;
308-
c2 := c2m;
304+
c1 := 1;
305+
c2 := 1;
309306
end;
310307
end;
311308

@@ -348,7 +345,6 @@ function TLFPSO_BASE.LevyWalk(const X, gBest: single): single;
348345
end;
349346

350347

351-
352348
procedure TLFPSO_BASE.CalcSolution;
353349
begin
354350
try
@@ -398,6 +394,8 @@ function TLFPSO_BASE.FindTheBest: boolean;
398394
if FTerminated then Break;
399395
end;
400396

397+
// CFactor := eps + (FGlobalBestChiSqr- FLastBestChiSqr)/ (FLastWorseChiSQR - FGlobalBestChiSqr);
398+
CFactor := 1; // left for future
401399

402400
if FLastBestChiSqr < FGlobalBestChiSqr then
403401
begin
@@ -409,15 +407,12 @@ function TLFPSO_BASE.FindTheBest: boolean;
409407
abest := Copy(gbest, 0, MaxInt);
410408
CalcSolution(abest);
411409
Result := True;
412-
// ShowMessage(Format('%f %f %f',[abest[0][1][0], abest[0][1][1], FAbsoluteBestChiSqr]));
413-
end;
414-
CFactor := eps + (FLastBestChiSqr - FAbsoluteBestChiSqr)/ (FLastWorseChiSQR - FGlobalBestChiSqr);
410+
end ;
415411
end
416412
else begin
417413
SetLength(FResultingCurve, 0);
418414
Inc(FJammingCount);
419415
end;
420-
421416
end;
422417

423418
procedure TLFPSO_BASE.Init(const Step: integer);
@@ -454,15 +449,15 @@ procedure TLFPSO_BASE.Shake(const t: integer; var SuccessCount, ReInitCount: in
454449
FGlobalBestChiSqr := FGlobalBestChiSqr * FFitParams.KChiSqr;
455450
FFitParams.Vmax := FFitParams.Vmax * FFitParams.KVmax;
456451
FFitParams.Ksxr := FFitParams.Ksxr * FFitParams.KVmax;
452+
Inc(ReInitCount);
453+
dec(SuccessCount);
457454
end;
458455
UpdateStructure(gbest); // re-init based on current global best solution
459456
TmpStructure := FStructure;
460457
SetStructure(TmpStructure); // Don't use X[0] = abest! The full re-set is requred
461458

462459
Init(t);
463-
Inc(ReInitCount);
464460
FJammingCount := 0;
465-
dec(SuccessCount);
466461
end;
467462

468463
procedure TLFPSO_BASE.Run;
@@ -508,8 +503,11 @@ procedure TLFPSO_BASE.Run;
508503

509504
if FFitParams.Shake and (FJammingCount > FFitParams.JammingMax) then
510505
Shake(t, SuccessCount, ReInitCount, Vmax0, Ksxr0)
511-
else
506+
else begin
507+
FFitParams.Vmax := Vmax0;
508+
FFitParams.Ksxr := Ksxr0;
512509
inc(SuccessCount);
510+
end;
513511
end;
514512
// ShowMessage(Format('%f %f %f',[abest[0][1][0], abest[0][1][1], FAbsoluteBestChiSqr]));
515513
UpdateStructure(abest); // don't delete!

‎LFPSO/unit_LFPSO_Poly.pas

+12-3
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,15 @@ implementation
4141

4242
{ TLFPSO Periodic}
4343

44+
function TP(const n: Integer): Integer;
45+
var
46+
i : Integer;
47+
begin
48+
Result := 10;
49+
for I := 2 to n do
50+
Result := Result * 10;
51+
end;
52+
4453
procedure TLFPSO_Poly.UpdateLFPSO(const t: integer);
4554
var
4655
i, j, k,c, Ord: integer;
@@ -156,7 +165,7 @@ procedure TLFPSO_Poly.InitVelocity;
156165
begin
157166
if p > 0 then
158167
begin
159-
Vmax[0][j][k][p] := Vmax[0][j][k][0]/(p * 10 + 1);
168+
Vmax[0][j][k][p] := Vmax[0][j][k][0]/TP(p);
160169
Vmin[0][j][k][p] := -Vmax[0][j][k][p];
161170
end;
162171
V[i][j][k][p] := Rand(Vmax[0][j][k][p]);
@@ -203,7 +212,7 @@ procedure TLFPSO_Poly.RangeSeed;
203212
X[i][j][k][0] := X[0][Indexes[j]][k][0] + Val
204213
end
205214
else
206-
X[i][j][k][p] := Rand(1)/sqr(1 + p);
215+
X[i][j][k][p] := Rand(1)/TP(p);
207216
end;
208217
CheckLimits(i, j, k);
209218
end;
@@ -351,7 +360,7 @@ procedure TLFPSO_Poly.Set_Init_XPoly(const N, Index, ValueType: Integer; const P
351360
X[0][Index][ValueType][10]:= FFitParams.MaxPOrder;
352361

353362
for p := 1 to Order(Index, ValueType) do
354-
Xrange[0][Index][ValueType][p] := Xrange[0][Index][ValueType][0] / Sqr(p + 1);
363+
Xrange[0][Index][ValueType][p] := Xrange[0][Index][ValueType][0] / TP(p);
355364
end;
356365
end;
357366

‎README.md

+12
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,18 @@ In this version, the automatic optimization based on modified LFPSO algorithm wa
66

77
The X-Ray Calc distribution contents several demonstration projects located in the Examples folder To see the demos, click the Open button, navigate to the Examples folder, and select a project file.
88

9+
2023-07-31 3.0.5
10+
Fixed:
11+
- Poly Fitting
12+
- Shake (k2 error)
13+
- "Paired" check-box behaviour
14+
- Deleting exp. curve
15+
- Decimal separator mismatch
16+
- Main graph scaling
17+
- Refactoring (dcc32 warnings)
18+
Reworked
19+
- Defalt Shake LFPSO parameters
20+
921
2023-07-18 3.0.4
1022
Added:
1123
- Popup menu for stacks

‎XRayCalc3.dproj

+4-4
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@
114114
<VerInfo_AutoGenVersion>true</VerInfo_AutoGenVersion>
115115
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=3.0.0.200;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.0.0;Comments=</VerInfo_Keys>
116116
<Icon_MainIcon>Resources\XRayCalc3_Icon.ico</Icon_MainIcon>
117-
<Debugger_RunParams>-f &quot;d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\ML(20x4)_Poly1_#1.xrcx&quot; -a</Debugger_RunParams>
117+
<Debugger_RunParams>-f &quot;d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\Multilayer(4x20).xrcx&quot; -a</Debugger_RunParams>
118118
</PropertyGroup>
119119
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
120120
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -134,9 +134,9 @@
134134
<DCC_ImportedDataReferences>false</DCC_ImportedDataReferences>
135135
<Icon_MainIcon>Resources\XRayCalc3_Icon.ico</Icon_MainIcon>
136136
<VerInfo_MajorVer>3</VerInfo_MajorVer>
137-
<VerInfo_Build>346</VerInfo_Build>
138-
<VerInfo_Keys>CompanyName=Zhejiang University;FileDescription=$(MSBuildProjectName);FileVersion=3.0.4.346;InternalName=;LegalCopyright=Oleksiy Penkov;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.4;Comments=</VerInfo_Keys>
139-
<VerInfo_Release>4</VerInfo_Release>
137+
<VerInfo_Build>350</VerInfo_Build>
138+
<VerInfo_Keys>CompanyName=Zhejiang University;FileDescription=$(MSBuildProjectName);FileVersion=3.0.5.350;InternalName=;LegalCopyright=Oleksiy Penkov;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.4;Comments=</VerInfo_Keys>
139+
<VerInfo_Release>5</VerInfo_Release>
140140
</PropertyGroup>
141141
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
142142
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>

‎components/unit_XRCLayerControl.pas

+7-3
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ TXRCLayerControl = class (TRzPanel)
5353
function GetStackID: Integer;
5454
procedure CreateMenu;
5555
procedure MenuOnClick(Sender: TObject);
56+
procedure SetEnableLinking(const Value: boolean);
5657
public
5758
constructor Create(AOwner: TComponent; const Handler: HWND; const Data: TLayerData); reintroduce; overload;
5859
destructor Destroy; override;
@@ -69,7 +70,7 @@ TXRCLayerControl = class (TRzPanel)
6970
property Checked: Boolean read GetLinkChecked;
7071
property Selected: boolean read FSelected write SetSlected;
7172
property Pairable: boolean write SetPairable;
72-
73+
property EnableLinking: boolean write SetEnableLinking;
7374
property Data: TLayerData read FData write SetLayerData;
7475

7576
procedure IncreaseThickness;
@@ -264,6 +265,11 @@ procedure TXRCLayerControl.SetEnabled(const Value: Boolean);
264265
Enabled := Value;
265266
end;
266267

268+
procedure TXRCLayerControl.SetEnableLinking(const Value: boolean);
269+
begin
270+
FLinkCheckBox.Visible := Value;
271+
end;
272+
267273
function TXRCLayerControl.GetCheckBox: TRzCheckBox;
268274
begin
269275
Result := FLinkCheckBox;
@@ -363,8 +369,6 @@ procedure TXRCLayerControl.SetLinked(const Value: TXRCLayerControl);
363369

364370
procedure TXRCLayerControl.SetPairable(const Value: boolean);
365371
begin
366-
FLinkCheckBox.Visible := Value;
367-
368372
PairedH.Visible := Value;
369373
PairedS.Visible := Value;
370374
PairedR.Visible := Value;

‎components/unit_XRCProjectTree.pas

+2-2
Original file line numberDiff line numberDiff line change
@@ -37,8 +37,8 @@ TXRCProjectTree = class (TVirtualStringTree)
3737
procedure ProjectAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
3838
procedure ProjectBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
3939
public
40-
constructor Create(AOwner: TComponent); override;
41-
destructor Destroy; override;
40+
constructor Create(AOwner: TComponent); override;
41+
destructor Destroy; reintroduce; overload;
4242

4343
property Version: Integer write FProjectVersion;
4444
property ActiveModel:PProjectData read FActiveModel write FActiveModel;

‎components/unit_XRCStackControl.pas

+18-4
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ TXRCStack = class (TRzPanel)
3232
procedure SetIncrement(const Value: Single);
3333
function GetMaterialsList: TMaterialsList;
3434
procedure SetID(const Value: Integer);
35-
procedure UpdateLayersStatus(const Pairable: Boolean);
35+
procedure UpdateLayersStatus(const Pairable, EnableLinking: Boolean);
3636
procedure SetLayerColor(const ID: Integer);
3737
procedure RealignLayers;
3838
protected
@@ -49,6 +49,7 @@ TXRCStack = class (TRzPanel)
4949
procedure DeleteLayer(const Index: integer);
5050
procedure MoveLayer(const Index, Direction: integer);
5151
procedure UpdateLayersID;
52+
procedure ForcePeriodicity(const Val: Boolean);
5253

5354
property Selected: Boolean write SetSelected;
5455
property ID: Integer read FID write SetID;
@@ -181,12 +182,15 @@ procedure TXRCStack.UpdateLayersID;
181182
end;
182183
end;
183184

184-
procedure TXRCStack.UpdateLayersStatus(const Pairable: Boolean);
185+
procedure TXRCStack.UpdateLayersStatus(const Pairable, EnableLinking: Boolean);
185186
var
186187
i: integer;
187188
begin
188189
for I := 0 to High(FLayers) do
190+
begin
189191
FLayers[i].Pairable := Pairable;
192+
FLayers[i].EnableLinking := EnableLinking;
193+
end;
190194
end;
191195

192196
constructor TXRCStack.Create(AOwner: TComponent; const Title: string; const N: integer);
@@ -273,7 +277,7 @@ procedure TXRCStack.Edit;
273277
procedure TXRCStack.EnablePairing(const Enabled: Boolean);
274278
begin
275279
FEnablePairing := Enabled;
276-
UpdateLayersStatus((FN > 1) and Enabled);
280+
UpdateLayersStatus((FN > 1) and Enabled, (FN > 1));
277281
end;
278282

279283
procedure TXRCStack.FOnClick(Sender: TObject);
@@ -287,13 +291,23 @@ procedure TXRCStack.FOnDoubleClick(Sender: TObject);
287291
begin
288292
edtrStack.Edit(FTitle, FN);
289293
UpdateInfo;
290-
UpdateLayersStatus((FN > 1) and FEnablePairing);
294+
UpdateLayersStatus((FN > 1) and FEnablePairing, (FN > 1));
291295
end
292296
else begin
293297
FLayers[0].Edit;
294298
end;
295299
end;
296300

301+
procedure TXRCStack.ForcePeriodicity(const Val: Boolean);
302+
var
303+
I: Integer;
304+
begin
305+
if FN = 1 then Exit;
306+
307+
for I := 0 to High(FLayers) do
308+
FLayers[i].Pairable := Val;
309+
end;
310+
297311
function TXRCStack.GetLayersData: TLayersData;
298312
var
299313
i: Integer;

‎components/unit_XRCStructure.pas

+19-8
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ TXRCStructure = class (TRzPanel)
3535

3636
FClipBoardLayers: TLayersData;
3737
JLayer, JStack, JSub: TJSONValue;
38+
FPeriodicMode: boolean;
3839

3940
procedure RealignStacks;
4041
procedure SetIncrement(const Value: single);
@@ -43,6 +44,7 @@ TXRCStructure = class (TRzPanel)
4344
function FindValue(const Value: string; Base: single): single;
4445
function FindStrValue(const Value: string): string;
4546
function GetSelectedLayer: Integer;
47+
procedure SetPeriodicMode(const Value: boolean);
4648
public
4749
constructor Create(AOwner: TComponent); override;
4850
destructor Destroy; override;
@@ -51,6 +53,7 @@ TXRCStructure = class (TRzPanel)
5153
property SelectedLayer: Integer read GetSelectedLayer;
5254
property Stacks: TStacks read FStacks;
5355
property Period: single read FPeriod;
56+
property PeriodicMode: boolean read FPeriodicMode write SetPeriodicMode;
5457

5558
procedure AddLayer(const StackID: Integer; const Data: TLayerData);
5659
procedure InsertLayer(const Data: TLayerData);
@@ -87,7 +90,7 @@ TXRCStructure = class (TRzPanel)
8790
procedure GetStacksList(PeriodicOnly: Boolean; List: TStrings; var RealID: TIntArray);
8891
procedure GetLayersList(const ID: integer; List: TStrings);
8992
function GetStackSize(const ID: Integer): Integer;
90-
procedure EnablePairing;
93+
// procedure EnablePairing;
9194
function IfValidLayerSelected: Boolean; inline;
9295
published
9396
property Increment: single read FIncrement write SetIncrement;
@@ -331,13 +334,13 @@ procedure TXRCStructure.EditStack;
331334
FStacks[ID].Edit;
332335
end;
333336

334-
procedure TXRCStructure.EnablePairing;
335-
var
336-
Stack: TXRCStack;
337-
begin
338-
for Stack in FStacks do
339-
Stack.EnablePairing(True);
340-
end;
337+
//procedure TXRCStructure.EnablePairing;
338+
//var
339+
// Stack: TXRCStack;
340+
//begin
341+
// for Stack in FStacks do
342+
// Stack.EnablePairing(True);
343+
//end;
341344

342345

343346
procedure TXRCStructure.InsertLayer(const Data: TLayerData);
@@ -493,6 +496,14 @@ procedure TXRCStructure.SetIncrement(const Value: single);
493496
FStacks[i].Increment := Value;
494497
end;
495498

499+
procedure TXRCStructure.SetPeriodicMode(const Value: boolean);
500+
var
501+
Stack: TXRCStack;
502+
begin
503+
for Stack in FStacks do
504+
Stack.EnablePairing(Value);
505+
end;
506+
496507
procedure TXRCStructure.UpdateInterfaceNP(const Inp: TFitStructure);
497508
var
498509
i, j: integer;

‎forms/frm_Benchmark.dfm

+15-33
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
object frmBenchmark: TfrmBenchmark
22
Left = 0
33
Top = 0
4-
BorderStyle = bsNone
4+
BorderStyle = bsToolWindow
55
Caption = 'Benchmark'
6-
ClientHeight = 436
7-
ClientWidth = 999
6+
ClientHeight = 409
7+
ClientWidth = 991
88
Color = clBtnFace
99
Font.Charset = DEFAULT_CHARSET
1010
Font.Color = clWindowText
@@ -18,19 +18,18 @@ object frmBenchmark: TfrmBenchmark
1818
AlignWithMargins = True
1919
Left = 3
2020
Top = 3
21-
Width = 993
22-
Height = 430
21+
Width = 985
22+
Height = 403
2323
Align = alClient
2424
BorderOuter = fsGroove
2525
BorderWidth = 2
26+
Color = 15987699
2627
TabOrder = 0
27-
ExplicitLeft = 31
28-
ExplicitTop = 152
29-
ExplicitWidth = 185
30-
ExplicitHeight = 41
28+
ExplicitWidth = 993
29+
ExplicitHeight = 430
3130
object BitBtn1: TBitBtn
3231
Left = 896
33-
Top = 387
32+
Top = 363
3433
Width = 75
3534
Height = 25
3635
Caption = 'Close'
@@ -40,36 +39,19 @@ object frmBenchmark: TfrmBenchmark
4039
object Grid: TStringGrid
4140
AlignWithMargins = True
4241
Left = 7
43-
Top = 54
44-
Width = 979
45-
Height = 322
42+
Top = 7
43+
Width = 971
44+
Height = 342
4645
Margins.Bottom = 50
4746
Align = alClient
4847
ColCount = 6
4948
DefaultColWidth = 50
5049
FixedCols = 0
5150
RowCount = 2
5251
TabOrder = 1
53-
end
54-
object pnl1: TPanel
55-
AlignWithMargins = True
56-
Left = 7
57-
Top = 7
58-
Width = 979
59-
Height = 41
60-
Align = alTop
61-
Alignment = taLeftJustify
62-
Caption = 'Benchmark'
63-
Font.Charset = DEFAULT_CHARSET
64-
Font.Color = clWindowText
65-
Font.Height = -16
66-
Font.Name = 'Segoe UI'
67-
Font.Style = [fsBold]
68-
ParentFont = False
69-
TabOrder = 2
70-
ExplicitLeft = 5
71-
ExplicitTop = -3
72-
ExplicitWidth = 200
52+
ExplicitTop = 54
53+
ExplicitWidth = 979
54+
ExplicitHeight = 322
7355
end
7456
end
7557
end

‎forms/frm_Benchmark.pas

-1
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@ TfrmBenchmark = class(TForm)
1212
RzPanel1: TRzPanel;
1313
BitBtn1: TBitBtn;
1414
Grid: TStringGrid;
15-
pnl1: TPanel;
1615
procedure BitBtn1Click(Sender: TObject);
1716
private
1817
FLine: Integer;

‎forms/frm_Main.dfm

+8-10
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ object frmMain: TfrmMain
1414
Menu = mmMain
1515
Position = poDesigned
1616
WindowState = wsMaximized
17+
OnCloseQuery = FormCloseQuery
1718
OnCreate = FormCreate
1819
OnDestroy = FormDestroy
1920
TextHeight = 15
@@ -416,20 +417,16 @@ object frmMain: TfrmMain
416417
BottomAxis.Maximum = 100.000000000000000000
417418
BottomAxis.Minimum = -1.000000000000000000
418419
BottomAxis.Title.Caption = 'Iteration'
419-
LeftAxis.Automatic = False
420-
LeftAxis.AutomaticMaximum = False
421-
LeftAxis.AutomaticMinimum = False
422420
LeftAxis.AxisValuesFormat = '#.0 "x10" E+0'
421+
LeftAxis.ExactDateTime = False
423422
LeftAxis.LabelsExponent = True
424423
LeftAxis.LabelsFormat.Margins.Left = 0
425424
LeftAxis.LabelsFormat.Margins.Right = 0
426425
LeftAxis.LabelsFormat.Margins.Bottom = 0
427426
LeftAxis.LabelsFormat.Margins.Units = maPercentSize
428427
LeftAxis.LabelsSeparation = 20
429428
LeftAxis.Logarithmic = True
430-
LeftAxis.Maximum = 20.000000000000000000
431429
LeftAxis.MaximumRound = True
432-
LeftAxis.Minimum = 0.005000000000000000
433430
LeftAxis.Title.Caption = #967'2'
434431
LeftAxis.Title.Font.Height = -13
435432
View3D = False
@@ -1009,6 +1006,7 @@ object frmMain: TfrmMain
10091006
Checked = True
10101007
State = cbChecked
10111008
TabOrder = 6
1009+
OnClick = cbTreatPeriodicClick
10121010
end
10131011
object cbPoly: TRzCheckBox
10141012
Left = 264
@@ -1188,7 +1186,7 @@ object frmMain: TfrmMain
11881186
Font.Style = []
11891187
ParentFont = False
11901188
TabOrder = 3
1191-
Text = '0'
1189+
Text = '0.1'
11921190
end
11931191
object edLFPSORImax: TEdit
11941192
Left = 106
@@ -1218,7 +1216,7 @@ object frmMain: TfrmMain
12181216
Font.Style = []
12191217
ParentFont = False
12201218
TabOrder = 5
1221-
Text = '3'
1219+
Text = '1.41'
12221220
end
12231221
object edLFPSOkVmax: TEdit
12241222
Left = 291
@@ -1233,7 +1231,7 @@ object frmMain: TfrmMain
12331231
Font.Style = []
12341232
ParentFont = False
12351233
TabOrder = 6
1236-
Text = '1'
1234+
Text = '1.41'
12371235
end
12381236
object edLFPSOSkip: TEdit
12391237
Left = 175
@@ -1257,9 +1255,9 @@ object frmMain: TfrmMain
12571255
Height = 19
12581256
AlignmentVertical = avCenter
12591257
Caption = 'Ad.V'
1260-
Checked = True
1261-
State = cbChecked
1258+
State = cbUnchecked
12621259
TabOrder = 8
1260+
Visible = False
12631261
end
12641262
object cbSeedRange: TRzCheckBox
12651263
Left = 234

‎forms/frm_Main.pas

+24-4
Original file line numberDiff line numberDiff line change
@@ -395,6 +395,8 @@ TfrmMain = class(TForm)
395395
procedure actCalcBenchmarkExecute(Sender: TObject);
396396
procedure actSystemSettingsExecute(Sender: TObject);
397397
procedure actSystemExitExecute(Sender: TObject);
398+
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
399+
procedure cbTreatPeriodicClick(Sender: TObject);
398400
private
399401
Project : TXRCProjectTree;
400402
LFPSO: TLFPSO_Base;
@@ -582,8 +584,8 @@ procedure TfrmMain.OnFitUpdateMsg(var Msg: TMessage);
582584
begin
583585
msg_prm := PUpdateFitProgressMsg(Msg.WParam);
584586
lsrConvergence.AddXY(msg_prm.Step, msg_prm.BestChi);
585-
if chFittingProgress.LeftAxis.Maximum < msg_prm.BestChi then
586-
chFittingProgress.LeftAxis.Maximum := 1.1 * msg_prm.BestChi;
587+
// if chFittingProgress.LeftAxis.Maximum < msg_prm.BestChi then
588+
// chFittingProgress.LeftAxis.Maximum := 1.1 * msg_prm.BestChi;
587589

588590

589591
spChiSqr.Caption := FloatToStrF(msg_prm.BestChi, ffFixed, 8, 4);
@@ -813,7 +815,11 @@ procedure TfrmMain.ProjectItemDeleteExecute(Sender: TObject);
813815
if IsModel and IsItem then
814816
DeleteModel(LastNode, LastData);
815817
if IsData and IsItem then
818+
begin
819+
if LastData = Project.LinkedData then
820+
Project.LinkedData := nil;
816821
DeleteData(LastNode, LastData);
822+
end;
817823
if IsFolder then
818824
DeleteFolder(LastNode);
819825
if IsExtension then
@@ -1554,6 +1560,7 @@ procedure TfrmMain.FinalizeCalc(Calc: TCalc);
15541560
var
15551561
Hour, Min, Sec, MSec: Word;
15561562
begin
1563+
RescaleChart;
15571564
PlotResults(Calc.Results);
15581565
DecodeTime(Now - StartTime, Hour, Min, Sec, MSec);
15591566
spnTime.Caption := Format('Time: %d.%3.3d s.', [60 * Min + Sec, MSec]);
@@ -1816,7 +1823,7 @@ procedure TfrmMain.PrepareInterfaceAF;
18161823
chFittingProgress.BottomAxis.Minimum := 0;
18171824
chFittingProgress.BottomAxis.Maximum := FFitParams.NMax;
18181825
chFittingProgress.BottomAxis.Minimum := -1;
1819-
chFittingProgress.LeftAxis.Minimum := FFitParams.Tolerance / 5;
1826+
// chFittingProgress.LeftAxis.Minimum := FFitParams.Tolerance / 5;
18201827
end;
18211828

18221829
function TfrmMain.PrepareCalc: Boolean;
@@ -2026,7 +2033,9 @@ procedure TfrmMain.RecoverProjectTree(const ActiveID: Integer);
20262033
end;
20272034

20282035
Structure.FromString(Project.ActiveModel.Data);
2029-
Structure.EnablePairing;
2036+
// if cbTreatPeriodic.Checked then
2037+
// Structure.EnablePairing;
2038+
Structure.PeriodicMode := not cbTreatPeriodic.Checked;
20302039
end;
20312040

20322041
procedure TfrmMain.ResultCopyExecute(Sender: TObject);
@@ -2430,6 +2439,11 @@ procedure TfrmMain.CreateDefaultProject;
24302439
Project.LinkedData := nil;
24312440
end;
24322441

2442+
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
2443+
begin
2444+
CanClose := MessageDlg('Exit application?', mtConfirmation, [mbYes, mbNo], 0, mbNO) = mrYes;
2445+
end;
2446+
24332447
procedure TfrmMain.FormCreate(Sender: TObject);
24342448
var
24352449
Value: string;
@@ -2472,6 +2486,7 @@ procedure TfrmMain.FormCreate(Sender: TObject);
24722486
procedure TfrmMain.FormDestroy(Sender: TObject);
24732487
begin
24742488
Project.Clear;
2489+
FreeAndNil(Project);
24752490
FreeAndNil(Structure);
24762491
FreeAndNil(FStack);
24772492
FreeAndNil(Config);
@@ -2515,6 +2530,11 @@ procedure TfrmMain.cbMinLimitChange(Sender: TObject);
25152530
Chart.LeftAxis.Minimum := StrToFloat(cbMinLimit.Text);
25162531
end;
25172532

2533+
procedure TfrmMain.cbTreatPeriodicClick(Sender: TObject);
2534+
begin
2535+
Structure.PeriodicMode := not cbTreatPeriodic.Checked;
2536+
end;
2537+
25182538
procedure TfrmMain.WMLayerClick(var Msg: TMessage);
25192539
var
25202540
ID, LayerID: Integer;

‎math/math_complex.pas

+9-1
Original file line numberDiff line numberDiff line change
@@ -461,7 +461,15 @@ function ExpZ(const Z: TComplex): TComplex;
461461
var
462462
x: single;
463463
begin
464-
x := FastExp(Z.Re);
464+
{$IFDEF WIN32}
465+
x := FastExp(Z.Re);
466+
{$ELSE}
467+
if (Z.Re > -1023) and (Z.Re < 1023) then
468+
x := FastExp(Z.Re)
469+
else
470+
x := Exp(Z.Re);
471+
{$ENDIF}
472+
465473
Result.Re := x * FastCos(Z.Im);
466474
Result.Im := x * FastSin(Z.Im);
467475
end;

‎math/unit_calc.pas

+9-5
Original file line numberDiff line numberDiff line change
@@ -324,11 +324,15 @@ function TCalc.RefCalc(const ATheta, Lambda:single; ALayers: TCalcLayers): singl
324324
Result := sqr(AbsZ(ALayers[0].R));
325325
end;
326326

327-
function Roughness(const RF: TRoughnessFunction; const sigma, s: single):Single;inline;
327+
function Roughness(const RF: TRoughnessFunction; const sigma, s: single):Single; inline;
328+
var
329+
Pow: single;
328330
begin
329331
case RF of
330-
rfError:
331-
Result := FastExp(-1 * sqr(sigma / 1.41) * sqr(s));
332+
rfError: begin
333+
Pow := -1 * sqr(sigma / 1.41) * sqr(s);
334+
Result := FastExp(Pow);
335+
end;
332336
rfExp:
333337
Result := 1 / (1 + (sqr(s) * sqr(sigma)) / 2);
334338
rfLinear:
@@ -344,7 +348,7 @@ function TCalc.RefCalc(const ATheta, Lambda:single; ALayers: TCalcLayers): singl
344348
end;
345349
end;
346350

347-
procedure LayerAmplitudeRefractionS; { Коэффициент отражения Rs}
351+
procedure LayerAmplitudeRefractionS; { Коэффициент отражения Rs}
348352
var
349353
i: integer;
350354
b1, b2: TComplex;
@@ -362,7 +366,7 @@ function TCalc.RefCalc(const ATheta, Lambda:single; ALayers: TCalcLayers): singl
362366
end;
363367
end;
364368

365-
procedure LayerAmplitudeRefractionP; { Коэффициент отражения Rp }
369+
procedure LayerAmplitudeRefractionP; { Коэффициент отражения Rp }
366370
var
367371
i: integer;
368372
a1, a2, b1, b2: TComplex;

0 commit comments

Comments
 (0)
Please sign in to comment.