Kaprekar numbers
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
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;
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++
<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!
Common Lisp
<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)))))))
(test-million 10)
(test-million 17)</lang>
D
<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
Fast version
More than ten times faster than the first version (same output):
<lang d>import std.stdio, std.algorithm, std.range;
bool isKaprekar(in long n) pure nothrow in {
assert(n > 0, "isKaprekar(n) is defined for n > 0."); assert(n <= 3_162_277_660UL, "isKaprekar(n) overflow.");
} body {
immutable ulong nn = n * n;
ulong tens = 1;
while (tens < nn)
tens *= 10;
while ((tens /= 10) > n)
if (nn - n == (nn / tens) * (tens - 1))
return true;
return n == 1;
}
void main() {
writeln(filter!isKaprekar(iota(1, 10_000))); writeln(count!isKaprekar(iota(1, 1_000_000)));
}</lang>
Alternative version
Right to left: <lang d>import std.stdio;
bool isKaprekar(in long n) in {
assert(n > 0 && n <= uint.max, "n must be > 0 and < uint.max");
} body {
ulong right = n ^^ 2UL;
ulong left = right % 10;
for (ulong tens = 1, temp = 0; right > 0; tens *= 10) {
left += temp * tens;
if (left > n)
break;
right /= 10;
if (left && right + left == n)
return true;
temp = right % 10;
}
return false;
}
void main() {
int count = 1;
foreach (i; 1 .. 1_000_000)
if (isKaprekar(i))
writefln("%d: %d", count++, i);
}</lang>
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>
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
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