fpspreadsheet: Support regression.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9006 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-03 18:56:15 +00:00
parent 13ac26a52b
commit 0fe9411ff3
3 changed files with 313 additions and 12 deletions

View File

@ -9,9 +9,9 @@ const
// SERIES_CLASS: TsChartSeriesClass = TsBarSeries; // SERIES_CLASS: TsChartSeriesClass = TsBarSeries;
// SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries; // SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries;
// SERIES_CLASS: TsChartSeriesClass = TsLineSeries; // SERIES_CLASS: TsChartSeriesClass = TsLineSeries;
// SERIES_CLASS: TsChartSeriesClass = TsScatterSeries; SERIES_CLASS: TsChartSeriesClass = TsScatterSeries;
// SERIES_CLASS: TsChartSeriesClass = TsRadarSeries; // SERIES_CLASS: TsChartSeriesClass = TsRadarSeries;
SERIES_CLASS: TsChartSeriesClass = TsPieSeries; // SERIES_CLASS: TsChartSeriesClass = TsPieSeries;
r1 = 1; r1 = 1;
r2 = 8; r2 = 8;
FILL_COLORS: array[0..r2-r1] of TsColor = (scRed, scGreen, scBlue, scYellow, scMagenta, scSilver, scBlack, scOlive); FILL_COLORS: array[0..r2-r1] of TsColor = (scRed, scGreen, scBlue, scYellow, scMagenta, scSilver, scBlack, scOlive);

View File

@ -311,9 +311,50 @@ type
constructor Create(AChart: TsChart); override; constructor Create(AChart: TsChart); override;
end; end;
TsRegressionType = (rtNone, rtLinear, rtLogarithmic, rtExponential, rtPower, rtPolynomial);
TsRegressionEquation = class
Fill: TsChartFill;
Font: TsFont;
Border: TsChartLine;
NumberFormat: String;
Left, Top: Double; // mm, relative to outer chart boundaries!
XName: String;
YName: String;
constructor Create;
destructor Destroy; override;
function DefaultBorder: Boolean;
function DefaultFill: Boolean;
function DefaultFont: Boolean;
function DefaultNumberFormat: Boolean;
function DefaultPosition: Boolean;
function DefaultXName: Boolean;
function DefaultYName: Boolean;
end;
TsChartRegression = class
Title: String;
RegressionType: TsRegressionType;
ExtrapolateForwardBy: Double;
ExtrapolateBackwardBy: Double;
ForceYIntercept: Boolean;
YInterceptValue: Double;
PolynomialDegree: Integer;
DisplayEquation: Boolean;
DisplayRSquare: Boolean;
Equation: TsRegressionEquation;
Line: TsChartLine;
constructor Create;
destructor Destroy; override;
end;
TsScatterSeries = class(TsLineSeries) TsScatterSeries = class(TsLineSeries)
private
FRegression: TsChartRegression;
public public
constructor Create(AChart: TsChart); override; constructor Create(AChart: TsChart); override;
destructor Destroy; override;
property Regression: TsChartRegression read FRegression write FRegression;
end; end;
TsChartSeriesList = class(TFPList) TsChartSeriesList = class(TFPList)
@ -846,6 +887,7 @@ begin
Result := ctRadar; Result := ctRadar;
end; end;
{ TsRingSeries } { TsRingSeries }
constructor TsRingSeries.Create(AChart: TsChart); constructor TsRingSeries.Create(AChart: TsChart);
begin begin
@ -855,12 +897,99 @@ begin
end; end;
{ TsRegressionEquation }
constructor TsRegressionEquation.Create;
begin
inherited Create;
Font := TsFont.Create;
Font.Size := 9;
Border := TsChartLine.Create;
Border.Style := clsNoLine;
Border.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
Border.Color := scBlack;
Fill := TsChartFill.Create;
Fill.FgColor := scWhite;
XName := 'x';
YName := 'f(x)';
end;
destructor TsRegressionEquation.Destroy;
begin
Fill.Free;
Border.Free;
Font.Free;
inherited;
end;
function TsRegressionEquation.DefaultBorder: Boolean;
begin
Result := Border.Style = clsNoLine;
end;
function TsRegressionEquation.DefaultFill: Boolean;
begin
Result := Fill.Style = fsNoFill;
end;
function TsRegressionEquation.DefaultFont: Boolean;
begin
Result := (Font.FontName = '') and (Font.Size = 9) and (Font.Style = []) and
(Font.Color = scBlack);
end;
function TsRegressionEquation.DefaultNumberFormat: Boolean;
begin
Result := NumberFormat = '';
end;
function TsRegressionEquation.DefaultPosition: Boolean;
begin
Result := (Left = 0) and (Top = 0);
end;
function TsRegressionEquation.DefaultXName: Boolean;
begin
Result := XName = 'x';
end;
function TsRegressionEquation.DefaultYName: Boolean;
begin
Result := YName = 'f(x)';
end;
{ TsChartRegression }
constructor TsChartRegression.Create;
begin
inherited Create;
Line := TsChartLine.Create;
Line.Style := clsSolid;
Line.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
Line.Color := scBlack;
Equation := TsRegressionEquation.Create;
end;
destructor TsChartRegression.Destroy;
begin
Line.Free;
inherited;
end;
{ TsScatterSeries } { TsScatterSeries }
constructor TsScatterSeries.Create(AChart: TsChart); constructor TsScatterSeries.Create(AChart: TsChart);
begin begin
inherited Create(AChart); inherited Create(AChart);
FChartType := ctScatter; FChartType := ctScatter;
FRegression := TsChartRegression.Create;
end;
destructor TsScatterSeries.Destroy;
begin
FRegression.Free;
inherited;
end; end;

View File

@ -23,11 +23,19 @@ type
function GetChartBackgroundStyleAsXML(AChart: TsChart; AFill: TsChartFill; function GetChartBackgroundStyleAsXML(AChart: TsChart; AFill: TsChartFill;
ABorder: TsChartLine; AIndent: Integer; AStyleID: Integer): String; ABorder: TsChartLine; AIndent: Integer; AStyleID: Integer): String;
function GetChartCaptionStyleAsXML(AChart: TsChart; ACaptionKind, AIndent, AStyleID: Integer): String; function GetChartCaptionStyleAsXML(AChart: TsChart; ACaptionKind, AIndent, AStyleID: Integer): String;
function GetChartFillStyleGraphicPropsAsXML(AChart: TsChart; AFill: TsChartFill): String; function GetChartFillStyleGraphicPropsAsXML(AChart: TsChart;
function GetChartLegendStyleAsXML(AChart: TsChart; AIndent, AStyleID: Integer): String; AFill: TsChartFill): String;
function GetChartLineStyleAsXML(AChart: TsChart; ALine: TsChartLine; AIndent, AStyleID: Integer): String; function GetChartLegendStyleAsXML(AChart: TsChart;
function GetChartLineStyleGraphicPropsAsXML(AChart: TsChart; ALine: TsChartLine): String; AIndent, AStyleID: Integer): String;
function GetChartPlotAreaStyleAsXML(AChart: TsChart; AIndent, AStyleID: Integer): String; function GetChartLineStyleAsXML(AChart: TsChart;
ALine: TsChartLine; AIndent, AStyleID: Integer): String;
function GetChartLineStyleGraphicPropsAsXML(AChart: TsChart;
ALine: TsChartLine): String;
function GetChartPlotAreaStyleAsXML(AChart: TsChart;
AIndent, AStyleID: Integer): String;
function GetChartRegressionEquationStyleAsXML(AChart: TsChart;
AEquation: TsRegressionEquation; AIndent, AStyleID: Integer): String;
function GetChartRegressionStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: Integer): String;
function GetChartSeriesStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: integer): String; function GetChartSeriesStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: integer): String;
// function GetChartTitleStyleAsXML(AChart: TsChart; AStyleIndex, AIndent: Integer): String; // function GetChartTitleStyleAsXML(AChart: TsChart; AStyleIndex, AIndent: Integer): String;
procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet); procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
@ -525,6 +533,100 @@ begin
indent + ' </style:style>' + LE; indent + ' </style:style>' + LE;
end; end;
function TsSpreadOpenDocChartWriter.GetChartRegressionEquationStyleAsXML(
AChart: TsChart; AEquation: TsRegressionEquation; AIndent, AStyleID: Integer): String;
var
indent: String;
numStyle: String = 'N0';
chartprops: String = '';
lineprops: String = '';
fillprops: String = '';
textprops: String = '';
begin
Result := '';
indent := DupeString(' ', AIndent);
// TO DO: Create chart number style list and find the current style there!
if not AEquation.DefaultNumberFormat then
numStyle := 'N0';
if not AEquation.DefaultXName then
chartprops := chartprops + Format('loext:regression-x-name="%s" ', [AEquation.XName]);
if not AEquation.DefaultYName then
chartprops := chartprops + Format('loext:regression-y-name="%s" ', [AEquation.YName]) ;
if not AEquation.DefaultBorder then
lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, AEquation.Border);
if not AEquation.DefaultFill then
fillProps := GetChartFillStyleGraphicPropsAsXML(AChart, AEquation.Fill);
if not AEquation.DefaultFont then
textprops := TsSpreadOpenDocWriter(Writer).WriteFontStyleXMLAsString(AEquation.Font);
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="%s">' + LE +
indent + ' <style:chart-properties %s/>' + LE +
indent + ' <style:graphic-properties %s/>' + LE +
indent + ' <style:text-properties %s/>' + LE +
indent + '</style:style>' + LE,
[ AStyleID, numStyle, chartprops, fillprops + lineprops, textprops ]
);
end;
function TsSpreadOpenDocChartWriter.GetChartRegressionStyleAsXML(AChart: TsChart;
ASeriesIndex, AIndent, AStyleID: Integer): String;
const
REGRESSION_TYPE: array [TsRegressionType] of string = (
'', 'linear', 'logarithmic', 'exponential', 'power', 'polynomial');
var
series: TsScatterSeries;
indent: String;
chartProps: String = '';
graphProps: String = '';
textProps: String = '';
lineProps: String = '';
fillProps: String = '';
labelSeparator: String = '';
begin
Result := '';
series := AChart.Series[ASeriesIndex] as TsScatterSeries;
if series.Regression.RegressionType = rtNone then
exit;
indent := DupeString(' ', AIndent);
chartprops := Format(
'chart:regression-name="%s" ' +
'chart:regression-type="%s" ' +
'chart:regression-extrapolate-forward="%g" ' +
'chart:regression-extrapolate-backward="%g" ' +
'chart:regression-force-intercept="%s" ' +
'chart:regression-intercept-value="%g" ' +
'chart:regression-max-degree="%d" ',
[ series.Regression.Title,
REGRESSION_TYPE[series.Regression.RegressionType] ,
series.Regression.ExtrapolateForwardBy,
series.Regression.ExtrapolateBackwardBy,
FALSE_TRUE[series.Regression.ForceYIntercept],
series.Regression.YInterceptValue,
series.Regression.PolynomialDegree
], FPointSeparatorSettings
);
graphprops := GetChartLineStyleGraphicPropsAsXML(AChart, series.Regression.Line);
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart"> ' + LE +
indent + ' <style:chart-properties %s/>' + LE +
indent + ' <style:graphic-properties %s/>' + LE +
indent + '</style:style>' + LE,
[ AStyleID, chartprops, graphprops ]
);
end;
{ <style:style style:name="ch1400" style:family="chart" style:data-style-name="N0"> { <style:style style:name="ch1400" style:family="chart" style:data-style-name="N0">
<style:chart-properties <style:chart-properties
chart:symbol-type="named-symbol" chart:symbol-type="named-symbol"
@ -617,7 +719,9 @@ begin
if lineSer.ShowSymbols then if lineSer.ShowSymbols then
graphProps := graphProps + fillProps; graphProps := graphProps + fillProps;
if lineSer.ShowLines and (lineser.Line.Style <> clsNoLine) then if lineSer.ShowLines and (lineser.Line.Style <> clsNoLine) then
graphProps := graphProps + lineProps; graphProps := graphProps + lineProps
else
graphProps := graphProps + 'draw:stroke="none" ';
end else end else
graphProps := fillProps + lineProps; graphProps := fillProps + lineProps;
@ -1294,6 +1398,10 @@ var
domainRangeY: String = ''; domainRangeY: String = '';
fillColorRange: String = ''; fillColorRange: String = '';
chartClass: String = ''; chartClass: String = '';
regressionEquation: String = '';
needRegressionStyle: Boolean = false;
needRegressionEquationStyle: Boolean = false;
regression: TsChartRegression = nil;
titleAddr: String; titleAddr: String;
count: Integer; count: Integer;
begin begin
@ -1366,10 +1474,10 @@ begin
// Store the series properties // Store the series properties
AppendToStream(AChartStream, Format( AppendToStream(AChartStream, Format(
indent + '<chart:series chart:style-name="ch%d" ' + indent + '<chart:series chart:style-name="ch%d" ' +
'chart:class="chart:%s" ' + // series type
'chart:values-cell-range-address="%s" ' + // y values 'chart:values-cell-range-address="%s" ' + // y values
'chart:label-cell-address="%s" ' + // series title 'chart:label-cell-address="%s">' + LE, // series title
'chart:class="chart:%s">' + LE, [ AStyleID, chartClass, valuesRange, titleAddr, chartClass ]
[ AStyleID, valuesRange, titleAddr, chartClass ]
)); ));
if domainRangeY <> '' then if domainRangeY <> '' then
AppendToStream(AChartStream, Format( AppendToStream(AChartStream, Format(
@ -1390,11 +1498,57 @@ begin
{ --- not working... { --- not working...
if borderColorRange <> '' then if borderColorRange <> '' then
AppendToStream(AChartStream, Format( AppendToStream(AChartStream, Format(
indent + '<loext:propertry-mapping loext:property="BorderColor" loext:cell-range-address="%s"/>' + LE, indent + '<loext:property-mapping loext:property="BorderColor" loext:cell-range-address="%s"/>' + LE,
[ borderColorRange ] [ borderColorRange ]
)); ));
} }
// Regression
if (series is TsScatterSeries) then
begin
regression := TsScatterSeries(series).Regression;
if regression.RegressionType <> rtNone then
begin
if regression.DisplayEquation or regression.DisplayRSquare then
begin
if (not regression.Equation.DefaultXName) or (not regression.Equation.DefaultYName) or
(not regression.Equation.DefaultBorder) or (not regression.Equation.DefaultFill) or
(not regression.Equation.DefaultFont) or (not regression.Equation.DefaultNumberFormat) or
(not regression.Equation.DefaultPosition) then
begin
regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [AStyleID + 2]);
needRegressionEquationStyle := true;
end;
end;
if regression.DisplayEquation then
regressionEquation := regressionEquation + 'chart:display-equation="true" ';
if regression.DisplayRSquare then
regressionEquation := regressionEquation + 'chart:display-r-square="true" ';
if regressionEquation <> '' then
begin
if not regression.Equation.DefaultPosition then
regressionEquation := regressionEquation + Format(
'svg:x="%.2fmm" svg:y="%.2fmm" ',
[ regression.Equation.Left, regression.Equation.Top ],
FPointSeparatorSettings
);
AppendToStream(AChartStream, Format(
indent + ' <chart:regression-curve chart:style-name="ch%d">' + LE +
indent + ' <chart:equation %s />' + LE +
indent + ' </chart:regression-curve>' + LE,
[ AStyleID + 1, regressionEquation ]
))
end else
AppendToStream(AChartStream, Format(
indent + ' <chart:regression-curve chart:style-name="ch%d"/>',
[ AStyleID + 1 ]
));
needRegressionStyle := true;
end;
end;
AppendToStream(AChartStream, Format( AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:repeated="%d"/>' + LE, indent + ' <chart:data-point chart:repeated="%d"/>' + LE,
[ count ] [ count ]
@ -1408,6 +1562,24 @@ begin
GetChartSeriesStyleAsXML(AChart, ASeriesIndex, AStyleIndent, AStyleID) GetChartSeriesStyleAsXML(AChart, ASeriesIndex, AStyleIndent, AStyleID)
); );
// Regression style
if needRegressionStyle then
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartRegressionStyleAsXML(AChart, ASeriesIndex, AStyleIndent, AStyleID)
);
// Style of regression equation
if needRegressionEquationStyle then
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartRegressionEquationStyleAsXML(AChart, regression.Equation, AStyleIndent, AStyleID)
);
end;
end;
// Next style // Next style
inc(AStyleID); inc(AStyleID);
end; end;