Kaprekar numbers: Difference between revisions
| Line 443: | Line 443: | ||
</PRE> |
</PRE> |
||
===Casting Out Nines (fast)=== |
===Casting Out Nines (fast)=== |
||
The code "if (k%(Base-1) == (k*k)%(Base-1))" is explained here: |
The code "if (k%(Base-1) == (k*k)%(Base-1))" is explained here: [[Casting out nines]]. |
||
<lang cpp> |
<lang cpp> |
||
Revision as of 19:42, 29 June 2012
You are encouraged to solve this task according to the task description, using any language you may know.
A positive integer is a Kaprekar number if:
- It is 1
- The decimal representation of its square may be split once into two parts consisting of positive integers which sum to the original number. Note that a split resulting in a part consisting purely of 0s is not valid, as 0 is not considered positive.
- Example Kaprekar numbers
- is a Kaprekar number, as , may be split to and , and .
- The series of Kaprekar numbers is known as A006886, and begins as .
- Example process
10000 (1002) splitting from left to right:
- The first split is [1, 0000], and is invalid; the 0000 element consists entirely of 0s, and 0 is not considered positive.
- Slight optimization opportunity: When splitting from left to right, once the right part consists entirely of 0s, no further testing is needed; all further splits would also be invalid.
- Task description
Generate and show all Kaprekar numbers less than 10,000.
- Extra credit
Optionally, count (and report the count of) how many Kaprekar numbers are less than 1,000,000.
- Extra extra credit
The concept of Kaprekar numbers is not limited to base 10 (i.e. decimal numbers); if you can, show that Kaprekar numbers exist in other bases too. For this purpose, do the following:
- Find all Kaprekar numbers for base 17 between 1 and 1,000,000 (one million);
- Display each of them in base 10 representation;
- Optionally, using base 17 representation (use letters 'a' to 'g' for digits 10(10) to 16(10)), display each of the numbers, its square, and where to split the square. For example, 225(10) is "d4" in base 17, its square "a52g", and a5(17) + 2g(17) = d4(17), so the display would be something like:
225 d4 a52g a5 + 2g
- Reference
- The Kaprekar Numbers by Douglas E. Iannucci (2000). PDF version
Ada
with extra bases from 2 up to 36 (0..9a..z)
task description wasn't clear if 1000000 for base 17 was base 17 or base 10, so i chose base 17 (17 ** 6).
<lang ada>with Ada.Text_IO; with Ada.Strings.Fixed;
procedure Kaprekar2 is
use Ada.Strings.Fixed;
To_Digit : constant String := "0123456789abcdefghijklmnopqrstuvwxyz";
type Int is mod 2 ** 64; subtype Base_Number is Int range 2 .. 36;
From_Digit : constant array (Character) of Int :=
('0' => 0,
'1' => 1,
'2' => 2,
'3' => 3,
'4' => 4,
'5' => 5,
'6' => 6,
'7' => 7,
'8' => 8,
'9' => 9,
'a' => 10,
'b' => 11,
'c' => 12,
'd' => 13,
'e' => 14,
'f' => 15,
'g' => 16,
'h' => 17,
'i' => 18,
'j' => 19,
'k' => 20,
'l' => 21,
'm' => 22,
'n' => 23,
'o' => 24,
'p' => 25,
'q' => 26,
'r' => 27,
's' => 28,
't' => 29,
'u' => 30,
'v' => 31,
'w' => 32,
'x' => 33,
'y' => 34,
'z' => 35,
others => 0);
function To_String (Item : Int; Base : Base_Number := 10) return String is
Value : Int := Item;
Digit_Index : Natural;
Result : String (1 .. 64);
First : Natural := Result'Last;
begin
while Value > 0 loop
Digit_Index := Natural (Value mod Base);
Result (First) := To_Digit (Digit_Index + 1);
Value := Value / Base;
First := First - 1;
end loop;
return Result (First + 1 .. Result'Last);
end To_String;
procedure Get (From : String; Item : out Int; Base : Base_Number := 10) is
begin
Item := 0;
for I in From'Range loop
Item := Item * Base;
Item := Item + From_Digit (From (I));
end loop;
end Get;
function Is_Kaprekar (N : Int; Base : Base_Number := 10) return Boolean is
Square : Int;
begin
if N = 1 then
return True;
else
Square := N ** 2;
declare
Image : String := To_String (Square, Base);
A, B : Int;
begin
for I in Image'First .. Image'Last - 1 loop
exit when Count (Image (I + 1 .. Image'Last), "0")
= Image'Last - I;
Get (From => Image (Image'First .. I),
Item => A,
Base => Base);
Get (From => Image (I + 1 .. Image'Last),
Item => B,
Base => Base);
if A + B = N then
return True;
end if;
end loop;
end;
end if;
return False;
end Is_Kaprekar;
Count : Natural := 0;
begin
for I in Int range 1 .. 10_000 loop
if Is_Kaprekar (I) then
Count := Count + 1;
Ada.Text_IO.Put (To_String (I) & ",");
end if;
end loop;
Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));
for I in Int range 10_001 .. 1_000_000 loop
if Is_Kaprekar (I) then
Count := Count + 1;
end if;
end loop;
Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000:" &
Integer'Image (Count));
Count := 0;
Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000 in base 17:");
for I in Int range 1 .. 17 ** 6 loop
if Is_Kaprekar (I, 17) then
Count := Count + 1;
Ada.Text_IO.Put (To_String (I, 17) & ",");
end if;
end loop;
Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));
end Kaprekar2;</lang>
Output:
1,9,45,55,99,297,703,999,2223,2728,4879,4950,5050,5292,7272,7777,9999, Total: 17 Kaprekar Numbers below 1000000: 54 Kaprekar Numbers below 1000000 in base 17: 1,g,3d,d4,gg,556,bbb,ggg,18bd,1f1f,36db,43cd,61eb,785d,7a96,967b,98b4,af26,cd44,da36,f1f2,f854,gggg,33334,ddddd,fgacc,ggggg,146fca,236985,2b32b3,2gde03,3a2d6f,3fa16d,443ccd,4e9c28,54067b,5aggb6,687534,6f6f6g,7e692a,7f391e,91d7f3,92a7e7,a1a1a1,a89bdd,b6005b,bcga96,c274e9,ccd444,d16fa4,d6e3a2,e032ge,e5de5e,eda78c,fca147,g10645,gggggg, Total: 57
Bracmat
<lang bracmat>( 0:?n & 1:?count & out$(!count 1) & whl
' ( 1+!n:<1000000:?n
& ( @( !n^2
: #?a
( ? (#>0:?b)
& !a+!b:!n
& 1+!count:?count
& (!n:<10000&out$!n|)
)
)
|
)
)
& out$(str$("There are " !count " kaprekar numbers less than 1000000")) );</lang> Output:
1 1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 There are 54 kaprekar numbers less than 1000000
Brat
<lang Brat>kaprekar = { limit |
results = []
1.to limit, { num |
true? num == 1
{ results << 1 }
{
sqr = (num ^ 2).to_s
0.to (sqr.length - 1) { i |
lhs = sqr[0,i].to_i
rhs = sqr[i + 1,-1].to_i
true? (rhs > 0) && { lhs + rhs == num }
{ results << num }
}
}
}
results
}
p "Kaprekar numbers below 10,000:" p kaprekar 10000
p "Number of Kaprekar numbers below 1,000,000:" p kaprekar(1000000).length</lang>
Output:
Kaprekar numbers below 10,000: [1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999] Number of Kaprekar numbers below 1,000,000: 54
C
Sample for extra extra credit: <lang C>#include <stdio.h>
- include <stdint.h>
typedef uint64_t ulong;
int kaprekar(ulong n, int base) { ulong nn = n * n, r, tens = 1;
if ((nn - n) % (base - 1)) return 0;
while (tens < n) tens *= base; if (n == tens) return 1 == n;
while ((r = nn % tens) < n) { if (nn / tens + r == n) return tens; tens *= base; }
return 0; }
void print_num(ulong n, int base) { ulong q, div = base;
while (div < n) div *= base; while (n && (div /= base)) { q = n / div; if (q < 10) putchar(q + '0'); else putchar(q + 'a' - 10); n -= q * div; } }
int main() { ulong i, tens; int cnt = 0; int base = 10;
printf("base 10:\n"); for (i = 1; i < 1000000; i++) if (kaprekar(i, base)) printf("%3d: %llu\n", ++cnt, i);
base = 17; printf("\nbase %d:\n 1: 1\n", base); for (i = 2, cnt = 1; i < 1000000; i++) if ((tens = kaprekar(i, base))) { printf("%3d: %llu", ++cnt, i); printf(" \t"); print_num(i, base); printf("\t"); print_num(i * i, base); printf("\t"); print_num(i * i / tens, base); printf(" + "); print_num(i * i % tens, base); printf("\n"); }
return 0; }</lang>Output:
base 10: 1: 1 2: 9 3: 45 4: 55 5: 99 6: 297 7: 703 8: 999 9: 2223 10: 2728 11: 4879 12: 4950 13: 5050 14: 5292 15: 7272 16: 7777 17: 9999 ... 47: 791505 48: 812890 49: 818181 50: 851851 51: 857143 52: 961038 53: 994708 54: 999999 base 17: 1: 1 2: 16 g f1 f + 1 3: 64 3d e2g e + 2g 4: 225 d4 a52g a5 + 2g 5: 288 gg gf01 gf + 1 6: 1536 556 1b43b2 1b4 + 3b2 7: 3377 bbb 8093b2 809 + 3b2 8: 4912 ggg ggf001 ggf + 1 9: 7425 18bd 24e166g 24e + 166g 10: 9280 1f1f 39b1b94 39b + 1b94 ... 21: 74241 f1f2 d75f1b94 d75f + 1b94 22: 76096 f854 e1f5166g e1f5 + 166g 23: 83520 gggg gggf0001 gggf + 1 24: 266224 33334 a2c52a07g a2c5 + 2a07g
C++
Using String Manipulation (very slow)
<lang cpp>#include <vector>
- include <string>
- include <iostream>
- include <sstream>
- include <algorithm>
- include <iterator>
- include <utility>
long string2long( const std::string & s ) {
long result ; std::istringstream( s ) >> result ; return result ;
}
bool isKaprekar( long number ) {
long long squarenumber = ((long long)number) * number ;
std::ostringstream numberbuf ;
numberbuf << squarenumber ;
std::string numberstring = numberbuf.str( ) ;
for ( int i = 0 ; i < numberstring.length( ) ; i++ ) {
std::string firstpart = numberstring.substr( 0 , i ) ,
secondpart = numberstring.substr( i ) ;
//we do not accept figures ending in a sequence of zeroes
if ( secondpart.find_first_not_of( "0" ) == std::string::npos ) {
return false ;
}
if ( string2long( firstpart ) + string2long( secondpart ) == number ) {
return true ;
} } return false ;
}
int main( ) {
std::vector<long> kaprekarnumbers ;
kaprekarnumbers.push_back( 1 ) ;
for ( int i = 2 ; i < 1000001 ; i++ ) {
if ( isKaprekar( i ) )
kaprekarnumbers.push_back( i ) ;
}
std::vector<long>::const_iterator svi = kaprekarnumbers.begin( ) ;
std::cout << "Kaprekar numbers up to 10000: \n" ;
while ( *svi < 10000 ) {
std::cout << *svi << " " ;
svi++ ;
}
std::cout << '\n' ;
std::cout << "All the Kaprekar numbers up to 1000000 :\n" ;
std::copy( kaprekarnumbers.begin( ) , kaprekarnumbers.end( ) ,
std::ostream_iterator<long>( std::cout , "\n" ) ) ;
std::cout << "There are " << kaprekarnumbers.size( )
<< " Kaprekar numbers less than one million!\n" ;
return 0 ;
}</lang> Output:
Kaprekar numbers up to 10000: 1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 All the Kaprekar numbers up to 1000000 : 1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 17344 ..... 818181 851851 857143 961038 994708 999999 There are 54 Kaprekar numbers less than one million!
Casting Out Nines (fast)
The code "if (k%(Base-1) == (k*k)%(Base-1))" is explained here: Casting out nines.
<lang cpp> // Generate Kaprekar Numbers // // Nigel Galloway. June 24th., 2012 //
- include <iostream>
int main() { const int Base = 10; const int N = 6; int Paddy_cnt = 0; for (unsigned long long int k=1; k<pow((double)Base,N); k++) if (k%(Base-1) == (k*k)%(Base-1)) for (int n=1; n<=N*2; n++){ const unsigned long long int B = pow((double)Base,n); const double nr = k*(B-k)/(B-1); const int q = k-nr; if (k*k==q*B+nr && 0<nr){ std::cout << ++Paddy_cnt << ": " << k << " is " << q << " + " << (int)nr << " and squared is " << k*k << ". It is a member of Residual Set " << k%(Base-1) << "\n"; break; }}
return 0;
} </lang> Produces:
1: 1 is 0 + 1 and squared is 1. It is a member of Residual Set 1 2: 9 is 8 + 1 and squared is 81. It is a member of Residual Set 0 3: 45 is 20 + 25 and squared is 2025. It is a member of Residual Set 0 4: 55 is 30 + 25 and squared is 3025. It is a member of Residual Set 1 5: 99 is 98 + 1 and squared is 9801. It is a member of Residual Set 0 6: 297 is 88 + 209 and squared is 88209. It is a member of Residual Set 0 7: 703 is 494 + 209 and squared is 494209. It is a member of Residual Set 1 8: 999 is 998 + 1 and squared is 998001. It is a member of Residual Set 0 9: 2223 is 494 + 1729 and squared is 4941729. It is a member of Residual Set 0 10: 2728 is 744 + 1984 and squared is 7441984. It is a member of Residual Set 1 11: 4879 is 238 + 4641 and squared is 23804641. It is a member of Residual Set 1 12: 4950 is 2450 + 2500 and squared is 24502500. It is a member of Residual Set 0 13: 5050 is 2550 + 2500 and squared is 25502500. It is a member of Residual Set 1 14: 5292 is 28 + 5264 and squared is 28005264. It is a member of Residual Set 0 15: 7272 is 5288 + 1984 and squared is 52881984. It is a member of Residual Set 0 16: 7777 is 6048 + 1729 and squared is 60481729. It is a member of Residual Set 1 17: 9999 is 9998 + 1 and squared is 99980001. It is a member of Residual Set 0 18: 17344 is 3008 + 14336 and squared is 300814336. It is a member of Residual Set 1 19: 22222 is 4938 + 17284 and squared is 493817284. It is a member of Residual Set 1 20: 38962 is 1518 + 37444 and squared is 1518037444. It is a member of Residual Set 1 21: 77778 is 60494 + 17284 and squared is 6049417284. It is a member of Residual Set 0 22: 82656 is 68320 + 14336 and squared is 6832014336. It is a member of Residual Set 0 23: 95121 is 90480 + 4641 and squared is 9048004641. It is a member of Residual Set 0 24: 99999 is 99998 + 1 and squared is 9999800001. It is a member of Residual Set 0 25: 142857 is 20408 + 122449 and squared is 20408122449. It is a member of Residual Set 0 26: 148149 is 21948 + 126201 and squared is 21948126201. It is a member of Residual Set 0 27: 181819 is 33058 + 148761 and squared is 33058148761. It is a member of Residual Set 1 28: 187110 is 35010 + 152100 and squared is 35010152100. It is a member of Residual Set 0 29: 208495 is 43470 + 165025 and squared is 43470165025. It is a member of Residual Set 1 30: 318682 is 101558 + 217124 and squared is 101558217124. It is a member of Residual Set 1 31: 329967 is 108878 + 221089 and squared is 108878221089. It is a member of Residual Set 0 32: 351352 is 123448 + 227904 and squared is 123448227904. It is a member of Residual Set 1 33: 356643 is 127194 + 229449 and squared is 127194229449. It is a member of Residual Set 0 34: 390313 is 152344 + 237969 and squared is 152344237969. It is a member of Residual Set 1 35: 461539 is 213018 + 248521 and squared is 213018248521. It is a member of Residual Set 1 36: 466830 is 217930 + 248900 and squared is 217930248900. It is a member of Residual Set 0 37: 499500 is 249500 + 250000 and squared is 249500250000. It is a member of Residual Set 0 38: 500500 is 250500 + 250000 and squared is 250500250000. It is a member of Residual Set 1 39: 533170 is 284270 + 248900 and squared is 284270248900. It is a member of Residual Set 1 40: 538461 is 289940 + 248521 and squared is 289940248521. It is a member of Residual Set 0 41: 609687 is 371718 + 237969 and squared is 371718237969. It is a member of Residual Set 0 42: 627615 is 39390 + 588225 and squared is 393900588225. It is a member of Residual Set 0 43: 643357 is 413908 + 229449 and squared is 413908229449. It is a member of Residual Set 1 44: 648648 is 420744 + 227904 and squared is 420744227904. It is a member of Residual Set 0 45: 670033 is 448944 + 221089 and squared is 448944221089. It is a member of Residual Set 1 46: 681318 is 464194 + 217124 and squared is 464194217124. It is a member of Residual Set 0 47: 791505 is 626480 + 165025 and squared is 626480165025. It is a member of Residual Set 0 48: 812890 is 660790 + 152100 and squared is 660790152100. It is a member of Residual Set 1 49: 818181 is 669420 + 148761 and squared is 669420148761. It is a member of Residual Set 0 50: 851851 is 725650 + 126201 and squared is 725650126201. It is a member of Residual Set 1 51: 857143 is 734694 + 122449 and squared is 734694122449. It is a member of Residual Set 1 52: 961038 is 923594 + 37444 and squared is 923594037444. It is a member of Residual Set 0 53: 994708 is 989444 + 5264 and squared is 989444005264. It is a member of Residual Set 1 54: 999999 is 999998 + 1 and squared is 999998000001. It is a member of Residual Set 0
The code may be modified to use a base other than 10: <lang cpp> const int Base = 16; const int N = 4; std::cout << std::dec << ++Paddy_cnt << ": " << std::hex << k << " is " << q << " + " << (int)nr << " and squared is " << k*k << ". It is a member of Residual Set " << k%(Base-1) << "\n"; </lang> Which produces:
1: 1 is 0 + 1 and squared is 1. It is a member of Residual Set 1 2: 6 is 2 + 4 and squared is 24. It is a member of Residual Set 6 3: a is 6 + 4 and squared is 64. It is a member of Residual Set a 4: f is e + 1 and squared is e1. It is a member of Residual Set 0 5: 33 is a + 29 and squared is a29. It is a member of Residual Set 6 6: 55 is 1c + 39 and squared is 1c39. It is a member of Residual Set a 7: 5b is 2 + 59 and squared is 2059. It is a member of Residual Set 1 8: 78 is 38 + 40 and squared is 3840. It is a member of Residual Set 0 9: 88 is 48 + 40 and squared is 4840. It is a member of Residual Set 1 10: ab is 72 + 39 and squared is 7239. It is a member of Residual Set 6 11: cd is a4 + 29 and squared is a429. It is a member of Residual Set a 12: ff is fe + 1 and squared is fe01. It is a member of Residual Set 0 13: 15f is 1e + 141 and squared is 1e141. It is a member of Residual Set 6 14: 334 is a4 + 290 and squared is a4290. It is a member of Residual Set a 15: 38e is ca + 2c4 and squared is ca2c4. It is a member of Residual Set a 16: 492 is 14e + 344 and squared is 14e344. It is a member of Residual Set 0 17: 4ed is 184 + 369 and squared is 184369. It is a member of Residual Set 1 18: 7e0 is 3e0 + 400 and squared is 3e0400. It is a member of Residual Set 6 19: 820 is 420 + 400 and squared is 420400. It is a member of Residual Set a 20: b13 is 7aa + 369 and squared is 7aa369. It is a member of Residual Set 0 21: b6e is 82a + 344 and squared is 82a344. It is a member of Residual Set 1 22: c72 is 9ae + 2c4 and squared is 9ae2c4. It is a member of Residual Set 6 23: ccc is a3c + 290 and squared is a3c290. It is a member of Residual Set 6 24: ea1 is d60 + 141 and squared is d60141. It is a member of Residual Set a 25: fa5 is f4c + 59 and squared is f4c059. It is a member of Residual Set 0 26: fff is ffe + 1 and squared is ffe001. It is a member of Residual Set 0 27: 191a is 276 + 16a4 and squared is 27616a4. It is a member of Residual Set 6 28: 2a2b is 6f2 + 2339 and squared is 6f22339. It is a member of Residual Set a 29: 3c3c is e2c + 2e10 and squared is e2c2e10. It is a member of Residual Set 0 30: 4444 is 1234 + 3210 and squared is 12343210. It is a member of Residual Set 1 31: 5556 is 1c72 + 38e4 and squared is 1c7238e4. It is a member of Residual Set 6 32: 6667 is 28f6 + 3d71 and squared is 28f63d71. It is a member of Residual Set a 33: 7f80 is 3f80 + 4000 and squared is 3f804000. It is a member of Residual Set 0 34: 8080 is 4080 + 4000 and squared is 40804000. It is a member of Residual Set 1 35: 9999 is 5c28 + 3d71 and squared is 5c283d71. It is a member of Residual Set 6 36: aaaa is 71c6 + 38e4 and squared is 71c638e4. It is a member of Residual Set a 37: bbbc is 89ac + 3210 and squared is 89ac3210. It is a member of Residual Set 0 38: c3c4 is 95b4 + 2e10 and squared is 95b42e10. It is a member of Residual Set 1 39: d5d5 is b29c + 2339 and squared is b29c2339. It is a member of Residual Set 6 40: e6e6 is d042 + 16a4 and squared is d04216a4. It is a member of Residual Set a 41: ffff is fffe + 1 and squared is fffe0001. It is a member of Residual Set 0
Common Lisp
The implementation below is a fast version (currently) limited to base 10 numbers. The algorithm starts checking from the middle of the squared number, working to the left and ending early if possible. This reduces the number of iterations/checks compared to implementations that start at either the right or left end. This version also makes use of additional language constructs that should help make the code easier to understand. <lang lisp>;;num-digits was defined as a macro because the compiler wouldn't inline the do form. (defmacro num-digits (n)
"Returns the number of digits in n." (let ((count (gensym))
(tens (gensym)))
`(do ((count 1 (1+ count))
(tens 10 (* tens 10)))
((> tens ,n) count))))
(defun kaprekar-p (n)
"Determines whether n is a Kaprekar number. Returns three values: boolean indicating if this is a Kaprekar, left half and right half." (cond ((< n 1) nil)
((= n 1) (values t 1 0)) (t (do* ((nn (* n n)) (start (truncate (num-digits nn) 2)) (div (expt 10 start) (* div 10))) ((> div nn)) (let* ((rh (mod nn div)) (lh (truncate nn div))) (if (zerop rh) (return-from kaprekar-p)) (if (= (+ lh rh) n) (return-from kaprekar-p (values t lh rh))))))))
(defun test (n &optional (start 1))
(let* ((width (max 5 (+ 2 (num-digits n))))
(fmt (format nil "~~4d ~~~D:d ~~~Dd ~~~Dd ~~~D:d ~~%" (floor (+ 2 width)) width width (* 2 width))))
(format t fmt "K#" "Value" "Left" "Right" "Square") (do ((count 0)
(i start (1+ i))) ((= i n))
(multiple-value-bind (kp lh rh)
(kaprekar-p i) (when kp (format t fmt (incf count) i lh rh (* i i)))))))</lang> Output:
(test 1000000) K# Value Left Right Square 1 1 1 0 1 2 9 8 1 81 3 45 20 25 2,025 4 55 30 25 3,025 5 99 98 1 9,801 6 297 88 209 88,209 7 703 494 209 494,209 8 999 998 1 998,001 9 2,223 494 1729 4,941,729 10 2,728 744 1984 7,441,984 ... 53 994,708 989444 5264 989,444,005,264 54 999,999 999998 1 999,998,000,001
This implementation is written in a C programming style, includes support for additional number bases and is shorter than the previous version. However, it is also slower and more difficult to understand. <lang lisp>(defun is-kaprecar (n base)
"check if a number is Kaprecar; returns dividing power of base if true"
(if (= 1 n) n
(let ((nn (* n n)) (b 1) r)
(do () ((>= b nn)) (setf b (* b base)))
(do () ((<= b n))
(setf b (/ b base) r (mod nn b)) (if (zerop r) (return-from is-kaprecar)) (if (= (+ r (/ (- nn r) b)) n) (return-from is-kaprecar b))))))
(defun test-million (base)
(format t "Base ~d~%" base) (let* ((i 0)
(pow) (b (concatenate 'string "~" (write-to-string base) ",,,r")) (fmt (concatenate 'string "~A~3t| x=~A "b"~24tx^2 = "b":~32t"b" + "b"~%")))
(dotimes (x 1000000)
(when (setf pow (is-kaprecar x base))
(let ((nn (* x x))) (format t fmt (incf i) x x nn (floor (/ nn pow)) (mod nn pow))))))) </lang> Output:
CL-USER> (test-million 1000000 17) Base 17 1 | x=1 1 x^2 = 1: 1 + 0 2 | x=16 G x^2 = F1: F + 1 3 | x=64 3D x^2 = E2G: E + 2G 4 | x=225 D4 x^2 = A52G: A5 + 2G 5 | x=288 GG x^2 = GF01: GF + 1 6 | x=1536 556 x^2 = 1B43B2: 1B4 + 3B2 7 | x=3377 BBB x^2 = 8093B2: 809 + 3B2 8 | x=4912 GGG x^2 = GGF001: GGF + 1 9 | x=7425 18BD x^2 = 24E166G: 24E + 166G 10 | x=9280 1F1F x^2 = 39B1B94: 39B + 1B94 11 | x=16705 36DB x^2 = B992C42: B99 + 2C42 12 | x=20736 43CD x^2 = 10DE32FG: 10DE + 32FG 13 | x=30016 61EB x^2 = 23593F92: 2359 + 3F92 14 | x=36801 785D x^2 = 351E433G: 351E + 433G 15 | x=37440 7A96 x^2 = 37144382: 3714 + 4382 16 | x=46081 967B x^2 = 52G94382: 52G9 + 4382 17 | x=46720 98B4 x^2 = 5575433G: 5575 + 433G 18 | x=53505 AF26 x^2 = 6GA43F92: 6GA4 + 3F92 19 | x=62785 CD44 x^2 = 9A5532FG: 9A55 + 32FG 20 | x=66816 DA36 x^2 = AEG42C42: AEG4 + 2C42 21 | x=74241 F1F2 x^2 = D75F1B94: D75F + 1B94 22 | x=76096 F854 x^2 = E1F5166G: E1F5 + 166G 23 | x=83520 GGGG x^2 = GGGF0001: GGGF + 1 24 | x=266224 33334 x^2 = A2C52A07G: A2C5 + 2A07G
D
Straightforward Version
<lang d>import std.stdio, std.conv, std.algorithm, std.range;
bool isKaprekar(in long n) /*pure nothrow*/ in {
assert(n > 0, "isKaprekar(n) is defined for n > 0.");
} body {
if (n == 1)
return true;
immutable sn = text(n ^^ 2);
foreach (i; 1 .. sn.length) {
immutable a = to!long(sn[0 .. i]);
immutable b = to!long(sn[i .. $]);
if (b && a + b == n)
return true;
}
return false;
}
void main() {
writeln(filter!isKaprekar(iota(1, 10_000))); writeln(count!isKaprekar(iota(1, 1_000_000)));
}</lang>
- Output:
[1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999] 54
Faster Version
Right to left: <lang d>bool isKaprekar(in uint n) pure nothrow {
ulong powr = n ^^ 2UL;
ulong r, l, tens = 10;
while (r < n) {
r = powr % tens;
l = powr / tens;
if (r && (l + r == n))
return true;
tens *= 10;
}
return false;
}
void main() {
import std.stdio;
int count = 1;
foreach (i; 1 .. 1_000_000)
if (isKaprekar(i))
writefln("%d: %d", count++, i);
}</lang>
- Output:
1: 1 2: 9 3: 45 4: 55 5: 99 6: 297 7: 703 8: 999 9: 2223 10: 2728 11: 4879 12: 4950 13: 5050 14: 5292 15: 7272 16: 7777 17: 9999 ... 51: 857143 52: 961038 53: 994708 54: 999999
Forth
This one takes the internal Forth variable BASE into account. Since Forth is perfectly suited to work with any base between 2 and 36, this works just fine. <lang forth>: square ( n - n^2) dup * ;
\ Return nonzero if n is a Kaprekar number for tens, where tens is a \ nonzero power of base.
- is-kaprekar? ( tens n n^2 - t) rot /mod over >r + = r> and ;
\ If n is a Kaprekar number, return is the power of base for which it \ is Kaprekar. If n is not a Kaprekar number, return zero.
- kaprekar ( +n - +n1)
dup square >r
base @ swap
begin ( tens n) ( R: n^2)
over r@ < while
2dup r@ is-kaprekar? if
drop r> drop exit then
swap base @ * swap
repeat
r> drop 1 = and ;
</lang>
Fortran
<lang fortran>program Karpekar_Numbers
implicit none integer, parameter :: i64 = selected_int_kind(18) integer :: count call karpekar(10000_i64, .true.) write(*,*) call karpekar(1000000_i64, .false.)
contains
subroutine karpekar(n, printnums)
integer(i64), intent(in) :: n
logical, intent(in) :: printnums
integer(i64) :: c, i, j, n1, n2
character(19) :: str, s1, s2
c = 0
do i = 1, n
write(str, "(i0)") i*i
do j = 0, len_trim(str)-1
s1 = str(1:j)
s2 = str(j+1:len_trim(str))
read(s1, "(i19)") n1
read(s2, "(i19)") n2
if(n2 == 0) cycle
if(n1 + n2 == i) then
c = c + 1
if (printnums .eqv. .true.) write(*, "(i0)") i
exit
end if
end do
end do
if (printnums .eqv. .false.) write(*, "(i0)") c
end subroutine end program</lang> Output
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 54
GAP
<lang gap>IsKaprekar := function(n) local a, b, p, q; if n = 1 then return true; fi; q := n*n; p := 10; while p < q do a := RemInt(q, p); b := QuoInt(q, p); if a > 0 and a + b = n then return true; fi; p := p*10; od; return false; end;
Filtered([1 .. 10000], IsKaprekar);
- [ 1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272,
- 7777, 9999 ]
Size(last);
- 17
Filtered([1 .. 1000000], IsKaprekar);
- [ 1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272,
- 7777, 9999, 17344, 22222, 38962, 77778, 82656, 95121, 99999, 142857,
- 148149, 181819, 187110, 208495, 318682, 329967, 351352, 356643, 390313,
- 461539, 466830, 499500, 500500, 533170, 538461, 609687, 627615, 643357,
- 648648, 670033, 681318, 791505, 812890, 818181, 851851, 857143, 961038,
- 994708, 999999 ]
Size(last);
- 54
IsKaprekarAndHow := function(n, base)
local a, b, p, q;
if n = 1 then
return true;
fi;
q := n*n;
p := base;
while p < q do
a := RemInt(q, p);
b := QuoInt(q, p);
if a > 0 and a + b = n then
return [a, b];
fi;
p := p*base;
od;
return false;
end;
IntegerToBaseRep := function(n, base) local s, digit; if base > 36 then return fail; elif n = 0 then return "0"; else s := ""; digit := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; while n <> 0 do Add(s, digit[RemInt(n, base) + 1]); n := QuoInt(n, base); od; return Reversed(s); fi; end;
PrintIfKaprekar := function(n, base) local v; v := IsKaprekarAndHow(n, base); if IsList(v) then Print(n, "(10) or in base ", base, ", ", IntegerToBaseRep(n, base), "^2 = ", IntegerToBaseRep(n^2, base), " and ", IntegerToBaseRep(v[2], base), " + ", IntegerToBaseRep(v[1], base), " = ", IntegerToBaseRep(n, base), "\n"); fi; return fail; end;
- In base 17...
Perform([1 .. 1000000], n -> PrintIfKaprekar(n, 17));
- 16(10) or in base 17, G^2 = F1 and F + 1 = G
- 64(10) or in base 17, 3D^2 = E2G and E + 2G = 3D
- 225(10) or in base 17, D4^2 = A52G and A5 + 2G = D4
- 288(10) or in base 17, GG^2 = GF01 and GF + 1 = GG
- 1536(10) or in base 17, 556^2 = 1B43B2 and 1B4 + 3B2 = 556
- 3377(10) or in base 17, BBB^2 = 8093B2 and 809 + 3B2 = BBB
- 4912(10) or in base 17, GGG^2 = GGF001 and GGF + 1 = GGG
- 7425(10) or in base 17, 18BD^2 = 24E166G and 24E + 166G = 18BD
- 9280(10) or in base 17, 1F1F^2 = 39B1B94 and 39B + 1B94 = 1F1F
- 16705(10) or in base 17, 36DB^2 = B992C42 and B99 + 2C42 = 36DB
- 20736(10) or in base 17, 43CD^2 = 10DE32FG and 10DE + 32FG = 43CD
- 30016(10) or in base 17, 61EB^2 = 23593F92 and 2359 + 3F92 = 61EB
- 36801(10) or in base 17, 785D^2 = 351E433G and 351E + 433G = 785D
- 37440(10) or in base 17, 7A96^2 = 37144382 and 3714 + 4382 = 7A96
- 46081(10) or in base 17, 967B^2 = 52G94382 and 52G9 + 4382 = 967B
- 46720(10) or in base 17, 98B4^2 = 5575433G and 5575 + 433G = 98B4
- 53505(10) or in base 17, AF26^2 = 6GA43F92 and 6GA4 + 3F92 = AF26
- 62785(10) or in base 17, CD44^2 = 9A5532FG and 9A55 + 32FG = CD44
- 66816(10) or in base 17, DA36^2 = AEG42C42 and AEG4 + 2C42 = DA36
- 74241(10) or in base 17, F1F2^2 = D75F1B94 and D75F + 1B94 = F1F2
- 76096(10) or in base 17, F854^2 = E1F5166G and E1F5 + 166G = F854
- 83520(10) or in base 17, GGGG^2 = GGGF0001 and GGGF + 1 = GGGG
- 266224(10) or in base 17, 33334^2 = A2C52A07G and A2C5 + 2A07G = 33334</lang>
Go
Using the Ada interpretation of 1000000 base 17: <lang go>package main
import (
"fmt" "strconv"
)
func kaprekar(n uint64, base uint64) (bool, int) {
order := 0
if n == 1 {
return true, -1
}
nn, power := n*n, uint64(1)
for power <= nn {
power *= base
order++
}
power /= base
order--
for ; power > 1; power /= base {
q, r := nn/power, nn%power
if q >= n {
return false, -1
}
if q+r == n {
return true, order
}
order-- }
return false, -1
}
func main() {
max := uint64(10000)
fmt.Printf("Kaprekar numbers < %d:\n", max)
for m := uint64(0); m < max; m++ {
if is, _ := kaprekar(m, 10); is {
fmt.Println(" ", m)
}
}
// extra credit
max = 1e6
var count int
for m := uint64(0); m < max; m++ {
if is, _ := kaprekar(m, 10); is {
count++
}
}
fmt.Printf("\nThere are %d Kaprekar numbers < %d.\n", count, max)
// extra extra credit
const base = 17
maxB := "1000000"
fmt.Printf("\nKaprekar numbers between 1 and %s(base %d):\n", maxB, base)
max, _ = strconv.ParseUint(maxB, base, 64)
fmt.Printf("\n Base 10 Base %d Square Split\n", base)
for m := uint64(2); m < max; m++ {
is, pos := kaprekar(m, base)
if !is {
continue
}
sq := strconv.FormatUint(m*m, base)
str := strconv.FormatUint(m, base)
fmt.Printf("%8d %7s %12s %6s + %s\n", m,
str, sq, sq[0:pos], sq[pos:len(sq)]) // optional extra extra credit
}
}</lang> Output:
Kaprekar numbers < 10000:
1
9
45
55
99
297
703
999
2223
2728
4879
4950
5050
5292
7272
7777
9999
There are 54 Kaprekar numbers < 1000000.
Kaprekar numbers between 1 and 1000000(base 17):
Base 10 Base 17 Square Split
16 g f1 f + 1
64 3d e2g e2 + g
225 d4 a52g a5 + 2g
288 gg gf01 gf + 01
1536 556 1b43b2 1b4 + 3b2
3377 bbb 8093b2 809 + 3b2
4912 ggg ggf001 ggf + 001
7425 18bd 24e166g 24e1 + 66g
9280 1f1f 39b1b94 39b1 + b94
16705 36db b992c42 b992 + c42
20736 43cd 10de32fg 10de + 32fg
30016 61eb 23593f92 2359 + 3f92
36801 785d 351e433g 351e + 433g
37440 7a96 37144382 3714 + 4382
46081 967b 52g94382 52g9 + 4382
46720 98b4 5575433g 5575 + 433g
53505 af26 6ga43f92 6ga4 + 3f92
62785 cd44 9a5532fg 9a55 + 32fg
66816 da36 aeg42c42 aeg4 + 2c42
74241 f1f2 d75f1b94 d75f + 1b94
76096 f854 e1f5166g e1f5 + 166g
83520 gggg gggf0001 gggf + 0001
266224 33334 a2c52a07g a2c52 + a07g
1153633 ddddd b3d5e2a07g b3d5e + 2a07g
1334529 fgacc f0540f1a78 f0540f + 1a78
1419856 ggggg ggggf00001 ggggf + 00001
1787968 146fca 19g4c12dg7f 19g4c1 + 2dg7f
3122497 236985 4e3be1f95d8 4e3be1 + f95d8
3773952 2b32b3 711cb2420f9 711cb2 + 420f9
4243968 2gde03 8fegb27eg09 8fegb2 + 7eg09
5108481 3a2d6f cg10b2e3c64 cg10b2 + e3c64
5561920 3fa16d f5eae3043cg f5eae3 + 043cg
6031936 443ccd 110dde332ffg 110dde + 332ffg
6896449 4e9c28 16a10c37gb1d 16a10c + 37gb1d
7435233 54067b 1a72g93aa382 1a72g9 + 3aa382
8017920 5aggb6 1ef1d43d1ef2 1ef1d4 + 3d1ef2
9223201 687534 2835c5403g7g 2835c5 + 403g7g
9805888 6f6f6g 2dbe3f41c131 2dbe3f + 41c131
11140416 7e692a 3a997c43dgbf 3a997c + 43dgbf
11209185 7f391e 3b58d543f059 3b58d5 + 43f059
12928384 91d7f3 4ef79b43f059 4ef79b + 43f059
12997153 92a7e7 4fd82943dgbf 4fd829 + 43dgbf
14331681 a1a1a1 5gf07041c131 5gf070 + 41c131
14914368 a89bdd 685c5e403g7g 685c5e + 403g7g
16119649 b6005b 79f2793d1ef2 79f279 + 3d1ef2
16702336 bcga96 8267143aa382 826714 + 3aa382
17241120 c274e9 8b7acd37gb1d 8b7acd + 37gb1d
18105633 ccd444 99a555332ffg 99a555 + 332ffg
18575649 d16fa4 a12be53043cg a12be5 + 3043cg
19029088 d6e3a2 a9a83f2e3c64 a9a83f + 2e3c64
19893601 e032ge b953g527eg09 b953g5 + 27eg09
20363617 e5de5e c1bd752420f9 c1bd75 + 2420f9
21015072 eda78c cf11c41f95d8 cf11c4 + 1f95d8
22349601 fca147 e9d1d912dg7f e9d1d9 + 12dg7f
22803040 g10645 f2fcde0f1a78 f2fcde + 0f1a78
24137568 gggggg gggggf000001 gggggf + 000001
Haskell
<lang Haskell>import Data.List import Data.Maybe import Numeric import Text.Printf
-- Return a list of pairs such that the sum of each pair is a base-b Kaprecar -- number. For simplicity, we expect the caller to deal with the value 1. kapPairs :: Integral a => a -> [a] -> [(a, a)] kapPairs b = mapMaybe (\m -> kapPair m $ splits b (m*m))
where kapPair n = find (\(j,k) -> j+k == n)
splits b n = filt . map (divMod n) $ iterate (b*) b
filt = takeWhile ((/=0) . fst) . filter ((/=0) . snd)
-- Print a heading for the list of numbers. heading :: Int -> String heading = printf (h ++ d)
where h = " # Value (base 10) Sum (base %d) Square\n"
d = " - --------------- ------------- ------\n"
-- Return information about one Kaprecar number. (We assume the base, b, is -- between 2 and 36, inclusive.) printKap :: Integral a => a -> (Int,(a, a)) -> String printKap b (i,(m,n)) = printf "%2d %13s %31s %16s" i (show s) ss (base b (s*s))
where s = m + n
ss = base b s ++ " = " ++ base b m ++ " + " ++ base b n
base b n = showIntAtBase b (("0123456789" ++ ['a'..'z']) !!) n ""
main :: IO () main = do
let mx = 1000000 :: Int
kap10 = (1,0) : kapPairs 10 [1..mx]
kap17 = (1,0) : kapPairs 17 [1..mx]
putStrLn $ heading 10
mapM_ (putStrLn . printKap 10) $ zip [1..] kap10
putStrLn $ '\n' : heading 17
mapM_ (putStrLn . printKap 17) $ zip [1..] kap17</lang>
Output:
# Value (base 10) Sum (base 10) Square
- --------------- ------------- ------
1 1 1 = 1 + 0 1
2 9 9 = 8 + 1 81
3 45 45 = 20 + 25 2025
4 55 55 = 30 + 25 3025
5 99 99 = 98 + 1 9801
6 297 297 = 88 + 209 88209
7 703 703 = 494 + 209 494209
8 999 999 = 998 + 1 998001
9 2223 2223 = 494 + 1729 4941729
10 2728 2728 = 744 + 1984 7441984
11 4879 4879 = 238 + 4641 23804641
12 4950 4950 = 2450 + 2500 24502500
13 5050 5050 = 2550 + 2500 25502500
14 5292 5292 = 28 + 5264 28005264
15 7272 7272 = 5288 + 1984 52881984
16 7777 7777 = 6048 + 1729 60481729
17 9999 9999 = 9998 + 1 99980001
18 17344 17344 = 3008 + 14336 300814336
19 22222 22222 = 4938 + 17284 493817284
20 38962 38962 = 1518 + 37444 1518037444
21 77778 77778 = 60494 + 17284 6049417284
22 82656 82656 = 68320 + 14336 6832014336
23 95121 95121 = 90480 + 4641 9048004641
24 99999 99999 = 99998 + 1 9999800001
.
.
.
48 812890 812890 = 660790 + 152100 660790152100
49 818181 818181 = 669420 + 148761 669420148761
50 851851 851851 = 725650 + 126201 725650126201
51 857143 857143 = 734694 + 122449 734694122449
52 961038 961038 = 923594 + 37444 923594037444
53 994708 994708 = 989444 + 5264 989444005264
54 999999 999999 = 999998 + 1 999998000001
# Value (base 10) Sum (base 17) Square
- --------------- ------------- ------
1 1 1 = 1 + 0 1
2 16 g = f + 1 f1
3 64 3d = e + 2g e2g
4 225 d4 = a5 + 2g a52g
5 288 gg = gf + 1 gf01
6 1536 556 = 1b4 + 3b2 1b43b2
7 3377 bbb = 809 + 3b2 8093b2
8 4912 ggg = ggf + 1 ggf001
9 7425 18bd = 24e + 166g 24e166g
10 9280 1f1f = 39b + 1b94 39b1b94
11 16705 36db = b99 + 2c42 b992c42
12 20736 43cd = 10de + 32fg 10de32fg
13 30016 61eb = 2359 + 3f92 23593f92
14 36801 785d = 351e + 433g 351e433g
15 37440 7a96 = 3714 + 4382 37144382
16 46081 967b = 52g9 + 4382 52g94382
17 46720 98b4 = 5575 + 433g 5575433g
18 53505 af26 = 6ga4 + 3f92 6ga43f92
19 62785 cd44 = 9a55 + 32fg 9a5532fg
20 66816 da36 = aeg4 + 2c42 aeg42c42
21 74241 f1f2 = d75f + 1b94 d75f1b94
22 76096 f854 = e1f5 + 166g e1f5166g
23 83520 gggg = gggf + 1 gggf0001
24 266224 33334 = a2c5 + 2a07g a2c52a07g
Icon and Unicon
<lang Icon>procedure is_kaprekar(n) #: return n if n is a kaprekar number if ( n = 1 ) |
( n^2 ? ( n = move(1 to *&subject-1) + (0 ~= tab(0)) | fail )) then return n
end
procedure main() every write(is_kaprekar(1 to 10000)) # primary goal every (count := 0, is_kaprekar(1 to 999999), count +:= 1) # stretch goal write ("Number of Kaprekar numbers less than 1000000 is ", count) end</lang>
Output:
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 Number of Kaprekar numbers less than 1000000 is 54
J
Solution: <lang j>kapbase=: 0,. [ ^ 1 + [: i. 1 + [ <.@^. >.&1 isKap=: 1 e. ] ((0 < {:"1@]) *. [ = +/"1@]) kapbase #: *:@]</lang>
Example use:
<lang j> I. 10 isKap"0 i.1e6 1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 17344 22222 38962 77778 82656 95121 99999 142857 148149 181819 187110 208495 318682 329967 351352 356643 390313 461539 466830 499500 500500 533170 538461 609687 627615 643357 648648 670033 681318 791505 812890 818181 851851 857143 961038 994708 999999</lang>
"Extra credit": (text representing numbers left in boxes for alignment purposes) <lang j>
]K17=: I. 17 isKap"0 i.1e6
1 16 64 225 288 1536 3377 4912 7425 9280 16705 20736 30016 36801 37440 46081 46720 53505 62785 66816 74241 76096 83520 266224
base=: [: (] u:@+ 39 * 57 < ]) 48 + #.inv
17 ([ base&.> ],*:@],] (] {:@,@#~ (0 < {:"1@]) *. [ = +/"1@]) kapbase #: *:@])"0 x:K17
┌─────┬─────────┬─────┐ │1 │1 │1 │ ├─────┼─────────┼─────┤ │g │f1 │1 │ ├─────┼─────────┼─────┤ │3d │e2g │2g │ ├─────┼─────────┼─────┤ │d4 │a52g │2g │ ├─────┼─────────┼─────┤ │gg │gf01 │1 │ ├─────┼─────────┼─────┤ │556 │1b43b2 │3b2 │ ├─────┼─────────┼─────┤ │bbb │8093b2 │3b2 │ ├─────┼─────────┼─────┤ │ggg │ggf001 │1 │ ├─────┼─────────┼─────┤ │18bd │24e166g │166g │ ├─────┼─────────┼─────┤ │1f1f │39b1b94 │1b94 │ ├─────┼─────────┼─────┤ │36db │b992c42 │2c42 │ ├─────┼─────────┼─────┤ │43cd │10de32fg │32fg │ ├─────┼─────────┼─────┤ │61eb │23593f92 │3f92 │ ├─────┼─────────┼─────┤ │785d │351e433g │433g │ ├─────┼─────────┼─────┤ │7a96 │37144382 │4382 │ ├─────┼─────────┼─────┤ │967b │52g94382 │4382 │ ├─────┼─────────┼─────┤ │98b4 │5575433g │433g │ ├─────┼─────────┼─────┤ │af26 │6ga43f92 │3f92 │ ├─────┼─────────┼─────┤ │cd44 │9a5532fg │32fg │ ├─────┼─────────┼─────┤ │da36 │aeg42c42 │2c42 │ ├─────┼─────────┼─────┤ │f1f2 │d75f1b94 │1b94 │ ├─────┼─────────┼─────┤ │f854 │e1f5166g │166g │ ├─────┼─────────┼─────┤ │gggg │gggf0001 │1 │ ├─────┼─────────┼─────┤ │33334│a2c52a07g│2a07g│ └─────┴─────────┴─────┘</lang>
The fastest times can be obtained by two optimizations: first, partitions with over half of the digits on the left (i.e. more than 3 for a 5-digit number) will not be considered because the left half is mathematically guaranteed to be greater than the original number in this case. Second, the numbers are computed in groups corresponding to the number of digits in their squares to allow isKap to be computed at full rank. Note that this method excludes 1, so it must be added manually to the list of solutions. <lang j> kapbase=: 0,.10 ^ [: (<.+i.@>.)@(-:&.<:) 10 <.@^. >.&1
isKapGroup=: [: +./"1 (((0 < {:"1@]) *. [ = +/"1@]) (kapbase@{: #:"2 0 ])@:*:)
6!:2 'a=.1, I. ([:; (<@isKapGroup/.~ 10<.@^.*:)) i.1e6'
12.3963
#a
54</lang>
Alternative solution: The following is a more naive, mechanical solution <lang j>splitNum=: {. ,&(_&".) }. allSplits=: (i.&.<:@# splitNum"0 1 ])@": sumValidSplits=: +/"1@:(#~ 0 -.@e."1 ]) filterKaprekar=: #~ ] e."0 1 [: sumValidSplits@allSplits"0 *:</lang>
Example use: <lang j> filterKaprekar i. 10000 0 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999
#filterKaprekar i. 1e6
54</lang>
Java
<lang java>public class Kaprekar {
private static String[] splitAt(String str, int idx){
String[] ans = new String[2];
ans[0] = str.substring(0, idx);
if(ans[0].equals("")) ans[0] = "0"; //parsing "" throws an exception
ans[1] = str.substring(idx);
return ans;
}
public static void main(String[] args){
int count = 0;
int base = (args.length > 0) ? Integer.parseInt(args[0]) : 10;
for(long i = 1; i <= 1000000; i++){
String sqrStr = Long.toString(i * i, base);
for(int j = 0; j < sqrStr.length() / 2 + 1; j++){
String[] parts = splitAt(sqrStr, j);
long firstNum = Long.parseLong(parts[0], base);
long secNum = Long.parseLong(parts[1], base);
//if the right part is all zeroes, then it will be forever, so break
if(secNum == 0) break;
if(firstNum + secNum == i){
System.out.println(i + "\t" + Long.toString(i, base) +
"\t" + sqrStr + "\t" + parts[0] + " + " + parts[1]);
count++;
break;
}
}
}
System.out.println(count + " Kaprekar numbers < 1000000 (base 10) in base "+base);
}
}</lang> Output (base 10, shortened):
1 1 1 0 + 1 9 9 81 8 + 1 45 45 2025 20 + 25 55 55 3025 30 + 25 99 99 9801 98 + 01 297 297 88209 88 + 209 703 703 494209 494 + 209 999 999 998001 998 + 001 2223 2223 4941729 494 + 1729 2728 2728 7441984 744 + 1984 4879 4879 23804641 238 + 04641 4950 4950 24502500 2450 + 2500 5050 5050 25502500 2550 + 2500 5292 5292 28005264 28 + 005264 7272 7272 52881984 5288 + 1984 7777 7777 60481729 6048 + 1729 9999 9999 99980001 9998 + 0001 ... 818181 818181 669420148761 669420 + 148761 851851 851851 725650126201 725650 + 126201 857143 857143 734694122449 734694 + 122449 961038 961038 923594037444 923594 + 037444 994708 994708 989444005264 989444 + 005264 999999 999999 999998000001 999998 + 000001 54 Kaprekar numbers < 1000000 (base 10) in base 10
Output (base 17, shortened):
1 1 1 0 + 1 16 g f1 f + 1 64 3d e2g e + 2g 225 d4 a52g a5 + 2g 288 gg gf01 gf + 01 1536 556 1b43b2 1b4 + 3b2 3377 bbb 8093b2 809 + 3b2 4912 ggg ggf001 ggf + 001 7425 18bd 24e166g 24e + 166g 9280 1f1f 39b1b94 39b + 1b94 ... 76096 f854 e1f5166g e1f5 + 166g 83520 gggg gggf0001 gggf + 0001 266224 33334 a2c52a07g a2c5 + 2a07g 24 Kaprekar numbers < 1000000 (base 10) in base 17
Liberty BASIC
<lang lb>
For i = 1 To 10000 '1000000 - Changing to one million takes a long time to complete!!!! Kaprekar = isKaprekar(i) If Kaprekar Then numKaprekar = (numKaprekar + 1) : Print Kaprekar
Next i
Print numKaprekar End
Function isKaprekar(num)
If num < 1 Then isKaprekar = 0 : Exit Function
If num = 1 Then isKaprekar = num : Exit Function
squarenum$ = str$(num ^ 2)
For i = 1 To Len(squarenum$)
If Val(Mid$(squarenum$, i)) = 0 Then isKaprekar = 0 : Exit Function
If (Val(Left$(squarenum$, (i - 1))) + Val(Mid$(squarenum$, i)) = num) Then isKaprekar = num : Exit Function
Next i
End Function </lang>
PARI/GP
<lang parigp>K(d)={
my(D=10^d,DD,t,v=List());
for(n=D/10+1,D-1,
t=divrem(n^2,D);
if(t[2]&t[1]+t[2]==n,listput(v,n);next);
DD=D;
while(t[2]<n,
t=divrem(n^2,DD*=10);
if(t[2]&t[1]+t[2]==n,listput(v,n);next(2))
);
DD=D;
while(t[1]<n,
t=divrem(n^2,DD/=10);
if(t[2]&t[1]+t[2]==n,listput(v,n);next(2))
)
);
Vec(v)
}; upTo(d)=my(v=[1]);for(n=1,d,v=concat(v,K(n)));v; upTo(4) v=upTo(6);v
- v</lang>
Output:
%1 = [1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999] %2 = [1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999, 17344, 22222, 38962, 77778, 82656, 95121, 99999, 142857, 148149, 181819, 187110, 208495, 318682, 329967, 351352, 356643, 390313, 461539, 466830, 499500, 500500, 533170, 538461, 609687, 627615, 643357, 648648, 670033, 681318, 791505, 812890, 818181, 851851, 857143, 961038, 994708, 999999] %3 = 54
Perl
<lang Perl>sub is_kaprekar {
my $n = shift;
return 1 if $n == 1;
my $s = $n * $n;
for (1 .. length($s)) {
return 1 if substr($s, 0, $_) + (0 + substr($s, $_) || return) == $n;
}
}
- one million is a small number, let's brute force it
is_kaprekar($_) and print "$_\n" for 1 .. 1_000_000;</lang>
Output:
1 9 10 45 55 99 297 703 999 2223 2728 4879 . . . 851851 857143 961038 994708 999999
Perl 6
<lang perl6>sub kaprekar( Int $n ) {
my $sq = $n ** 2;
for 0 ^..^ $sq.chars -> $i {
my $x = +$sq.substr(0, $i);
my $y = +$sq.substr($i) || return;
return True if $x + $y == $n;
}
False;
}
print 1; print " $_" if .&kaprekar for ^10000; print "\n";</lang>
Output:
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999
Note that we check only the second part for 0 since the first must start with a non-zero digit.
PHP
<lang php>set_time_limit(300);
print_r(array_filter(range(1, 10000), 'isKaprekar')); echo count(array_filter(range(1, 1000000), 'isKaprekar'));
function isKaprekar($n) {
$a = $n * $n;
$b = bcmod("$a", "10");
for ($d = 1, $t = 0; $a > 0; $d *= 10) {
$b += $t * $d;
if ($b > $n) break;
$a = floor($a / 10);
if ($b && $a + $b == $n)
return true;
$t = bcmod("$a", "10");
}
return false;
}</lang>
Array
(
[0] => 1
[8] => 9
[44] => 45
[54] => 55
[98] => 99
[296] => 297
[702] => 703
[998] => 999
[2222] => 2223
[2727] => 2728
[4878] => 4879
[4949] => 4950
[5049] => 5050
[5291] => 5292
[7271] => 7272
[7776] => 7777
[9998] => 9999
)
54
PicoLisp
<lang PicoLisp>(de kaprekar (N)
(let L (cons 0 (chop (* N N)))
(for ((I . R) (cdr L) R (cdr R))
(NIL (gt0 (format R)))
(T (= N (+ @ (format (head I L)))) N) ) ) )</lang>
Output:
: (filter kaprekar (range 1 10000)) -> (1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999) : (cnt kaprekar (range 1 1000000)) -> 54
PL/I
<lang PL/I> kaprekar: procedure options (main); /* 22 January 2012 */
declare i fixed decimal (9), j fixed binary; declare s character (20) character varying; declare m fixed decimal (9); declare (z, zeros) character (20) varying;
zeros = '00000000000000000000';
put skip list (1);
do i = 2 to 100000;
s = i*i;
s = trim(s);
z = substr(zeros, 1, length(s));
do j = 1 to length(s)-1;
if substr(s, j+1) = substr(z, j+1) then leave;
m = substr(s, 1, j) + substr(s, j+1);
if i = m then put skip list (i);
end;
end;
end kaprekar; </lang> OUTPUT:
1
9
45
55
99
297
703
999
2223
2728
4879
4950
5050
5292
7272
7777
9999
Prolog
Works with SWI-Prolog, uses a list comprehension : http://rosettacode.org/wiki/List_comprehensions#Prolog <lang Prolog>kaprekar_(Z, X) :- split_number(Z, 10, X).
split_number(Z, N, X) :-
N < Z,
A is Z // N,
B is Z mod N,
( (X is A+B, B\= 0)-> true; N1 is N*10, split_number(Z, N1, X)).
kaprekar(N, V) :- V <- {X & X <- 1 .. N & ((Z is X * X, kaprekar_(Z, X)); X = 1) }. </lang> Example of output :
?- kaprekar(1000, V).
V = [1,9,45,55,99,297,703,999]
?- kaprekar(1000000, V), length(V, N), format('Numbers of kaprekar numbers under 1000000 : ~w~n', [N]).
Numbers of kaprekar numbers under 1000000 : 54
V = [1,9,45,55,99,297,703,999,2223,2728,4879,4950,5050,5292,7272,7777,9999,17344,22222,38962,77778,82656,95121,99999,142857,
148149,181819,187110,208495,318682,329967,351352,356643,390313,461539,466830,499500,500500,533170,538461,609687,627615,
643357,648648,670033,681318,791505,812890,818181,851851,857143,961038,994708,999999],
N = 54 .
PureBasic
<lang PureBasic>Procedure Kaprekar(n.i)
nn.q = n*n
tens.q= 1
While tens<nn: tens*10: Wend
Repeat
tens/10
If tens<=n: Break: EndIf
If nn-n = (nn/tens) * (tens-1)
ProcedureReturn #True
EndIf
ForEver
If n=1
ProcedureReturn #True
EndIf
EndProcedure
If OpenConsole()
For i=1 To 1000000
If Kaprekar(i)
cnt+1
PrintN(RSet(Str(cnt),3)+":"+RSet(Str(i),8))
EndIf
Next
;
Print("Press ENTER to exit")
Input()
EndIf</lang>
1: 1 2: 9 3: 45 4: 55 5: 99 6: 297 7: 703 8: 999 ........... 51: 857143 52: 961038 53: 994708 54: 999999 Press ENTER to exit
Python
(Swap the commented return statement to return the split information). <lang python>>>> def k(n): n2 = str(n**2) for i in range(len(n2)): a, b = int(n2[:i] or 0), int(n2[i:]) if b and a + b == n: return n #return (n, (n2[:i], n2[i:]))
>>> [x for x in range(1,10000) if k(x)]
[1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999]
>>> len([x for x in range(1,1000000) if k(x)])
54
>>> </lang>
A stronger code that gives a list of Kaprekar numbers within a range in a given base. The range must be given as a decimal number. <lang python>def encode(n, base):
result = ""
while n:
n, d = divmod(n, base)
if d < 10:
result += str(d)
else:
result += chr(d - 10 + ord("a"))
return result[::-1]
def Kaprekar(n, base):
if n == '1':
return True
sq = encode((int(n, base)**2), base)
for i in range(1,len(sq)):
if (int(sq[:i], base) + int(sq[i:], base) == int(n, base)) and (int(sq[:i], base) > 0) and (int(sq[i:], base)>0):
return True
return False
def Find(m, n, base):
return [encode(i, base) for i in range(m,n+1) if Kaprekar(encode(i, base), base)]
m = int(raw_input('Where to start?\n')) n = int(raw_input('Where to stop?\n')) base = int(raw_input('Enter base:')) KNumbers = Find(m, n, base) for i in KNumbers:
print i
print 'The number of Kaprekar Numbers found are', print len(KNumbers) raw_input()</lang>
REXX
<lang rexx>/*REXX program to generate Kaprekar numbers. */ /*┌────────────────────────────────────────────────────────────────────┐
│ generate (any maybe show) Kaprekar numbers (and their count). │ │ │ │ Kaprekar numbers were thought of by the mathematician from India, │ │ Shri Dattathreya Ramachardra Kaprekar (1905-1986). │ └────────────────────────────────────────────────────────────────────┘*/
call kaprekar 10000 /*gen Kaprekar numbers & echo nums.*/ call kaprekar -1000000 /*gen Kaprekar numbers & no echo #.*/ exit
/*───────────────────────────────────Kaprekar subroutine────────────────*/ kaprekar: procedure; arg limit; #=0; if 1<=abs(limit) then call tell 1 numeric digits max(9,2*length(limit**2)) /*insure enough digs for square*/
do j=2 to abs(limit) - 1; s = j**2
do k=1 for length(s) % 2
if j==left(s,k)+substr(s,k+1) then call tell j /*Eureka!*/
end /*k*/
end /*j*/
say center("There're" # 'Kaprekar numbers below' abs(limit)".",79,'=');say return
/*───────────────────────────────────tell subroutine────echo# if limit>0*/ tell: #=#+1; if limit>0 then say right(arg(1), length(limit)); return</lang> output
1
9
45
55
99
297
703
999
2223
2728
4879
4950
5050
5292
7272
7777
9999
===================There're 17 Kaprekar numbers below 10000.=================
==================There're 54 Kaprekar numbers below 1000000.================
Ruby
with extra extra credit <lang ruby>def kaprekar(n, base = 10)
n = n.to_s
return [1, 1, 1, ""] if n == "1"
sqr = (n.to_i(base) ** 2).to_s(base)
0.upto(sqr.length - 1) do |i|
a = sqr[0 .. i]
b = sqr[i+1 .. -1]
break if b.delete("0").empty?
sum = (a.to_i(base) + b.to_i(base)).to_s(base)
return [n, sqr, a, b] if sum == n
end
nil
end
count = 0 1.upto(10_000 - 1) do |i|
if result = kaprekar(i) puts "%4d %8d %s + %s" % result count += 1 end
end
10_000.upto(1_000_000 - 1) {|i| count += 1 if kaprekar(i)} puts "#{count} kaprekar numbers under 1,000,000"
puts "\nbase17 kaprekar numbers under (base10)1,000,000" base = 17 1.upto(1_000_000) do |decimal|
if result = kaprekar(decimal.to_s(base), base) puts "%7s %5s %9s %s + %s\n" % [decimal, *result] end
end</lang>
outputs
1 1 1 +
9 81 8 + 1
45 2025 20 + 25
55 3025 30 + 25
99 9801 98 + 01
297 88209 88 + 209
703 494209 494 + 209
999 998001 998 + 001
2223 4941729 494 + 1729
2728 7441984 744 + 1984
4879 23804641 238 + 04641
4950 24502500 2450 + 2500
5050 25502500 2550 + 2500
5292 28005264 28 + 005264
7272 52881984 5288 + 1984
7777 60481729 6048 + 1729
9999 99980001 9998 + 0001
54 kaprekar numbers under 1,000,000
base17 kaprekar numbers under (base10)1,000,000
1 1 1 1 +
16 g f1 f + 1
64 3d e2g e + 2g
225 d4 a52g a5 + 2g
288 gg gf01 gf + 01
1536 556 1b43b2 1b4 + 3b2
3377 bbb 8093b2 809 + 3b2
4912 ggg ggf001 ggf + 001
7425 18bd 24e166g 24e + 166g
9280 1f1f 39b1b94 39b + 1b94
16705 36db b992c42 b99 + 2c42
20736 43cd 10de32fg 10de + 32fg
30016 61eb 23593f92 2359 + 3f92
36801 785d 351e433g 351e + 433g
37440 7a96 37144382 3714 + 4382
46081 967b 52g94382 52g9 + 4382
46720 98b4 5575433g 5575 + 433g
53505 af26 6ga43f92 6ga4 + 3f92
62785 cd44 9a5532fg 9a55 + 32fg
66816 da36 aeg42c42 aeg4 + 2c42
74241 f1f2 d75f1b94 d75f + 1b94
76096 f854 e1f5166g e1f5 + 166g
83520 gggg gggf0001 gggf + 0001
266224 33334 a2c52a07g a2c5 + 2a07g
Run BASIC
<lang runbasic>for i = 1 to 5000
x$ = str$(i * i) if i = 1 then x$ = "10" for j = 1 to len(x$) - 1 if val(left$(x$,j)) + val(mid$(x$,j+1)) = i then print "Kaprekar :";left$(x$,j);" + ";mid$(x$,j+1);" = ";i next j
next i</lang>
Kaprekar :1 + 0 = 1 Kaprekar :8 + 1 = 9 Kaprekar :10 + 0 = 10 Kaprekar :20 + 25 = 45 Kaprekar :30 + 25 = 55 Kaprekar :98 + 01 = 99 Kaprekar :100 + 00 = 100 Kaprekar :88 + 209 = 297 Kaprekar :494 + 209 = 703 Kaprekar :998 + 001 = 999 Kaprekar :1000 + 000 = 1000 Kaprekar :494 + 1729 = 2223 Kaprekar :744 + 1984 = 2728 Kaprekar :238 + 04641 = 4879 Kaprekar :2450 + 2500 = 4950
Scala
<lang Scala>object Kaprekar extends App {
def isKaprekar(n: Int, base: Int = 10):Option[Triple[String,String,String]] = {
val check: Long => Option[Triple[String,String,String]] = n => {
val split: Pair[String, Int] => Pair[String, String] = p => (p._1.slice(0,p._2),p._1.slice(p._2,p._1.size).padTo[Char,String](1,'0'))
val pwr = n*n
val sN = java.lang.Long.toString(n, base)
val sPwr = java.lang.Long.toString(pwr, base)
for (i <- 1 to sPwr.size) {
val (a, b) = split(sPwr,i)
val la = java.lang.Long.parseLong(a, base)
val lb = java.lang.Long.parseLong(b, base)
if (lb==0) return None
if (la+lb==n) return Some(Triple(sPwr,a,b))
}
None
}
n match {
case 1 => Some(Triple("1","0","1"))
case n if (n>1) => check(n)
case _ => None
}
}
def kaprekars(n: Int,base: Int=10) = (1 to n).map(isKaprekar(_,base)).zip(1 to n).filter(_._1!=None).map(p=>Triple(base,p._2,p._1 match {case Some(t) => t; case _ => Nil}))
val k1 = kaprekars(10000)
k1 foreach {p=>println(p._2)}
println(k1.size + " Kaprekar numbers < 10000 (b:10) for base 10"+"\n"*2)
val k2 = kaprekars(1000000)
k2 foreach {p => println(p._2+"\t"+java.lang.Long.toString(p._2,p._1)+"\t"+p._3.productElement(0)+"\t"+p._3.productElement(1)+" + "+p._3.productElement(2))}
println(k2.size + " Kaprekar numbers < 1000000 (b:10) for base 10"+"\n"*2)
val k3 = kaprekars(1000000,17)
k3 foreach {p => println(p._2+"\t"+java.lang.Long.toString(p._2,p._1)+"\t"+p._3.productElement(0)+"\t"+p._3.productElement(1)+" + "+p._3.productElement(2))}
println(k3.size + " Kaprekar numbers < 1000000 (b:10) for base 17"+"\n"*2)
}</lang> Output:
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999 17 Kaprekar numbers < 10000 (b:10) for base 10 1 1 1 0 + 1 9 9 81 8 + 1 45 45 2025 20 + 25 55 55 3025 30 + 25 99 99 9801 98 + 01 297 297 88209 88 + 209 703 703 494209 494 + 209 999 999 998001 998 + 001 2223 2223 4941729 494 + 1729 2728 2728 7441984 744 + 1984 4879 4879 23804641 238 + 04641 4950 4950 24502500 2450 + 2500 5050 5050 25502500 2550 + 2500 5292 5292 28005264 28 + 005264 7272 7272 52881984 5288 + 1984 7777 7777 60481729 6048 + 1729 9999 9999 99980001 9998 + 0001 17344 17344 300814336 3008 + 14336 22222 22222 493817284 4938 + 17284 38962 38962 1518037444 1518 + 037444 77778 77778 6049417284 60494 + 17284 82656 82656 6832014336 68320 + 14336 95121 95121 9048004641 90480 + 04641 99999 99999 9999800001 99998 + 00001 142857 142857 20408122449 20408 + 122449 148149 148149 21948126201 21948 + 126201 181819 181819 33058148761 33058 + 148761 187110 187110 35010152100 35010 + 152100 208495 208495 43470165025 43470 + 165025 318682 318682 101558217124 101558 + 217124 329967 329967 108878221089 108878 + 221089 351352 351352 123448227904 123448 + 227904 356643 356643 127194229449 127194 + 229449 390313 390313 152344237969 152344 + 237969 461539 461539 213018248521 213018 + 248521 466830 466830 217930248900 217930 + 248900 499500 499500 249500250000 249500 + 250000 500500 500500 250500250000 250500 + 250000 533170 533170 284270248900 284270 + 248900 538461 538461 289940248521 289940 + 248521 609687 609687 371718237969 371718 + 237969 627615 627615 393900588225 39390 + 0588225 643357 643357 413908229449 413908 + 229449 648648 648648 420744227904 420744 + 227904 670033 670033 448944221089 448944 + 221089 681318 681318 464194217124 464194 + 217124 791505 791505 626480165025 626480 + 165025 812890 812890 660790152100 660790 + 152100 818181 818181 669420148761 669420 + 148761 851851 851851 725650126201 725650 + 126201 857143 857143 734694122449 734694 + 122449 961038 961038 923594037444 923594 + 037444 994708 994708 989444005264 989444 + 005264 999999 999999 999998000001 999998 + 000001 54 Kaprekar numbers < 1000000 (b:10) for base 10 1 1 1 0 + 1 16 g f1 f + 1 64 3d e2g e + 2g 225 d4 a52g a5 + 2g 288 gg gf01 gf + 01 1536 556 1b43b2 1b4 + 3b2 3377 bbb 8093b2 809 + 3b2 4912 ggg ggf001 ggf + 001 7425 18bd 24e166g 24e + 166g 9280 1f1f 39b1b94 39b + 1b94 16705 36db b992c42 b99 + 2c42 20736 43cd 10de32fg 10de + 32fg 30016 61eb 23593f92 2359 + 3f92 36801 785d 351e433g 351e + 433g 37440 7a96 37144382 3714 + 4382 46081 967b 52g94382 52g9 + 4382 46720 98b4 5575433g 5575 + 433g 53505 af26 6ga43f92 6ga4 + 3f92 62785 cd44 9a5532fg 9a55 + 32fg 66816 da36 aeg42c42 aeg4 + 2c42 74241 f1f2 d75f1b94 d75f + 1b94 76096 f854 e1f5166g e1f5 + 166g 83520 gggg gggf0001 gggf + 0001 266224 33334 a2c52a07g a2c5 + 2a07g 24 Kaprekar numbers < 1000000 (b:10) for base 17
Scheme
<lang scheme>; auxiliary functions : range, filter (define (range a b) (let loop ((v '()) (i b)) (if (< i a)
v
(loop (cons i v)
(- i 1)))))
(define (filter p u) (if (equal? u '())
'()
(let ((x (car u)) (v (filter p (cdr u))))
(if (p x)
(cons x v)
v))))
(define (kaprekar? n) (or (= n 1)
(let ((q (* n n)))
(let loop ((p 10))
(cond ((> p q) #f)
((let ((a (remainder q p)) (b (quotient q p)))
(and (> a 0) (= n (+ a b)))) #t)
(else (loop (* p 10))))))))
(filter kaprekar? (range 1 10000))
- (1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999)</lang>
Seed7
<lang seed7>$ include "seed7_05.s7i";
include "bigint.s7i";
const func bigInteger: kaprekar (in bigInteger: n, in bigInteger: base) is func
result
var bigInteger: kaprekar is 0_;
local
var bigInteger: nn is 0_;
var bigInteger: r is 0_;
var bigInteger: powerOfBase is 1_;
begin
nn := n ** 2;
while powerOfBase < n do
powerOfBase *:= base;
end while;
if n = powerOfBase then
kaprekar := bigInteger conv ord(n = 1_);
else
r := nn rem powerOfBase;
while r < n do
if nn div powerOfBase + r = n then
kaprekar := powerOfBase;
r := n;
else
powerOfBase *:= base;
r := nn rem powerOfBase;
end if;
end while;
end if;
end func;
const proc: main is func
local
var bigInteger: aNumber is 0_;
var integer: count is 0;
var bigInteger: powerOfBase is 1_;
const integer: base is 17;
begin
writeln("base 10:");
for aNumber range 1_ to 1000000_ do
if kaprekar(aNumber, 10_) <> 0_ then
incr(count);
writeln(count lpad 3 <& ": " <& aNumber);
end if;
end for;
writeln;
writeln("base " <& base <& ":");
writeln(" 1: 1");
count := 1;
for aNumber range 2_ to 1000000_ do
powerOfBase := kaprekar(aNumber, bigInteger conv base);
if powerOfBase <> 0_ then
incr(count);
write(count lpad 3 <& ": " <& aNumber);
write(" \t" <& str(aNumber, base));
write("\t" <& str(aNumber ** 2, base));
write("\t" <& str(aNumber ** 2 mdiv powerOfBase, base));
write(" + " <& str(aNumber ** 2 mod powerOfBase, base));
writeln;
end if;
end for;
end func;</lang>
Output:
base 10: 1: 1 2: 9 3: 45 4: 55 5: 99 6: 297 7: 703 8: 999 9: 2223 10: 2728 11: 4879 12: 4950 13: 5050 14: 5292 15: 7272 16: 7777 17: 9999 18: 17344 19: 22222 20: 38962 21: 77778 22: 82656 23: 95121 24: 99999 25: 142857 26: 148149 27: 181819 28: 187110 29: 208495 30: 318682 31: 329967 32: 351352 33: 356643 34: 390313 35: 461539 36: 466830 37: 499500 38: 500500 39: 533170 40: 538461 41: 609687 42: 627615 43: 643357 44: 648648 45: 670033 46: 681318 47: 791505 48: 812890 49: 818181 50: 851851 51: 857143 52: 961038 53: 994708 54: 999999 base 17: 1: 1 2: 16 G F1 F + 1 3: 64 3D E2G E + 2G 4: 225 D4 A52G A5 + 2G 5: 288 GG GF01 GF + 1 6: 1536 556 1B43B2 1B4 + 3B2 7: 3377 BBB 8093B2 809 + 3B2 8: 4912 GGG GGF001 GGF + 1 9: 7425 18BD 24E166G 24E + 166G 10: 9280 1F1F 39B1B94 39B + 1B94 11: 16705 36DB B992C42 B99 + 2C42 12: 20736 43CD 10DE32FG 10DE + 32FG 13: 30016 61EB 23593F92 2359 + 3F92 14: 36801 785D 351E433G 351E + 433G 15: 37440 7A96 37144382 3714 + 4382 16: 46081 967B 52G94382 52G9 + 4382 17: 46720 98B4 5575433G 5575 + 433G 18: 53505 AF26 6GA43F92 6GA4 + 3F92 19: 62785 CD44 9A5532FG 9A55 + 32FG 20: 66816 DA36 AEG42C42 AEG4 + 2C42 21: 74241 F1F2 D75F1B94 D75F + 1B94 22: 76096 F854 E1F5166G E1F5 + 166G 23: 83520 GGGG GGGF0001 GGGF + 1 24: 266224 33334 A2C52A07G A2C5 + 2A07G
Tcl
<lang tcl>package require Tcl 8.5; # Arbitrary precision arithmetic, for stretch goal only proc kaprekar n {
if {$n == 1} {return 1}
set s [expr {$n * $n}]
for {set i 1} {$i < [string length $s]} {incr i} {
scan $s "%${i}d%d" a b if {$b && $n == $a + $b} { return 1 #return [list 1 $a $b] }
} return 0
}
- Base goal
for {set i 1} {$i < 10000} {incr i} {
if {[kaprekar $i]} {lappend klist $i}
} puts [join $klist ", "]
- Stretch goal
for {set i 1} {$i < 1000000} {incr i} {
incr kcount [kaprekar $i]
} puts "$kcount Kaprekar numbers less than 1000000"</lang> Output:
1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272, 7777, 9999 54 Kaprekar numbers less than 1000000
Ursala
First we define a function kd parameterized by a pair of functions p and r for printing and reading natural numbers, which takes a natural number to its Kaprekar decomposition if any.
<lang Ursala>#import std
- import nat
kd("p","r") = ~&ihB+ (~&rr&& ^|E/~& sum)~|^/~& "r"~~*hNCtXS+ cuts\1+ "p"+ product@iiX
- cast %nLnX
t = ^|(~&,length) (iota; :/1+ ~&rFlS+ * ^/~& kd\%np ~&h+ %nP)~~/10000 1000000</lang>
The kd function parameterized by the built in decimal printing and reading functions is applied to the sequences from zero to 10000 and zero to 1000000, with the results filtered according to whether the decomposition exists. The inputs in the former case and the length in the latter are shown.
(
<
1,
9,
45,
55,
99,
297,
703,
999,
2223,
2728,
4879,
4950,
5050,
5292,
7272,
7777,
9999>,
54)
For the rest of the task, functions p and r are defined for numbers in base 17.
<lang Ursala>p = ||'0'! ~&a^& ^|J(~&,division\17); ^lrNCT/~&falPR @ar -$/iota17 digits--'abcdefg'
r = sum^|(~&,product/17)=>0+ *x -$/digits--'abcdefg' iota17
- show+
t = mat` *K7 pad` *K7 ^C(~&h+ %nP@l,p*+ <.~&l,product@llX,~&rl,~&rr>)*rF ^(~&,kd/p r@h)* iota 1000000</lang>
The kd function is parameterized by them and a table of results for numbers between 1 and 1000000 is displayed.
16 g f1 f 1 64 3d e2g e 2g 225 d4 a52g a5 2g 288 gg gf01 gf 1 1536 556 1b43b2 1b4 3b2 3377 bbb 8093b2 809 3b2 4912 ggg ggf001 ggf 1 7425 18bd 24e166g 24e 166g 9280 1f1f 39b1b94 39b 1b94 16705 36db b992c42 b99 2c42 20736 43cd 10de32fg 10de 32fg 30016 61eb 23593f92 2359 3f92 36801 785d 351e433g 351e 433g 37440 7a96 37144382 3714 4382 46081 967b 52g94382 52g9 4382 46720 98b4 5575433g 5575 433g 53505 af26 6ga43f92 6ga4 3f92 62785 cd44 9a5532fg 9a55 32fg 66816 da36 aeg42c42 aeg4 2c42 74241 f1f2 d75f1b94 d75f 1b94 76096 f854 e1f5166g e1f5 166g 83520 gggg gggf0001 gggf 1 266224 33334 a2c52a07g a2c5 2a07g