diff --git a/LFPSO/unit_LFPSO_Base.pas b/LFPSO/unit_LFPSO_Base.pas index 5b2dd43..6bf0abe 100644 --- a/LFPSO/unit_LFPSO_Base.pas +++ b/LFPSO/unit_LFPSO_Base.pas @@ -27,13 +27,9 @@ TUpdateFitProgressMsg = record Curve : TDataArray; end; - TLayerIndexes = array [1..3] of Integer; + TLayerIndexes = array [1..3] of SmallInt; TIndexes = array of TLayerIndexes; - TLayer = array [1..3] of TPolyArray; // Array of layer parameters - TSolution = array of TLayer; // H, Sigma, rho x N Layers - TPopulation = array of TSolution; - TLFPSO_BASE = class protected FCalc: TCalc; @@ -81,7 +77,7 @@ TLFPSO_BASE = class procedure SetParams(const Value: TFitParams); virtual; procedure Init(const Step: integer); //inline; function Omega(const t, TMax: integer): single; inline; - procedure SetDomain(const Count: integer; var X: TPopulation); + procedure SetDomain(const Count, Order: integer; var X: TPopulation); procedure InitVelocity; virtual; procedure UpdatePSO(const t: integer); virtual; @@ -92,7 +88,7 @@ TLFPSO_BASE = class procedure UpdateStructure(Solution:TSolution); virtual; function FitModelToLayer(Solution: TSolution): TLayeredModel; virtual; procedure Set_Init_X(const LIndex, PIndex: Integer; Val: TFitValue); - procedure Init_Domains; + procedure Init_Domains(const Order: Integer); procedure ApplyCFactor(var c1, c2: single);// inline; function Rand(const dx: Single): single; function GetPolynomes: TProfileFunctions; virtual; @@ -330,6 +326,9 @@ procedure TLFPSO_BASE.CheckLimits(const i, j, k: integer); if X[i][j][k][0] < Xmin[0][j][k][0] then X[i][j][k][0] := Xmin[0][j][k][0]; + + if X[i][j][k][0] < 0 then ShowMessage(Format('%d %d %d',[i,j,k])); + end; function TLFPSO_BASE.LevyWalk(const X, gBest: single): single; @@ -372,7 +371,7 @@ procedure TLFPSO_BASE.CalcSolution; if Length(FMaterials) = 0 then FMaterials := FCalc.Model.Materials; // saving to cache - FCalc.CalcChiSquare(FFitParams.ThetaWieght); + FCalc.CalcChiSquare(FFitParams.ThetaWeight); if FCalc.ChiSQR < FLastBestChiSqr then begin @@ -565,14 +564,17 @@ procedure TLFPSO_BASE.SendUpdateStep(const Step: integer); Application.ProcessMessages; end; -procedure TLFPSO_BASE.SetDomain(const Count: integer; var X: TPopulation); +procedure TLFPSO_BASE.SetDomain(const Count, Order: integer; var X: TPopulation); var - i: integer; + i, j, k: integer; begin SetLength(X, FPopulation); for I := 0 to High(X) do begin SetLength(X[i], Count); + for j := 0 to Count - 1 do + for k := 1 to 3 do + SetLength(X[i][j][k], Order + 1); end; end; @@ -637,13 +639,13 @@ procedure TLFPSO_BASE.Set_Init_X(const LIndex, PIndex: Integer; Val: TFitValue); procedure TLFPSO_BASE.Init_Domains; begin - SetDomain(FLayersCount, X); - SetDomain(FLayersCount, Xmax); - SetDomain(FLayersCount, Xmin); - SetDomain(FLayersCount, Xrange); - SetDomain(FLayersCount, Vmin); - SetDomain(FLayersCount, Vmax); - SetDomain(FLayersCount, V); + SetDomain(FLayersCount, Order, X); + SetDomain(FLayersCount, Order, Xmax); + SetDomain(FLayersCount, Order, Xmin); + SetDomain(FLayersCount, Order, Xrange); + SetDomain(FLayersCount, Order, Vmin); + SetDomain(FLayersCount, Order, Vmax); + SetDomain(FLayersCount, Order, V); end; end. diff --git a/LFPSO/unit_LFPSO_Irregular.pas b/LFPSO/unit_LFPSO_Irregular.pas new file mode 100644 index 0000000..b4c9215 --- /dev/null +++ b/LFPSO/unit_LFPSO_Irregular.pas @@ -0,0 +1,288 @@ +(* ***************************************************************************** + * + * X-Ray Calc 3 + * + * Copyright (C) 2001-2023 Oleksiy Penkov + * e-mail: oleksiypenkov@intl.zju.edu.cn + * + ****************************************************************************** *) + +unit unit_LFPSO_Irregular; + +interface + +uses + unit_materials, unit_Types, unit_calc, unit_SMessages, Windows, + unit_LFPSO_Base; + +type + + TSmoothieLayers = record + StackID, LayerID, ParamID: Word; + Layers: array of Word; + end; + + TLFPSO_Irregular = class (TLFPSO_BASE) + private + procedure Smooth(const i: Word); + protected + FLinks : TIndexes; + FSmoothies: array of TSmoothieLayers; + + procedure UpdateLFPSO(const t: integer); override; + procedure RangeSeed; override; + procedure XSeed; override; + procedure SetStructure(const Inp: TFitStructure); override; + procedure UpdatePSO(const t: integer); override; + procedure InitVelocity; override; + public + // + destructor Destroy; override; + end; + +implementation + +uses + Forms, + System.SysUtils, + Neslib.FastMath, + unit_helpers, + Dialogs; + +{ TLFPSO Periodic} + +procedure TLFPSO_Irregular.Smooth(const i: Word); +var + Data: TDataArray; + s, n : Word; +begin + for s := 0 to High(FSmoothies) do + begin + SetLength(Data, Length(FSmoothies[s].Layers)); + for n := 0 to High(Data) do + begin + Data[n].t := n; + Data[n].r := X[i][FSmoothies[s].Layers[n]][FSmoothies[s].ParamID][0]; + end; + + Data := unit_helpers.Smooth(Data, FFitParams.SmoothWindow); + + for n := 0 to High(Data) do + X[i][FSmoothies[s].Layers[n]][FSmoothies[s].ParamID][0] := Data[n].r; + end; +end; + + +procedure TLFPSO_Irregular.UpdateLFPSO(const t: integer); +var + i, j, k: integer; + c1, c2: single; +begin + ApplyCFactor(c1, c2); + + for i := 1 to High(X) do // for every member of the population + begin + for j := 0 to High(X[I]) do // for every layer + for k := 1 to 3 do // for H, s, rho + begin + if FLinks[j][k] = -1 then + begin + V[i][j][k][0] := Omega(t, FTMax) * LevyWalk(X[i][j][k][0], gbest[j][k][0]) + + c1 * Random * (pbest[j][k][0] - X[i][j][k][0]) + + c2 * Random * (gbest[j][k][0] - X[i][j][k][0]); + CheckLimits(i, j, k); + end + else + X[i][j][k][0] := X[i][FLinks[j][k]][k][0]; + end; + + if FFitParams.Smooth then Smooth(i); + end; +end; + +procedure TLFPSO_Irregular.UpdatePSO(const t: integer); +var + i, j, k: integer; + c1, c2: single; +begin + ApplyCFactor(c1, c2); + + for i := 1 to High(X) do // for every member of the population + begin + for j := 0 to High(X[I]) do // for every layer + for k := 1 to 3 do // for H, s, rho + begin + if FLinks[j][k] = -1 then + begin + V[i][j][k][0] := Omega(t, FTMax) * V[i][j][k][0] + + c1 * Random * (pbest[j][k][0] - X[i][j][k][0]) + + c2 * Random * (gbest[j][k][0] - X[i][j][k][0]); + CheckLimits(i, j, k); + end + else + X[i][j][k][0] := X[i][FLinks[j][k]][k][0]; + end; + + if FFitParams.Smooth then Smooth(i); + end; +end; + +destructor TLFPSO_Irregular.Destroy; +begin + Finalize(FLinks); + inherited; +end; + +procedure TLFPSO_Irregular.InitVelocity; +var + i, j, k: Word; +begin + MultiplyVector(Xrange, FFitParams.Vmax, Vmax); + MultiplyVector(Vmax, -1, Vmin); + + for i := 0 to High(V) do // for every member of the population + for j := 0 to High(V[I]) do // for every layer + for k := 1 to 3 do // for H, s, rho + if FLinks[j][k] > -1 then + V[i][j][k][0] := 0 + else + V[i][j][k][0] := Random * (Vmax[0][j][k][0] - Vmin[0][j][k][0]) + Vmin[0][j][k][0]; + +end; + +procedure TLFPSO_Irregular.XSeed; +var + i, j, k: Word; +begin + for i := 1 to High(X) do // for every member of the population + begin + for j := 0 to High(X[i]) do //for every layer + for k := 1 to 3 do // for H, s, rho + X[i][j][k][0] := X[0][j][k][0] + Rand(XRange[0][j][k][0] * FFitParams.Ksxr); + + if FFitParams.Smooth then Smooth(i); + end; +end; + +procedure TLFPSO_Irregular.RangeSeed; +var + i, j, k: Word; +begin + Randomize; + + for I := 1 to High(X) do // for every member of the population + begin + for j := 0 to High(X[I]) do // for every layer + for k := 1 to 3 do // for H, s, rho + begin + if FLinks[j][k] > -1 then + X[i][j][k][0] := X[i][FLinks[j][k]][k][0] + else + X[i][j][k][0] := Xmin[0][j][k][0] + Random * (Xmax[0][j][k][0] - Xmin[0][j][k][0]); // min + Random * (min-max) + end; + + if FFitParams.Smooth then Smooth(i); + end; +end; + +procedure InitArray(const Length: Word; var A: TIndexes); +begin + SetLength(A, 0); + SetLength(A, Length); +end; + +procedure TLFPSO_Irregular.SetStructure(const Inp: TFitStructure); +var + i, j, k, l, p, Index, s: Word; + Links: TIndexes; + NLayers: Word; +begin + FLayersCount := Inp.TotalNP; + + // Init(FStructure) + SetLength(FStructure.Stacks, 0); + SetLength(FStructure.Stacks, 1); + SetLength(FStructure.Stacks[0].Layers, FLayersCount); + FStructure.Subs := Inp.Subs; + FStructure.Stacks[0].N := 1; + + Init_Domains(0); + + InitArray(FLayersCount, FLinks); + if not FReInit then + SetLength(FSmoothies, 0); + + Index := 0; + for i := 0 to High(Inp.Stacks) do + begin + NLayers := Length(Inp.Stacks[i].Layers); + for k := 1 to Inp.Stacks[i].N do // for every layer in stack + begin + if (k = 1) and not FReInit then + InitArray(NLayers, Links); + + for j := 0 to NLayers - 1 do + begin + FStructure.Stacks[0].Layers[Index] := Inp.Stacks[i].Layers[j]; + + for p := 1 to 3 do + Set_Init_X(Index, p, Inp.Stacks[i].Layers[j].P[p]); + + if not FReInit then + begin + if k = 1 then + begin + for l := 1 to 3 do + begin + FLinks[Index][l] := -1; + Links[j][l] := -1; + end; + + for p := 1 to 3 do + begin + if Inp.Stacks[i].Layers[j].P[p].Paired then + Links[j][p] := Index + else + if FFitParams.Smooth and (Inp.Stacks[i].N > 1) then // create Smooths indexes for this layer + begin + s := Length(FSmoothies); + SetLength(FSmoothies, s + 1); + SetLength(FSmoothies[s].Layers, Inp.Stacks[i].N); + + FSmoothies[s].StackID := i; + FSmoothies[s].LayerID := j; + FSmoothies[s].ParamID := p; + end; + end; + end + else + for l := 1 to 3 do + FLinks[Index][l] := Links[j][l]; + end; + Inc(Index); + end; + end; + end; + + if not FReInit and FFitParams.Smooth then + begin + Index := 0; + + for i := 0 to High(Inp.Stacks) do + for k := 0 to Inp.Stacks[i].N - 1 do + begin + for j := 0 to High(Inp.Stacks[i].Layers) do + begin + for s := 0 to High(FSmoothies) do + if (FSmoothies[s].StackID = i) and + (FSmoothies[s].LayerID = j) + then + FSmoothies[s].Layers[k] := Index; + Inc(Index); + end; + end; + end; + +end; + +end. diff --git a/LFPSO/unit_LFPSO_Periodic.pas b/LFPSO/unit_LFPSO_Periodic.pas index 3aab5cf..aecf8e8 100644 --- a/LFPSO/unit_LFPSO_Periodic.pas +++ b/LFPSO/unit_LFPSO_Periodic.pas @@ -161,7 +161,7 @@ procedure TLFPSO_Periodic.SetStructure(const Inp: TFitStructure); FStructure := Inp; FLayersCount := Inp.Total; - Init_Domains; + Init_Domains(0); for I := 0 to High(FStructure.Stacks) do begin diff --git a/LFPSO/unit_LFPSO_Poly.pas b/LFPSO/unit_LFPSO_Poly.pas index 9e25414..5225dcc 100644 --- a/LFPSO/unit_LFPSO_Poly.pas +++ b/LFPSO/unit_LFPSO_Poly.pas @@ -18,8 +18,11 @@ interface type TLFPSO_Poly = class (TLFPSO_BASE) + private + MO: Integer; + + function TP(const n: Integer): LongInt; protected - Indexes: TIntArray; Counts: TIntArray; procedure CheckLimitsP(const i, j, k, Ord: integer); @@ -33,7 +36,6 @@ TLFPSO_Poly = class (TLFPSO_BASE) const Paired: Boolean; Val: TFitValue); function FitModelToLayer(Solution: TSolution): TLayeredModel; override; function GetPolynomes: TProfileFunctions; override; - function Order(const j, k: Integer): integer; inline; public destructor Destroy; override; // @@ -50,13 +52,13 @@ implementation { TLFPSO Periodic} -function TP(const n: Integer): Integer; +function TLFPSO_Poly.TP(const n: Integer): LongInt; var i : Integer; begin - Result := 10; + Result := FFitParams.PolyFactor; for I := 2 to n do - Result := Result * 10; + Result := Result * FFitParams.PolyFactor; end; procedure TLFPSO_Poly.UpdateLFPSO(const t: integer); @@ -71,7 +73,7 @@ procedure TLFPSO_Poly.UpdateLFPSO(const t: integer); for j := 0 to High(X[I]) do // for every layer for k := 1 to 3 do // for H, s, rho begin - Ord := Order(j, k); + Ord := High(X[0][j][k]); for c := 0 to Ord do // for every coefficient begin V[i][j][k][c] := Omega(t, FTMax) * LevyWalk(X[i][j][k][c], gbest[j][k][c]) + @@ -95,7 +97,7 @@ procedure TLFPSO_Poly.UpdatePSO(const t: integer); for j := 0 to High(X[I]) do // for every layer for k := 1 to 3 do begin - Ord := Order(j, k); + Ord := High(X[0][j][k]); for c := 0 to Ord do // for every coefficient begin V[i][j][k][c] := Omega(t, FTMax) * V[i][j][k][c] + @@ -110,8 +112,34 @@ procedure TLFPSO_Poly.UpdatePSO(const t: integer); procedure TLFPSO_Poly.CheckLimitsP(const i, j, k, Ord: integer); var - Val, Max, Min: Single; - p, r, Nmin, Nmax: Integer; + Max, Min: Single; + p: Integer; + + procedure Eval; + var + r: integer; + Val: single; + begin + Max := 0; Min := 1E9; + for r := 1 to Counts[j] do + begin + Val := Poly(r, X[i][j][k]); + if Val > Max then + Max := Val; + if Val < Min then + Min := Val; + end; + end; + + + procedure CheckRange; + begin + if X[i][j][k][0] > Xmax[0][j][k][0] then + X[i][j][k][0] := Xmax[0][j][k][0]; + if X[i][j][k][0] < Xmin[0][j][k][0] then + X[i][j][k][0] := Xmin[0][j][k][0]; + end; + begin for p := 0 to Ord do begin @@ -124,64 +152,29 @@ procedure TLFPSO_Poly.CheckLimitsP(const i, j, k, Ord: integer); X[i][j][k][p] := X[i][j][k][p] + V[i][j][k][p] end; - Max := 0; Min := 1E9; - if Ord > 0 then begin - for r := 1 to Counts[j] do + Eval; + if (Min < Xmin[0][j][k][0]) or (Max > Xmax[0][j][k][0]) then begin - Val := Poly(r, Xmin[0][Indexes[j]][k][0], Xmax[0][Indexes[j]][k][0], X[i][j][k]); - if Val > Max then + for p := Ord downto 1 do begin - Max := Val; - NMax := r; - end; - if Val < Min then - begin - Min := Val; - Nmin := r; - end; - end - end - else begin - Max := X[i][j][k][0]; - Min := X[i][j][k][0]; - end; - - if Max >= Xmax[0][Indexes[j]][k][0] then - begin - if X[i][j][k][0] > Xmax[0][Indexes[j]][k][0] then - begin - X[i][j][k][0] := Xmax[0][Indexes[j]][k][0]; - for p := 1 to Ord do - X[i][j][k][p] := 0; - end - else begin - X[i][j][k][1] := (Xmax[0][Indexes[j]][k][0] - X[i][j][k][0]) / Nmax; - for p := 2 to Ord do - X[i][j][k][p] := 0; - end; - end; - - if Min <= Xmin[0][Indexes[j]][k][0] then - begin - if X[i][j][k][0] < Xmin[0][Indexes[j]][k][0] then - begin - X[i][j][k][0] := Xmin[0][Indexes[j]][k][0]; - for p := 1 to Ord do - X[i][j][k][p] := 0; - end - else begin - X[i][j][k][1] := (Xmin[0][Indexes[j]][k][0] - X[i][j][k][0]) / Nmin; - for p := 2 to Ord do X[i][j][k][p] := 0; + V[i][j][k][p] := 0; + Eval; + if (Min >= Xmin[0][j][k][0]) and (Max <= Xmax[0][j][k][0]) then + Break; + if p = 1 then CheckRange; + end; end; - end; +// else CheckRange; + end + else CheckRange; end; procedure TLFPSO_Poly.InitVelocity; var - i, j, k, p: integer; + i, j, k, p, Order: integer; begin MultiplyVector(Xrange, FFitParams.Vmax, Vmax); MultiplyVector(Vmax, -1, Vmin); @@ -190,7 +183,8 @@ procedure TLFPSO_Poly.InitVelocity; for j := 0 to High(V[i]) do //for every layer for k := 1 to 3 do // for H, s, rho begin - for p := 0 to Order(j, k) do + Order := High(X[0][j][k]); + for p := 0 to Order do begin if p > 0 then begin @@ -211,7 +205,7 @@ procedure TLFPSO_Poly.XSeed; for j := 0 to High(X[i]) do //for every layer for k := 1 to 3 do // for H, s, rho begin - Ord := Order(j, k); + Ord := High(X[0][j][k]); for p := 0 to Ord do // for every oefficient of polynome if p = 0 then X[i][j][k][0] := X[0][j][k][0] + Rand(XRange[0][j][k][0] * FFitParams.Ksxr) @@ -224,34 +218,12 @@ procedure TLFPSO_Poly.XSeed; end; procedure TLFPSO_Poly.RangeSeed; -var - i, j, k, p, Ord: integer; - Val: Single; begin - for i := 0 to High(X) do // for every member of the population - begin - for j := 0 to High(X[i]) do //for every layer - for k := 1 to 3 do // for H, s, rho - begin - Ord := Order(j, k); - for p := 0 to Ord do // for every oefficient of polynome - begin - if p = 0 then - begin - Val := Rand(XRange[0][Indexes[j]][k][0]); - X[i][j][k][0] := X[0][Indexes[j]][k][0] + Val - end - else - X[i][j][k][p] := Rand(1)/TP(p); - end; - CheckLimitsP(i, j, k, Ord); - end; - end; + XSeed; end; destructor TLFPSO_Poly.Destroy; begin - Finalize(Indexes); Finalize(Counts); inherited; @@ -284,7 +256,12 @@ function TLFPSO_Poly.FitModelToLayer(Solution: TSolution): TLayeredModel; begin for k := 0 to High(FStructure.Stacks[i].Layers) do for p := 1 to 3 do - Data[k].P[p].V := Poly(j, Solution[Data[k].Index][p]); + begin + if High(Solution[Data[k].Index][p]) = 0 then + Data[k].P[p].V := Solution[Data[k].Index][p][0] + else + Data[k].P[p].V := Poly(j, Solution[Data[k].Index][p]); + end; Result.AddLayers(-1, Data); end; @@ -309,7 +286,7 @@ function TLFPSO_Poly.GetPolynomes: TProfileFunctions; begin if FStructure.Stacks[i].N = 1 then begin - Inc(Base, FStructure.Stacks[i].N); + Inc(Base, Length(FStructure.Stacks[i].Layers)); Continue; end; @@ -322,7 +299,7 @@ function TLFPSO_Poly.GetPolynomes: TProfileFunctions; NewRecord.Subj := TParameterType(p - 1); NewRecord.LayerID := FStructure.Stacks[i].Layers[j].LayerID; NewRecord.StackID := FStructure.Stacks[i].Layers[j].StackID; - NewRecord.C := abest[Indexes[Base + j]][p]; + NewRecord.C := Copy(abest[Base + j][p], 0, MO); Result := Result + [NewRecord]; end; end; @@ -333,17 +310,16 @@ function TLFPSO_Poly.GetPolynomes: TProfileFunctions; procedure TLFPSO_Poly.SetStructure(const Inp: TFitStructure); var - i, j, k, p, Index, Base: integer; + i, j, k, p, Index: integer; begin SetLength(FStructure.Stacks, 0); FStructure := Inp; FLayersCount := Inp.Total; - Init_Domains; + MO := FFitParams.MaxPOrder + 1; + Init_Domains(0); - SetLength(Indexes, 0); SetLength(Counts, 0); - SetLength(Indexes, FStructure.TotalNP); SetLength(Counts, FStructure.TotalNP); Index := 0; for i := 0 to High(Inp.Stacks) do @@ -357,49 +333,44 @@ procedure TLFPSO_Poly.SetStructure(const Inp: TFitStructure); end; end; - Index := 0; Base := 0; + Index := 0; for I := 0 to High(FStructure.Stacks) do begin for j := 1 to FStructure.Stacks[i].N do for k := 0 to High(FStructure.Stacks[i].Layers) do begin - Indexes[Index] := Base + k; Counts[Index] := FStructure.Stacks[i].N; Inc(Index); end; - Inc(Base, FStructure.Stacks[i].N ); end; - - for i := 1 to High(X) do // for every member of the population - for j := 0 to High(X[i]) do //for every layer - for k := 1 to 3 do - X[i][j][k][10] := X[0][j][k][10]; end; procedure TLFPSO_Poly.Set_Init_XPoly(const N, Index, ValueType: Integer; const Paired: Boolean; Val: TFitValue); var - p: Integer; + p, i: Integer; begin X[0][Index][ValueType][0] := Val.V; - Xmax[0][Index][ValueType][0] := Val.max; Xmin[0][Index][ValueType][0] := Val.min; + Xmax[0][Index][ValueType][0] := Val.max; Xrange[0][Index][ValueType][0] := Xmax[0][Index][ValueType][0] - Xmin[0][Index][ValueType][0]; if not (Paired or (N = 1)) then begin - X[0][Index][ValueType][10]:= FFitParams.MaxPOrder; + SetLength(X[0][Index][ValueType], MO); + SetLength(Xrange[0][Index][ValueType], MO); + SetLength(V[0][Index][ValueType], MO); + SetLength(Vmin[0][Index][ValueType], MO); + SetLength(Vmax[0][Index][ValueType], MO); - for p := 1 to Order(Index, ValueType) do + for p := 1 to MO - 1 do Xrange[0][Index][ValueType][p] := Xrange[0][Index][ValueType][0] / TP(p); - end; -end; -function TLFPSO_Poly.Order(const j, k: Integer): integer; -var - v : single; -begin - v := X[0][j][k][10]; - Result := System.Trunc(v); + for i := 1 to High(X) do // for every member of the population + begin + SetLength(X[i][Index][ValueType], MO); + SetLength(V[i][Index][ValueType], MO); + end; + end; end; end. diff --git a/XRayCalc3.dpr b/XRayCalc3.dpr index abd6f5c..ddb52fe 100644 --- a/XRayCalc3.dpr +++ b/XRayCalc3.dpr @@ -24,7 +24,6 @@ uses frm_about in 'forms\frm_about.pas' {frmAbout}, frm_NewMaterial in 'forms\frm_NewMaterial.pas' {frmNewMaterial}, unit_LFPSO_Periodic in 'LFPSO\unit_LFPSO_Periodic.pas', - unit_LFPSO_Regular in 'LFPSO\unit_LFPSO_Regular.pas', frm_MaterialSelector in 'forms\frm_MaterialSelector.pas' {frmMaterialSelector}, editor_ProfileFunction in 'editors\editor_ProfileFunction.pas' {edtrProfileFunction}, frm_ExtensionType in 'forms\frm_ExtensionType.pas' {frmExtensionSelector}, @@ -39,7 +38,10 @@ uses unit_Config in 'units\unit_Config.pas', frm_settings in 'forms\frm_settings.pas' {frmSettings}, editor_ProfileTable in 'editors\editor_ProfileTable.pas' {edtrProfileTable}, - unit_XRCGrid in 'components\unit_XRCGrid.pas'; + unit_XRCGrid in 'components\unit_XRCGrid.pas', + unit_sys_helpers in 'units\unit_sys_helpers.pas', + unit_LFPSO_Irregular in 'LFPSO\unit_LFPSO_Irregular.pas', + frm_FitSettings in 'forms\frm_FitSettings.pas' {frmFitSettings}; {$R *.res} @@ -62,5 +64,6 @@ begin Application.CreateForm(TfrmSettings, frmSettings); Application.CreateForm(TfrmSettings, frmSettings); Application.CreateForm(TedtrProfileTable, edtrProfileTable); + Application.CreateForm(TfrmFitSettings, frmFitSettings); Application.Run; end. diff --git a/XRayCalc3.dproj b/XRayCalc3.dproj index 745c09e..f2e76fc 100644 --- a/XRayCalc3.dproj +++ b/XRayCalc3.dproj @@ -114,7 +114,7 @@ true CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=3.0.0.200;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.0.0;Comments= Resources\XRayCalc3_Icon.ico - -f "d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\Mo-B(230314B)_Poly.xrcx" -a + -f "d:\DelphiProjects\X-Ray Calc\X-Ray Calc 3\test_data\W-BN(221101A).xrcx" -a PerMonitorV2 @@ -134,12 +134,18 @@ false Resources\XRayCalc3_Icon.ico 3 - 360 - CompanyName=Zhejiang University;FileDescription=$(MSBuildProjectName);FileVersion=3.0.6.360;InternalName=;LegalCopyright=Oleksiy Penkov;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.4;Comments= - 6 + 415 + CompanyName=Zhejiang University;FileDescription=$(MSBuildProjectName);FileVersion=3.0.7.415;InternalName=;LegalCopyright=Oleksiy Penkov;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=3.0.4;Comments= + 7 PerMonitorV2 + .\OUT\BIN64 + .\OUT\DCP64 + .\OUT\DCU64 + true + 1033 + Resources\XRayCalc3_x64_Icon.ico @@ -184,7 +190,6 @@ dfm -
frmMaterialSelector
dfm @@ -222,6 +227,12 @@ dfm + + + +
frmFitSettings
+ dfm + Base diff --git a/components/unit_XRCGrid.pas b/components/unit_XRCGrid.pas index 7b12d9b..a274e00 100644 --- a/components/unit_XRCGrid.pas +++ b/components/unit_XRCGrid.pas @@ -21,15 +21,19 @@ TXRCGrid = class (TRzStringGrid) FAutoFit: Boolean; procedure SetAutofit(const Value: Boolean); - function GetText: string; - procedure SetText(const Value: string); + function GetText: string; + procedure SetText(const Value: string); + procedure SetEnableStat(const Value: boolean); public procedure AutoSizeCol(Column: integer); procedure SaveToFile(const FileName: String); + procedure CalcStat; published property AutoFit: Boolean read FAutoFit write SetAutofit; property Text: string read GetText write SetText; + property EnableStat: boolean write SetEnableStat; + end; procedure Register; @@ -48,6 +52,16 @@ procedure TXRCGrid.SetAutofit(const Value: Boolean); FAutoFit := Value; end; +procedure TXRCGrid.SetEnableStat(const Value: boolean); +var + N : Integer; +begin + N := Self.ColCount - 1; + Self.ColCount := Self.ColCount + 2; + Self.Cells[N + 1, 0] := 'Mean'; + Self.Cells[N + 2, 0] := 'Std'; +end; + procedure TXRCGrid.SetText(const Value: string); begin @@ -66,6 +80,42 @@ procedure TXRCGrid.AutoSizeCol(Column: integer); Self.ColWidths[Column] := WMax + 10; end; +procedure TXRCGrid.CalcStat; +var + x, y, N: Integer; + Values: array of Single; + Mean, Std: single; +begin + try + N := Self.ColCount - 3; + if N < 1 then Exit; + + SetLength(Values, N); + + for y := 1 to Self.RowCount-1 do + begin + Mean := 0; + for x := 1 to N do + begin + Values[x - 1] := StrToFloat(Self.Cells[x, y]); + Mean := Mean + Values[x - 1]; + end; + Mean := Mean / N; + + Std := 0; + for x := 0 to High(Values) do + Std := Std + Sqr(Values[x] - Mean); + + Std := Sqrt(Std/(N - 1)); + + Self.Cells[N + 1, y] := FloatToStrF(Mean, ffFixed, 4, 3); + Self.Cells[N + 2, y] := FloatToStrF(Std, ffFixed, 4, 3); + end; + except + on Exception do; + end; +end; + function TXRCGrid.GetText: string; var x, y: Integer; @@ -80,7 +130,7 @@ function TXRCGrid.GetText: string; end; end; -procedure TXRCGrid.SaveToFile(const FileName: String); +procedure TXRCGrid.SaveToFile; var F: TextFile; begin diff --git a/components/unit_XRCLayerControl.pas b/components/unit_XRCLayerControl.pas index 55409ce..3ba5695 100644 --- a/components/unit_XRCLayerControl.pas +++ b/components/unit_XRCLayerControl.pas @@ -162,7 +162,7 @@ constructor TXRCLayerControl.Create(AOwner: TComponent; const Handler: HWND; con Name := TRzLabel.Create(Self); //Thickness - Thickness := AddSpinEdit(1, 90, 99999); + Thickness := AddSpinEdit(1, 90, 9999); PairedH := AddCheckBox(1, 150); //Sigma diff --git a/components/unit_XRCProjectTree.pas b/components/unit_XRCProjectTree.pas index 1a07df7..46e3e67 100644 --- a/components/unit_XRCProjectTree.pas +++ b/components/unit_XRCProjectTree.pas @@ -269,7 +269,7 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; var Data: PProjectData; S: string; - p, i: Integer; + p, i, Order: Integer; function GetString: string; var @@ -293,7 +293,7 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; begin Data := Sender.GetNodeData(Node); - Stream.Read(Data.ID, SizeOf(Data.ID)); + Stream.Read(Data.ID, SizeOf(Integer)); Data.Title := GetString; Stream.Read(Data.RowType, SizeOf(Data.RowType)); Stream.Read(Data.Group, SizeOf(Data.Group)); @@ -318,8 +318,8 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; 3: begin Stream.Read(Data.Enabled, SizeOf(Data.Enabled)); Stream.Read(Data.ExtType, SizeOf(Data.ExtType)); - Stream.Read(Data.LayerID, SizeOf(Data.LayerID)); - Stream.Read(Data.StackID, SizeOf(Data.StackID)); + Stream.Read(Data.LayerID, SizeOf(Integer)); + Stream.Read(Data.StackID, SizeOf(Integer)); Stream.Read(Data.Form, SizeOf(Data.Form)); Stream.Read(Data.Subj, SizeOf(Data.Subj)); for I := 1 to 3 do @@ -329,8 +329,8 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; 4: begin Stream.Read(Data.Enabled, SizeOf(Data.Enabled)); Stream.Read(Data.ExtType, SizeOf(Data.ExtType)); - Stream.Read(Data.LayerID, SizeOf(Data.LayerID)); - Stream.Read(Data.StackID, SizeOf(Data.StackID)); + Stream.Read(Data.LayerID, SizeOf(Integer)); + Stream.Read(Data.StackID, SizeOf(Integer)); Stream.Read(Data.Form, SizeOf(Data.Form)); Stream.Read(Data.Subj, SizeOf(Data.Subj)); for I := 1 to 10 do @@ -341,8 +341,8 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; 5: begin Stream.Read(Data.Enabled, SizeOf(Data.Enabled)); Stream.Read(Data.ExtType, SizeOf(Data.ExtType)); - Stream.Read(Data.LayerID, SizeOf(Data.LayerID)); - Stream.Read(Data.StackID, SizeOf(Data.StackID)); + Stream.Read(Data.LayerID, SizeOf(Integer)); + Stream.Read(Data.StackID, SizeOf(Integer)); Stream.Read(Data.Form, SizeOf(Data.Form)); Stream.Read(Data.Subj, SizeOf(Data.Subj)); @@ -353,11 +353,34 @@ procedure TXRCProjectTree.ProjectLoadNode(Sender: TBaseVirtualTree; if (Data.Group = gtModel) and (Data.RowType = prItem) then Data.Data := GetString; end; + 6: begin + Stream.Read(Data.Enabled, SizeOf(Data.Enabled)); + Stream.Read(Data.ExtType, SizeOf(Data.ExtType)); + Stream.Read(Data.LayerID, SizeOf(Integer)); + Stream.Read(Data.StackID, SizeOf(Integer)); + Stream.Read(Data.Form, SizeOf(Data.Form)); + Stream.Read(Data.Subj, SizeOf(Data.Subj)); + + if (Data.Group = gtModel) and (Data.RowType = prExtension) then + begin + Stream.Read(Order, SizeOf(Order)); + for I := 1 to Order do + Stream.Read(Data.Poly[i], SizeOf(Data.Poly[i])); + Data.Poly[10] := Order; + end; + + if (Data.Group = gtModel) and (Data.RowType = prItem) then + Data.Data := GetString; + end; + end; // case p := pos('}}', Data.Data); if p <> Length(Data.Data) - 1 then Data.Data := copy(Data.Data, 1, p + 1); + + if pos('Models', Data.Title) > 0 then Data.Title := 'Models'; + if pos('Data', Data.Title) > 0 then Data.Title := 'Data'; end; procedure TXRCProjectTree.ProjectPaintText(Sender: TBaseVirtualTree; @@ -379,7 +402,7 @@ procedure TXRCProjectTree.ProjectSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream); var Data: PProjectData; - size, i: Integer; + size, i, order: Integer; procedure WriteString(const s: string); begin @@ -408,8 +431,12 @@ procedure TXRCProjectTree.ProjectSaveNode(Sender: TBaseVirtualTree; Stream.Write(Data.Subj, SizeOf(Data.Subj)); if (Data.Group = gtModel) and (Data.RowType = prExtension) then - for I := 1 to 10 do + begin + Order := Trunc(Data.Poly[10]); + Stream.Write(Order, SizeOf(Order)); + for I := 1 to Order do Stream.Write(Data.Poly[i], SizeOf(Data.Poly[i])); + end; if (Data.Group = gtModel) and (Data.RowType = prItem) then WriteString(Data.Data); end; diff --git a/components/unit_XRCStructure.pas b/components/unit_XRCStructure.pas index 0aff926..ba6cd5a 100644 --- a/components/unit_XRCStructure.pas +++ b/components/unit_XRCStructure.pas @@ -345,14 +345,6 @@ 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.InsertLayer(const Data: TLayerData); var @@ -366,7 +358,9 @@ procedure TXRCStructure.InsertStack(const N: Integer; const Title: string); var Count, pos: Integer; begin + FVisibility := Visible; Visible := False; + Count := Length(FStacks); if FSelectedStack <> -1 then Pos := FSelectedStack @@ -513,7 +507,7 @@ procedure TXRCStructure.SetPeriodicMode(const Value: boolean); Stack: TXRCStack; begin for Stack in FStacks do - Stack.EnablePairing(Value); + Stack.EnablePairing(not Value); end; procedure TXRCStructure.UpdateInterfaceNP(const Inp: TFitStructure); diff --git a/editors/editor_ProfileFunction.dfm b/editors/editor_ProfileFunction.dfm index 3b1c01d..263d756 100644 --- a/editors/editor_ProfileFunction.dfm +++ b/editors/editor_ProfileFunction.dfm @@ -37,7 +37,7 @@ object edtrProfileFunction: TedtrProfileFunction 828 41) object btnOK: TRzBitBtn - Left = 729 + Left = 745 Top = 10 Width = 66 Alignment = taRightJustify @@ -46,7 +46,7 @@ object edtrProfileFunction: TedtrProfileFunction TabStop = False OnClick = btnOKClick Kind = bkOK - ExplicitLeft = 721 + ExplicitLeft = 737 end object btnCancel: TRzBitBtn Left = 9 @@ -209,8 +209,21 @@ object edtrProfileFunction: TedtrProfileFunction Title.Visible = False View3D = False TabOrder = 8 + DesignSize = ( + 476 + 271) DefaultCanvas = 'TGDIPlusCanvas' ColorPaletteIndex = 13 + object btnCopy: TBitBtn + Left = 384 + Top = 15 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Copy' + TabOrder = 0 + OnClick = btnCopyClick + end object Series1: TLineSeries HoverElement = [heCurrent] Brush.BackColor = clDefault diff --git a/editors/editor_ProfileFunction.pas b/editors/editor_ProfileFunction.pas index 2ed104f..2290690 100644 --- a/editors/editor_ProfileFunction.pas +++ b/editors/editor_ProfileFunction.pas @@ -45,6 +45,7 @@ TedtrProfileFunction = class(TForm) Series1: TLineSeries; btnPreview: TBitBtn; btnFunctionHelp: TBitBtn; + btnCopy: TBitBtn; procedure FormShow(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure cbbStackChange(Sender: TObject); @@ -52,6 +53,7 @@ TedtrProfileFunction = class(TForm) procedure seOrderChange(Sender: TObject); procedure btnPreviewClick(Sender: TObject); procedure cbLayerChange(Sender: TObject); + procedure btnCopyClick(Sender: TObject); private { Private declarations } FData: PProjectData; @@ -75,7 +77,12 @@ implementation {$R *.dfm} -uses frm_main, math_globals; +uses frm_main, math_globals, unit_helpers; + +procedure TedtrProfileFunction.btnCopyClick(Sender: TObject); +begin + SeriesToClipboard('N', FData.Title, '', 'A', Series1); +end; procedure TedtrProfileFunction.btnOKClick(Sender: TObject); begin @@ -132,13 +139,13 @@ procedure TedtrProfileFunction.FillCoefficients; i: integer; N: Integer; begin - N := Trunc(FData.Poly[10]); + N := High(Data.PolyD); seOrder.IntValue := N; Grid.RowCount := N + 1; for i := 1 to N do begin Grid.Cells[0, i] := Format('c%d',[i]); - Grid.Cells[1, i] := FloatToStrF(FData.Poly[i], ffGeneral, 4, 3); + Grid.Cells[1, i] := FloatToStrF(FData.PolyD[i], ffGeneral, 4, 3); end; end; diff --git a/forms/frm_Benchmark.dfm b/forms/frm_Benchmark.dfm index 4289b39..c2065f9 100644 --- a/forms/frm_Benchmark.dfm +++ b/forms/frm_Benchmark.dfm @@ -3,8 +3,8 @@ object frmBenchmark: TfrmBenchmark Top = 0 BorderStyle = bsToolWindow Caption = 'Benchmark' - ClientHeight = 409 - ClientWidth = 991 + ClientHeight = 397 + ClientWidth = 983 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -18,15 +18,13 @@ object frmBenchmark: TfrmBenchmark AlignWithMargins = True Left = 3 Top = 3 - Width = 985 - Height = 403 + Width = 977 + Height = 391 Align = alClient BorderOuter = fsGroove BorderWidth = 2 Color = 15987699 TabOrder = 0 - ExplicitWidth = 977 - ExplicitHeight = 391 object BitBtn1: TBitBtn Left = 896 Top = 363 diff --git a/forms/frm_Benchmark.pas b/forms/frm_Benchmark.pas index b455f8d..d0b0c6f 100644 --- a/forms/frm_Benchmark.pas +++ b/forms/frm_Benchmark.pas @@ -24,6 +24,7 @@ TfrmBenchmark = class(TForm) procedure BitBtn1Click(Sender: TObject); private FLine: Integer; + FFileName: string; { Private declarations } public { Public declarations } @@ -31,7 +32,9 @@ TfrmBenchmark = class(TForm) procedure AddValue(const n: integer; Val: string); procedure AddFile(const Name: string); - procedure CalcStats; + procedure CalcStats(const Full: Boolean); + procedure Init(const OutputDir: string); + end; var @@ -62,7 +65,8 @@ procedure TfrmBenchmark.BitBtn1Click(Sender: TObject); procedure TfrmBenchmark.CalcStats; begin - Grid.SaveToFile('benchmark.dat'); + if Full then Grid.CalcStat; + Grid.SaveToFile(FFileName); end; procedure TfrmBenchmark.Clear; @@ -78,6 +82,18 @@ procedure TfrmBenchmark.Clear; for I := 1 to N do Grid.Cells[i, 0] := 'Run ' + IntToStr(i); + + Grid.EnableStat := True; +end; + +procedure TfrmBenchmark.Init; +var + FileName, Date: string; +begin + DateTimeToString(Date, 'yymmdd-hh-mm', Now); + FileName := Format('%s-%s.dat',['benchmark', Date]); + + FFileName := OutputDir + FileName; end; end. diff --git a/forms/frm_FitSettings.dfm b/forms/frm_FitSettings.dfm new file mode 100644 index 0000000..377c29c --- /dev/null +++ b/forms/frm_FitSettings.dfm @@ -0,0 +1,429 @@ +object frmFitSettings: TfrmFitSettings + Left = 0 + Top = 0 + BorderStyle = bsDialog + Caption = 'Advanced fitting settings' + ClientHeight = 441 + ClientWidth = 447 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Position = poMainFormCenter + StyleName = 'Windows' + TextHeight = 15 + object RzPanel1: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 3 + Width = 441 + Height = 388 + Align = alClient + BorderOuter = fsFlatRounded + TabOrder = 0 + object Tip: TMHLStaticTip + AlignWithMargins = True + Left = 5 + Top = 332 + Width = 431 + Height = 51 + Align = alBottom + Caption = 'Select a parameter to see its description' + ExplicitLeft = 2 + ExplicitTop = 336 + ExplicitWidth = 441 + end + object RzGroupBox1: TRzGroupBox + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 431 + Height = 55 + Align = alTop + Caption = 'General' + TabOrder = 0 + object Label20: TLabel + Left = 12 + Top = 23 + Width = 47 + Height = 13 + Caption = 'Tolerance' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object edFitTolerance: TEdit + Left = 65 + Top = 19 + Width = 43 + Height = 22 + Hint = 'Target tolerance (cost function). Fitting stops when reach it.' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 0 + Text = '0.005' + OnEnter = ShowParamHint + end + object cbAdaptiveVelocity: TRzCheckBox + Left = 352 + Top = 20 + Width = 44 + Height = 17 + AlignmentVertical = avCenter + Caption = 'Ad.V' + State = cbUnchecked + TabOrder = 1 + Visible = False + end + end + object RzGroupBox2: TRzGroupBox + AlignWithMargins = True + Left = 5 + Top = 66 + Width = 431 + Height = 103 + Align = alTop + Caption = 'LFPSO' + Color = 15987699 + TabOrder = 1 + object Label16: TLabel + Left = 11 + Top = 48 + Width = 26 + Height = 13 + Caption = 'Vmax' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label18: TLabel + Left = 108 + Top = 49 + Width = 17 + Height = 13 + Caption = ' '#969'1' + Font.Charset = GREEK_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label19: TLabel + Left = 189 + Top = 49 + Width = 17 + Height = 13 + Caption = ' '#969'2' + Font.Charset = GREEK_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label15: TLabel + Left = 99 + Top = 24 + Width = 25 + Height = 13 + Caption = 'Jmax' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label17: TLabel + Left = 4 + Top = 23 + Width = 33 + Height = 13 + Caption = 'SHmax' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label13: TLabel + Left = 26 + Top = 74 + Width = 11 + Height = 13 + Caption = 'k1' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label14: TLabel + Left = 110 + Top = 74 + Width = 11 + Height = 13 + Caption = 'k2' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object edFVmax: TEdit + Left = 43 + Top = 44 + Width = 50 + Height = 22 + Hint = 'Max. particle velocity factor' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 0 + Text = '0.3' + OnEnter = ShowParamHint + end + object edLFPSOOmega1: TEdit + Left = 131 + Top = 44 + Width = 50 + Height = 22 + Hint = 'Velocity scale factor (permanent)' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 1 + Text = '0.3' + OnEnter = ShowParamHint + end + object edLFPSOOmega2: TEdit + Left = 212 + Top = 45 + Width = 50 + Height = 22 + Hint = 'Velocity reducing factor' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 2 + Text = '0.1' + OnEnter = ShowParamHint + end + object edLFPSOSkip: TEdit + Left = 130 + Top = 19 + Width = 51 + Height = 22 + Hint = 'Number of iterations without improvement to perform shake' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 3 + Text = '1' + OnEnter = ShowParamHint + end + object edLFPSORImax: TEdit + Left = 43 + Top = 19 + Width = 50 + Height = 22 + Hint = 'Max. number of consequent shakes' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 4 + Text = '3' + OnEnter = ShowParamHint + end + object edLFPSOChiFactor: TEdit + Left = 43 + Top = 70 + Width = 50 + Height = 22 + Hint = 'Velocity shake coefficient' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 5 + Text = '1.41' + OnEnter = ShowParamHint + end + object edLFPSOkVmax: TEdit + Left = 130 + Top = 70 + Width = 50 + Height = 22 + Hint = 'Best cost functuion shake coefficient' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 6 + Text = '1.41' + OnEnter = ShowParamHint + end + end + object RzGroupBox3: TRzGroupBox + AlignWithMargins = True + Left = 5 + Top = 175 + Width = 431 + Height = 55 + Align = alTop + Caption = 'Irregular' + Color = 15987699 + TabOrder = 2 + ExplicitTop = 151 + object Label1: TLabel + Left = 12 + Top = 23 + Width = 89 + Height = 13 + Caption = 'Smoothing window' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object edIrrSmoothWindow: TEdit + Left = 107 + Top = 19 + Width = 50 + Height = 22 + Hint = + 'Width of the smoothing windows (integer). Set "-1" for automatic' + + ' ' + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + NumbersOnly = True + ParentFont = False + TabOrder = 0 + Text = '3' + OnEnter = ShowParamHint + end + end + object RzGroupBox4: TRzGroupBox + AlignWithMargins = True + Left = 5 + Top = 236 + Width = 431 + Height = 55 + Align = alTop + Caption = 'Polynomial' + Color = 15987699 + TabOrder = 3 + ExplicitTop = 212 + object Label8: TLabel + Left = 10 + Top = 25 + Width = 94 + Height = 15 + Caption = 'Polynomial factor' + end + object Label10: TLabel + Left = 249 + Top = 27 + Width = 22 + Height = 15 + Caption = 'Ksxr' + end + object sePolyFactor: TSpinEdit + Left = 105 + Top = 22 + Width = 84 + Height = 24 + MaxValue = 15 + MinValue = 1 + TabOrder = 0 + Value = 10 + end + object edKsxr: TEdit + Left = 279 + Top = 23 + Width = 49 + Height = 23 + Hint = 'Velocity scale factor for polynomes' + NumbersOnly = True + TabOrder = 1 + Text = '0.2' + OnEnter = ShowParamHint + end + end + end + object rzpnl1: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 397 + Width = 441 + Height = 41 + Align = alBottom + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 1 + object btnSave: TRzBitBtn + Left = 360 + Top = 8 + TabOrder = 0 + Kind = bkOK + end + object btnCancel: TBitBtn + Left = 9 + Top = 8 + Width = 75 + Height = 25 + Kind = bkCancel + NumGlyphs = 2 + TabOrder = 1 + end + end +end diff --git a/forms/frm_FitSettings.pas b/forms/frm_FitSettings.pas new file mode 100644 index 0000000..c5bbd92 --- /dev/null +++ b/forms/frm_FitSettings.pas @@ -0,0 +1,103 @@ +unit frm_FitSettings; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, RzPanel, RzButton, + RzRadChk, Vcl.StdCtrls, RzTabs, unit_Types, Vcl.Buttons, unit_StaticTip, + Vcl.Mask, RzEdit, Vcl.Samples.Spin; + +type + TfrmFitSettings = class(TForm) + RzPanel1: TRzPanel; + rzpnl1: TRzPanel; + RzGroupBox1: TRzGroupBox; + edFitTolerance: TEdit; + Label20: TLabel; + cbAdaptiveVelocity: TRzCheckBox; + RzGroupBox2: TRzGroupBox; + Label16: TLabel; + edFVmax: TEdit; + Label18: TLabel; + edLFPSOOmega1: TEdit; + Label19: TLabel; + edLFPSOOmega2: TEdit; + edLFPSOSkip: TEdit; + Label15: TLabel; + edLFPSORImax: TEdit; + Label17: TLabel; + Label13: TLabel; + edLFPSOChiFactor: TEdit; + Label14: TLabel; + edLFPSOkVmax: TEdit; + RzGroupBox3: TRzGroupBox; + Label1: TLabel; + edIrrSmoothWindow: TEdit; + Tip: TMHLStaticTip; + btnSave: TRzBitBtn; + btnCancel: TBitBtn; + RzGroupBox4: TRzGroupBox; + sePolyFactor: TSpinEdit; + Label8: TLabel; + Label10: TLabel; + edKsxr: TEdit; + procedure ShowParamHint(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + procedure ShowSettings(var Params: TFitParams); + end; + +var + frmFitSettings: TfrmFitSettings; + +implementation + +{$R *.dfm} + +{ TfrmFitSettings } + +procedure TfrmFitSettings.ShowParamHint(Sender: TObject); +begin + Tip.Caption := (Sender as TEdit).Hint; +end; + +procedure TfrmFitSettings.ShowSettings(var Params: TFitParams); +begin + edFVmax.Text := Params.Vmax.ToString(ffFixed, 2, 2); + edLFPSOSkip.Text := Params.JammingMax.ToString; + edLFPSORImax.Text := Params.ReInitMax.ToString; + edLFPSOChiFactor.Text := Params.KChiSqr.ToString(ffFixed, 2, 2); + edLFPSOkVmax.Text := Params.KVmax.ToString(ffFixed, 2, 2); + edLFPSOOmega1.Text := Params.w1.ToString(ffFixed, 2, 2); + edLFPSOOmega2.Text := Params.w2.ToString(ffFixed, 2, 2); + edFitTolerance.Text := Params.Tolerance.ToString(ffFixed, 2, 3); + edIrrSmoothWindow.Text := Params.SmoothWindow.ToString; + + sePolyFactor.Value := Params.PolyFactor; + edKsxr.Text := Params.Ksxr.ToString(ffFixed, 2, 2); + + cbAdaptiveVelocity.Checked := Params.AdaptVel; + + if ShowModal = mrOk then + begin + Params.Vmax := StrToFloat(edFVmax.Text); + Params.JammingMax := StrToInt(edLFPSOSkip.Text); + Params.ReInitMax := StrToInt(edLFPSORImax.Text); + Params.KChiSqr := StrToFloat(edLFPSOChiFactor.Text); + Params.KVmax := StrToFloat(edLFPSOkVmax.Text); + Params.w1 := StrToFloat(edLFPSOOmega1.Text); + Params.w2 := StrToFloat(edLFPSOOmega2.Text); + Params.Tolerance := StrToFloat(edFitTolerance.Text); + Params.AdaptVel := cbAdaptiveVelocity.Checked; + Params.SmoothWindow := StrToInt(edIrrSmoothWindow.Text); + + Params.PolyFactor := sePolyFactor.Value; + Params.Ksxr := StrToFloat(edKsxr.Text); + + end; +end; + +end. diff --git a/forms/frm_Main.dfm b/forms/frm_Main.dfm index 74e9ea1..a10fefb 100644 --- a/forms/frm_Main.dfm +++ b/forms/frm_Main.dfm @@ -2,8 +2,8 @@ object frmMain: TfrmMain Left = 381 Top = 305 Caption = 'X-Ray Calc 3' - ClientHeight = 708 - ClientWidth = 1462 + ClientHeight = 697 + ClientWidth = 1718 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -20,8 +20,8 @@ object frmMain: TfrmMain TextHeight = 15 object Status: TRzStatusBar Left = 0 - Top = 689 - Width = 1462 + Top = 678 + Width = 1718 Height = 19 BorderInner = fsNone BorderOuter = fsNone @@ -29,8 +29,8 @@ object frmMain: TfrmMain BorderWidth = 0 Color = 15987699 TabOrder = 0 - ExplicitTop = 688 - ExplicitWidth = 1458 + ExplicitTop = 677 + ExplicitWidth = 1714 object spnTime: TRzStatusPane Left = 0 Top = 0 @@ -47,7 +47,7 @@ object frmMain: TfrmMain Caption = '' end object RzVersionInfoStatus1: TRzVersionInfoStatus - Left = 1362 + Left = 1618 Top = 0 Height = 19 Align = alRight @@ -60,22 +60,22 @@ object frmMain: TfrmMain object LeftSplitter: TRzSplitter Left = 0 Top = 0 - Width = 1462 - Height = 689 + Width = 1718 + Height = 678 Position = 234 - Percent = 16 + Percent = 14 UpperLeft.Color = 15987699 LowerRight.Color = 15987699 Align = alClient Color = 15987699 TabOrder = 1 - ExplicitWidth = 1458 - ExplicitHeight = 688 + ExplicitWidth = 1714 + ExplicitHeight = 677 BarSize = ( 234 0 238 - 689) + 678) UpperLeftControls = ( RzPanel1) LowerRightControls = ( @@ -86,7 +86,7 @@ object frmMain: TfrmMain Left = 3 Top = 3 Width = 228 - Height = 683 + Height = 672 Align = alClient BorderOuter = fsFlatRounded Color = 15987699 @@ -124,44 +124,47 @@ object frmMain: TfrmMain object BtnOpen: TRzToolButton Left = 29 Top = 2 + Width = 39 DisabledIndex = 3 + DropDownMenu = pmRecentList ImageIndex = 2 + ToolStyle = tsDropDown Action = FileOpen end object BtnSave: TRzToolButton - Left = 87 + Left = 101 Top = 2 DisabledIndex = 5 ImageIndex = 4 Action = FileSave end object RzSpacer1: TRzSpacer - Left = 112 + Left = 126 Top = 2 end object BtnPrint: TRzToolButton - Left = 120 + Left = 134 Top = 2 DisabledIndex = 7 ImageIndex = 6 Action = FilePrint end object btnReopenProject: TRzToolButton - Left = 54 + Left = 68 Top = 2 DisabledIndex = 23 ImageIndex = 22 Action = actProjectReopen end object rzspcr2: TRzSpacer - Left = 79 + Left = 93 Top = 2 end end object RzPanel5: TRzPanel AlignWithMargins = True Left = 5 - Top = 596 + Top = 585 Width = 218 Height = 82 Align = alBottom @@ -169,7 +172,7 @@ object frmMain: TfrmMain Color = 15987699 FlatColor = clSkyBlue TabOrder = 1 - ExplicitTop = 595 + ExplicitTop = 584 object mmDescription: TRzMemo AlignWithMargins = True Left = 5 @@ -284,8 +287,8 @@ object frmMain: TfrmMain AlignWithMargins = True Left = 356 Top = 3 - Width = 868 - Height = 683 + Width = 1124 + Height = 672 Margins.Left = 0 Margins.Right = 0 Align = alClient @@ -295,16 +298,16 @@ object frmMain: TfrmMain object Pages: TRzPageControl AlignWithMargins = True Left = 5 - Top = 515 - Width = 858 + Top = 504 + Width = 1114 Height = 163 Hint = '' ActivePage = tsFittingProgress Align = alBottom TabIndex = 3 TabOrder = 0 - ExplicitTop = 514 - ExplicitWidth = 854 + ExplicitTop = 503 + ExplicitWidth = 1110 FixedDimension = 21 object tsThickness: TRzTabSheet Color = 15987699 @@ -313,7 +316,7 @@ object frmMain: TfrmMain AlignWithMargins = True Left = 3 Top = 3 - Width = 848 + Width = 1104 Height = 132 Cursor = crCross Legend.HorizMargin = 5 @@ -349,7 +352,7 @@ object frmMain: TfrmMain AlignWithMargins = True Left = 3 Top = 3 - Width = 848 + Width = 1104 Height = 132 Cursor = crCross Legend.HorizMargin = 5 @@ -382,7 +385,7 @@ object frmMain: TfrmMain AlignWithMargins = True Left = 3 Top = 3 - Width = 848 + Width = 1104 Height = 132 Cursor = crCross Legend.HorizMargin = 5 @@ -411,12 +414,12 @@ object frmMain: TfrmMain object tsFittingProgress: TRzTabSheet Color = 15987699 Caption = 'Convergence' - ExplicitWidth = 850 + ExplicitWidth = 1106 object chFittingProgress: TChart AlignWithMargins = True Left = 3 Top = 3 - Width = 848 + Width = 1104 Height = 132 Cursor = crCross Border.Color = clDefault @@ -461,21 +464,21 @@ object frmMain: TfrmMain BevelOuter = bvNone Color = 16771538 TabOrder = 0 - ExplicitWidth = 844 + ExplicitWidth = 1100 DesignSize = ( - 848 + 1104 132) DefaultCanvas = 'TGDIPlusCanvas' ColorPaletteIndex = 13 object btnCopyConvergence: TRzButton - Left = 778 + Left = 1034 Top = 9 Width = 59 Anchors = [akTop, akRight] Caption = 'Copy' TabOrder = 0 OnClick = btnCopyConvergenceClick - ExplicitLeft = 774 + ExplicitLeft = 1030 end object lsrConvergence: TLineSeries HoverElement = [heCurrent] @@ -499,8 +502,8 @@ object frmMain: TfrmMain AlignWithMargins = True Left = 5 Top = 148 - Width = 858 - Height = 305 + Width = 1114 + Height = 294 Cursor = crCross Foot.Visible = False Legend.Brush.Color = clSilver @@ -606,8 +609,8 @@ object frmMain: TfrmMain OnMouseMove = ChartMouseMove OnMouseUp = ChartMouseUp OnResize = ChartResize - ExplicitWidth = 854 - ExplicitHeight = 304 + ExplicitWidth = 1110 + ExplicitHeight = 293 DefaultCanvas = 'TGDIPlusCanvas' PrintMargins = ( 5 @@ -728,18 +731,18 @@ object frmMain: TfrmMain object RzPanel3: TRzPanel AlignWithMargins = True Left = 5 - Top = 459 - Width = 858 + Top = 448 + Width = 1114 Height = 50 Align = alBottom BorderOuter = fsFlatRounded Color = 15987699 FlatColor = clSkyBlue TabOrder = 2 - ExplicitTop = 458 - ExplicitWidth = 854 + ExplicitTop = 447 + ExplicitWidth = 1110 DesignSize = ( - 858 + 1114 50) object RzStatusPane1: TRzStatusPane Left = 5 @@ -932,7 +935,7 @@ object frmMain: TfrmMain Caption = '0.00' end object btnChartScale: TRzBitBtn - Left = 702 + Left = 958 Top = 7 Anchors = [akTop, akRight] Caption = 'Linear' @@ -944,10 +947,10 @@ object frmMain: TfrmMain ParentFont = False TabOrder = 0 OnClick = btnChartScaleClick - ExplicitLeft = 698 + ExplicitLeft = 954 end object cbMinLimit: TRzComboBox - Left = 783 + Left = 1039 Top = 8 Width = 66 Height = 24 @@ -968,465 +971,217 @@ object frmMain: TfrmMain '10E-7' '10E-8' '10E-9') - ExplicitLeft = 779 + ExplicitLeft = 1035 end end object pnlSettings: TPanel Left = 2 Top = 31 - Width = 864 + Width = 1120 Height = 114 Align = alTop BevelOuter = bvNone TabOrder = 3 - ExplicitWidth = 860 + ExplicitWidth = 1116 object RzPanel6: TRzPanel AlignWithMargins = True Left = 387 Top = 6 - Width = 474 + Width = 730 Height = 105 Margins.Top = 6 Align = alClient + Alignment = taLeftJustify + AlignmentVertical = avTop BorderOuter = fsFlatRounded + Caption = 'Fitting' Color = 15987699 TabOrder = 0 - ExplicitWidth = 470 - object RzPageControl1: TRzPageControl - Left = 2 - Top = 2 - Width = 359 - Height = 101 - Hint = '' - ActivePage = TabSheet1 - Align = alLeft - TabIndex = 0 + ExplicitWidth = 726 + object Label7: TLabel + Left = 8 + Top = 29 + Width = 47 + Height = 13 + Caption = 'Iterations' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label8: TLabel + Left = 6 + Top = 57 + Width = 50 + Height = 13 + Caption = 'Population' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object lblPolyOrder: TLabel + Left = 291 + Top = 51 + Width = 28 + Height = 13 + Caption = 'Order' + Enabled = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object Label21: TLabel + Left = 256 + Top = 83 + Width = 32 + Height = 15 + Caption = ' TW'#967'2' + end + object rgFittingMode: TRzRadioGroup + AlignWithMargins = True + Left = 132 + Top = 3 + Width = 237 + Height = 39 + Margins.Top = 15 + Caption = 'Mode' + Color = 15987699 + Columns = 3 + ItemHeight = 17 + ItemIndex = 0 + Items.Strings = ( + 'Irregualr' + 'Periodic' + 'Polynomial') + SpaceEvenly = True TabOrder = 0 - FixedDimension = 21 - object TabSheet1: TRzTabSheet - Color = 15987699 - Caption = 'Fitting' - object Label7: TLabel - Left = 7 - Top = 15 - Width = 27 - Height = 13 - Caption = 'Nmax' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label8: TLabel - Left = 9 - Top = 51 - Width = 50 - Height = 13 - Caption = 'Population' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label20: TLabel - Left = 92 - Top = 15 - Width = 47 - Height = 13 - Caption = 'Tolerance' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label5: TLabel - Left = 178 - Top = 50 - Width = 38 - Height = 13 - Caption = 'Window' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label21: TLabel - Left = 260 - Top = 49 - Width = 32 - Height = 15 - Caption = ' TW'#967'2' - end - object edFIter: TEdit - Left = 40 - Top = 11 - Width = 42 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - NumbersOnly = True - ParentFont = False - TabOrder = 0 - Text = '100' - end - object edFPopulation: TEdit - Left = 63 - Top = 47 - Width = 43 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - NumbersOnly = True - ParentFont = False - TabOrder = 1 - Text = '100' - end - object cbPWChiSqr: TRzCheckBox - Left = 113 - Top = 49 - Width = 56 - Height = 19 - Caption = 'PW '#967'2' - Checked = True - State = cbChecked - TabOrder = 2 - end - object edFWindow: TEdit - Left = 216 - Top = 46 - Width = 41 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 3 - Text = '0.05' - end - object cbTWChi: TComboBox - Left = 296 - Top = 46 - Width = 56 - Height = 23 - ItemIndex = 0 - TabOrder = 4 - Text = 'None' - Items.Strings = ( - 'None' - 'sqr' - 'line' - 'sqrt' - '1/sqr' - '1/sqrt') - end - object edFitTolerance: TEdit - Left = 145 - Top = 11 - Width = 43 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 5 - Text = '0.005' - end - object cbTreatPeriodic: TRzCheckBox - Left = 192 - Top = 13 - Width = 66 - Height = 19 - Caption = 'Periodic' - Checked = True - State = cbChecked - TabOrder = 6 - OnClick = cbTreatPeriodicClick - end - object cbPoly: TRzCheckBox - Left = 264 - Top = 13 - Width = 46 - Height = 19 - Caption = 'Poly' - State = cbUnchecked - TabOrder = 7 - end - object edPolyOrder: TEdit - Left = 316 - Top = 11 - Width = 34 - Height = 22 - Hint = 'Polynomial order' - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - MaxLength = 1 - NumbersOnly = True - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 8 - Text = '1' - end - end - object TabSheet2: TRzTabSheet - Color = 15987699 - Caption = 'LSPSO' - object Label16: TLabel - Left = 11 - Top = 14 - Width = 26 - Height = 13 - Caption = 'Vmax' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label18: TLabel - Left = 88 - Top = 14 - Width = 17 - Height = 13 - Caption = ' '#969'1' - Font.Charset = GREEK_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label19: TLabel - Left = 163 - Top = 14 - Width = 17 - Height = 13 - Caption = ' '#969'2' - Font.Charset = GREEK_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label17: TLabel - Left = 67 - Top = 52 - Width = 33 - Height = 13 - Caption = 'SHmax' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label13: TLabel - Left = 216 - Top = 52 - Width = 11 - Height = 13 - Caption = 'k1' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label14: TLabel - Left = 274 - Top = 52 - Width = 11 - Height = 13 - Caption = 'k2' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object Label15: TLabel - Left = 148 - Top = 52 - Width = 25 - Height = 13 - Caption = 'Jmax' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object edFVmax: TEdit - Left = 43 - Top = 10 - Width = 35 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 0 - Text = '0.3' - end - object cbLFPSOShake: TRzCheckBox - Left = 5 - Top = 49 - Width = 50 - Height = 17 - AlignmentVertical = avCenter - Caption = 'Shake' - Checked = True - State = cbChecked - TabOrder = 1 - end - object edLFPSOOmega1: TEdit - Left = 111 - Top = 10 - Width = 42 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 2 - Text = '0.3' - end - object edLFPSOOmega2: TEdit - Left = 186 - Top = 10 - Width = 42 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 3 - Text = '0.1' - end - object edLFPSORImax: TEdit - Left = 106 - Top = 48 - Width = 35 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 4 - Text = '3' - end - object edLFPSOChiFactor: TEdit - Left = 233 - Top = 48 - Width = 35 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 5 - Text = '1.41' - end - object edLFPSOkVmax: TEdit - Left = 291 - Top = 48 - Width = 35 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 6 - Text = '1.41' - end - object edLFPSOSkip: TEdit - Left = 175 - Top = 48 - Width = 35 - Height = 22 - Alignment = taRightJustify - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -12 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 7 - Text = '1' - end - object cbAdaptiveVelocity: TRzCheckBox - Left = 304 - Top = 11 - Width = 44 - Height = 17 - AlignmentVertical = avCenter - Caption = 'Ad.V' - State = cbUnchecked - TabOrder = 8 - Visible = False - end - object cbSeedRange: TRzCheckBox - Left = 234 - Top = 11 - Width = 51 - Height = 17 - AlignmentVertical = avCenter - Caption = 'SeedR' - Checked = True - State = cbChecked - TabOrder = 9 - end - end + OnClick = rgFittingModeClick + end + object edFIter: TEdit + Left = 60 + Top = 25 + Width = 50 + Height = 22 + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + NumbersOnly = True + ParentFont = False + TabOrder = 1 + Text = '100' + end + object edFPopulation: TEdit + Left = 60 + Top = 53 + Width = 50 + Height = 22 + Alignment = taRightJustify + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + NumbersOnly = True + ParentFont = False + TabOrder = 2 + Text = '100' + end + object cbLFPSOShake: TRzCheckBox + Left = 7 + Top = 81 + Width = 54 + Height = 19 + AlignmentVertical = avCenter + Caption = 'Shake' + Checked = True + State = cbChecked + TabOrder = 3 + end + object cbSeedRange: TRzCheckBox + Left = 71 + Top = 81 + Width = 55 + Height = 19 + AlignmentVertical = avCenter + Caption = 'SeedR' + Checked = True + State = cbChecked + TabOrder = 4 + end + object edPolyOrder: TEdit + Left = 335 + Top = 48 + Width = 34 + Height = 22 + Hint = 'Polynomial order' + Alignment = taRightJustify + Enabled = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Tahoma' + Font.Style = [] + MaxLength = 1 + NumbersOnly = True + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 5 + Text = '1' + end + object cbTWChi: TComboBox + Left = 297 + Top = 78 + Width = 72 + Height = 23 + ItemIndex = 0 + TabOrder = 6 + Text = 'None' + Items.Strings = ( + 'None' + 'sqr' + 'line' + 'sqrt' + '1/sqr' + '1/sqrt') + end + object cbPWChiSqr: TRzCheckBox + Left = 141 + Top = 81 + Width = 56 + Height = 19 + Caption = 'PW '#967'2' + Checked = True + State = cbChecked + TabOrder = 7 + end + object btnAdvFitSettings: TRzBitBtn + Left = 375 + Top = 9 + Height = 92 + Caption = 'Advanced'#13'Settings' + TabOrder = 8 + OnClick = btnAdvFitSettingsClick + end + object cbSmooth: TRzCheckBox + Left = 141 + Top = 48 + Width = 65 + Height = 19 + Caption = 'Smooth' + State = cbUnchecked + TabOrder = 9 end end object RzPanel7: TRzPanel @@ -1773,7 +1528,7 @@ object frmMain: TfrmMain object ChartToolBar: TRzToolbar Left = 2 Top = 2 - Width = 864 + Width = 1120 Height = 29 Images = ilCalc TextOptions = ttoCustom @@ -1783,7 +1538,7 @@ object frmMain: TfrmMain BorderWidth = 0 StyleName = 'Windows' TabOrder = 4 - ExplicitWidth = 860 + ExplicitWidth = 1116 ToolbarControls = ( btnCalcRun BtnFastForward @@ -1887,7 +1642,7 @@ object frmMain: TfrmMain Left = 3 Top = 3 Width = 350 - Height = 683 + Height = 672 Align = alLeft BorderOuter = fsFlatRounded Color = 15987699 @@ -2073,8 +1828,8 @@ object frmMain: TfrmMain object Openproject1: TMenuItem Action = FileOpen end - object Reopen1: TMenuItem - Caption = 'Reopen ...' + object miRecent: TMenuItem + Caption = 'Recent projects' end object Openproject2: TMenuItem Action = FileSave @@ -2202,6 +1957,9 @@ object frmMain: TfrmMain object Smooth1: TMenuItem Action = actDataSmooth end + object rim1: TMenuItem + Action = actDataTrim + end object N7: TMenuItem Caption = '-' end @@ -2228,6 +1986,9 @@ object frmMain: TfrmMain object Fitting1: TMenuItem Action = actAutoFitting end + object Calcbatchjobs1: TMenuItem + Action = actCalcFitJobs + end object N14: TMenuItem Caption = '-' end @@ -3377,6 +3138,16 @@ object frmMain: TfrmMain Caption = 'Copy as image' OnExecute = actCopyStructureBitmapExecute end + object actDataTrim: TAction + Category = 'Data' + Caption = 'Trim' + OnExecute = actDataTrimExecute + end + object actCalcFitJobs: TAction + Category = 'Calc' + Caption = 'Batch jobs Fitting' + OnExecute = actCalcFitJobsExecute + end end object ilProject: TImageList ColorDepth = cd32Bit @@ -4351,7 +4122,7 @@ object frmMain: TfrmMain Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] Title = 'Save project' Left = 336 - Top = 408 + Top = 424 end object dlgExport: TSaveDialog Filter = @@ -5768,4 +5539,11 @@ object frmMain: TfrmMain FFFFFFFF00000000000000000000000000000000000000000000000000000000 000000000000} end + object pmRecentList: TPopupMenu + Left = 155 + Top = 235 + object pmRecentList1: TMenuItem + Caption = 'pmRecentList' + end + end end diff --git a/forms/frm_Main.pas b/forms/frm_Main.pas index 805285c..97f1c49 100644 --- a/forms/frm_Main.pas +++ b/forms/frm_Main.pas @@ -15,7 +15,7 @@ interface unit_SMessages, unit_calc, unit_XRCProjectTree, RzRadGrp, Vcl.RibbonLunaStyleActnCtrls, unit_materials, VCLTee.TeeFunci, unit_LFPSO_Base, unit_LFPSO_Periodic, Vcl.Buttons, - unit_LFPSO_Regular, Vcl.Imaging.pngimage; + unit_LFPSO_Irregular, Vcl.Imaging.pngimage; type TSeriesList = array of TLineSeries; @@ -96,7 +96,7 @@ TfrmMain = class(TForm) About1: TMenuItem; Calc3: TMenuItem; Calcall1: TMenuItem; - Reopen1: TMenuItem; + miRecent: TMenuItem; dlgOpenProject: TOpenDialog; Zip: TAbZipper; UnZip: TAbUnZipper; @@ -261,36 +261,6 @@ TfrmMain = class(TForm) N7: TMenuItem; Copytoclipboad1: TMenuItem; Exporttofile1: TMenuItem; - RzPageControl1: TRzPageControl; - TabSheet1: TRzTabSheet; - TabSheet2: TRzTabSheet; - edFIter: TEdit; - Label7: TLabel; - Label8: TLabel; - edFPopulation: TEdit; - Label20: TLabel; - cbPWChiSqr: TRzCheckBox; - Label5: TLabel; - edFWindow: TEdit; - cbTWChi: TComboBox; - Label21: TLabel; - edFitTolerance: TEdit; - Label16: TLabel; - edFVmax: TEdit; - cbLFPSOShake: TRzCheckBox; - Label18: TLabel; - Label19: TLabel; - edLFPSOOmega1: TEdit; - edLFPSOOmega2: TEdit; - Label17: TLabel; - edLFPSORImax: TEdit; - Label13: TLabel; - edLFPSOChiFactor: TEdit; - edLFPSOkVmax: TEdit; - Label14: TLabel; - edLFPSOSkip: TEdit; - Label15: TLabel; - cbTreatPeriodic: TRzCheckBox; NewFolder1: TMenuItem; N8: TMenuItem; actEditHenke: TAction; @@ -298,8 +268,6 @@ TfrmMain = class(TForm) actProjecEditModelText: TAction; actProjecEditModelText1: TMenuItem; N9: TMenuItem; - cbPoly: TRzCheckBox; - edPolyOrder: TEdit; N10: TMenuItem; Fitting1: TMenuItem; N11: TMenuItem; @@ -309,8 +277,6 @@ TfrmMain = class(TForm) N13: TMenuItem; acStructureUndo: TAction; Undo1: TMenuItem; - cbAdaptiveVelocity: TRzCheckBox; - cbSeedRange: TRzCheckBox; btnReopenProject: TRzToolButton; rzspcr2: TRzSpacer; actProjectReopen: TAction; @@ -324,6 +290,26 @@ TfrmMain = class(TForm) Copyasimage1: TMenuItem; btnStop: TRzBitBtn; ilIcons: TImageList; + actDataTrim: TAction; + rim1: TMenuItem; + actCalcFitJobs: TAction; + Calcbatchjobs1: TMenuItem; + pmRecentList: TPopupMenu; + pmRecentList1: TMenuItem; + rgFittingMode: TRzRadioGroup; + edFIter: TEdit; + Label7: TLabel; + Label8: TLabel; + edFPopulation: TEdit; + cbLFPSOShake: TRzCheckBox; + cbSeedRange: TRzCheckBox; + edPolyOrder: TEdit; + lblPolyOrder: TLabel; + Label21: TLabel; + cbTWChi: TComboBox; + cbPWChiSqr: TRzCheckBox; + btnAdvFitSettings: TRzBitBtn; + cbSmooth: TRzCheckBox; procedure btnChartScaleClick(Sender: TObject); procedure FileOpenExecute(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -399,9 +385,12 @@ TfrmMain = class(TForm) procedure actSystemSettingsExecute(Sender: TObject); procedure actSystemExitExecute(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure cbTreatPeriodicClick(Sender: TObject); procedure actCopyStructureBitmapExecute(Sender: TObject); procedure ChartResize(Sender: TObject); + procedure actDataTrimExecute(Sender: TObject); + procedure actCalcFitJobsExecute(Sender: TObject); + procedure rgFittingModeClick(Sender: TObject); + procedure btnAdvFitSettingsClick(Sender: TObject); private Project : TXRCProjectTree; LFPSO: TLFPSO_Base; @@ -433,7 +422,9 @@ TfrmMain = class(TForm) FFitStructure: TFitStructure; FLastChiSquare: Single; - FStack: TStack; + FOperationsStack: TStack; + FRecentProjects : TList; + FTerminated: Boolean; FBenchmarkMode: Boolean; FBenchmarkPath: string; @@ -444,7 +435,7 @@ TfrmMain = class(TForm) function DataName(Data: PProjectData): string; procedure CreateDefaultProject; procedure PrepareProjectFolder(const FileName: string; Clear: Boolean); - procedure LoadProjectParams(var LinkedID, ActiveID: Integer); + procedure LoadProjectParams(var LinkedID, ActiveID: System.Integer); procedure RecoverProjectTree(const ActiveID: Integer); procedure RecoverDataCurves(const LinkedID: integer); procedure FinalizeCalc(Calc: TCalc); @@ -483,6 +474,13 @@ TfrmMain = class(TForm) procedure ProcessBenchFile(Sender: TObject; const F: TSearchRec); procedure EditTable(var Data: PProjectData); procedure EnableControls(const Enable: boolean); + procedure AutoSave; + procedure ProcessJobFile(Sender: TObject; const F: TSearchRec); + procedure AddRecentItem(const FileName: string); + procedure RecentListOnClick(Sender: TObject); + procedure FillRecentMenu; + procedure LoadRecentProjectsList; + function FittingMode: TFittingMode; inline; { Private declarations } public { Public declarations } @@ -531,10 +529,15 @@ implementation unit_config, frm_settings, unit_XRCStackControl, - editor_ProfileTable; + editor_ProfileTable, unit_sys_helpers, frm_FitSettings; {$R *.dfm} +procedure TfrmMain.btnAdvFitSettingsClick(Sender: TObject); +begin + frmFitSettings.ShowSettings(FFitParams); +end; + procedure TfrmMain.btnChartScaleClick(Sender: TObject); begin // if (FSeriesList[Project.ActiveModel.CurveID].Count = 0) and (Project.ActiveData = nil) then @@ -709,8 +712,8 @@ procedure TfrmMain.ProjectChange(Sender: TBaseVirtualTree; Node: PVirtualNode); if LastData.Data <> '' then begin Structure.FromString(LastData.Data); - FStack.Clear; - FStack.Push(LastData.Data); + FOperationsStack.Clear; + FOperationsStack.Push(LastData.Data); PrepareDistributionCharts; PlotProfile; end; @@ -949,7 +952,7 @@ procedure TfrmMain.CreateFitGradientExtensions(const P: TProfileFunctions); Data.Subj := P[i].Subj; Data.StackID := P[i].StackID; Data.LayerID := P[i].LayerID; - Data.Poly := P[i].C; + Data.SetPoly(P[i].C); end; MatchToStructure; @@ -1113,6 +1116,25 @@ procedure TfrmMain.actDataSmoothExecute(Sender: TObject); SeriesToFile(FSeriesList[Project.ActiveData.CurveID], DataName(Project.ActiveData)); end; +procedure TfrmMain.actDataTrimExecute(Sender: TObject); +var + t1, t2: single; + index: integer; +begin + t1 := StrToFloat(edStartTeta.Text); + t2 := StrToFloat(edEndTeta.Text); + + FSeriesList[Project.ActiveData.CurveID].BeginUpdate; + + index := FSeriesList[Project.ActiveData.CurveID].XValues.Locate(t1); + FSeriesList[Project.ActiveData.CurveID].Delete(0, Index); + + index := FSeriesList[Project.ActiveData.CurveID].XValues.Locate(t2); + FSeriesList[Project.ActiveData.CurveID].Delete(index, FSeriesList[Project.ActiveData.CurveID].XValues.Count - Index - 1); + SeriesToFile(FSeriesList[Project.ActiveData.CurveID], DataName(Project.ActiveData)); + FSeriesList[Project.ActiveData.CurveID].EndUpdate; +end; + procedure TfrmMain.actEditHenkeExecute(Sender: TObject); begin edtrHenkeTable.ShowModal; @@ -1207,6 +1229,26 @@ procedure TfrmMain.AddCurve(Data: PProjectData); Data.CurveID := Count; end; +procedure TfrmMain.AutoSave; +var + FileName, Path: string; + p: Integer; +begin + if TConfig.Section.AutoSave then + begin + FileName := FProjectName; + if TConfig.SystemDir[sdOutDir] <> '' then + Path := TConfig.SystemDir[sdOutDir] + else + Path := ExtractFilePath(FileName); + + p := pos(PROJECT_EXT, FileName); + Delete(FileName, p, Length(PROJECT_EXT)); + FileName := Path + FileName + '-fitted' + PROJECT_EXT; + SaveProject(FileName); + end; +end; + procedure TfrmMain.btnSetFitLimitsClick(Sender: TObject); var FitStructure: TFitStructure; @@ -1238,8 +1280,8 @@ procedure TfrmMain.DataPasteExecute(Sender: TObject); procedure TfrmMain.SaveHistory; begin - FStack.Push(Structure.ToString); - FStack.TrimExcess; + FOperationsStack.Push(Structure.ToString); + FOperationsStack.TrimExcess; end; procedure TfrmMain.MatchToStructure; @@ -1254,11 +1296,14 @@ procedure TfrmMain.PeriodAddExecute(Sender: TObject); Name: string; N : Integer; begin - SaveHistory; N := 1; edtrStack.Edit(Name, N); if Name <> '' then - Structure.AddStack(N, Name); + begin + SaveHistory; + Structure.AddStack(N, Name); + MatchToStructure; + end; end; procedure TfrmMain.PeriodDeleteExecute(Sender: TObject); @@ -1274,13 +1319,14 @@ procedure TfrmMain.PeriodInsertExecute(Sender: TObject); Name: string; N : Integer; begin - SaveHistory; - N := 1; edtrStack.Edit(Name, N); if Name <> '' then - Structure.InsertStack(N, Name); - MatchToStructure; + begin + SaveHistory; + Structure.InsertStack(N, Name); + MatchToStructure; + end; end; procedure TfrmMain.PrepareProjectFolder(const FileName: string; Clear: Boolean); @@ -1306,9 +1352,11 @@ procedure TfrmMain.PrepareProjectFolder(const FileName: string; Clear: Boolean); end; -procedure TfrmMain.LoadProjectParams(var LinkedID, ActiveID: Integer); +procedure TfrmMain.LoadProjectParams(var LinkedID, ActiveID: System.Integer); var INF: TMemIniFile; + Periodic, Poly: boolean; + FitMode: Integer; begin INF := TMemIniFile.Create(FProjectDir + PARAMETERS_FILE_NAME); try @@ -1334,26 +1382,39 @@ procedure TfrmMain.LoadProjectParams(var LinkedID, ActiveID: Integer); edFIter.Text := INF.ReadString('FIT', 'Namx', '100'); edFPopulation.Text := INF.ReadString('FIT', 'Pop', '100'); - edFitTolerance.Text := INF.ReadString('FIT', 'Tol', '0.005'); - cbTreatPeriodic.Checked := INF.ReadBool('FIT', 'Periodic', True); - cbPoly.Checked := INF.ReadBool('FIT', 'Poly', False); - edPolyOrder.Text := INF.ReadString('FIT', 'PolyOrder', '1'); + FitMode := INF.ReadInteger('FIT', 'Mode', -1); + if FitMode = -1 then + begin + Periodic := INF.ReadBool('FIT', 'Periodic', False); + Poly := INF.ReadBool('FIT', 'Poly', False); + + if Periodic then rgFittingMode.ItemIndex := Ord(fmPeriodic); + if Poly then rgFittingMode.ItemIndex := Ord(fmPoly); + end + else + rgFittingMode.ItemIndex := FitMode; + + edPolyOrder.Text := INF.ReadString('FIT', 'PolyOrder', '1'); cbPWChiSqr.Checked := INF.ReadBool('FIT', 'PWChi', True); - edFWindow.Text := INF.ReadString('FIT', 'Window', '0.05'); cbTWChi.ItemIndex := INF.ReadInteger('FIT', 'TWChi', 0); - - edFVmax.Text := INF.ReadString('LFPSO', 'Vmax', '0.1'); - edLFPSOSkip.Text := INF.ReadString('LFPSO', 'Jmax', '1'); - edLFPSORImax.Text := INF.ReadString('LFPSO', 'RIMax', '3'); - edLFPSOChiFactor.Text := INF.ReadString('LFPSO', 'kChi', '2'); - edLFPSOkVmax.Text := INF.ReadString('LFPSO', 'kVmax', '2'); - edLFPSOOmega1.Text := INF.ReadString('LFPSO', 'w1', '0.1'); - edLFPSOOmega2.Text := INF.ReadString('LFPSO', 'w2', '0.1'); - cbAdaptiveVelocity.Checked := INF.ReadBool('LFPSO', 'AdaptV', False); cbSeedRange.Checked := INF.ReadBool('LFPSO', 'SeedRange', False); - - cbLFPSOShake.Checked := INF.ReadBool('LFPSO', 'Shake', True); + cbLFPSOShake.Checked := INF.ReadBool('LFPSO', 'Shake', True); + cbSmooth.Checked := INF.ReadBool('LFPSO', 'Smooth', False); + + FFitParams.Tolerance := StrToFloat(INF.ReadString('FIT', 'Tol', '0.005')); + FFitParams.MovAvgWindow := StrToFloat(INF.ReadString('FIT', 'Window', '0.05')); + FFitParams.Vmax := StrToFloat(INF.ReadString('LFPSO', 'Vmax', '0.1')); + FFitParams.JammingMax := StrToInt(INF.ReadString('LFPSO', 'Jmax', '1')); + FFitParams.ReInitMax := StrToInt(INF.ReadString('LFPSO', 'RIMax', '3')); + FFitParams.KChiSqr := StrToFloat(INF.ReadString('LFPSO', 'kChi', '1.41')); + FFitParams.KVmax := StrToFloat(INF.ReadString('LFPSO', 'kVmax', '1.41')); + FFitParams.w1 := StrToFloat(INF.ReadString('LFPSO', 'w1', '0.3')); + FFitParams.w2 := StrToFloat(INF.ReadString('LFPSO', 'w2', '0.3')); + FFitParams.AdaptVel := INF.ReadBool('LFPSO', 'AdaptV', False); + FFitParams.SmoothWindow := INF.ReadInteger('LFPSO', 'SmoothWindow', -1); + FFitParams.Ksxr := StrToFloat(INF.ReadString('LFPSO', 'Ksxr', '0.2')); + FFitParams.PolyFactor := INF.ReadInteger('LFPSO', 'PolyFactor', 10); finally INF.Free; end; @@ -1376,21 +1437,12 @@ function TfrmMain.GetFitParams: boolean; FFitParams.NMax := StrToInt(edFIter.Text); FFitParams.Pop := StrToInt(edFPopulation.Text); - FFitParams.Vmax := StrToFloat(edFVmax.Text); - FFitParams.JammingMax := StrToInt(edLFPSOSkip.Text); - FFitParams.ReInitMax := StrToInt(edLFPSORImax.Text); - FFitParams.KChiSqr := StrToFloat(edLFPSOChiFactor.Text); - FFitParams.KVmax := StrToFloat(edLFPSOkVmax.Text); - FFitParams.w1 := StrToFloat(edLFPSOOmega1.Text); - FFitParams.w2 := StrToFloat(edLFPSOOmega2.Text); - FFitParams.Tolerance := StrToFloat(edFitTolerance.Text); - FFitParams.Shake := cbLFPSOShake.Checked; - FFitParams.ThetaWieght := cbTWChi.ItemIndex; - FFitParams.AdaptVel := cbAdaptiveVelocity.Checked; + FFitParams.ThetaWeight := cbTWChi.ItemIndex; + FFitParams.RangeSeed := cbSeedRange.Checked; FFitParams.MaxPOrder := StrToInt(edPolyOrder.Text); - FFitParams.Ksxr := 0.2; + FFitParams.Smooth := cbSmooth.Checked; Result := True; end; @@ -1410,7 +1462,7 @@ function TfrmMain.GetProfileFunctions: TProfileFunctions; if (Data.RowType = prExtension) and (Data.Enabled) and (Data.ExtType = etFunction) then begin SetLength(Result, Count + 1); - Result[Count].C := Data.Poly; + Result[Count].C := Data.PolyD; Result[Count].C[0] := Structure.Stacks[Data.StackID].Layers[Data.LayerID].Data.P[Ord(Data.Subj) + 1].V; Result[Count].StackID := Data.StackID; Result[Count].LayerID := Data.LayerID; @@ -1728,6 +1780,12 @@ procedure TfrmMain.ClearProfiles; FSeriesArray[p][StackIndex].Clear; end; + +function TfrmMain.FittingMode: TFittingMode; +begin + Result := TFittingMode(rgFittingMode.ItemIndex); +end; + procedure TfrmMain.PlotProfile; begin ClearProfiles; @@ -1736,7 +1794,7 @@ procedure TfrmMain.PlotProfile; if Length(FProfiles) > 0 then PlotGradedProfile else - if IsProfileEnbled and not cbTreatPeriodic.Checked then + if IsProfileEnbled and (FittingMode <> fmPeriodic) then PlotProfileNP else PlotSimpleProfile; @@ -1803,7 +1861,7 @@ procedure TfrmMain.CalcRunExecute(Sender: TObject); FLastChiSquare := 0; end; - if IsProfileEnbled and not cbTreatPeriodic.Checked then + if IsProfileEnbled and (FittingMode <> fmPeriodic) then PlotProfileNP else PlotProfile; @@ -1859,12 +1917,12 @@ function TfrmMain.PrepareCalc: Boolean; begin FCalc.ExpValues := SeriesToData(FSeriesList[Project.LinkedData.CurveID]); if cbPWChiSqr.Checked then - FCalc.MovAvg := MovAvg(FCalc.ExpValues, StrToFloat(edFWindow.Text)); + FCalc.MovAvg := MovAvg(FCalc.ExpValues, FFitParams.MovAvgWindow); end; GetThreadParams; FCalc.Params := FCalcThreadParams; - FCalc.Model := Structure.Model(IsProfileEnbled and not cbTreatPeriodic.Checked); + FCalc.Model := Structure.Model(IsProfileEnbled and (FittingMode <> fmPeriodic)); FCalc.Model.Profiles := GetProfileFunctions; Screen.Cursor := crHourGlass; Result := True; @@ -1874,13 +1932,13 @@ function TfrmMain.PrepareCalc: Boolean; function TfrmMain.PrepareLFPSO: Boolean; begin Result := False; - if cbTreatPeriodic.Checked then - LFPSO := TLFPSO_Periodic.Create - else - if cbPoly.Checked then - LFPSO := TLFPSO_Poly.Create - else - LFPSO := TLFPSO_Regular.Create; + case FittingMode of + fmIrregular : LFPSO := TLFPSO_Irregular.Create; + fmPeriodic : LFPSO := TLFPSO_Periodic.Create; + fmPoly : LFPSO := TLFPSO_Poly.Create; + end; + + GetThreadParams; @@ -1891,7 +1949,7 @@ function TfrmMain.PrepareLFPSO: Boolean; begin LFPSO.ExpValues := SeriesToData(FSeriesList[Project.LinkedData.CurveID]); if cbPWChiSqr.Checked then - LFPSO.MovAvg := MovAvg(LFPSO.ExpValues, StrToFloat(edFWindow.Text)); + LFPSO.MovAvg := MovAvg(LFPSO.ExpValues, FFitParams.MovAvgWindow); end else begin FreeAndNil(LFPSO); @@ -1911,10 +1969,10 @@ function TfrmMain.PrepareLFPSO: Boolean; procedure TfrmMain.acStructureUndoExecute(Sender: TObject); begin - if FStack.Count > 0 then + if FOperationsStack.Count > 0 then begin - Structure.FromString(FStack.Peek); - FStack.Extract; + Structure.FromString(FOperationsStack.Peek); + FOperationsStack.Extract; end; end; @@ -1934,10 +1992,10 @@ procedure TfrmMain.actAutoFittingExecute(Sender: TObject); if Structure.IsPeriodic then begin - if cbTreatPeriodic.Checked then + if FittingMode = fmPeriodic then Structure.UpdateInterfaceP(LFPSO.Structure) else begin - if cbPoly.Checked then + if FittingMode = fmPoly then begin Structure.UpdateInterfaceP(LFPSO.Structure); CreateFitGradientExtensions(LFPSO.Polynomes) @@ -1963,6 +2021,19 @@ procedure TfrmMain.actAutoFittingExecute(Sender: TObject); EnableControls(True); FreeAndNil(LFPSO); end; + AutoSave; +end; + +procedure TfrmMain.ProcessJobFile(Sender: TObject; const F: TSearchRec); +begin + Application.ProcessMessages; + if FTerminated then Exit; + + FProjectFileName := FBenchmarkPath + F.Name; + + actProjectReopenExecute(nil); + actAutoFittingExecute(nil); + AutoSave; end; procedure TfrmMain.ProcessBenchFile(Sender: TObject; const F: TSearchRec); @@ -1970,35 +2041,37 @@ procedure TfrmMain.ProcessBenchFile(Sender: TObject; const F: TSearchRec); i: Integer; begin FProjectFileName := FBenchmarkPath + F.Name; + frmBenchmark.AddFile(ChangeFileExt(F.Name, '')); for i := 1 to FBenchmarkRuns do begin actProjectReopenExecute(nil); actAutoFittingExecute(nil); frmBenchmark.AddValue(i, spChiSqr.Caption); - frmBenchmark.CalcStats; + frmBenchmark.CalcStats(False); Application.ProcessMessages; if FTerminated then Break; end; - frmBenchmark.CalcStats; + frmBenchmark.CalcStats(True); end; procedure TfrmMain.actCalcBenchmarkExecute(Sender: TObject); var Files: TFilesList; begin - FBenchmarkRuns := 20; + FBenchmarkRuns := TConfig.Section.BenchmarkRuns; try FTerminated := False; frmBenchmark.Clear(FBenchmarkRuns); + frmBenchmark.Init(TConfig.SystemDir[sdBenchOutDir]); frmBenchmark.Show; FBenchmarkMode := True; Files := TFilesList.Create(nil); - FBenchmarkPath := Config.BenchPath; + FBenchmarkPath := TConfig.SystemDir[sdBenchDir]; Files.TargetPath := FBenchmarkPath; - Files.Mask := '*.xrcx'; + Files.Mask := '*' + PROJECT_EXT; Files.OnFile := ProcessBenchFile; Files.Process; FBenchmarkMode := False; @@ -2007,6 +2080,29 @@ procedure TfrmMain.actCalcBenchmarkExecute(Sender: TObject); end; end; +procedure TfrmMain.actCalcFitJobsExecute(Sender: TObject); +var + Files: TFilesList; +begin + try + FTerminated := False; + FBenchmarkMode := True; + Files := TFilesList.Create(nil); + FBenchmarkPath := TConfig.SystemDir[sdJobsDir]; + Files.TargetPath := FBenchmarkPath; + Files.Mask := '*' + PROJECT_EXT; + Files.OnFile := ProcessJobFile; + Files.Process; + if not FTerminated then + ShowMessage('All jobs done') + else + ShowMessage('Batch was terminated!'); + finally + FreeAndNil(Files); + FBenchmarkMode := False; + end; +end; + procedure TfrmMain.actCopyStructureBitmapExecute(Sender: TObject); var Image: TPNGImage; @@ -2102,7 +2198,7 @@ procedure TfrmMain.RecoverProjectTree(const ActiveID: Integer); Structure.FromString(Project.ActiveModel.Data); // if cbTreatPeriodic.Checked then // Structure.EnablePairing; - Structure.PeriodicMode := not cbTreatPeriodic.Checked; + Structure.PeriodicMode := FittingMode = fmPeriodic; end; procedure TfrmMain.ResultCopyExecute(Sender: TObject); @@ -2228,7 +2324,7 @@ procedure TfrmMain.LayerPasteExecute(Sender: TObject); procedure TfrmMain.LoadProject(const FileName: string; Clear: Boolean); var - LinkedID, ActiveID: Integer; + LinkedID, ActiveID: System.Integer; begin FIgnoreFocusChange := True; PrepareProjectFolder(FileName, Clear); @@ -2258,13 +2354,69 @@ procedure TfrmMain.FileNewExecute(Sender: TObject); procedure TfrmMain.FileOpenExecute(Sender: TObject); begin + if TConfig.SystemDir[sdProjDir] <> '' then + dlgOpenProject.InitialDir := TConfig.SystemDir[sdProjDir]; + if dlgOpenProject.Execute then begin LoadProject(dlgOpenProject.FileName, True); -// AddRecentItem(FProjectFileName , True); + if TConfig.Section.AutoCalc then + CalcRunExecute(frmMain); + + AddRecentItem(FProjectFileName); end; end; + +procedure TfrmMain.RecentListOnClick(Sender: TObject); +var + Index : Integer; +begin + Index := (Sender as TMenuItem).Tag - 100; + FProjectFileName := FRecentProjects.List[Index]; + FRecentProjects.Move(Index, 0); + FillRecentMenu; + + LoadProject(FProjectFileName, True); + if TConfig.Section.AutoCalc then + CalcRunExecute(frmMain); +end; + + +procedure TfrmMain.FillRecentMenu; +var + i: Integer; + Item, PopupItem: TMenuItem; +begin + miRecent.Clear; + pmRecentList.Items.Clear; + for I := 0 to FRecentProjects.Count - 1 do + begin + Item := TMenuItem.Create(miRecent); + miRecent.Add(Item); + Item.Caption := ExtractFileName(FRecentProjects.List[i]); + Item.Tag := 100 + i; + Item.OnClick := RecentListOnClick; + + PopupItem := TMenuItem.Create(pmRecentList); + pmRecentList.Items.Add(PopupItem); + PopupItem.Caption := Item.Caption; + PopupItem.Tag := Item.Tag; + PopupItem.OnClick := RecentListOnClick; + end; +end; + + +procedure TfrmMain.AddRecentItem(const FileName: string); +begin + FRecentProjects.Insert(0, FileName); + if FRecentProjects.Count > MAX_RECENT_CAPACITY then + FRecentProjects.Delete(FRecentProjects.Count - 1); + + TConfig.WiteStringList('Recent', FRecentProjects.List); + FillRecentMenu; +end; + procedure TfrmMain.FilePlotCopyWMFExecute(Sender: TObject); begin Chart.CopyToClipboardMetafile(True); @@ -2329,26 +2481,29 @@ procedure TfrmMain.SaveProject(const FileName: string); INF.WriteString('FIT', 'Namx', edFIter.Text); INF.WriteString('FIT', 'Pop', edFPopulation.Text); - INF.WriteString('FIT', 'Tol', edFitTolerance.Text); - INF.WriteBool('FIT', 'Periodic', cbTreatPeriodic.Checked); - INF.WriteBool('FIT', 'Poly', cbPoly.Checked); + INF.WriteInteger('FIT', 'Mode', rgFittingMode.ItemIndex); INF.WriteString('FIT', 'PolyOrder', edPolyOrder.Text); INF.WriteBool('FIT', 'PWChi', cbPWChiSqr.Checked); - INF.WriteString('FIT', 'Window', edFWindow.Text); + INF.WriteFloat('FIT', 'Window', FFitParams.MovAvgWindow); INF.WriteInteger('FIT', 'TWChi', cbTWChi.ItemIndex); - INF.WriteString('LFPSO', 'Vmax', edFVmax.Text); - INF.WriteString('LFPSO', 'Jmax', edLFPSOSkip.Text ); - INF.WriteString('LFPSO', 'RIMax', edLFPSORImax.Text ); - INF.WriteString('LFPSO', 'kChi', edLFPSOChiFactor.Text); - INF.WriteString('LFPSO', 'kVmax', edLFPSOkVmax.Text ); - INF.WriteString('LFPSO', 'w1', edLFPSOOmega1.Text ); - INF.WriteString('LFPSO', 'w2', edLFPSOOmega2.Text); + INF.WriteString('FIT', 'Tol', FFitParams.Tolerance.ToString); + INF.WriteString('LFPSO', 'Vmax', FFitParams.Vmax.ToString); + INF.WriteString('LFPSO', 'Jmax', FFitParams.JammingMax.ToString); + INF.WriteString('LFPSO', 'RIMax', FFitParams.ReInitMax.ToString); + INF.WriteString('LFPSO', 'kChi', FFitParams.KChiSqr.ToString); + INF.WriteString('LFPSO', 'kVmax', FFitParams.KVmax.ToString); + INF.WriteString('LFPSO', 'w1', FFitParams.w1.ToString); + INF.WriteString('LFPSO', 'w2', FFitParams.w2.ToString); + INF.WriteBool('LFPSO', 'AdaptV', FFitParams.AdaptVel); + INF.WriteBool('LFPSO', 'Shake', cbLFPSOShake.Checked); - INF.WriteBool('LFPSO', 'AdaptV', cbAdaptiveVelocity.Checked); INF.WriteBool('LFPSO', 'SeedRange', cbSeedRange.Checked); - + INF.WriteBool('LFPSO', 'Smooth', cbSmooth.Checked); + INF.WriteInteger('LFPSO', 'SmoothWindow', FFitParams.SmoothWindow); + INF.WriteString('LFPSO', 'Ksxr', FFitParams.Ksxr.ToString); + INF.WriteInteger('LFPSO', 'PolyFactor', FFitParams.PolyFactor ); INF.UpdateFile; if FileExists(FileName) then @@ -2510,6 +2665,20 @@ procedure TfrmMain.CreateDefaultProject; FDataRoot := PG; Caption := 'X-Ray Calc 3: ' + FProjectName; Project.LinkedData := nil; + + FFitParams.Tolerance := 0.005; + FFitParams.MovAvgWindow := 0.05; + FFitParams.Vmax := 0.3; + FFitParams.JammingMax := 1; + FFitParams.ReInitMax := 3; + FFitParams.KChiSqr := 1.41; + FFitParams.KVmax := 1.41; + FFitParams.w1 := 0.3; + FFitParams.w2 := 0.3; + FFitParams.AdaptVel := False; + FFitParams.SmoothWindow := -1; + FFitParams.Ksxr := 0.2; + FFitParams.PolyFactor := 10; end; procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -2517,6 +2686,23 @@ procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); CanClose := MessageDlg('Exit X-Ray Calc 3?', mtConfirmation, [mbYes, mbNo], 0, mbNO) = mrYes; end; +procedure TfrmMain.LoadRecentProjectsList; +var + RecentList: array of String; + i: Integer; +begin + FRecentProjects := TList.Create; + + SetLength(RecentList, MAX_RECENT_CAPACITY); + TConfig.ReadStringList('Recent', RecentList); + + for i := 0 to High(RecentList) do + if RecentList[i] <> '' then + FRecentProjects.Add(RecentList[i]); + + FillRecentMenu; +end; + procedure TfrmMain.FormCreate(Sender: TObject); var Value: string; @@ -2528,8 +2714,10 @@ procedure TfrmMain.FormCreate(Sender: TObject); Structure := TXRCStructure.Create(StructurePanel); Structure.Parent := StructurePanel; - FStack := TStack.Create; - FStack.Capacity := 10; + FOperationsStack := TStack.Create; + FOperationsStack.Capacity := 10; + + LoadRecentProjectsList; Project.NodeDataSize := SizeOf(TProjectData); @@ -2537,6 +2725,9 @@ procedure TfrmMain.FormCreate(Sender: TObject); CreateDir(Config.TempDir); Pages.ActivePageindex := 0; + +// FindPCores; + if ParamCount <> 0 then begin if FindCmdLineSwitch('f', Value, True, [clstValueNextParam]) then @@ -2545,7 +2736,7 @@ procedure TfrmMain.FormCreate(Sender: TObject); begin FProjectFileName := Value; LoadProject(FProjectFileName, True); - if FindCmdLineSwitch('a') then + if FindCmdLineSwitch('a') or TConfig.Section.AutoCalc then CalcRunExecute(frmMain); end else @@ -2561,7 +2752,7 @@ procedure TfrmMain.FormDestroy(Sender: TObject); Project.Clear; FreeAndNil(Project); FreeAndNil(Structure); - FreeAndNil(FStack); + FreeAndNil(FOperationsStack); FreeAndNil(Config); end; @@ -2585,6 +2776,17 @@ procedure TfrmMain.rgCalcModeChanging(Sender: TObject; NewIndex: Integer; end; +procedure TfrmMain.rgFittingModeClick(Sender: TObject); +var + Mode: TFittingMode; +begin + Mode := FittingMode; + Structure.PeriodicMode := FittingMode = fmPeriodic; + cbSmooth.Enabled := FittingMode = fmIrregular; + edPolyOrder.Enabled := Mode = fmPoly; + lblPolyOrder.Enabled := edPolyOrder.Enabled; +end; + procedure TfrmMain.btnCopyConvergenceClick(Sender: TObject); begin case Pages.ActivePageIndex of @@ -2603,14 +2805,6 @@ procedure TfrmMain.cbMinLimitChange(Sender: TObject); Chart.LeftAxis.Minimum := StrToFloat(cbMinLimit.Text); end; -procedure TfrmMain.cbTreatPeriodicClick(Sender: TObject); -begin - Structure.PeriodicMode := not cbTreatPeriodic.Checked; - - cbPoly.Enabled := not cbTreatPeriodic.Checked; - if cbTreatPeriodic.Checked then cbPoly.Checked := False; - edPolyOrder.Enabled := not cbTreatPeriodic.Checked; -end; procedure TfrmMain.WMLayerClick(var Msg: TMessage); var diff --git a/forms/frm_MaterialSelector.dfm b/forms/frm_MaterialSelector.dfm index 2576d4b..9d32ea0 100644 --- a/forms/frm_MaterialSelector.dfm +++ b/forms/frm_MaterialSelector.dfm @@ -3,8 +3,8 @@ object frmMaterialSelector: TfrmMaterialSelector Top = 0 BorderStyle = bsToolWindow Caption = 'Select material' - ClientHeight = 403 - ClientWidth = 286 + ClientHeight = 391 + ClientWidth = 278 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -13,8 +13,8 @@ object frmMaterialSelector: TfrmMaterialSelector Font.Style = [] Position = poMainFormCenter DesignSize = ( - 286 - 403) + 278 + 391) TextHeight = 15 object SearchBox1: TSearchBox Left = 8 @@ -32,8 +32,8 @@ object frmMaterialSelector: TfrmMaterialSelector TabOrder = 1 end object BitBtn1: TBitBtn - Left = 201 - Top = 372 + Left = 185 + Top = 360 Width = 75 Height = 25 Anchors = [akRight, akBottom] @@ -41,15 +41,17 @@ object frmMaterialSelector: TfrmMaterialSelector ModalResult = 1 TabOrder = 2 ExplicitLeft = 205 + ExplicitTop = 372 end object BitBtn2: TBitBtn Left = 8 - Top = 372 + Top = 360 Width = 75 Height = 25 Anchors = [akLeft, akBottom] Caption = 'Cancel' ModalResult = 2 TabOrder = 3 + ExplicitTop = 372 end end diff --git a/forms/frm_MaterialSelector.pas b/forms/frm_MaterialSelector.pas index b767751..4c3eac6 100644 --- a/forms/frm_MaterialSelector.pas +++ b/forms/frm_MaterialSelector.pas @@ -40,7 +40,7 @@ implementation procedure TfrmMaterialSelector.SelectMaterial(var Name: string); begin - FillElementsList(Config.HenkePath, lbFiles); + FillElementsList(Config.SystemDir[sdHenke], lbFiles); if ShowModal = mrOk then begin Name := lbFiles.Items[lbFiles.ItemIndex]; diff --git a/forms/frm_NewMaterial.dfm b/forms/frm_NewMaterial.dfm index 818a696..b862eed 100644 --- a/forms/frm_NewMaterial.dfm +++ b/forms/frm_NewMaterial.dfm @@ -4,8 +4,8 @@ object frmNewMaterial: TfrmNewMaterial ActiveControl = Edit1 BorderStyle = bsToolWindow Caption = 'New Material' - ClientHeight = 342 - ClientWidth = 268 + ClientHeight = 358 + ClientWidth = 278 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -19,13 +19,13 @@ object frmNewMaterial: TfrmNewMaterial AlignWithMargins = True Left = 3 Top = 3 - Width = 262 - Height = 336 + Width = 272 + Height = 352 Align = alClient Color = 15987699 TabOrder = 0 - ExplicitWidth = 270 - ExplicitHeight = 348 + ExplicitWidth = 254 + ExplicitHeight = 324 object Label3: TLabel Left = 115 Top = 55 @@ -34,7 +34,7 @@ object frmNewMaterial: TfrmNewMaterial Caption = 'Number of elements:' end object Label2: TLabel - Left = 142 + Left = 146 Top = 27 Width = 36 Height = 13 @@ -48,7 +48,7 @@ object frmNewMaterial: TfrmNewMaterial Caption = 'Name' end object lbl1: TLabel - Left = 241 + Left = 245 Top = 27 Width = 28 Height = 13 @@ -96,7 +96,7 @@ object frmNewMaterial: TfrmNewMaterial TabOrder = 3 end object Edit2: TEdit - Left = 184 + Left = 188 Top = 24 Width = 50 Height = 21 diff --git a/forms/frm_NewMaterial.pas b/forms/frm_NewMaterial.pas index 367a470..1a13baf 100644 --- a/forms/frm_NewMaterial.pas +++ b/forms/frm_NewMaterial.pas @@ -183,7 +183,7 @@ function TfrmNewMaterial.NewElement: boolean; StreamIn := TMemoryStream.Create; StreamOut := TMemoryStream.Create; - StreamIn.LoadFromFile(Config.HenkePath + Grid.Cells[0,1] + '.bin'); + StreamIn.LoadFromFile(Config.SystemDir[sdHenke] + Grid.Cells[0,1] + '.bin'); s := GetString(StreamIn); WriteString(Edit1.Text); @@ -217,7 +217,7 @@ function TfrmNewMaterial.NewElement: boolean; StreamOut.Write(f1.Re, Size); StreamOut.Write(f1.Im, Size); end; - StreamOut.SaveToFile(Config.HenkePath + Edit1.Text + '.bin'); + StreamOut.SaveToFile(Config.SystemDir[sdHenke] + Edit1.Text + '.bin'); Result := True; finally FreeAndNil(StreamIn); diff --git a/forms/frm_settings.dfm b/forms/frm_settings.dfm index ff2bfd1..46254fa 100644 --- a/forms/frm_settings.dfm +++ b/forms/frm_settings.dfm @@ -21,7 +21,7 @@ object frmSettings: TfrmSettings Top = 3 Width = 451 Height = 384 - ActivePage = tsGraphics + ActivePage = tsCalc Align = alClient TabOrder = 1 ExplicitWidth = 447 @@ -34,10 +34,10 @@ object frmSettings: TfrmSettings AlignWithMargins = True Left = 3 Top = 3 - Width = 86 + Width = 437 Height = 13 Align = alTop - Caption = 'FIles and Paths' + Caption = 'Files and Paths' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -45,6 +45,201 @@ object frmSettings: TfrmSettings Font.Style = [fsBold] ParentFont = False Transparent = True + ExplicitWidth = 84 + end + object rzpnl1: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 63 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 0 + ExplicitWidth = 433 + object Label4: TLabel + Left = 8 + Top = 11 + Width = 110 + Height = 13 + Caption = 'Default Project'#39's folder' + end + object edProjectDir: TRzButtonEdit + Tag = 1 + Left = 132 + Top = 14 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end + end + object RzPanel3: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 104 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 1 + ExplicitWidth = 433 + object Label5: TLabel + Left = 8 + Top = 11 + Width = 101 + Height = 13 + Caption = 'Default output folder' + end + object edOutputDir: TRzButtonEdit + Tag = 2 + Left = 132 + Top = 8 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end + end + object RzPanel4: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 145 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 2 + ExplicitWidth = 433 + object Label7: TLabel + Left = 8 + Top = 11 + Width = 110 + Height = 13 + Caption = 'Benchmark input folder' + end + object edBenchmarkDir: TRzButtonEdit + Tag = 3 + Left = 132 + Top = 8 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end + end + object btnRegisterExtensions: TButton + Left = 3 + Top = 346 + Width = 437 + Height = 25 + Caption = 'Register file associations (xrcx)' + TabOrder = 3 + OnClick = btnRegisterExtensionsClick + end + object RzPanel6: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 22 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 4 + ExplicitWidth = 433 + object Label9: TLabel + Left = 8 + Top = 11 + Width = 59 + Height = 13 + Caption = 'Henke libray' + end + object edHenkeDir: TRzButtonEdit + Left = 132 + Top = 8 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end + end + object RzPanel8: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 186 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 5 + ExplicitWidth = 433 + object Label13: TLabel + Left = 8 + Top = 11 + Width = 118 + Height = 13 + Caption = 'Benchmark output folder' + end + object edBenchOutputDir: TRzButtonEdit + Tag = 4 + Left = 132 + Top = 8 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end + end + object RzPanel9: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 227 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 6 + ExplicitWidth = 433 + object Label14: TLabel + Left = 8 + Top = 11 + Width = 81 + Height = 13 + Caption = 'Batch jobs folder' + end + object edJobsDir: TRzButtonEdit + Tag = 4 + Left = 132 + Top = 8 + Width = 301 + Height = 21 + Text = '' + TabOrder = 0 + AltBtnNumGlyphs = 1 + ButtonNumGlyphs = 1 + OnButtonClick = edBenchmarkDirButtonClick + end end end object tsBehavour: TTabSheet @@ -66,7 +261,7 @@ object frmSettings: TfrmSettings AlignWithMargins = True Left = 3 Top = 3 - Width = 50 + Width = 431 Height = 13 Align = alTop Caption = 'Behavior' @@ -77,11 +272,12 @@ object frmSettings: TfrmSettings Font.Style = [fsBold] ParentFont = False Transparent = True + ExplicitWidth = 50 end object chkCheckForUpdates: TCheckBox AlignWithMargins = True Left = 9 - Top = 45 + Top = 68 Width = 425 Height = 17 Margins.Left = 9 @@ -90,26 +286,29 @@ object frmSettings: TfrmSettings Color = clBtnFace ParentColor = False TabOrder = 0 - ExplicitTop = 22 end - object btnRegisterExtensions: TButton + object chkAutoCalcOpen: TCheckBox + AlignWithMargins = True Left = 9 - Top = 320 - Width = 416 - Height = 25 - Caption = 'Register file associations (xrcx)' + Top = 22 + Width = 425 + Height = 17 + Margins.Left = 9 + Align = alTop + Caption = 'Automatically calculate when opening poject' + Color = clBtnFace + ParentColor = False TabOrder = 1 - OnClick = btnRegisterExtensionsClick end - object chkAutoClacOpen: TCheckBox + object chkAutoSaveResults: TCheckBox AlignWithMargins = True Left = 9 - Top = 22 + Top = 45 Width = 425 Height = 17 Margins.Left = 9 Align = alTop - Caption = 'Automatically calculate when file is open' + Caption = 'Automatically save results to output folder after fitting' Color = clBtnFace ParentColor = False TabOrder = 2 @@ -124,7 +323,7 @@ object frmSettings: TfrmSettings AlignWithMargins = True Left = 3 Top = 3 - Width = 102 + Width = 437 Height = 13 Align = alTop Caption = 'Interface settings' @@ -135,10 +334,11 @@ object frmSettings: TfrmSettings Font.Style = [fsBold] ParentFont = False Transparent = True + ExplicitWidth = 102 end end object tsCalc: TTabSheet - Caption = 'Calc' + Caption = 'Calc & Fit' ImageIndex = 3 TabVisible = False object lbl2: TLabel @@ -158,16 +358,34 @@ object frmSettings: TfrmSettings Transparent = True ExplicitWidth = 72 end - object pnlCores: TPanel + object Label11: TLabel AlignWithMargins = True Left = 3 - Top = 24 + Top = 63 + Width = 437 + Height = 13 + Align = alTop + Caption = 'Benchmark' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + Transparent = True + ExplicitTop = 123 + ExplicitWidth = 64 + end + object RzPanel1: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 22 Width = 437 Height = 35 - Margins.Top = 5 Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 TabOrder = 0 - ExplicitTop = 22 object Label1: TLabel Left = 8 Top = 11 @@ -176,14 +394,15 @@ object frmSettings: TfrmSettings Caption = 'Number od CPU cores to use' end object cbbCPUCores: TComboBox - Left = 184 + Left = 275 Top = 8 Width = 145 Height = 21 + ItemIndex = 0 TabOrder = 0 - Text = 'All' + Text = 'Auto (Use all)' Items.Strings = ( - 'Auto' + 'Auto (Use all)' '2' '4' '8' @@ -193,6 +412,35 @@ object frmSettings: TfrmSettings '64') end end + object RzPanel7: TRzPanel + AlignWithMargins = True + Left = 3 + Top = 82 + Width = 437 + Height = 35 + Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 + TabOrder = 1 + ExplicitTop = 142 + object Label12: TLabel + Left = 9 + Top = 9 + Width = 74 + Height = 13 + Caption = 'Number of runs' + end + object seBenchRuns: TSpinEdit + Left = 104 + Top = 6 + Width = 84 + Height = 22 + MaxValue = 100 + MinValue = 1 + TabOrder = 0 + Value = 10 + end + end end object tsGraphics: TTabSheet Caption = 'tsGraphics' @@ -215,27 +463,27 @@ object frmSettings: TfrmSettings Transparent = True ExplicitWidth = 98 end - object Panel1: TPanel + object RzPanel2: TRzPanel AlignWithMargins = True Left = 3 - Top = 24 + Top = 22 Width = 437 Height = 35 - Margins.Top = 5 Align = alTop + BorderOuter = fsFlatRounded + Color = 15987699 TabOrder = 0 - ExplicitWidth = 433 object Label2: TLabel - Left = 8 - Top = 11 + Left = 9 + Top = 9 Width = 83 Height = 13 Caption = 'Default line width' end object seLineWidth: TSpinEdit - Left = 98 + Left = 104 Top = 6 - Width = 90 + Width = 84 Height = 22 MaxValue = 10 MinValue = 1 @@ -261,7 +509,7 @@ object frmSettings: TfrmSettings 613 41) object btnOk: TButton - Left = 433 + Left = 413 Top = 10 Width = 75 Height = 25 @@ -271,10 +519,10 @@ object frmSettings: TfrmSettings ModalResult = 1 TabOrder = 0 OnClick = SaveSettingsClick - ExplicitLeft = 429 + ExplicitLeft = 409 end object btnCancel: TButton - Left = 514 + Left = 494 Top = 10 Width = 75 Height = 25 @@ -283,7 +531,7 @@ object frmSettings: TfrmSettings Caption = '&Cancel' ModalResult = 2 TabOrder = 1 - ExplicitLeft = 510 + ExplicitLeft = 490 end object btnHelp: TButton Left = 12 @@ -315,14 +563,18 @@ object frmSettings: TfrmSettings 00650073002E0000000000000000000000FFFFFFFFFFFFFFFF00000000000000 000000000001084200650068006100760069006F007200300000000000000000 000000FFFFFFFFFFFFFFFF000000000000000000000000010949006E00740065 - 0072006600610063006500260000000000000000000000FFFFFFFFFFFFFFFF00 - 00000000000000000000000104430061006C0063002E00000000000000000000 - 00FFFFFFFFFFFFFFFF0000000000000000000000000108470072006100700068 - 00690063007300} + 0072006600610063006500320000000000000000000000FFFFFFFFFFFFFFFF00 + 0000000000000000000000010A430061006C0063002000260020004600690074 + 002E0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000000000 + 00010847007200610070006800690063007300} ExplicitHeight = 380 end object dlgColors: TColorDialog Left = 32 Top = 176 end + object dlgFolder: TRzSelectFolderDialog + Left = 411 + Top = 281 + end end diff --git a/forms/frm_settings.pas b/forms/frm_settings.pas index 7cf5892..95a11cb 100644 --- a/forms/frm_settings.pas +++ b/forms/frm_settings.pas @@ -28,7 +28,7 @@ interface ComCtrls, ImgList, unit_AutoCompleteEdit, - RzPanel, Vcl.Samples.Spin; + RzPanel, Vcl.Samples.Spin, RzEdit, RzBtnEdt, MHLButtonedEdit, RzShellDialogs; type TfrmSettings = class(TForm) @@ -44,21 +44,45 @@ TfrmSettings = class(TForm) Panel3: TPanel; Label6: TLabel; chkCheckForUpdates: TCheckBox; - btnRegisterExtensions: TButton; tsInterface: TTabSheet; Label3: TLabel; lbl1: TLabel; tsCalc: TTabSheet; lbl2: TLabel; - chkAutoClacOpen: TCheckBox; - pnlCores: TPanel; - Label1: TLabel; - cbbCPUCores: TComboBox; + chkAutoCalcOpen: TCheckBox; tsGraphics: TTabSheet; lbl3: TLabel; - Panel1: TPanel; + chkAutoSaveResults: TCheckBox; + rzpnl1: TRzPanel; + Label4: TLabel; + RzPanel1: TRzPanel; + Label1: TLabel; + cbbCPUCores: TComboBox; + RzPanel2: TRzPanel; Label2: TLabel; seLineWidth: TSpinEdit; + edProjectDir: TRzButtonEdit; + RzPanel3: TRzPanel; + Label5: TLabel; + edOutputDir: TRzButtonEdit; + RzPanel4: TRzPanel; + Label7: TLabel; + edBenchmarkDir: TRzButtonEdit; + btnRegisterExtensions: TButton; + RzPanel6: TRzPanel; + Label9: TLabel; + edHenkeDir: TRzButtonEdit; + dlgFolder: TRzSelectFolderDialog; + Label11: TLabel; + RzPanel7: TRzPanel; + Label12: TLabel; + seBenchRuns: TSpinEdit; + RzPanel8: TRzPanel; + Label13: TLabel; + edBenchOutputDir: TRzButtonEdit; + RzPanel9: TRzPanel; + Label14: TLabel; + edJobsDir: TRzButtonEdit; procedure SaveSettingsClick(Sender: TObject); procedure ShowHelpClick(Sender: TObject); @@ -68,6 +92,7 @@ TfrmSettings = class(TForm) procedure FormShow(Sender: TObject); procedure edTimeOutChange(Sender: TObject); procedure btnRegisterExtensionsClick(Sender: TObject); + procedure edBenchmarkDirButtonClick(Sender: TObject); private // procedure SetPanelFontColor(Value: Graphics.TColor); @@ -95,10 +120,11 @@ procedure TfrmSettings.LoadSetting; begin with TConfig.Section do begin - if NumberOfThreads = -1 then - cbbCPUCores.Text := 'Auto' + if NumberOfThreads = 0 then + cbbCPUCores.ItemIndex := 0 else cbbCPUCores.Text := IntToStr(NumberOfThreads); + seBenchRuns.Value := BenchmarkRuns; end; with TConfig.Section do @@ -106,22 +132,49 @@ procedure TfrmSettings.LoadSetting; seLineWidth.Value := LineWidth; end; + + with TConfig.Section do + begin + chkAutoCalcOpen.Checked := AutoCalc; + chkAutoSaveResults.Checked := AutoSave; + end; + + edHenkeDir.Text := Config.SystemDirS[sdHenke]; + edProjectDir.Text := Config.SystemDirS[sdProjDir]; + edBenchmarkDir.Text := Config.SystemDirS[sdBenchDir]; + edOutputDir.Text := Config.SystemDirS[sdOutDir]; + edBenchOutputDir.Text := Config.SystemDirS[sdBenchOutDir]; + edJobsDir.Text := Config.SystemDirS[sdJobsDir]; end; procedure TfrmSettings.SaveSettings; begin with TConfig.Section do begin - if cbbCPUCores.Text = 'Auto' then - NumberOfThreads := -1 + if cbbCPUCores.ItemIndex = 0 then + NumberOfThreads := 0 else NumberOfThreads := StrToInt(cbbCPUCores.Text); + BenchmarkRuns := seBenchRuns.Value; end; with TConfig.Section do begin LineWidth := seLineWidth.Value; end; + + with TConfig.Section do + begin + AutoCalc := chkAutoCalcOpen.Checked; + AutoSave := chkAutoSaveResults.Checked; + end; + + Config.SystemDir[sdHenke] := edHenkeDir.Text; + Config.SystemDir[sdProjDir] := edProjectDir.Text; + Config.SystemDir[sdBenchDir] := edBenchmarkDir.Text; + Config.SystemDir[sdOutDir] := edOutputDir.Text; + Config.SystemDir[sdBenchOutDir] := edBenchOutputDir.Text; + Config.SystemDirS[sdJobsDir] := edJobsDir.Text; end; @@ -145,20 +198,6 @@ procedure TfrmSettings.FormShow(Sender: TObject); LoadSetting; end; - -// -// ��������� ���������� -// -//procedure TfrmSettings.SetPanelFontColor(Value: Graphics.TColor); -//begin -//end; - -//procedure TfrmSettings.SetCustomFontColor(Sender: TObject); -//begin -//end; - -// -// // procedure TfrmSettings.tvSectionsChange(Sender: TObject; Node: TTreeNode); begin @@ -193,6 +232,20 @@ procedure TfrmSettings.btnRegisterExtensionsClick(Sender: TObject); // ============================================================================ +procedure TfrmSettings.edBenchmarkDirButtonClick(Sender: TObject); +var + DirType: TXRCSystemDir; +begin + DirType := TXRCSystemDir((Sender as TRzButtonEdit).Tag); + + dlgFolder.SelectedPathName := TConfig.SystemDir[DirType]; + if dlgFolder.Execute then + begin + TConfig.SystemDirS[DirType] := dlgFolder.SelectedPathName; + (Sender as TRzButtonEdit).Text := TConfig.SystemDirS[DirType]; + end; +end; + procedure TfrmSettings.edTimeOutChange(Sender: TObject); begin // diff --git a/math/math_globals.pas b/math/math_globals.pas index 7d20d68..c099930 100644 --- a/math/math_globals.pas +++ b/math/math_globals.pas @@ -45,17 +45,16 @@ implementation uses unit_Config, + unit_helpers, SysUtils, VCLTee.TeEngine; function Poly(const x: Integer; const C: TPolyArray): Single; overload; var i, Last: Int64; - Order: integer; begin - Order := Trunc(C[10]); Result := C[0]; Last := 1; - for I := 1 to Order do + for I := 1 to High(C) do begin Last := Last * (x - 1); Result := Result + C[i] * Last; @@ -66,11 +65,9 @@ function Poly(const x: Integer; const C: TPolyArray): Single; overload; function Poly(const x: Integer; Min, Max: single; const C: TPolyArray): Single; overload; var i, Last: Int64; - Order: integer; begin - Order := Trunc(C[10]); Result := C[0]; Last := 1; - for I := 1 to Order do + for I := 1 to High(C) do begin Last := Last * (x - 1); Result := Result + C[i] * Last; @@ -81,11 +78,9 @@ function Poly(const x: Integer; Min, Max: single; const C: TPolyArray): Single; function Poly(const x: Integer; Polynome: TFuncProfileRec): Single; overload; var i, Last: Int64; - Order: integer; begin - Order := Trunc(Polynome.C[10]); Result := Polynome.C[0]; Last := 1; - for I := 1 to Order do + for I := 1 to High(Polynome.C) do begin Last := Last * (x - 1); Result := Result + Polynome.C[i] * Last @@ -207,7 +202,7 @@ procedure ReadHenkeTXT(const N: string; E, L: single; var f: TComplex; begin if E = 0 then E := H / L; - fn := Config.HenkePath + '\' + N + '.txt'; + fn := Config.SystemDir[sdHenke] + '\' + N + '.txt'; if not FileExists(fn) then begin Msg := Format('Error! Material %s not found in the database!', [N]); @@ -271,7 +266,7 @@ procedure ReadHenke(const N: string; E, L: single; var f: TComplex; var Na, Nro: if E = 0 then E := H / L; - fn := Config.HenkePath + N + '.bin'; + fn := Config.SystemDir[sdHenke] + N + '.bin'; if not FileExists(fn) then begin Msg := Format('Error! Material %s not found in the database!', [N]); @@ -331,7 +326,7 @@ procedure ReadHenkeTable(const N: string; var Na, Nro: single; var Table: THenke begin - fn := Config.HenkePath + N + '.bin'; + fn := Config.SystemDir[sdHenke] + N + '.bin'; if not FileExists(fn) then begin Msg := Format('Error! Material %s not found in the database!', [N]); @@ -383,7 +378,7 @@ procedure WriteHenkeTable(const N: string; Na, Nro: single; Table: THenkeTable); end; begin - fn := Config.HenkePath + N + '.bin'; + fn := Config.SystemDir[sdHenke] + N + '.bin'; try Stream := TMemoryStream.Create; diff --git a/math/unit_calc.pas b/math/unit_calc.pas index 347b660..4871c6b 100644 --- a/math/unit_calc.pas +++ b/math/unit_calc.pas @@ -55,7 +55,7 @@ TCalc = class(TObject) FChiSQR: single; Tasks: array of TProc; - NThreads : byte; + NThreads : integer; FTail: Integer; @@ -72,7 +72,6 @@ TCalc = class(TObject) destructor Destroy; override; procedure Run; function CalcChiSquare(const ThetaWieght: integer): single; - property Params: TCalcThreadParams write FParams; property ExpValues: TDataArray read FData write FData; property MovAvg: TDataArray read FMovAvg write FMovAvg; @@ -86,7 +85,7 @@ TCalc = class(TObject) implementation uses - math_globals, unit_helpers, unit_Config; + math_globals, unit_helpers, unit_Config, unit_sys_helpers; { TCalc } @@ -139,15 +138,13 @@ function TCalc.CalcChiSquare(const ThetaWieght: integer): single; FChiSQR := Result / High(FData) * 1000; end; + procedure TCalc.PrepareWorkers; var Count, j, n: Integer; dt, step: single; begin - if Config.Section.NumberOfThreads = -1 then - NThreads := Environment.Process.Affinity.Count - else - NThreads := Config.Section.NumberOfThreads; + NThreads := GetNThreads; SetLength(Tasks, NThreads); SetLength(CalcParams, NThreads); @@ -263,7 +260,6 @@ destructor TCalc.Destroy; inherited; end; - procedure TCalc.RunThetaThreads; var Config: IOmniTaskConfig; @@ -279,7 +275,7 @@ procedure TCalc.RunThetaThreads; Parallel.ForEach(0, NThreads - 1, 1) .TaskConfig(Config) .Execute( - procedure(const elem:Integer) + procedure(const elem:System.Integer) begin CalcTet(CalcParams[elem]); end); diff --git a/math/unit_materials.pas b/math/unit_materials.pas index a88775c..5b49d8e 100644 --- a/math/unit_materials.pas +++ b/math/unit_materials.pas @@ -120,8 +120,8 @@ procedure TLayeredModel.AddSubstrate(const Data: TLayersData); L := 1E8; s := Data[0].P[2].V; ro := Data[0].P[3].V; - StackID := -99; - LayerID := -99; + StackID := 65535; + LayerID := 65535; end; end; diff --git a/units/unit_Config.pas b/units/unit_Config.pas index 183ae97..101896a 100644 --- a/units/unit_Config.pas +++ b/units/unit_Config.pas @@ -18,16 +18,22 @@ interface type - TSciRefSystemFile = ( + TXRCSystemFile = ( sfSystemIniFile, sfAppHelp, sfAppVerInfo, sfLicenseFile ); - /// - /// јтрибут класса названи¤ секции в INI-файле - /// + TXRCSystemDir = ( + sdHenke, + sdProjDir, + sdOutDir, + sdBenchDir, + sdBenchOutDir, + sdJobsDir + ); + SectionAttribute = class(TCustomAttribute) strict private FSection : string; @@ -36,31 +42,17 @@ SectionAttribute = class(TCustomAttribute) property Section : string read FSection; end; - /// - /// «начение пол¤ по умолчанию (дл¤ int, bool, string) - /// DefaultValueAttribute = class(TCustomAttribute) strict private FValue : TValue; public constructor Create(aIntValue : integer); overload; + constructor Create(aFloatValue : single); overload; constructor Create(aBoolValue : boolean); overload; constructor Create(aStringValue : string); overload; property Value : TValue read FValue; end; - /// - /// Ѕазовый класс доступа к свойствам. - ///  аждое свойство дл¤ сохранени¤/получани¤ в INI *ƒолжно* иметь индекс. - /// в конечных классах дл¤ каждого типа свойсства следует указывать один из - /// методов чтени¤/записи: - /// - getIntegerValue/SetIntegerValue - /// - getBooleanValue/setBooleanValue - /// - getStringValue/SetStringValue - /// ѕеред каждым свойством должен быть описан атрибут DefaulValue - /// «начение по умолчанию строкового свойства может иметь подстроку - /// %PATH% дл¤ замены ее директорией программы, двойные "/" удал¤ютс¤ - /// TBaseOptions = class(TObject) strict protected FCtx : TRttiContext; @@ -73,10 +65,12 @@ TBaseOptions = class(TObject) function getBooleanValue(index : integer):boolean; virtual; function getIntegerValue(index : integer):integer; virtual; + function getFloatValue(index : integer):single; virtual; function getStringValue(index : integer):string; virtual; procedure SetBooleanValue(index : integer; value : boolean); virtual; procedure SetIntegerValue(index : integer; value : integer); virtual; + procedure SetFloatValue(index : integer; value : single); virtual; procedure SetStringValue(index : integer; value: string); virtual; function getProperty(index : integer) : TRttiProperty; @@ -93,14 +87,20 @@ TOtherOptions = class(TBaseOptions) [DefaultValue(False)] property CheckForUpdates : boolean index 0 read getBooleanValue write SetBooleanValue; [DefaultValue('https://raw.githubusercontent.com/OleksiyPenkov/X-RayCalc3/xraycalc3.info')] - property UpdateInfoURL : string index 1 read getStringValue write SetStringValue; + property UpdateInfoURL : string index 1 read getStringValue write SetStringValue; + [DefaultValue(True)] + property AutoCalc : boolean index 2 read getBooleanValue write SetBooleanValue; + [DefaultValue(False)] + property AutoSave : boolean index 3 read getBooleanValue write SetBooleanValue; end; [Section('Calc')] TCalcOptions = class(TBaseOptions) public - [DefaultValue(-1)] + [DefaultValue(0)] property NumberOfThreads : integer index 0 read getIntegerValue write SetIntegerValue; + [DefaultValue(20)] + property BenchmarkRuns : integer index 1 read getIntegerValue write SetIntegerValue; end; [Section('Graphics')] @@ -115,8 +115,16 @@ TPathOptions = class(TBaseOptions) public [DefaultValue('Henke')] property HenkeDir : string index 0 read getStringValue write SetStringValue; - [DefaultValue('benchmark')] + [DefaultValue('Benchmark')] property BenchmarkDir : string index 1 read getStringValue write SetStringValue; + [DefaultValue('')] + property ProjectDir : string index 2 read getStringValue write SetStringValue; + [DefaultValue('Output')] + property OutputDir : string index 3 read getStringValue write SetStringValue; + [DefaultValue('BenchResults')] + property BenchOutputDir : string index 4 read getStringValue write SetStringValue; + [DefaultValue('Jobs')] + property JobsDir : string index 5 read getStringValue write SetStringValue; end; [Section('Window')] @@ -151,13 +159,16 @@ TConfig = class(TObject) FOptions : TObjectList; private - class function GetSystemFileName(fileType: TSciRefSystemFile): string; static; - class function GetHenkePath: string; static; + class function GetSystemFileName(fileType: TXRCSystemFile): string; static; + + class function GetSystemDir(DirType: TXRCSystemDir): string; static; + class procedure SetSystemDir(DirType: TXRCSystemDir; const Value: string); static; + class function GetTempPath: string; static; - class function GetHenkeDir: string; static; class function GetWorkPath: string; static; - class function GetBenchDir: string; static; - class function GetBenchPath: string; static; + + class function GetSystemDirS(DirType: TXRCSystemDir): string; static; + class procedure SetSystemDirS(DirType: TXRCSystemDir; const Value: string); static; public class constructor Create(); class destructor Destroy(); @@ -168,19 +179,20 @@ TConfig = class(TObject) class property ErrorLog: Boolean read FErrorLog write FErrorLog; class property AppPath : string read FAppPath; - class property HenkeDir: string read GetHenkeDir; - class property HenkePath: string read GetHenkePath; - - class property BenchDir: string read GetBenchDir; - class property BenchPath: string read GetBenchPath; - class property WorkDir: string read FWorkDir; class property WorkPath: string read GetWorkPath; class property TempDir: string read FTempDir; class property TempPath: string read GetTempPath; - class property SystemFileName[fileType: TSciRefSystemFile]: string read GetSystemFileName; + class property SystemFileName[fileType: TXRCSystemFile]: string read GetSystemFileName; + class property SystemDir[DirType: TXRCSystemDir]: string read GetSystemDir write SetSystemDir; + class property SystemDirS[DirType: TXRCSystemDir]: string read GetSystemDirS write SetSystemDirS; + + class procedure WiteStringList(const Section: string; + var List: array of string); static; + class procedure ReadStringList(const Section: string; + var List: array of string); static; end; EConfigException = Exception; @@ -237,23 +249,45 @@ implementation FIni.Free(); end; -class function TConfig.GetBenchDir: string; -begin - Result := FAppPath + TConfig.Section.BenchmarkDir; -end; - -class function TConfig.GetHenkeDir: string; +class function TConfig.GetSystemDir(DirType: TXRCSystemDir): string; +var + Dir: string; begin - Result := FAppPath + TConfig.Section.HenkeDir; + case DirType of + sdHenke: Dir := TConfig.Section.HenkeDir; + sdBenchDir: Dir := TConfig.Section.BenchmarkDir; + sdProjDir: Dir := TConfig.Section.ProjectDir; + sdOutDir: Dir := TConfig.Section.OutputDir; + sdBenchOutDir: Dir := TConfig.Section.BenchOutputDir; + sdJobsDir: Dir := TConfig.Section.JobsDir; + else + Assert(False); + end; + + if Pos(':', Dir) <> 0 then + begin + Result := IncludeTrailingPathDelimiter(Dir); + Exit; + end; + Result := IncludeTrailingPathDelimiter(AppPath + Dir); end; -class function TConfig.GetHenkePath: string; +class function TConfig.GetSystemDirS(DirType: TXRCSystemDir): string; begin - Result := IncludeTrailingPathDelimiter(GetHenkeDir); + case DirType of + sdHenke: Result := TConfig.Section.HenkeDir; + sdBenchDir: Result := TConfig.Section.BenchmarkDir; + sdProjDir: Result := TConfig.Section.ProjectDir; + sdOutDir: Result := TConfig.Section.OutputDir; + sdBenchOutDir: Result := TConfig.Section.BenchOutputDir; + sdJobsDir: Result := TConfig.Section.JobsDir; + else + Assert(False); + end; end; -class function TConfig.GetSystemFileName(fileType: TSciRefSystemFile): string; +class function TConfig.GetSystemFileName(fileType: TXRCSystemFile): string; begin case fileType of sfAppHelp: Result := AppPath + APP_HELP_FILENAME; @@ -273,10 +307,6 @@ class function TConfig.GetWorkPath: string; Result := IncludeTrailingPathDelimiter(FWorkDir); end; -class function TConfig.GetBenchPath: string; -begin - Result := IncludeTrailingPathDelimiter(GetBenchDir); -end; class procedure TConfig.RegisterOptions(OptionsClass: TBaseOptionsClass); var opt : TBaseOptions; @@ -303,6 +333,59 @@ class function TConfig.Section(): T; raise EConfigException.Create('Unregistered option group' + string(PTypeInfo(typeinfo(t)).Name)); end; +class procedure TConfig.SetSystemDir(DirType: TXRCSystemDir; + const Value: string); +begin + case DirType of + sdHenke: TConfig.Section.HenkeDir := Value; + sdBenchDir: TConfig.Section.BenchmarkDir := Value; + sdProjDir: TConfig.Section.ProjectDir := Value; + sdOutDir: TConfig.Section.OutputDir := Value; + sdBenchOutDir: TConfig.Section.BenchOutputDir := Value; + sdJobsDir: TConfig.Section.JobsDir := Value; + else + Assert(False); + end; +end; + +class procedure TConfig.SetSystemDirS(DirType: TXRCSystemDir; + const Value: string); +var + Dir: string; + p: Integer; +begin + Dir := Value; + p := Pos(AppPath, Dir); + if p > 0 then + Delete(Dir, 1, Length(AppPath)); + case DirType of + sdHenke: TConfig.Section.HenkeDir := Dir; + sdBenchDir: TConfig.Section.BenchmarkDir := Dir; + sdProjDir: TConfig.Section.ProjectDir := Dir; + sdOutDir: TConfig.Section.OutputDir := Dir; + sdBenchOutDir: TConfig.Section.BenchOutputDir := Dir; + sdJobsDir: TConfig.Section.JobsDir := Value; + else + Assert(False); + end; +end; + +class procedure TConfig.WiteStringList(const Section: string; var List: array of string); +var + i: Integer; +begin + for I := 0 to High(List) do + FIni.WriteString(Section, 'Recent' + IntToStr(i + 1), List[i]); +end; + + +class procedure TConfig.ReadStringList(const Section: string; var List: array of string); +var + i: Integer; +begin + for I := 0 to High(List) do + List[i] := FIni.ReadString(Section, 'Recent' + IntToStr(i + 1), ''); +end; {$ENDREGION} {$REGION '--------------------- TBaseOptions --------------------------'} @@ -365,6 +448,7 @@ function TBaseOptions.getGenericValue(index: integer): T; case prop.PropertyType.TypeKind of tkInteger : value := FIni.ReadInteger(FSection, prop.name, Default.Value.AsInteger); + tkFloat : value := FIni.ReadFloat(FSection, prop.name, Default.Value.AsExtended); tkString, tkUString : value := FIni.ReadString(FSection, prop.Name, Default.Value.asString); tkEnumeration : value := FIni.ReadInteger(FSection, prop.Name, ord(Default.Value.AsBoolean)) <> 0; @@ -389,6 +473,11 @@ function TBaseOptions.getIntegerValue(index: integer): integer; result := getGenericValue(index); end; +function TBaseOptions.getFloatValue(index: integer): single; +begin + result := getGenericValue(index); +end; + function TBaseOptions.getStringValue(index: integer): string; begin result := getGenericValue(index); @@ -417,6 +506,7 @@ procedure TBaseOptions.SetGenericValue(index: integer; value: T); newValue := TValue.From(value); case PTypeInfo(TypeInfo(T)).Kind of + tkFloat : FIni.WriteFloat(FSection, prop.Name, newValue.AsExtended); tkInteger : FIni.WriteInteger(FSection, prop.Name, newValue.AsInteger); tkString, tkUString : Fini.WriteString(FSection, prop.Name, newValue.AsString); @@ -430,6 +520,11 @@ procedure TBaseOptions.SetBooleanValue(index: integer; value: boolean); end; +procedure TBaseOptions.SetFloatValue(index: integer; value: single); +begin + setGenericValue(index, value); +end; + procedure TBaseOptions.SetIntegerValue(index, value: integer); begin setGenericValue(index, value); @@ -487,6 +582,11 @@ constructor DefaultValueAttribute.Create(aStringValue: string); FValue := aStringValue; end; +constructor DefaultValueAttribute.Create(aFloatValue: single); +begin + inherited Create(); + FValue := aFloatValue; +end; {$ENDREGION} initialization diff --git a/units/unit_Types.pas b/units/unit_Types.pas index 7cb9bbf..93f0d33 100644 --- a/units/unit_Types.pas +++ b/units/unit_Types.pas @@ -16,9 +16,15 @@ interface type + TFittingMode = (fmIrregular, fmPeriodic, fmPoly); + TFloatArray = array of Single; - TIntArray = array of Integer; - TPolyArray = array [0..10] of single; + TIntArray = array of Word; + TPolyArray = array of single; + + TLayer = array [1..3] of TPolyArray; // Array of layer parameters + TSolution = array of TLayer; // H, Sigma, rho x N Layers + TPopulation = array of TSolution; TRoughnessFunction = (rfError, rfExp, rfLinear, rfStep, rfSinus); TCalcMode = (cmTheta, cmLambda, cmTest); @@ -39,7 +45,8 @@ TProjectData = record Description: string; Data: string; function IsModel: Boolean; - + function PolyD: TPolyArray; + procedure SetPoly(var PolyD: TPolyArray); case RowType: TProjRowType of prGroup, prFolder: (); @@ -55,7 +62,7 @@ TProjectData = record etFunction: (StackID: integer; LayerID: integer; - Poly: TPolyArray; + Poly: array [0..10] of single; Form: TFunctionForm; Subj: TParameterType; ); @@ -89,13 +96,17 @@ TFitParams = record KChiSqr: single; KVmax : single; w1, w2: single; + MovAvgWindow: Single; Shake : boolean; - ThetaWieght: integer; + ThetaWeight: integer; AdaptVel: Boolean; RangeSeed: Boolean; MaxPOrder: Integer; Ksxr : Single; + PolyFactor: Integer; + Smooth: Boolean; + SmoothWindow: ShortInt; end; // Calculation data types @@ -106,26 +117,25 @@ TCalcLayer = record L, s, ro: single; { Thickness, sigma} K: TComplex; { kappa } RF, r: TComplex; { Френелевский коэф. } - LayerID, StackID: integer; + LayerID, StackID: Word; end; - TCalcLayers = array of TCalcLayer; TFuncProfileRec = record public Func: TFunctionForm; Subj: TParameterType; - LayerID: integer; - StackID: integer; + LayerID: Word; + StackID: Word; C: TPolyArray; - function X(const i: integer): Integer; - function Ord: Integer; + function X(const i: Word): Word; + function Ord: Word; procedure Assign(const Data: PProjectData); - function PIndex: Integer; + function PIndex: Word; private - IntX: Integer; + IntX: Word; end; TProfileFunctions = array of TFuncProfileRec; @@ -149,12 +159,12 @@ TFitValue = record TLayerData = record Material: string; P: array [1..3] of TFitValue; - StackID, LayerID, Index: integer; + StackID, LayerID, Index: Word; PP: array [1..3] of TFloatArray; public - procedure ClearProfiles(const p: integer); - procedure AddProfilePoint(const Val: Single; Index: integer); - function ProfileFromSrting(const p: integer; Profile: string): string; + procedure ClearProfiles(const p: Word); + procedure AddProfilePoint(const Val: Single; Index: Word); + function ProfileFromSrting(const p: Word; Profile: string): string; function ProfileToSrting(const Subj: TParameterType): string; end; @@ -169,8 +179,8 @@ TDataPoint = record TMaterialsList = array of record Name: string; - StackID: integer; - LayerID: integer; + StackID: word; + LayerID: word; end; // Fitting data types @@ -187,8 +197,8 @@ TFitStack = record TFitStructure = record Stacks: array of TFitStack; Subs: TLayerData; - function Total: integer; - function TotalNP: integer; + function Total: Word; + function TotalNP: Word; end; @@ -202,6 +212,27 @@ function TProjectData.IsModel: Boolean; Result := (Group = gtModel) and (RowType = prItem); end; +function TProjectData.PolyD: TPolyArray; +var + i: Integer; +begin + SetLength(Result, Trunc(Poly[10] + 1)); + for I := 0 to High(Result) do + Result[i] := Poly[i]; +end; + +procedure TProjectData.SetPoly(var PolyD: TPolyArray); +var + i: Integer; +begin + for I := 0 to High(PolyD) do + begin + Poly[i] := PolyD[i]; + if i = 10 then Break; + end; + Poly[10] := High(PolyD); +end; + { TFitValue } procedure TFitValue.Init(const AMin, AMax: single); @@ -237,9 +268,9 @@ procedure TFitValue.Init(const dev: single); { TFitPeriodicStructure } -function TFitStructure.Total: integer; +function TFitStructure.Total: Word; var - i: integer; + i: Word; begin Result := 0; for I := 0 to High(Stacks) do @@ -248,9 +279,9 @@ function TFitStructure.Total: integer; { TFitStructure } -function TFitStructure.TotalNP: integer; +function TFitStructure.TotalNP: Word; var - i: integer; + i: Word; begin Result := 0; for I := 0 to High(Stacks) do @@ -264,12 +295,12 @@ procedure TLayerData.ClearProfiles; SetLength(PP[p], 0); end; -procedure TLayerData.AddProfilePoint(const Val: Single; Index: integer); +procedure TLayerData.AddProfilePoint(const Val: Single; Index: Word); begin Insert(Val, PP[Index], MaxInt); end; -function TLayerData.ProfileFromSrting(const p: integer; Profile: string): string; +function TLayerData.ProfileFromSrting(const p: Word; Profile: string): string; var i, k: Integer; val: single; @@ -305,20 +336,20 @@ procedure TFuncProfileRec.Assign(const Data: PProjectData); LayerID := Data.LayerID; StackID := Data.StackID; Subj := Data.Subj; - C := Data.Poly; + C := Data.PolyD; end; -function TFuncProfileRec.Ord: Integer; +function TFuncProfileRec.Ord: Word; begin Result := Trunc(C[10]); end; -function TFuncProfileRec.PIndex: Integer; +function TFuncProfileRec.PIndex: Word; begin Result := System.Ord(Subj) + 1; end; -function TFuncProfileRec.X(const i: integer): Integer; +function TFuncProfileRec.X(const i: Word): Word; begin if i = 1 then IntX := 0; Inc(IntX); diff --git a/units/unit_consts.pas b/units/unit_consts.pas index 8952b0a..a265ffd 100644 --- a/units/unit_consts.pas +++ b/units/unit_consts.pas @@ -16,23 +16,26 @@ interface const - CURRENT_PROJECT_VERSION = 5; + CURRENT_PROJECT_VERSION = 6; PARAMETERS_FILE_NAME = 'params.dsc'; PROJECT_FILE_NAME = 'project.dsc'; + MAX_RECENT_CAPACITY = 10; + WM_RECALC = WM_USER + 1; WM_STARTEDITING = WM_USER + 2; PAlias : array [1..3] of string = ('H','s','r'); - APPDATA_DIR_NAME = 'X-Ray Calc3'; + APPDATA_DIR_NAME = 'X-RayCalc3'; SETTINGS_FILE_NAME = 'xrc3.ini'; APP_HELP_FILENAME = 'xraycalc3.chm'; VERINFO_FILENAME = 'version.info'; LICENSE_FILENAME = 'xraycalc3.lic'; DEFAULT_PROJECT_NAME = 'NewProject.xrcx'; + PROJECT_EXT = '.xrcx'; implementation end. diff --git a/units/unit_helpers.pas b/units/unit_helpers.pas index e25aeff..f927a12 100644 --- a/units/unit_helpers.pas +++ b/units/unit_helpers.pas @@ -32,13 +32,14 @@ procedure SeriesFromFile(Series: TLineSeries; const FileName: string; out Descr: procedure DataToFile(const FileName: string; Data: TDataArray); //procedure DataToClipboard(const Data: TDataArray); -function SeriesToData( Series: TLineSeries): TDataArray; +function SeriesToData(Series: TLineSeries): TDataArray; procedure DataToSeries(const Data: TDataArray; var Series: TLineSeries); procedure AutoMerge( var Series: TLineSeries); procedure ManualMerge( X, K: single; var Series: TLineSeries); procedure Normalize(K: single; var Series: TLineSeries); function MovAvg(const Inp: TDataArray; W: single): TDataArray; +function Smooth(const Inp: TDataArray; W: ShortInt): TDataArray; procedure FillElementsList(const Path: string; var List: TListBox); procedure OpenHelpFile(const FileName: string); @@ -101,6 +102,40 @@ function GetSpecialPath(CSIDL: word): string; Result := IncludeTrailingPathDelimiter(PChar(S)); end; + +function Smooth(const Inp: TDataArray; W: ShortInt): TDataArray; +var + i, j, Max: word; + s: single; +begin + Max := Length(Inp) - 1; + SetLength(Result, Max + 1); + + if W = -1 then + begin + W := Round(Max / 10); + if W < 1 then W := 1; + end; + + for I := 0 to Max - W do + begin + S := 0; + for j := i to i + W do + S := S + Inp[j].r; + Result[i].r := S/(W + 1); + end; + + for I := Max - W + 1 to Max do + begin + S := 0; + for j := i - W to i - 1 do + S := S + Inp[j].r; + Result[i].r := S/W; + end; + + +end; + function MovAvg(const Inp: TDataArray; W: single): TDataArray; var i, j: integer; @@ -297,6 +332,7 @@ procedure DataToSeries(const Data: TDataArray; var Series: TLineSeries); Series.AddXY(Data[i].t, Data[i].r); end; + function SeriesToData( Series: TLineSeries): TDataArray; var i: integer; @@ -515,4 +551,14 @@ function ClearDir(const DirectoryName: string; Full: boolean): boolean; end; {$WARNINGS ON} +function RemoveAppPath(const Path: string; AppPath: string): string; +var + p: Integer; +begin + Result := Path; + p := Pos(AppPath, Result); + if p > 0 then + Delete(Result, 1, Length(AppPath)); +end; + end. diff --git a/units/unit_sys_helpers.pas b/units/unit_sys_helpers.pas new file mode 100644 index 0000000..7bad5c3 --- /dev/null +++ b/units/unit_sys_helpers.pas @@ -0,0 +1,89 @@ +unit unit_sys_helpers; + +interface + +uses + Winapi.Windows; + + function SingleProcessorMask(const ProcessorIndex: Integer): DWORD_PTR; + function CombinedProcessorMask(const Processors: array of Integer): DWORD_PTR; + function GetNThreads: Integer; + procedure FindPCores; + +implementation + +uses + Dialogs, unit_Config, OtlCommon, System.SysUtils; + +const + CPUS : array [0..7] of Integer = (0,1,2,3,4,5,6,7); // (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15); +// +// +function SingleProcessorMask(const ProcessorIndex: Integer): DWORD_PTR; +begin + //When shifting constants the compiler will force the result to be 32-bit + //if you have more than 32 processors, `Result:= 1 shl x` will return + //an incorrect result. + Result := DWORD_PTR(1) shl (ProcessorIndex); +end; + +function CombinedProcessorMask(const Processors: array of Integer): DWORD_PTR; +var + i: Integer; +begin + Result := 0; + for i := low(Processors) to high(Processors) do + Result := Result or SingleProcessorMask(Processors[i]); +end; + +function GetNThreads: Integer; +begin + if Config.Section.NumberOfThreads = 0 then + Result := Environment.Process.Affinity.Count + else + Result := Config.Section.NumberOfThreads; + +// Result := Length(CPUS); +// Environment.Process.Affinity.Mask := CombinedProcessorMask(CPUS); + +// if not SetProcessAffinityMask(GetCurrentProcess, SingleProcessorMask(16)) then +// ShowMessage(SysErrorMessage(GetLastError)); + +end; + + +procedure FindPCores; +var + i : Integer; + ReturnLength: DWORD; + Buffer : array of TSystemLogicalProcessorInformation; +begin + SetLength(Buffer,256); + + ReturnLength := SizeOf(TSystemLogicalProcessorInformation) * 256; + + if not GetLogicalProcessorInformation(@Buffer[0], ReturnLength) then + begin + if GetLastError = ERROR_INSUFFICIENT_BUFFER then + begin + SetLength(Buffer,ReturnLength div SizeOf(TSystemLogicalProcessorInformation) + 1); + if not GetLogicalProcessorInformation(@Buffer[0], ReturnLength) then + RaiseLastOSError; + end + else + RaiseLastOSError; + end; + + SetLength(Buffer, ReturnLength div SizeOf(TSystemLogicalProcessorInformation)); + + for i := 0 to High(Buffer) do begin + case Buffer[i].Relationship of + RelationNumaNode: ; + RelationProcessorCore:; + RelationCache: if (Buffer[i].Cache.Level = 1) then ; + end; + end; + +end; + +end.