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

LFPSO/unit_LFPSO_Base.pas

@@ -120,9 +120,6 @@   TLFPSO_BASE = class
   MaxC = 10;
   a = 0.5;
   eps = 1;
-  c1m = 1.412;
-  c2m = 1.412;
-
 
 implementation
 
@@ -300,12 +297,12 @@ procedure TLFPSO_BASE.ApplyCFactor(var c1, c2: single);
 begin
   if FFitParams.AdaptVel and (CFactor > 0) then
   begin
-    c1 := c1m * CFactor;
-    c2 := c2m * CFactor;
+    c1 := CFactor;
+    c2 := CFactor;
   end else
   begin
-    c1 := c1m;
-    c2 := c2m;
+    c1 := 1;
+    c2 := 1;
   end;
 end;
 
@@ -348,7 +345,6 @@ function TLFPSO_BASE.LevyWalk(const X, gBest: single): single;
 end;
 
 
-
 procedure TLFPSO_BASE.CalcSolution;
 begin
   try
@@ -398,6 +394,8 @@ function TLFPSO_BASE.FindTheBest: boolean;
     if FTerminated then Break;
   end;
 
+//  CFactor := eps + (FGlobalBestChiSqr- FLastBestChiSqr)/ (FLastWorseChiSQR - FGlobalBestChiSqr);
+  CFactor := 1;  // left for future
 
   if FLastBestChiSqr <  FGlobalBestChiSqr then
   begin
@@ -409,15 +407,12 @@ function TLFPSO_BASE.FindTheBest: boolean;
       abest := Copy(gbest, 0, MaxInt);
       CalcSolution(abest);
       Result := True;
-//      ShowMessage(Format('%f   %f  %f',[abest[0][1][0], abest[0][1][1], FAbsoluteBestChiSqr]));
-    end;
-    CFactor := eps + (FLastBestChiSqr - FAbsoluteBestChiSqr)/ (FLastWorseChiSQR - FGlobalBestChiSqr);
+    end ;
   end
   else begin
     SetLength(FResultingCurve, 0);
     Inc(FJammingCount);
   end;
-
 end;
 
 procedure TLFPSO_BASE.Init(const Step: integer);
