Skip to content

Commit 0bfd896

Browse files
delphidabblerdelphidabbler
committed
Add 6 geometric mean routines to Maths category
Added Integer, Cardinal and Double overloads of both GeoMean and WeightedGeoMean functions. Added source code file for each routine. Added meta data about each function to maths.ini
1 parent 9e17171 commit 0bfd896

File tree

7 files changed

+146
-0
lines changed

7 files changed

+146
-0
lines changed

‎collection/675.dat

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
function GeoMean(const A: array of Double): Double; overload;
2+
begin
3+
if System.Length(A) = 0 then
4+
raise SysUtils.EArgumentException.Create('Array is empty');
5+
Result := System.Exp(SumOfLogs(A) / System.Length(A));
6+
end;

‎collection/676.dat

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
function GeoMean(const A: array of Cardinal): Double; overload;
2+
begin
3+
if System.Length(A) = 0 then
4+
raise SysUtils.EArgumentException.Create('Array is empty');
5+
Result := System.Exp(SumOfLogs(A) / System.Length(A));
6+
end;

‎collection/677.dat

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
function GeoMean(const A: array of Integer): Double; overload;
2+
begin
3+
if System.Length(A) = 0 then
4+
raise SysUtils.EArgumentException.Create('Array is empty');
5+
Result := System.Exp(SumOfLogs(A) / System.Length(A));
6+
end;

‎collection/678.dat

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
function WeightedGeoMean(const Values: array of Double;
2+
const Weights: array of Double): Double; overload;
3+
var
4+
Sum: Double;
5+
Idx: Integer;
6+
NormalisedWeights: Types.TDoubleDynArray;
7+
begin
8+
if System.Length(Values) = 0 then
9+
raise SysUtils.EArgumentException.Create('Array of values is empty');
10+
if System.Length(Values) <> System.Length(Weights) then
11+
raise SysUtils.EArgumentException.Create(
12+
'Number of values and number of weights must be the same'
13+
);
14+
NormalisedWeights := NormaliseByWeight(Weights);
15+
Sum := 0.0;
16+
for Idx := 0 to Pred(System.Length(Values)) do
17+
Sum := Sum + NormalisedWeights[Idx] * System.Ln(Values[Idx]);
18+
Result := System.Exp(Sum);
19+
end;

‎collection/679.dat

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
function WeightedGeoMean(const Values: array of Cardinal;
2+
const Weights: array of Double): Double; overload;
3+
var
4+
Idx: Integer;
5+
FloatValues: Types.TDoubleDynArray;
6+
begin
7+
System.Setlength(FloatValues, System.Length(Values));
8+
for Idx := 0 to Pred(System.Length(Values)) do
9+
FloatValues[Idx] := Values[Idx];
10+
Result := WeightedGeoMean(FloatValues, Weights);
11+
end;

‎collection/680.dat

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
function WeightedGeoMean(const Values: array of Integer;
2+
const Weights: array of Double): Double; overload;
3+
var
4+
Idx: Integer;
5+
FloatValues: Types.TDoubleDynArray;
6+
begin
7+
System.Setlength(FloatValues, System.Length(Values));
8+
for Idx := 0 to Pred(System.Length(Values)) do
9+
FloatValues[Idx] := Values[Idx];
10+
Result := WeightedGeoMean(FloatValues, Weights);
11+
end;

