Skip to content

Commit ae999a7

Browse files
delphidabblerdelphidabbler
committed
Add tests for 2 new new Maths functions
Added unit tests for IsPalindromic and IsNarcissistic functions to TestUMathsCatSnippets unit. Regenerated UMathsCatSnippets using CodeSnip to include the new functions.
1 parent bdaae99 commit ae999a7

File tree

2 files changed

+191
-3
lines changed

2 files changed

+191
-3
lines changed

‎tests/Cat-Maths/TestUMathsCatSnippets.pas‎

Lines changed: 139 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -77,10 +77,12 @@ TestMathsCatSnippets = class(TTestCase)
7777
procedure TestWeightedArithMean_Integer;
7878
procedure TestWeightedArithMean_Cardinal;
7979
procedure TestWeightedArithMean_Double;
80-
procedure TestDigitCountBase;
80+
procedure TestDigitCountBase; // required by DigitsOf, IsNarcissistic
8181
procedure TestDigitSumBase;
8282
procedure TestDigitsOf;
83-
procedure TestDigitPowerSum;
83+
procedure TestDigitPowerSum; // required by IsNarcissistic
84+
procedure TestIsPalindromic;
85+
procedure TestIsNarcissistic;
8486
end;
8587

8688
implementation
@@ -564,6 +566,141 @@ procedure TestMathsCatSnippets.TestGCD2;
564566
CheckEquals(10, GCD2(10, -10), 'GCD2(10, -10)');
565567
end;
566568

569+
procedure TestMathsCatSnippets.TestIsNarcissistic;
570+
const
571+
NarcNumsBase10: array[1..25] of Integer = (
572+
// Source: https://rosettacode.org/wiki/Narcissistic_decimal_number
573+
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 153, 370, 371, 407, 1634, 8208, 9474, 54748,
574+
92727, 93084, 548834, 1741725, 4210818, 9800817, 9926315
575+
);
576+
// Following all sourced from https://en.wikipedia.org/wiki/Narcissistic_number
577+
// and bases converted to decimal
578+
NarcNumsBase2: array[1..2] of Integer = (0, 1);
579+
NarcNumsBase3: array[1..6] of Integer = (0, 1, 2, 5, 8, 17);
580+
NarcNumsBase4: array[1..12] of Integer = (
581+
0, 1, 2, 3, 28, 29, 35, 43, 55, 62, 83, 243
582+
);
583+
NarcNumsBase5: array[1..16] of Integer = (
584+
0, 1, 2, 3, 4, 13, 18, 28, 118, 289, 353, 419, 4890, 4891, 9113, 1874374
585+
);
586+
NarcNumsBase6: array[1..18] of Integer = (
587+
0, 1, 2, 3, 4, 5, 99, 190, 2292, 2293, 2324, 3432, 3433, 6197, 36140,
588+
269458, 391907, 10067135
589+
);
590+
NarcNumsBase7: array[1..28] of Integer = (
591+
0, 1, 2, 3, 4, 5, 6, 10, 25, 32, 45, 133, 134, 152, 250, 3190, 3222, 3612,
592+
3613, 4183, 9286, 35411, 191334, 193393, 376889, 535069, 794376, 8094840
593+
);
594+
NarcNumsBase8: array[1..23] of Integer = (
595+
0, 1, 2, 3, 4, 5, 6, 7, 20, 52, 92, 133, 307, 432, 433, 16819, 17864, 17865,
596+
24583, 25639, 212419, 906298, 906426
597+
);
598+
NarcNumsBase13: array[1..26] of Integer = (
599+
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 17, 45, 85, 98, 136, 160, 793,
600+
794, 854, 1968, 8194, 62481, 167544
601+
);
602+
NarcNumsBase16: array[1..51] of Integer = (
603+
$0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $A, $B, $C, $D, $E, $F, $156, $173,
604+
$208, $248, $285, $4A5, $5B0, $5B1, $60B, $64B, $8C0, $8C1, $99A, $AA9,
605+
$AC3, $CA8, $E69, $EA0, $EA1, $B8D2, $13579, $2B702, $2B722, $5A07C, $5A47C,
606+
$C00E0, $C00E1, $C04E0, $C04E1, $C60E7, $C64E7, $C80E0, $C80E1, $C84E0,
607+
$C84E1
608+
);
609+
var
610+
X: Integer;
611+
Base: Byte;
612+
begin
613+
// Base 2
614+
for X in NarcNumsBase2 do
615+
CheckTrue(IsNarcissistic(X, 2), Format('%d base 2', [X]));
616+
// Base 3
617+
for X in NarcNumsBase3 do
618+
CheckTrue(IsNarcissistic(X, 3), Format('%d base 3', [X]));
619+
// Base 4
620+
for X in NarcNumsBase4 do
621+
CheckTrue(IsNarcissistic(X, 4), Format('%d base 4', [X]));
622+
// Base 5
623+
for X in NarcNumsBase5 do
624+
CheckTrue(IsNarcissistic(X, 5), Format('%d base 5', [X]));
625+
// Base 6
626+
for X in NarcNumsBase6 do
627+
CheckTrue(IsNarcissistic(X, 6), Format('%d base 6', [X]));
628+
// Base 7
629+
for X in NarcNumsBase7 do
630+
CheckTrue(IsNarcissistic(X, 7), Format('%d base 7', [X]));
631+
// Base 8
632+
for X in NarcNumsBase8 do
633+
CheckTrue(IsNarcissistic(X, 8), Format('%d base 8', [X]));
634+
// Base 10
635+
for X in NarcNumsBase10 do
636+
// uses default base
637+
CheckTrue(IsNarcissistic(X), Format('%d base 10', [X]));
638+
// Base 13
639+
for X in NarcNumsBase13 do
640+
CheckTrue(IsNarcissistic(X, 13), Format('%d base 13', [X]));
641+
// Base 16
642+
for X in NarcNumsBase16 do
643+
CheckTrue(IsNarcissistic(X, 16), Format('%d base 16', [X]));
644+
// Check some known falsities
645+
CheckFalse(IsNarcissistic($C04E2, 16), 'False #1');
646+
CheckFalse(IsNarcissistic(906299, 8), 'False #2');
647+
CheckFalse(IsNarcissistic(501), 'False #3');
648+
CheckFalse(IsNarcissistic(2, 2), 'False #4');
649+
// Bases 2..255: All single digits in the base are narcissistic
650+
for Base := 2 to 255 do
651+
for X := 0 to Base - 1 do
652+
CheckTrue(IsNarcissistic(X, Base), Format('Single digit%d base: %d', [X, Base]));
653+
end;
654+
655+
procedure TestMathsCatSnippets.TestIsPalindromic;
656+
const
657+
// All palindromic numbers base 10 less than 200
658+
// Source: https://oeis.org/A002113
659+
PalBase10LessThan256: set of Byte = [
660+
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 22, 33, 44, 55, 66, 77, 88, 99, 101, 111,
661+
121, 131, 141, 151, 161, 171, 181, 191, 202, 212, 222, 232, 242, 252
662+
];
663+
// All palindromic numbers base 2 less than 200 decimal
664+
// Source: https://oeis.org/A006995
665+
PalBase2LessThan256: set of Byte = [
666+
0, 1, 3, 5, 7, 9, 15, 17, 21, 27, 31, 33, 45, 51, 63, 65, 73, 85, 93, 99,
667+
107, 119, 127, 129, 153, 165, 189, 195, 219, 231, 255
668+
];
669+
// Bases for which 105 decimal is palindromic
670+
// Source: https://en.wikipedia.org/wiki/Palindromic_number#Other_bases
671+
Pal105Bases: set of Byte = [4, 8, 14, 20, 34, 104];
672+
var
673+
X, B: Byte;
674+
begin
675+
CheckTrue(IsPalindromic(243999, 8), '734437 octal');
676+
CheckTrue(IsPalindromic(30495, 8), '73437 octal');
677+
CheckFalse(IsPalindromic(30943, 8), '74337 octal');
678+
CheckTrue(IsPalindromic($FFFFFFFF, 16), 'FFFFFFFF hex');
679+
CheckTrue(IsPalindromic($FFFFFFFF, 2), '11111111111111111111111111111111 bin');
680+
CheckTrue(IsPalindromic($FFF11FFF, 16), 'FFF11FFF hex');
681+
CheckFalse(IsPalindromic($FFF11FFF, 2), '11111111111100010001111111111111 bin');
682+
CheckTrue(IsPalindromic(341, 2), '101010101 bin');
683+
CheckTrue(IsPalindromic(2081023, 128), '127|1|127 base 128');
684+
CheckFalse(IsPalindromic(2081024, 128), '127|2|0 base 128');
685+
CheckTrue(IsPalindromic(145787541), '145787541 base 10 (default)');
686+
CheckTrue(IsPalindromic(1, 25), '1 base 25');
687+
CheckFalse(IsPalindromic(66, 4), '1002 base 4');
688+
CheckTrue(IsPalindromic(66, 21), '33 base 21');
689+
for B in Pal105Bases do
690+
CheckTrue(IsPalindromic(105, B), Format('105 in base %d', [B]));
691+
for X := 0 to 255 do
692+
begin
693+
if X in PalBase10LessThan256 then
694+
CheckTrue(IsPalindromic(X), Format('%d in base 10', [X]))
695+
else
696+
CheckFalse(IsPalindromic(X), Format('%d in base 10', [X]));
697+
if X in PalBase2LessThan256 then
698+
CheckTrue(IsPalindromic(X, 2), Format('%d in base 2', [X]))
699+
else
700+
CheckFalse(IsPalindromic(X, 2), Format('%d in base 2', [X]));
701+
end;
702+
end;
703+
567704
procedure TestMathsCatSnippets.TestIsPrime;
568705
var
569706
AllValues: array[1..542] of Boolean;

‎tests/Cat-Maths/UMathsCatSnippets.pas‎

Lines changed: 52 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
* The unit is copyright © 2005-2024 by Peter Johnson & Contributors and is
77
* licensed under the MIT License (https://opensource.org/licenses/MIT).
88
*
9-
* Generated on : Thu, 09 Jan 2025 10:55:06 GMT.
9+
* Generated on : Thu, 09 Jan 2025 15:04:31 GMT.
1010
* Generated by : DelphiDabbler CodeSnip Release 4.24.0.
1111
*
1212
* The latest version of CodeSnip is available from the CodeSnip GitHub project
@@ -190,6 +190,22 @@ function GCD(A, B: Integer): Integer;
190190
}
191191
function GCD2(const A, B: Integer): Integer;
192192

193+
{
194+
Checks if the absolute value of integer N is a narcissistic number in base
195+
Base.
196+
Bases up to 255 are supported. If Base <= 2 then an EArgumentException
197+
exception is raised. An EOverflow exception may be raised for large numbers
198+
and bases.
199+
}
200+
function IsNarcissistic(N: Integer; const Base: Byte = 10): Boolean;
201+
202+
{
203+
Checks if the absolute value of integer N is palindromic in base Base.
204+
Bases up to 255 are supported. If Base < 2 then an EArgumentException
205+
exception is raised.
206+
}
207+
function IsPalindromic(const N: Int64; const Base: Byte = 10): Boolean;
208+
193209
{
194210
Checks if the given number is prime.
195211
}
@@ -1084,6 +1100,41 @@ function GCD2(const A, B: Integer): Integer;
10841100
Result := GCD2(B, A mod B);
10851101
end;
10861102

1103+
{
1104+
Checks if the absolute value of integer N is a narcissistic number in base
1105+
Base.
1106+
Bases up to 255 are supported. If Base <= 2 then an EArgumentException
1107+
exception is raised. An EOverflow exception may be raised for large numbers
1108+
and bases.
1109+
}
1110+
function IsNarcissistic(N: Integer; const Base: Byte = 10): Boolean;
1111+
var
1112+
Sum: Int64;
1113+
begin
1114+
N := Abs(N);
1115+
Sum := DigitPowerSum(N, Base, DigitCountBase(N, Base));
1116+
Result := N = Sum;
1117+
end;
1118+
1119+
{
1120+
Checks if the absolute value of integer N is palindromic in base Base.
1121+
Bases up to 255 are supported. If Base < 2 then an EArgumentException
1122+
exception is raised.
1123+
}
1124+
function IsPalindromic(const N: Int64; const Base: Byte = 10): Boolean;
1125+
var
1126+
Digits: SysUtils.TBytes;
1127+
Idx: Integer;
1128+
PartitionSize: Integer;
1129+
begin
1130+
Digits := DigitsOf(N, Base); // raises exception for Base < 2
1131+
Result := True;
1132+
PartitionSize := Length(Digits) div 2;
1133+
for Idx := 0 to Pred(PartitionSize) do
1134+
if Digits[Idx] <> Digits[Length(Digits) - Idx - 1] then
1135+
Exit(False);
1136+
end;
1137+
10871138
{
10881139
Checks if the given number is prime.
10891140
}

0 commit comments

Comments
 (0)