@@ -454,15 +449,15 @@ procedure TLFPSO_BASE.Shake(const t: integer; var  SuccessCount, ReInitCount: in
     FGlobalBestChiSqr := FGlobalBestChiSqr  * FFitParams.KChiSqr;
     FFitParams.Vmax := FFitParams.Vmax * FFitParams.KVmax;
     FFitParams.Ksxr := FFitParams.Ksxr * FFitParams.KVmax;
+    Inc(ReInitCount);
+    dec(SuccessCount);
   end;
   UpdateStructure(gbest);        // re-init based on current global best solution
   TmpStructure := FStructure;
   SetStructure(TmpStructure);    // Don't use X[0] = abest! The full re-set is requred
 
   Init(t);
-  Inc(ReInitCount);
   FJammingCount := 0;
-  dec(SuccessCount);
 end;
 
 procedure TLFPSO_BASE.Run;
@@ -508,8 +503,11 @@ procedure TLFPSO_BASE.Run;
 
     if FFitParams.Shake and (FJammingCount > FFitParams.JammingMax) then
       Shake(t, SuccessCount, ReInitCount, Vmax0, Ksxr0)
-    else
+    else begin
+      FFitParams.Vmax := Vmax0;
+      FFitParams.Ksxr := Ksxr0;
       inc(SuccessCount);
+    end;
   end;
 //  ShowMessage(Format('%f %f %f',[abest[0][1][0], abest[0][1][1], FAbsoluteBestChiSqr]));
   UpdateStructure(abest);  // don't delete!

LFPSO/unit_LFPSO_Poly.pas

@@ -41,6 +41,15 @@ implementation
 
 { TLFPSO Periodic}
 
+function TP(const n: Integer): Integer;
+var
+  i : Integer;
+begin
+  Result := 10;
+  for I := 2 to n do
+    Result := Result * 10;
+end;
+
 procedure TLFPSO_Poly.UpdateLFPSO(const t: integer);
 var
   i, j, k,c, Ord: integer;
@@ -156,7 +165,7 @@ procedure TLFPSO_Poly.InitVelocity;
         begin
           if p > 0 then
           begin
-            Vmax[0][j][k][p] :=  Vmax[0][j][k][0]/(p * 10 + 1);
+            Vmax[0][j][k][p] :=  Vmax[0][j][k][0]/TP(p);
             Vmin[0][j][k][p] := -Vmax[0][j][k][p];
           end;
           V[i][j][k][p] := Rand(Vmax[0][j][k][p]);
@@ -203,7 +212,7 @@ procedure TLFPSO_Poly.RangeSeed;
             X[i][j][k][0] := X[0][Indexes[j]][k][0] + Val
           end
           else
-            X[i][j][k][p] := Rand(1)/sqr(1 + p);
+            X[i][j][k][p] := Rand(1)/TP(p);
         end;
         CheckLimits(i, j, k);
       end;
@@ -351,7 +360,7 @@ procedure TLFPSO_Poly.Set_Init_XPoly(const N, Index, ValueType: Integer; const P
     X[0][Index][ValueType][10]:= FFitParams.MaxPOrder;
 
     for p := 1 to Order(Index, ValueType) do
-      Xrange[0][Index][ValueType][p] := Xrange[0][Index][ValueType][0] / Sqr(p + 1);
+      Xrange[0][Index][ValueType][p] := Xrange[0][Index][ValueType][0] / TP(p);
   end;
 end;
 

README.md

@@ -6,6 +6,18 @@ In this version, the automatic optimization based on modified LFPSO algorithm wa
 
 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.
 
+2023-07-31 3.0.5
+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
+
 2023-07-18 3.0.4
 Added:
  - Popup menu for stacks

XRayCalc3.dproj

@@ -114,7 +114,7 @@
         <VerInfo_AutoGenVersion>true</VerInfo_AutoGenVersion>
         <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>
         <Icon_MainIcon>Resources\XRayCalc3_Icon.ico</Icon_MainIcon>
-        <Debugger_RunParams>-f &quot;d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\ML(20x4)_Poly1_#1.xrcx&quot; -a</Debugger_RunParams>
+        <Debugger_RunParams>-f &quot;d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\Multilayer(4x20).xrcx&quot; -a</Debugger_RunParams>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
         <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -134,9 +134,9 @@
         <DCC_ImportedDataReferences>false</DCC_ImportedDataReferences>
         <Icon_MainIcon>Resources\XRayCalc3_Icon.ico</Icon_MainIcon>
         <VerInfo_MajorVer>3</VerInfo_MajorVer>
-        <VerInfo_Build>346</VerInfo_Build>
-        <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>
-        <VerInfo_Release>4</VerInfo_Release>
+        <VerInfo_Build>350</VerInfo_Build>
+        <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>
+        <VerInfo_Release>5</VerInfo_Release>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
         <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>

components/unit_XRCLayerControl.pas

@@ -53,6 +53,7 @@   TXRCLayerControl = class (TRzPanel)
       function GetStackID: Integer;
       procedure CreateMenu;
       procedure MenuOnClick(Sender: TObject);
+      procedure SetEnableLinking(const Value: boolean);
     public
       constructor Create(AOwner: TComponent; const Handler: HWND; const Data: TLayerData); reintroduce; overload;
       destructor  Destroy; override;
@@ -69,7 +70,7 @@   TXRCLayerControl = class (TRzPanel)
       property Checked: Boolean read GetLinkChecked;
       property Selected: boolean read FSelected write SetSlected;
       property Pairable: boolean write SetPairable;
-
+      property EnableLinking: boolean write SetEnableLinking;
       property Data: TLayerData read FData write SetLayerData;
 
       procedure IncreaseThickness;
@@ -264,6 +265,11 @@ procedure TXRCLayerControl.SetEnabled(const Value: Boolean);
   Enabled := Value;
 end;
 
+procedure TXRCLayerControl.SetEnableLinking(const Value: boolean);
+begin
+  FLinkCheckBox.Visible := Value;
+end;
+
 function TXRCLayerControl.GetCheckBox: TRzCheckBox;
 begin
   Result := FLinkCheckBox;
@@ -363,8 +369,6 @@ procedure TXRCLayerControl.SetLinked(const Value: TXRCLayerControl);
 
 procedure TXRCLayerControl.SetPairable(const Value: boolean);
 begin
-  FLinkCheckBox.Visible := Value;
-
   PairedH.Visible := Value;
   PairedS.Visible := Value;
   PairedR.Visible := Value;

components/unit_XRCProjectTree.pas

@@ -37,8 +37,8 @@   TXRCProjectTree = class (TVirtualStringTree)
       procedure ProjectAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
       procedure ProjectBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
     public
-      constructor Create(AOwner: TComponent); override;
-      destructor Destroy; override;
+      constructor Create(AOwner: TComponent);  override;
+      destructor Destroy;  reintroduce; overload;
 
       property Version: Integer write FProjectVersion;
       property ActiveModel:PProjectData read FActiveModel write FActiveModel;

components/unit_XRCStackControl.pas

@@ -32,7 +32,7 @@   TXRCStack = class (TRzPanel)
       procedure SetIncrement(const Value: Single);
       function GetMaterialsList: TMaterialsList;
       procedure SetID(const Value: Integer);
-      procedure UpdateLayersStatus(const Pairable: Boolean);
+      procedure UpdateLayersStatus(const Pairable, EnableLinking: Boolean);
       procedure SetLayerColor(const ID: Integer);
       procedure RealignLayers;
     protected
@@ -49,6 +49,7 @@   TXRCStack = class (TRzPanel)
       procedure DeleteLayer(const Index: integer);
       procedure MoveLayer(const Index, Direction: integer);
       procedure UpdateLayersID;
+      procedure ForcePeriodicity(const Val: Boolean);
 
       property Selected: Boolean write SetSelected;
       property ID: Integer read FID write SetID;
@@ -181,12 +182,15 @@ procedure TXRCStack.UpdateLayersID;
   end;
 end;
 
-procedure TXRCStack.UpdateLayersStatus(const Pairable: Boolean);
+procedure TXRCStack.UpdateLayersStatus(const Pairable, EnableLinking: Boolean);
 var
   i: integer;
 begin
   for I := 0 to High(FLayers) do
+  begin
     FLayers[i].Pairable := Pairable;
+    FLayers[i].EnableLinking := EnableLinking;
+  end;
 end;
 
 constructor TXRCStack.Create(AOwner: TComponent; const Title: string; const N: integer);
@@ -273,7 +277,7 @@ procedure TXRCStack.Edit;
 procedure TXRCStack.EnablePairing(const Enabled: Boolean);
 begin
   FEnablePairing := Enabled;
-  UpdateLayersStatus((FN > 1) and Enabled);
+  UpdateLayersStatus((FN > 1) and Enabled, (FN > 1));
 end;
 
 procedure TXRCStack.FOnClick(Sender: TObject);
@@ -287,13 +291,23 @@ procedure TXRCStack.FOnDoubleClick(Sender: TObject);
   begin
     edtrStack.Edit(FTitle, FN);
     UpdateInfo;
-    UpdateLayersStatus((FN > 1) and FEnablePairing);
+    UpdateLayersStatus((FN > 1) and FEnablePairing, (FN > 1));
   end
   else begin
     FLayers[0].Edit;
   end;
 end;
 
+procedure TXRCStack.ForcePeriodicity(const Val: Boolean);
+var
+  I: Integer;
+begin
+  if FN = 1 then Exit;
+
+  for I := 0 to High(FLayers) do
+    FLayers[i].Pairable := Val;
+end;
+
 function TXRCStack.GetLayersData: TLayersData;
 var
   i: Integer;

components/unit_XRCStructure.pas

@@ -35,6 +35,7 @@   TXRCStructure = class (TRzPanel)
 
       FClipBoardLayers: TLayersData;
       JLayer, JStack, JSub: TJSONValue;
+      FPeriodicMode: boolean;
 
       procedure RealignStacks;
       procedure SetIncrement(const Value: single);
@@ -43,6 +44,7 @@   TXRCStructure = class (TRzPanel)
       function FindValue(const Value: string; Base: single): single;
       function FindStrValue(const Value: string): string;
       function GetSelectedLayer: Integer;
+      procedure SetPeriodicMode(const Value: boolean);
     public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;
@@ -51,6 +53,7 @@   TXRCStructure = class (TRzPanel)
       property SelectedLayer: Integer read GetSelectedLayer;
       property Stacks: TStacks read FStacks;
       property Period: single read FPeriod;
+      property PeriodicMode: boolean read FPeriodicMode write SetPeriodicMode;
 
       procedure AddLayer(const StackID: Integer; const Data: TLayerData);
       procedure InsertLayer(const Data: TLayerData);
@@ -87,7 +90,7 @@   TXRCStructure = class (TRzPanel)
       procedure GetStacksList(PeriodicOnly: Boolean; List: TStrings; var RealID: TIntArray);
       procedure GetLayersList(const ID: integer; List: TStrings);
       function GetStackSize(const ID: Integer): Integer;
-      procedure EnablePairing;
+//      procedure EnablePairing;
       function IfValidLayerSelected: Boolean; inline;
     published
       property Increment: single read FIncrement write SetIncrement;
@@ -331,13 +334,13 @@ procedure TXRCStructure.EditStack;
   FStacks[ID].Edit;
 end;
 
-procedure TXRCStructure.EnablePairing;
-var
-  Stack: TXRCStack;
-begin
-  for Stack in FStacks do
-    Stack.EnablePairing(True);
-end;
+//procedure TXRCStructure.EnablePairing;
+//var
+//  Stack: TXRCStack;
+//begin
+//  for Stack in FStacks do
+//    Stack.EnablePairing(True);
+//end;
 
 
 procedure TXRCStructure.InsertLayer(const Data: TLayerData);
@@ -493,6 +496,14 @@ procedure TXRCStructure.SetIncrement(const Value: single);
     FStacks[i].Increment := Value;
 end;
 
+procedure TXRCStructure.SetPeriodicMode(const Value: boolean);
+var
+  Stack: TXRCStack;
+begin
+  for Stack in FStacks do
+    Stack.EnablePairing(Value);
+end;
+
 procedure TXRCStructure.UpdateInterfaceNP(const Inp: TFitStructure);
 var
   i, j: integer;