diff --git a/components/tachart/tachartutils.pas b/components/tachart/tachartutils.pas index 567ec7f2d2..906e5c28e4 100644 --- a/components/tachart/tachartutils.pas +++ b/components/tachart/tachartutils.pas @@ -101,6 +101,9 @@ type smsLabelPercentTotal, { Cars 12 % of 1234 } smsXValue); { 21/6/1996 } + TIntervalOption = (ioOpenStart, ioOpenEnd); + TIntervalOptions = set of TIntervalOption; + TDoubleInterval = record FStart, FEnd: Double; end; @@ -122,26 +125,23 @@ type TIntervalList = class private FEpsilon: Double; - FEpsilonScale: Double; - FAbsoluteEpsilon: Double; FIntervals: array of TDoubleInterval; FOnChange: TNotifyEvent; procedure Changed; function GetInterval(AIndex: Integer): TDoubleInterval; function GetIntervalCount: Integer; - procedure SetEpsilon(AValue: Double); procedure SetOnChange(AValue: TNotifyEvent); public procedure Assign(ASource: TIntervalList); constructor Create; public procedure AddPoint(APoint: Double); inline; - procedure AddRange(AStart, AEnd: Double); + procedure AddRange(AStart, AEnd: Double; ALimits: TIntervalOptions = []); procedure Clear; function Intersect( var ALeft, ARight: Double; var AHint: Integer): Boolean; public - property Epsilon: Double read FEpsilon write SetEpsilon; + property Epsilon: Double read FEpsilon write FEpsilon; property Interval[AIndex: Integer]: TDoubleInterval read GetInterval; property IntervalCount: Integer read GetIntervalCount; property OnChange: TNotifyEvent read FOnChange write SetOnChange; @@ -706,12 +706,15 @@ begin AddRange(APoint, APoint); end; -procedure TIntervalList.AddRange(AStart, AEnd: Double); +procedure TIntervalList.AddRange(AStart, AEnd: Double; ALimits: TIntervalOptions = []); var i: Integer; j: Integer; k: Integer; begin + if not (ioOpenStart in ALimits) then AStart -= FEpsilon; + if not (ioOpenEnd in ALimits) then AEnd += FEpsilon; + if AStart > AEnd then exit; i := 0; while (i <= High(FIntervals)) and (FIntervals[i].FEnd < AStart) do i += 1; @@ -733,11 +736,6 @@ begin FIntervals[k] := FIntervals[k - 1]; end; FIntervals[i] := DoubleInterval(AStart, AEnd); - if (abs(FIntervals[i].FStart) <> Infinity) and (abs(FIntervals[i].FStart) > FEpsilonScale) then - FEpsilonScale := abs(FIntervals[i].FStart); - if (abs(FIntervals[i].FEnd) <> Infinity) and (abs(FIntervals[i].FEnd) > FEpsilonScale) then - FEpsilonScale := abs(FIntervals[i].FEnd); - FAbsoluteEpsilon := IfThen(FEpsilonScale = 0, FEpsilon, FEpsilon * FEpsilonScale); Changed; end; @@ -762,7 +760,6 @@ end; constructor TIntervalList.Create; begin FEpsilon := DEFAULT_EPSILON; - FEpsilonScale := 0.0 end; function TIntervalList.GetInterval(AIndex: Integer): TDoubleInterval; @@ -784,13 +781,13 @@ begin if Length(FIntervals) = 0 then exit; AHint := EnsureRange(AHint, 0, High(FIntervals)); - while (AHint > 0) and (FIntervals[AHint].FStart - FAbsoluteEpsilon > ARight) do + while (AHint > 0) and (FIntervals[AHint].FStart >= ARight) do Dec(AHint); while - (AHint <= High(FIntervals)) and (FIntervals[AHint].FStart - FAbsoluteEpsilon <= ARight) + (AHint <= High(FIntervals)) and (FIntervals[AHint].FStart < ARight) do begin - if FIntervals[AHint].FEnd >= ALeft then begin + if FIntervals[AHint].FEnd > ALeft then begin if not Result then fi := AHint; li := AHint; Result := true; @@ -799,24 +796,11 @@ begin end; if Result then begin - ALeft := FIntervals[fi].FStart - FAbsoluteEpsilon; - ARight := FIntervals[li].FEnd + FAbsoluteEpsilon; + ALeft := FIntervals[fi].FStart; + ARight := FIntervals[li].FEnd; end; end; -procedure TIntervalList.SetEpsilon(AValue: Double); -begin - if FEpsilon = AValue then exit; - if AValue <= 0 then - raise EChartIntervalError.Create('Epsilon <= 0'); - FEpsilon := AValue; - if FEpsilonScale = 0 then - FAbsoluteEpsilon := FEpsilon - else - FAbsoluteEpsilon := FEpsilon * FEpsilonScale; - Changed; -end; - procedure TIntervalList.SetOnChange(AValue: TNotifyEvent); begin if TMethod(FOnChange) = TMethod(AValue) then exit; diff --git a/components/tachart/taexpressionseries.pas b/components/tachart/taexpressionseries.pas index 04a1f28824..6918dbe732 100644 --- a/components/tachart/taexpressionseries.pas +++ b/components/tachart/taexpressionseries.pas @@ -89,7 +89,6 @@ type TExpressionSeries = class(TCustomFuncSeries) private FDomain: String; - FDomainEpsilon: Double; FDomainScanner: TChartDomainScanner; FExpression: String; FParams: TChartExprParams; @@ -97,6 +96,7 @@ type FVariable: String; FX: TFPExprIdentifierDef; FDirty: Boolean; + function GetDomainEpsilon: Double; procedure SetDomain(const AValue: String); procedure SetDomainEpsilon(const AValue: Double); procedure SetExpression(const AValue: string); @@ -115,7 +115,7 @@ type function IsEmpty: Boolean; override; procedure RequestParserUpdate; inline; published - property DomainEpsilon: Double read FDomainEpsilon write SetDomainEpsilon; + property DomainEpsilon: Double read GetDomainEpsilon write SetDomainEpsilon; property Params: TChartExprParams read FParams write SetParams; property Variable: String read FVariable write SetVariable; property Domain: String read FDomain write SetDomain; @@ -271,6 +271,7 @@ constructor TChartDomainScanner.Create(ASeries: TExpressionSeries); begin FSeries := ASeries; FParser := ASeries.FParser; + FEpsilon := DEFAULT_EPSILON; end; { Analyzes the parts of the domain expression and extract the intervals on @@ -280,68 +281,67 @@ end; procedure TChartDomainScanner.Analyze(AList, ADomain: TIntervalList; const AParts: TDomainParts); var + SaveListEpsilon, SaveDomainEpsilon: Double; a, b: Double; begin - // two-sided interval, e.g. "0 < x <= 1", or "2 > x >= 1" - if (AParts[2] = Variable) and (AParts[3] <> '') and (AParts[4] <> '') then - begin - FParser.Expression := AParts[0]; - a := ArgToFloat(FParser.Evaluate); - FParser.Expression := AParts[4]; - b := ArgToFloat(FParser.Evaluate); - if (AParts[1][1] = '<') and (AParts[3][1] = '<') and (a < b) then - ADomain.AddRange(a, b) - else - if (AParts[1][1] = '>') and (AParts[3][1] = '>') and (a > b) then - ADomain.AddRange(b, a); - end else - // one-sided interval, variable is at left - if (AParts[0] = Variable) and (AParts[3] = '') and (AParts[4] = '') then - begin - FParser.Expression := AParts[2]; - a := ArgToFloat(FParser.Evaluate); - case AParts[1] of - '<>' : AList.AddPoint(a); // x <> a - '<', '<=' : ADomain.AddRange(-Infinity, a); // x < a, x <= a - '>', '>=' : ADomain.AddRange(a, Infinity); // x > a, x >= a - else Expressionerror; - end; - end else - // one-sided interval, variable is at right - if (AParts[2] = Variable) and (AParts[3] = '') and (AParts[4] = '') then - begin - FParser.Expression := AParts[0]; - a := ArgToFloat(FParser.Evaluate); - case AParts[1] of - '<>' : AList.AddPoint(a); // a <> x - '<', '<=' : ADomain.AddRange(a, Infinity); // a < x, a <= x - '>', '>=' : ADomain.AddRange(-Infinity, a); // a > x, a >= x - else ExpressionError; - end; - end else - ExpressionError; + SaveListEpsilon := AList.Epsilon; + SaveDomainEpsilon := ADomain.Epsilon; + try + AList.Epsilon := FEpsilon; // list of excluded ranges should be widened by Epsilon + ADomain.Epsilon := -FEpsilon; // list of included ranges should be narrowed by Epsilon + + // two-sided interval, e.g. "0 < x <= 1", or "2 > x >= 1" + if (AParts[2] = Variable) and (AParts[3] <> '') and (AParts[4] <> '') then + begin + FParser.Expression := AParts[0]; + a := ArgToFloat(FParser.Evaluate); + FParser.Expression := AParts[4]; + b := ArgToFloat(FParser.Evaluate); + if (AParts[1][1] = '<') and (AParts[3][1] = '<') and (a < b) then + ADomain.AddRange(a, b) + else + if (AParts[1][1] = '>') and (AParts[3][1] = '>') and (a > b) then + ADomain.AddRange(b, a); + end else + // one-sided interval, variable is at left + if (AParts[0] = Variable) and (AParts[3] = '') and (AParts[4] = '') then + begin + FParser.Expression := AParts[2]; + a := ArgToFloat(FParser.Evaluate); + case AParts[1] of + '<>' : AList.AddPoint(a); // x <> a + '<', '<=' : ADomain.AddRange(-Infinity, a); // x < a, x <= a + '>', '>=' : ADomain.AddRange(a, Infinity); // x > a, x >= a + else Expressionerror; + end; + end else + // one-sided interval, variable is at right + if (AParts[2] = Variable) and (AParts[3] = '') and (AParts[4] = '') then + begin + FParser.Expression := AParts[0]; + a := ArgToFloat(FParser.Evaluate); + case AParts[1] of + '<>' : AList.AddPoint(a); // a <> x + '<', '<=' : ADomain.AddRange(a, Infinity); // a < x, a <= x + '>', '>=' : ADomain.AddRange(-Infinity, a); // a > x, a >= x + else ExpressionError; + end; + end else + ExpressionError; + finally + AList.Epsilon := SaveListEpsilon; + ADomain.Epsilon := SaveDomainEpsilon; + end; end; { Converts the intervals in ADomain on which the function is defined to intervals in AList in which the function is NOT defined (= DomainExclusion) } procedure TChartDomainScanner.ConvertToExclusions(AList, ADomain: TIntervalList); - - function IsPoint(i: Integer): Boolean; - begin - Result := (i >= 0) and (i < ADomain.IntervalCount) and - (ADomain.Interval[i].FStart = ADomain.Interval[i].FEnd); - end; - -type - TIntervalPoint = record - Value: Double; - Contained: Boolean; - end; - var + SaveListEpsilon: Double; a, b: Double; i, j: Integer; - points: array of TIntervalPoint; + points: array of Double; begin if ADomain.IntervalCount = 0 then exit; @@ -350,52 +350,49 @@ begin SetLength(points, ADomain.IntervalCount*2); for i:=0 to ADomain.IntervalCount-1 do begin - if IsPoint(i) then - Continue; if ADomain.Interval[i].FStart <> -Infinity then begin - points[j].Value := ADomain.Interval[i].FStart; - points[j].Contained := IsPoint(i-1); + points[j] := ADomain.Interval[i].FStart; inc(j); end; if ADomain.Interval[i].FEnd <> +Infinity then begin - points[j].Value := ADomain.Interval[i].FEnd; - points[j].Contained := IsPoint(i+1); + points[j] := ADomain.Interval[i].FEnd; inc(j); end; end; SetLength(points, j); - // Case 1: domain extends to neg infinity - // -INF <---------|xxxxxxxx|------|xxxx> INF with - = allowed, x = forbidden - // 0 1 2 - if ADomain.Interval[0].FStart = -Infinity then - j := 0 - else - // Case 2: domain begins at finite value - // -INF INF - // 0 1 2 - begin - a := -Infinity; - b := points[0].Value; - AList.AddRange(a, b); - if not points[0].Contained then - AList.AddPoint(b); - j := 1; - end; - while j < Length(points) do begin - a := points[j].Value; - if not points[j].Contained then - AList.AddPoint(a); - if j = High(points) then begin - AList.AddRange(a, Infinity); - end else + SaveListEpsilon := AList.Epsilon; + try + AList.Epsilon := 0; // provide direct ADomain to AList conversion - all the + // required epsilons have already been applied earlier, + // in the Analyze() call + + // Case 1: domain extends to neg infinity + // -INF <---------|xxxxxxxx|------|xxxx> INF with - = allowed, x = forbidden + // 0 1 2 + if ADomain.Interval[0].FStart = -Infinity then + j := 0 + else + // Case 2: domain begins at finite value + // -INF INF + // 0 1 2 begin - b := points[j+1].Value; + a := -Infinity; + b := points[0]; AList.AddRange(a, b); - if not points[j+1].Contained then - AList.AddPoint(b); + j := 1; end; - inc(j, 2); + while j < Length(points) do begin + a := points[j]; + if j = High(points) then + b := Infinity + else + b := points[j+1]; + AList.AddRange(a, b); + inc(j, 2); + end; + finally + AList.Epsilon := SaveListEpsilon; end; end; @@ -418,8 +415,6 @@ begin savedExpr := FParser.Expression; domains := TIntervalList.Create; try - AList.Epsilon := FEpsilon; - domains.Epsilon := FEpsilon; ParseExpression(AList, domains); ConvertToExclusions(AList, domains); finally @@ -500,7 +495,6 @@ begin FX := FParser.Identifiers.AddFloatVariable(FVariable, 0.0); FDomainScanner := TChartDomainScanner.Create(self); - FDomainEpsilon := DEFAULT_EPSILON; FParams := TChartExprParams.Create(FParser, @OnChangedHandler); end; @@ -577,9 +571,17 @@ begin UpdateParentChart; end; +function TExpressionSeries.GetDomainEpsilon: Double; +begin + Result := FDomainScanner.Epsilon; +end; + procedure TExpressionSeries.SetDomainEpsilon(const AValue: Double); begin - FDomainScanner.Epsilon := AValue; + if FDomainScanner.Epsilon = abs(AValue) then exit; + FDomainScanner.Epsilon := abs(AValue); + RequestParserUpdate; + UpdateParentChart; end; procedure TExpressionSeries.SetExpression(const AValue: String); @@ -613,7 +615,6 @@ begin FParser.Identifiers.AddFloatVariable(p.Name, p.Value); end; - FDomainScanner.Epsilon := FDomainEpsilon; FDomainScanner.Expression := FDomain; FDomainScanner.ExtractDomainExclusions(DomainExclusions); diff --git a/components/tachart/tafuncseries.pas b/components/tachart/tafuncseries.pas index c696408e5d..a466c66147 100644 --- a/components/tachart/tafuncseries.pas +++ b/components/tachart/tafuncseries.pas @@ -327,7 +327,7 @@ type procedure InvalidateFitResults; virtual; procedure Loaded; override; function PrepareFitParams: boolean; - function PrepareIntervals: TIntervalList; + function PrepareIntervals: TIntervalList; virtual; procedure SourceChanged(ASender: TObject); override; public procedure Assign(ASource: TPersistent); override; @@ -1316,9 +1316,9 @@ begin FIntervals := TIntervalList.Create; try if not (csoExtrapolateLeft in FOwner.Options) then - FIntervals.AddRange(NegInfinity, FX[0]); + FIntervals.AddRange(NegInfinity, FX[0], [ioOpenStart, ioOpenEnd]); if not (csoExtrapolateRight in FOwner.Options) then - FIntervals.AddRange(FX[High(FX)], SafeInfinity); + FIntervals.AddRange(FX[High(FX)], SafeInfinity, [ioOpenStart, ioOpenEnd]); except FreeAndNil(FIntervals); raise; @@ -2162,8 +2162,8 @@ begin try CalcXRange(xmin, xmax); if DrawFitRangeOnly then begin - Result.AddRange(NegInfinity, xmin); - Result.AddRange(xmax, SafeInfinity); + Result.AddRange(NegInfinity, xmin, [ioOpenStart, ioOpenEnd]); + Result.AddRange(xmax, SafeInfinity, [ioOpenStart, ioOpenEnd]); end; except Result.Free; diff --git a/components/tachart/test/UtilsTest.pas b/components/tachart/test/UtilsTest.pas index a99e944d50..7baced2a69 100644 --- a/components/tachart/test/UtilsTest.pas +++ b/components/tachart/test/UtilsTest.pas @@ -118,12 +118,39 @@ begin r := 6.0; AssertTrue(FIList.Intersect(l, r, hint)); AssertEquals(2.0, r); - FIList.Epsilon := 0.1; // Meaning 10% of max exclusion edge, i.e. 0.2 - l := 0.5; - r := 2.5; + FIList.Epsilon := 0.1; + FIList.AddRange(101.0, 102.0); + l := 100.5; + r := 102.5; AssertTrue(FIList.Intersect(l, r, hint)); - AssertEquals(0.8, l); - AssertEquals(2.2, r); + AssertEquals(100.9, l); + AssertEquals(102.1, r); + FIList.Epsilon := -0.1; + FIList.AddRange(201.0, 202.0); + l := 200.5; + r := 202.5; + AssertTrue(FIList.Intersect(l, r, hint)); + AssertEquals(201.1, l); + AssertEquals(201.9, r); + FIList.Epsilon := 0.1; + FIList.AddRange(301.0, 302.0, [ioOpenStart]); + l := 300.5; + r := 302.5; + AssertTrue(FIList.Intersect(l, r, hint)); + AssertEquals(301.0, l); + AssertEquals(302.1, r); + FIList.AddRange(401.0, 402.0, [ioOpenEnd]); + l := 400.5; + r := 402.5; + AssertTrue(FIList.Intersect(l, r, hint)); + AssertEquals(400.9, l); + AssertEquals(402.0, r); + FIList.AddRange(501.0, 502.0, [ioOpenStart, ioOpenEnd]); + l := 500.5; + r := 502.5; + AssertTrue(FIList.Intersect(l, r, hint)); + AssertEquals(501.0, l); + AssertEquals(502.0, r); end; procedure TIntervalListTest.Merge;