Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit cfadac8

Browse files
Merge branch 'feature/17-count+sum-digits-in-specified-bases' into develop
Fixes #17 
2 parents a19dc9e + f160496 commit cfadac8

File tree

6 files changed

+322
-10
lines changed

6 files changed

+322
-10
lines changed

‎collection/657.dat

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
function DigitSumBase(N: Int64; const Base: Byte): Integer;
2+
var
3+
SignOfN: Math.TValueSign;
4+
begin
5+
if Base < 2 then
6+
raise SysUtils.EArgumentException.Create(
7+
'Base must be in the range 2..255'
8+
);
9+
if N = 0 then
10+
Exit(0);
11+
SignOfN := Math.Sign(N);
12+
N := Abs(N);
13+
Result := 0;
14+
repeat
15+
Inc(Result, N mod Base);
16+
N := N div Base;
17+
until N = 0;
18+
if SignOfN = Math.NegativeValue then
19+
Result := -1 * Result;
20+
end;

‎collection/658.dat

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
function DigitCountBase(N: Int64; const Base: Byte): Cardinal;
2+
begin
3+
if Base < 2 then
4+
raise SysUtils.EArgumentException.Create(
5+
'Base must be in the range 2..255'
6+
);
7+
if N = 0 then
8+
Exit(1);
9+
N := Abs(N);
10+
Result := 0;
11+
repeat
12+
Inc(Result);
13+
N := N div Base;
14+
until N = 0;
15+
end;

‎collection/659.dat

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
function DigitsOf(N: Int64; const Base: Byte): SysUtils.TBytes;
2+
var
3+
Idx: Integer;
4+
begin
5+
if Base < 2 then
6+
raise SysUtils.EArgumentException.Create(
7+
'Base must be in the range 2..255'
8+
);
9+
N := Abs(N);
10+
SetLength(Result, DigitCountBase(N, Base));
11+
if N > 0 then
12+
begin
13+
Idx := 0;
14+
repeat
15+
Result[Idx] := N mod Base;
16+
Inc(Idx);
17+
N := N div Base;
18+
until N = 0;
19+
end
20+
else
21+
Result[0] := 0;
22+
end;

‎collection/maths.ini

