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 47be72f

Browse files
Merge branch 'feature/18+19-tests-for-palindromic+narcissistic-numbers' into develop
Fixes #18 Fixes #19 
2 parents fb53ba7 + ae999a7 commit 47be72f

File tree

5 files changed

+241
-3
lines changed

5 files changed

+241
-3
lines changed

‎collection/660.dat

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
function IsPalindromic(const N: Int64; const Base: Byte = 10): Boolean;
2+
var
3+
Digits: SysUtils.TBytes;
4+
Idx: Integer;
5+
PartitionSize: Integer;
6+
begin
7+
Digits := DigitsOf(N, Base); // raises exception for Base < 2
8+
Result := True;
9+
PartitionSize := Length(Digits) div 2;
10+
for Idx := 0 to Pred(PartitionSize) do
11+
if Digits[Idx] <> Digits[Length(Digits) - Idx - 1] then
12+
Exit(False);
13+
end;

‎collection/662.dat

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
function IsNarcissistic(N: Integer; const Base: Byte = 10): Boolean;
2+
var
3+
Sum: Int64;
4+
begin
5+
N := Abs(N);
6+
Sum := DigitPowerSum(N, Base, DigitCountBase(N, Base));
7+
Result := N = Sum;
8+
end;

‎collection/maths.ini

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1812,3 +1812,32 @@ AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tes
18121812
Snip=661.dat
18131813
DelphiXE=Y
18141814
Delphi12A=Y
1815+
1816+
[IsPalindromic]
1817+
DisplayName="IsPalindromic"
1818+
DescEx="<p>Checks if the absolute value of integer <var>N</var> is palindromic 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>"
1819+
Extra="<p>A number expressed in a specified base is palindromic if it remains unchanged when its digits are reversed. See <a href="https://en.m.wikipedia.org/wiki/Palindromic_number">Wikipedia</a> for a formal definition and examples.</p><p>Strictly speaking a palindromic number should be non-negative. However, <var>IsPalindromic</var> considers negative numbers to be palindromic if and only if their absolute value is palindromic.</p>"
1820+
Kind=routine
1821+
Units=SysUtils
1822+
Depends=DigitsOf
1823+
SeeAlso=IsNarcissistic
1824+
TestInfo=advanced
1825+
AdvancedTest.Level=unit-tests
1826+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
1827+
Snip=660.dat
1828+
DelphiXE=Y
1829+
Delphi12A=Y
1830+
1831+
[IsNarcissistic]
1832+
DisplayName=IsNarcissistic
1833+
DescEx="<p>Checks if the absolute value of integer <var>N</var> is a narcissistic number 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. An <var>EOverflow</var> exception may be raised for large numbers and bases.</p>"
1834+
Extra="<p>A narcissistic number in a given number base is a number that is the sum of its own digits each raised to the power of the number of digits. See <a href="https://en.wikipedia.org/wiki/Narcissistic_number">Wikipedia</a> for a formal definition and examples.</p><p>Strictly speaking a palindromic number should be non-negative. However, <var>IsNarcissistic</var> considers negative numbers to be narcissistic if and only if their absolute value is narcissistic.</p>"
1835+
Kind=routine
1836+
Depends=DigitCountBase,DigitPowerSum
1837+
SeeAlso=IsPalindromic
1838+
TestInfo=advanced
1839+
AdvancedTest.Level=unit-tests
1840+
AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Maths"
1841+
Snip=662.dat
1842+
DelphiXE=Y
1843+
Delphi12A=Y

‎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, 4ドルA5, 5ドルB0, 5ドルB1, 60ドルB, 64ドルB, 8ドルC0, 8ドルC1, 99ドルA, $AA9,
605+
$AC3, $CA8, $E69, $EA0, $EA1, $B8D2, $13579, 2ドルB702, 2ドルB722, 5ドルA07C, 5ドルA47C,
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 : 2025年1月09日 10:55:06 GMT.
9+
* Generated on : 2025年1月09日 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)

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