‎collection/maths.ini

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2004,3 +2004,90 @@ AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tes
20042004
Snip=673.dat
20052005
DelphiXE=Y
20062006
Delphi12A=Y
2007+
2008+
[GeoMean_Double]
2009+
DisplayName="GeoMean (Double overload)"
2010+
DescEx="<p>Returns the geometric mean of an array of positive <var>Double</var> values.</p><p><var>EArgumentException</var> is raised if the array is empty while <var>EArgumentOutOfRangeException</var> is raised if any array element is not positive.</p>"
2011+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Geometric_mean">Wikipedia</a> for information about the geometric mean.</p>"
2012+
Kind=routine
2013+
Units=SysUtils
2014+
Depends=SumOfLogs_Double
2015+
SeeAlso=ArithMean_Double,GeoMean_Integer,GeoMean_Cardinal,WeightedGeoMean_Double
2016+
TestInfo=advanced
2017+
AdvancedTest.Level=unit-tests
2018+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2019+
Snip=675.dat
2020+
DelphiXE=Y
2021+
Delphi12A=Y
2022+
2023+
[GeoMean_Cardinal]
2024+
DisplayName="GeoMean (Cardinal overload)"
2025+
DescEx="<p>Returns the geometric mean of an array of positive <var>Cardinal</var> values.</p><p><var>EArgumentException</var> is raised if the array is empty while <var>EArgumentOutOfRangeException</var> is raised if any array element is not positive.</p>"
2026+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Geometric_mean">Wikipedia</a> for information about the geometric mean.</p>"
2027+
Kind=routine
2028+
Units=SysUtils
2029+
Depends=SumOfLogs_Cardinal
2030+
SeeAlso=ArithMean_Cardinal,GeoMean_Integer,GeoMean_Double,WeightedGeoMean_Cardinal
2031+
TestInfo=advanced
2032+
AdvancedTest.Level=unit-tests
2033+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2034+
Snip=676.dat
2035+
DelphiXE=Y
2036+
Delphi12A=Y
2037+
2038+
[GeoMean_Integer]
2039+
DisplayName="GeoMean (Integer overload)"
2040+
DescEx="<p>Returns the geometric mean of an array of positive <var>Integer</var> values.</p><p><var>EArgumentException</var> is raised if the array is empty while <var>EArgumentOutOfRangeException</var> is raised if any array element is not positive.</p>"
2041+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Geometric_mean">Wikipedia</a> for information about the geometric mean.</p>"
2042+
Kind=routine
2043+
Units=SysUtils
2044+
Depends=SumOfLogs_Integer
2045+
SeeAlso=ArithMean_Integer,GeoMean_Cardinal,GeoMean_Double,WeightedGeoMean_Integer
2046+
TestInfo=advanced
2047+
AdvancedTest.Level=unit-tests
2048+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2049+
Snip=677.dat
2050+
DelphiXE=Y
2051+
Delphi12A=Y
2052+
2053+
[WeightedGeoMean_Double]
2054+
DisplayName="WeightedGeoMean (Double overload)"
2055+
DescEx="<p>Calculates and returns the weighted geometric mean of the array <var>Value</var> of positive <var>Double</var> values where each element is weighted by the corresponding element in the array <var>Weights</var>.</p><p>An <var>EArgumentException</var> exception is raised if any of the following pre-conditions are not met: <var>Values</var> must be non-empty; all elements of <var>Values</var> must be positive; <var>Values</var> &amp; <var>Weights</var> must have the same number of elements; all elements of <var>Weights</var> must be non-negative, with at least one element being non-zero.</p>"
2056+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Weighted_geometric_mean">Wikipedia</a> for information about the weighted geometric mean.</p>"
2057+
Units=SysUtils,Types
2058+
Depends=NormaliseByWeight_Double
2059+
SeeAlso=GeoMean_Double,WeightedArithMean_Double,WeightedGeoMean_Cardinal,WeightedGeoMean_Integer
2060+
TestInfo=advanced
2061+
AdvancedTest.Level=unit-tests
2062+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2063+
Snip=678.dat
2064+
DelphiXE=Y
2065+
Delphi12A=Y
2066+
2067+
[WeightedGeoMean_Cardinal]
2068+
DisplayName="WeightedGeoMean (Cardinal overload)"
2069+
DescEx="<p>Calculates and returns the weighted geometric mean of the array <var>Value</var> of positive <var>Cardinal</var> values where each element is weighted by the corresponding element in the array <var>Weights</var>.</p><p>An <var>EArgumentException</var> exception is raised if any of the following pre-conditions are not met: <var>Values</var> must be non-empty; all elements of <var>Values</var> must be positive; <var>Values</var> &amp; <var>Weights</var> must have the same number of elements; all elements of <var>Weights</var> must be non-negative, with at least one element being non-zero.</p>"
2070+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Weighted_geometric_mean">Wikipedia</a> for information about the weighted geometric mean.</p>"
2071+
Units=Types
2072+
Depends=WeightedGeoMean_Double
2073+
SeeAlso=GeoMean_Cardinal,WeightedArithMean_Cardinal,WeightedGeoMean_Double,WeightedGeoMean_Integer
2074+
TestInfo=advanced
2075+
AdvancedTest.Level=unit-tests
2076+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2077+
Snip=679.dat
2078+
DelphiXE=Y
2079+
Delphi12A=Y
2080+
2081+
[WeightedGeoMean_Integer]
2082+
DisplayName="WeightedGeoMean (Integer overload)"
2083+
DescEx="<p>Calculates and returns the weighted geometric mean of the array <var>Value</var> of positive <var>Integer</var> values where each element is weighted by the corresponding element in the array <var>Weights</var>.</p><p>An <var>EArgumentException</var> exception is raised if any of the following pre-conditions are not met: <var>Values</var> must be non-empty; all elements of <var>Values</var> must be positive; <var>Values</var> &amp; <var>Weights</var> must have the same number of elements; all elements of <var>Weights</var> must be non-negative, with at least one element being non-zero.</p>"
2084+
Extra="<p>See <a href="https://en.m.wikipedia.org/wiki/Weighted_geometric_mean">Wikipedia</a> for information about the weighted geometric mean.</p>"
2085+
Units=Types
2086+
Depends=WeightedGeoMean_Double
2087+
SeeAlso=GeoMean_Integer,WeightedArithMean_Integer,WeightedGeoMean_Double,WeightedGeoMean_Cardinal
2088+
TestInfo=advanced
2089+
AdvancedTest.Level=unit-tests
2090+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
2091+
Snip=680.dat
2092+
DelphiXE=Y
2093+
Delphi12A=Y

0 commit comments

Comments
 (0)