Lines changed: 45 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,7 @@ Delphi12A=Y
141141
[DigitCount]
142142
DescEx="<p>Counts the number of digits in the given integer.</p>"
143143
Extra="<p>Contributed by Bill Miller.</p>"
144-
SeeAlso=DigitCount2,DigitCountR
144+
SeeAlso=DigitCount2,DigitCountR,DigitCountBase
145145
TestInfo=advanced
146146
AdvancedTest.Level=unit-tests
147147
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
@@ -168,7 +168,7 @@ FPC=Y
168168
DescEx="<p>Counts the number of digits in the given integer.</p>"
169169
Extra="<p>Based on code suggested by Don Rowlett.</p>"
170170
Units=Math
171-
SeeAlso=DigitCount,DigitCountR
171+
SeeAlso=DigitCount,DigitCountR,DigitCountBase
172172
TestInfo=advanced
173173
AdvancedTest.Level=unit-tests
174174
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
@@ -194,7 +194,7 @@ FPC=Y
194194
[DigitCountR]
195195
DescEx="<p>Counts the number of digits in the given integer using recursion.</p>"
196196
Extra="<p>Contributed by Rubem Nascimento da Rocha.</p>"
197-
SeeAlso=DigitCount,DigitCount2
197+
SeeAlso=DigitCount,DigitCount2,DigitCountBase
198198
TestInfo=advanced
199199
AdvancedTest.Level=unit-tests
200200
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
@@ -620,6 +620,7 @@ Extra="<p>Sums of digits of negative numbers are negative, for example <mono>Dig
620620
TestInfo=advanced
621621
AdvancedTest.Level=unit-tests
622622
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
623+
SeeAlso=DigitSumBase
623624
Snip=418.dat
624625
Delphi2=N
625626
Delphi3=N
@@ -1755,3 +1756,44 @@ AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tes
17551756
Snip=655.dat
17561757
DelphiXE=Y
17571758
Delphi12A=Y
1759+
1760+
[DigitSumBase]
1761+
DisplayName="DigitSumBase"
1762+
DescEx="<p>Calculates the sum of all the digits of integer <var>N</var> when epxressed in base <var>Base</var>. The returned value has the same sign as <var>N</var>.</p><p>Bases up to 255 are supported. If <var>Base</var> &lt; 2 then an <var>EArgumentException</var> exception is raised.</p>"
1763+
Kind=routine
1764+
Units=SysUtils,Math
1765+
SeeAlso=DigitSum
1766+
TestInfo=advanced
1767+
AdvancedTest.Level=unit-tests
1768+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
1769+
Snip=657.dat
1770+
DelphiXE=Y
1771+
Delphi12A=Y
1772+
1773+
[DigitCountBase]
1774+
DisplayName="DigitCountBase"
1775+
DescEx="<p>Returns the number of digits in integer <var>N</var> when expressed in base <var>Base</var>.</p><p>Bases up to 255 are supported. If <var>Base</var> &lt; 2 then an <var>EArgumentException</var> exception is raised.</p>"
1776+
Extra="<p>The number of digits of an integer <em>n</em> &gt; 0 in base <em>b</em> &gt;= 2 can be expressed mathematically as:</p><p><mono>floor(log<em>b</em>(<em>n</em>)) + 1</mono></p><p>Unfortunately testing a Pascal implementation of this formula failed on some tests, e.g. <mono>DigitCount($FFFFFFFF,16)</mono>. This was probably due to floating point rounding errors. Therefore this implementation using only integer operations was used instead.</p>"
1777+
Kind=routine
1778+
Units=SysUtils
1779+
SeeAlso=DigitCount,DigitCount2,DigitCountR
1780+
TestInfo=advanced
1781+
AdvancedTest.Level=unit-tests
1782+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
1783+
Snip=658.dat
1784+
DelphiXE=Y
1785+
Delphi12A=Y
1786+
1787+
[DigitsOf]
1788+
DisplayName=DigitsOf
1789+
DescEx="<p>Returns an array containing the digits of integer <var>N</var> when expressed in base <var>Base</var>. The array is ordered with the least significant digit first.</p><p>The returned array contains the <em>decimal value</em> of the digit, for e.g. the hex symbol <em>F</em> is represented by an array element containing the value <em>15</em>.</p><p>Bases up to 255 are supported. If <var>Base</var> &lt; 2 then an <var>EArgumentException</var> exception is raised.</p>"
1790+
Extra="<p>Examples:</p><p>1. <mono>DigitsOf($FACE,16)</mono> returns <mono>[15,10,12,14]</mono></p><p>2. <mono>DigitsOf(12,8)</mono> returns <mono>[1,4]</mono></p><p>3. <mono>DigitsOf(6,2)</mono> returns <mono>[1,1,0]</mono></p><p>4. <mono>DigitsOf(6,10)</mono> returns <mono>[6]</mono></p><p>5. <mono>DigitsOf(0,8)</mono> returns <mono>[0]</mono></p>"
1791+
Kind=routine
1792+
Units=SysUtils
1793+
Depends=DigitCountBase
1794+
TestInfo=advanced
1795+
AdvancedTest.Level=unit-tests
1796+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
1797+
Snip=659.dat
1798+
DelphiXE=Y
1799+
Delphi12A=Y

‎tests/Cat-Maths/TestUMathsCatSnippets.pas

Lines changed: 115 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
interface
44

55
uses
6-
Types, Math, TestFramework, UMathsCatSnippets;
6+
Types, Math, SysUtils, TestFramework, UMathsCatSnippets;
77

88
type
99
TestMathsCatSnippets = class(TTestCase)
@@ -18,7 +18,10 @@ TestMathsCatSnippets = class(TTestCase)
1818
procedure TestWeightedArithMean_Double_Except2;
1919
procedure TestWeightedArithMean_Double_Except3;
2020
procedure TestWeightedArithMean_Double_Except4;
21-
21+
procedure TestDigitSumBase_Except;
22+
procedure TestDigitsOf_ArgExcept;
23+
function EqualArrays(const Left, Right: TBytes): Boolean;
24+
function ReverseArray(const A: TBytes): TBytes;
2225
published
2326
procedure TestDigitCount;
2427
procedure TestDigitCount2;
@@ -68,17 +71,16 @@ TestMathsCatSnippets = class(TTestCase)
6871
procedure TestArithMean_Integer;
6972
procedure TestArithMean_Cardinal;
7073
procedure TestArithMean_Double;
71-
7274
procedure TestWeightedArithMean_Integer;
7375
procedure TestWeightedArithMean_Cardinal;
7476
procedure TestWeightedArithMean_Double;
77+
procedure TestDigitCountBase;
78+
procedure TestDigitSumBase;
79+
procedure TestDigitsOf;
7580
end;
7681

7782
implementation
7883

79-
uses
80-
SysUtils;
81-
8284
const
8385
First100Primes: array[1..100] of Int64 = (
8486
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
@@ -185,6 +187,27 @@ function RectHeight(const Rect: TRect): Integer;
185187

186188
{ TestMathsCatSnippets }
187189

190+
function TestMathsCatSnippets.EqualArrays(const Left, Right: TBytes): Boolean;
191+
var
192+
Idx: Integer;
193+
begin
194+
Result := True;
195+
if Length(Left) <> Length(Right) then
196+
Exit(False);
197+
for Idx := Low(Left) to High(Left) do
198+
if Left[Idx] <> Right[Idx] then
199+
Exit(False);
200+
end;
201+
202+
function TestMathsCatSnippets.ReverseArray(const A: TBytes): TBytes;
203+
var
204+
I: Integer;
205+
begin
206+
SetLength(Result, Length(A));
207+
for I := 0 to High(A) do
208+
Result[High(A)-I] := A[I];
209+
end;
210+
188211
procedure TestMathsCatSnippets.StretchRect_A_Except1;
189212
var
190213
R0, R1: TRect;
@@ -364,6 +387,23 @@ procedure TestMathsCatSnippets.TestDigitCount2;
364387
CheckEquals(5, DigitCount2(-12345), 'DigitCount2(-12345)');
365388
end;
366389

390+
procedure TestMathsCatSnippets.TestDigitCountBase;
391+
begin
392+
CheckEquals(1, DigitCountBase(0, 10), '0 base 10');
393+
CheckEquals(1, DigitCountBase(1, 10), '1 base 10');
394+
CheckEquals(2, DigitCountBase(9, 8), '9 base 8');
395+
CheckEquals(2, DigitCountBase(-9, 8), '9 base 8');
396+
CheckEquals(2, DigitCountBase(9, 7), '9 base 7');
397+
CheckEquals(1, DigitCountBase(9, 16), '9 base 16');
398+
CheckEquals(2, DigitCountBase(12, 10), '12 base 10');
399+
CheckEquals(4, DigitCountBase(12, 2), '12 base 2');
400+
CheckEquals(5, DigitCountBase(123456, 16), '123456 base 16');
401+
CheckEquals(11, DigitCountBase(1234567890, 8), '1234567890 base 8');
402+
CheckEquals(2, DigitCountBase(256, 255), '256 base 255');
403+
CheckEquals(9, DigitCountBase(-429981696, 12), '-429981696 base 12');
404+
CheckEquals(8, DigitCountBase($FFFFFFFF, 16), '$FFFFFFFF base 16');
405+
end;
406+
367407
procedure TestMathsCatSnippets.TestDigitCountR;
368408
begin
369409
CheckEquals(1, DigitCountR(0), 'DigitCountR(0)');
@@ -376,6 +416,57 @@ procedure TestMathsCatSnippets.TestDigitCountR;
376416
CheckEquals(5, DigitCountR(-12345), 'DigitCountR(-12345)');
377417
end;
378418

419+
procedure TestMathsCatSnippets.TestDigitsOf;
420+
var
421+
E: TBytes;
422+
begin
423+
E := TBytes.Create(0);
424+
CheckTrue(EqualArrays(E, DigitsOf(0, 10)), '0, base 10');
425+
CheckTrue(EqualArrays(E, DigitsOf(0, 16)), '0, base 16');
426+
E := ReverseArray(TBytes.Create(3, 6, 5, 7, 0, 4, 2, 1, 0));
427+
CheckTrue(EqualArrays(E, DigitsOf(365704210, 10)), '365704210, base 10');
428+
E := ReverseArray(TBytes.Create(1, 5, $C, $C, 3, 4, 1, 2));
429+
CheckTrue(EqualArrays(E, DigitsOf(365704210, 16)), '365704210, base 16');
430+
E := ReverseArray(TBytes.Create({0,0,0}1, 0,1,0,1, 1,1,0,0, 1,1,0,0, 0,0,1,1, 0,1,0,0, 0,0,0,1, 0,0,1,0));
431+
CheckTrue(EqualArrays(E, DigitsOf(365704210, 2)), '365704210, base 2');
432+
E := TBytes.Create(7);
433+
CheckTrue(EqualArrays(E, DigitsOf(7, 8)), '7, base 8');
434+
E := ReverseArray(TBytes.Create(1,3));
435+
CheckTrue(EqualArrays(E, DigitsOf(7, 4)), '7, base 4');
436+
E := ReverseArray(TBytes.Create(1,6));
437+
CheckTrue(EqualArrays(E, DigitsOf(16, 10)), '16, base 10');
438+
E := ReverseArray(TBytes.Create(1,0));
439+
CheckTrue(EqualArrays(E, DigitsOf(16, 16)), '16, base 16');
440+
E := TBytes.Create(16);
441+
CheckTrue(EqualArrays(E, DigitsOf(16, 32)), '16, base 32');
442+
E := ReverseArray(TBytes.Create(1,5));
443+
CheckTrue(EqualArrays(E, DigitsOf(15, 10)), '15, base 10');
444+
E := TBytes.Create(15);
445+
CheckTrue(EqualArrays(E, DigitsOf(15, 16)), '15, base 16');
446+
E := TBytes.Create(3);
447+
CheckTrue(EqualArrays(E, DigitsOf(3, 10)), '3, base 10');
448+
E := ReverseArray(TBytes.Create(1,0));
449+
CheckTrue(EqualArrays(E, DigitsOf(3, 3)), '3, base 3');
450+
E := ReverseArray(TBytes.Create(1,1));
451+
CheckTrue(EqualArrays(E, DigitsOf(3, 2)), '3, base 2');
452+
E := ReverseArray(TBytes.Create(1,254));
453+
CheckTrue(EqualArrays(E, DigitsOf(509, 255)), '509, base 255');
454+
E := ReverseArray(TBytes.Create(4,2,9,4,9,6,7,2,9,5));
455+
CheckTrue(EqualArrays(E, DigitsOf(4294967295, 10)), 'High(Cardinal), base 10');
456+
E := TBytes.Create($f,$f,$f,$f,$f,$f,$f,$f);
457+
CheckTrue(EqualArrays(E, DigitsOf($FFFFFFFF, 16)), 'High(Cardinal), base 16');
458+
E := ReverseArray(TBytes.Create(4,7,6,8,7,3,6,2));
459+
CheckTrue(EqualArrays(E, DigitsOf(-47687362, 10)), '-47687362, base 10');
460+
E := TBytes.Create(1,1);
461+
CheckTrue(EqualArrays(E, DigitsOf(-17, 16)), '-17, base 16');
462+
CheckException(TestDigitsOf_ArgExcept, EArgumentException, 'Argument Exception');
463+
end;
464+
465+
procedure TestMathsCatSnippets.TestDigitsOf_ArgExcept;
466+
begin
467+
DigitsOf(2345, 0);
468+
end;
469+
379470
procedure TestMathsCatSnippets.TestDigitSum;
380471
begin
381472
CheckEquals(0, DigitSum(0), 'DigitSum(0)');
@@ -392,6 +483,24 @@ procedure TestMathsCatSnippets.TestDigitSum;
392483
CheckEquals(-9, DigitSum(-9), 'DigitSum(-9)');
393484
end;
394485

486+
procedure TestMathsCatSnippets.TestDigitSumBase;
487+
begin
488+
CheckEquals(6, DigitSumBase(123, 10), '123 base 10');
489+
CheckEquals(18, DigitSumBase(123, 16), '123 base 16 (7B)');
490+
CheckEquals(6, DigitSumBase(123, 2), '123 base 2 (0111 1011)');
491+
CheckEquals(7, DigitSumBase(1785, 255), '1785 base 255 (70)');
492+
CheckEquals(17, DigitSumBase(512, 100), '512 base 100 (5,12)');
493+
CheckEquals(0, DigitSumBase(0, 32), '0 base 32');
494+
CheckEquals(8*$f, DigitSumBase($FFFFFFFF, 16), '$FFFFFFFF base 16');
495+
CheckEquals(-45, DigitSumBase(-9876543210, 10), '-9876543210 base 10');
496+
CheckException(TestDigitSumBase_Except, EArgumentException, 'Err: base 1');
497+
end;
498+
499+
procedure TestMathsCatSnippets.TestDigitSumBase_Except;
500+
begin
501+
DigitSumBase(42, 1);
502+
end;
503+
395504
procedure TestMathsCatSnippets.TestGCD;
396505
begin
397506
CheckEquals(1, GCD(1,1), 'GCD(1,1)');

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /