## Two Kaprekar Exercises

### March 22, 2011

For today’s exercise we return to the world of recreational mathematics with two exercises due to the Indian mathematician Dattaraya Ramchandra Kaprekar. First we compute Kaprekar chains:

1. Choose any four-digit number, with at least two different digits. Leading zeros are permitted.

2. Arrange the digits into two numbers, one with the digits sorted into ascending order, the other with the digits sorted into descending order.

3. Subtract the smaller number from the larger number.

4. Repeat until the number is 6174. At that point, the process will cycle with 7641 − 1467 = 6174.

For instance, starting with 2011, the chain is 2110 − 112 = 1998, 9981 − 1899 = 8082, 8820 − 288 = 8532, and 8532 − 2358 = 6174.

The second exercise determines if a number is a Kaprekar number, defined as an n-digit number such that, when it is squared, the sum of the first n or n−1 digits and the last n digits is the original number. For instance, 703 is a Kaprekar number because 7032 = 494209 and 494 + 209 = 703. Sloane gives the list of Kaprekar numbers at A053816.

Your task is twofold: first, write a program that computes the Kaprekar chain for a given starting number, and compute the longest possible Kaprekar chain; second, write a program to determine if a particular number is a Kaprekar number, and compute the list of all the Kaprekar numbers less than a thousand. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

Pages: 1 2

### 14 Responses to “Two Kaprekar Exercises”

1. […] today’s Programming Praxis exercise,our goal is to determine the longest possible Kaprekar chain and the […]

2. My Haskell solution (see http://bonsaicode.wordpress.com/2011/03/22/programming-praxis-two-kaprekar-exercises/ for a version with comments):

```import Data.List
import qualified Data.List.Key as K
import Text.Printf

chain :: Int -> [Int]
chain 0 = []
chain 6174 = 
chain n = n : chain (read (reverse p) - read p) where
p = sort \$ printf "%04d" n

isKaprekar :: Integral a => a -> Bool
isKaprekar n = n == uncurry (+) (divMod (n^2) \$ 10 ^ length (show n))

main :: IO ()
main = do print \$ chain 2011 == [2011, 1998, 8082, 8532, 6174]
print . K.maximum length \$ map chain [0..9999]
print \$ filter isKaprekar [1..999] ==
[1, 9, 45, 55, 99, 297, 703, 999]
```
3. Graham said

I believe we’ve done the second part before (exercise 169), but I came up with a
new solution this time.
My solution is available here.

4. Rainer said

My try in REXX

KAPREKAR_KONST = 6174

/* Kaprekar-Ketten */
do 10
erg = 0
do until erg = 1
zahl = right(random(1,9999),4,’0′)
erg = pruefe(zahl)
end
say ‘Die Kaprekar-Kette für’ zahl ‘lautet’,
kaprekar_kette(zahl)
end

/* Kaprekar-Zahlen */
do zahl = 1 to 10000
if kaprekar_zahl(zahl) then say,
zahl ‘ist eine Kaprekar-Zahl.’
end

exit

kaprekar_kette:
parse arg zahl
kette = zahl
do while zahl <> KAPREKAR_KONST
interpret ‘erg=’sort(zahl,’D’)’-‘sort(zahl,’A’)
kette = kette erg
zahl = erg
end
return kette

kaprekar_zahl:
parse arg zahl
q = zahl * zahl
lq = length(q)
kurz = lq % 2
lang = lq % 2
if odd(lq) then lang = lang + 1
if odd(lq) then chk = left(q,kurz) ‘+’ right(q,lang)
else chk = left(q,kurz) ‘+’ right(q,lang)
interpret ‘erg =’ chk
return erg == zahl

pruefe:
parse arg text
do x = 1 to length(text)
if verify(text, substr(text, x, 1), ‘N’) > 0
then return 1
end
return 0

sort:
parse arg text, folge
chg = 1
do while chg == 1 & length(text) > 1
chg = 0
do i = 1 to (length(text) – 1)
j = i + 1
if (folge == ‘A’ & substr(text, i, 1) >,
substr(text, j, 1) |,
folge == ‘D’ & substr(text, i, 1) <,
substr(text, j, 1))
then do
temp = substr(text,i,1)
text = overlay(substr(text,j,1), text, i, 1)
text = overlay(temp, text, j, 1)
chg = 1
end
end
end
return text

odd:
parse arg num
return (num // 2)

5. Rainer said

Sorry, forgot the formatting:

```
KAPREKAR_KONST = 6174

/* Kaprekar-Ketten */
do 10
erg = 0
do until erg = 1
zahl = right(random(1,9999),4,'0')
erg = pruefe(zahl)
end
say 'Die Kaprekar-Kette für' zahl 'lautet',
kaprekar_kette(zahl)
end

/* Kaprekar-Zahlen */
do zahl = 1 to 10000
if kaprekar_zahl(zahl) then say,
zahl 'ist eine Kaprekar-Zahl.'
end

exit

kaprekar_kette:
parse arg zahl
kette = zahl
do while zahl <> KAPREKAR_KONST
interpret 'erg='sort(zahl,'D')'-'sort(zahl,'A')
kette = kette erg
zahl = erg
end
return kette

kaprekar_zahl:
parse arg zahl
q = zahl * zahl
lq = length(q)
kurz = lq % 2
lang = lq % 2
if odd(lq) then lang = lang + 1
if odd(lq) then chk = left(q,kurz) '+' right(q,lang)
else            chk = left(q,kurz) '+' right(q,lang)
interpret 'erg =' chk
return erg == zahl

pruefe:
parse arg text
do x = 1 to length(text)
if verify(text, substr(text, x, 1), 'N') > 0
then return 1
end
return 0

sort:
parse arg text, folge
chg = 1
do while chg == 1 & length(text) > 1
chg = 0
do i = 1 to (length(text) - 1)
j = i + 1
if (folge == 'A' & substr(text, i, 1) >,
substr(text, j, 1) |,
folge == 'D' & substr(text, i, 1) <,
substr(text, j, 1))
then do
temp = substr(text,i,1)
text = overlay(substr(text,j,1), text, i, 1)
text = overlay(temp, text, j, 1)
chg = 1
end
end
end
return text

odd:
parse arg num
return (num // 2)

```
6. Khanh Nguyen said

In F#

```let rec kaprekar_chain (n:int) =
let digits = n.ToString().PadLeft(4,'0').ToCharArray()
|> List.ofArray
|> List.map (fun c -> (int c) - (int '0'))
let ascend = List.sort digits
let descend = List.rev ascend

let a = List.foldBack (fun x acc -> x + acc * 10) ascend 0
let b = List.foldBack (fun x acc -> x + acc * 10) descend 0

match a - b with
| 6174 -> [n;6174]
| 0    -> []
| _    -> n::(kaprekar_chain (a-b))

[1..9999] |> List.maxBy (fun c -> (kaprekar_chain >> List.length) c)
kaprekar_chain 14 |> List.length

let isKaprekar (input:int) =
match input with
| 1 -> true
| _ when input < 4 -> false
| _ ->
let n = string(input).Length
let squared = string(input * input)
let rightNDigits = int(squared.[(squared.Length-n) .. (squared.Length-1)])
input = int(squared.[0 .. (squared.Length - n - 1)]) + rightNDigits

List.filter isKaprekar [1 .. 999]
```
7. Mike said
```def chain(n):
sz = len(str(n))

yield n
while n and n != 6174:
s = list(sorted(str(n),reverse=True))
if len(s) < sz:
s.extend(['0']*(sz-len(s)))
n = int(''.join(s)) - int(''.join(reversed(s)))
yield n

max(len(list(chain(n))) for n in range(1000,10000))

def isKaprekar(n):
sz = len(str(n))
s = str(n*n)
m = int(s[:-sz] or 0) + int(s[-sz:])
return n == m

filter(isKaprekar, range(1,1000))

```
8. Bryce said

Here is my solution in python3.

(Used a variant of Mike’r isKaprekar function. As it was cleaner than my original one. And I also wanted to understand the “int(s[:-sz] or 0)” expression)

#!/usr/bin/python3

import itertools

def isKaprekar(number):
square = str(number ** 2)
numlen = len(str(number))
return number == int(square[:-numlen] or 0) + int(square[-numlen:])

def keprekar_chain(number):
retlist = [number]
if len(set(str(number))) > 2:
while retlist[-1] != 6174:
pers = [int(”.join(x)) for x in
itertools.permutations(str(retlist[-1]))]
retlist.append(max(pers) – min(pers))
return retlist
else:
return []

if __name__ == “__main__”:
print(‘Keprekar numbers from 1 to 1000:’)
print(*[x for x in range(1,1001) if isKaprekar(x)])

print(‘Longest chain between 1000 and 9999’)
kep_list = []
for x in range(1000,10000):
tlist = keprekar_chain(x)
kep_list.append((len(tlist), tlist))

print(sorted(kep_list, key= lambda x: x, reverse=True))

9. Bryce said

sorry, forgot formatting.

`#!/usr/bin/python3`

``` import itertools def isKaprekar(number): square = str(number ** 2) numlen = len(str(number)) return number == int(square[:-numlen] or 0) + int(square[-numlen:]) def keprekar_chain(number): retlist = [number] if len(set(str(number))) > 2: while retlist[-1] != 6174: pers = [int(''.join(x)) for x in itertools.permutations(str(retlist[-1]))] retlist.append(max(pers) - min(pers)) return retlist else: return [] if __name__ == "__main__": print('Keprekar numbers from 1 to 1000:') print(*[x for x in range(1,1001) if isKaprekar(x)]) print('Longest chain between 1000 and 9999') kep_list = [] for x in range(1000,10000): tlist = keprekar_chain(x) kep_list.append((len(tlist), tlist)) ```

` print(sorted(kep_list, key= lambda x: x, reverse=True))`

10. Bryce said

3rd time’s a charm. ;)

```#!/usr/bin/python3

import itertools

def isKaprekar(number):
square = str(number ** 2)
numlen = len(str(number))
return number == int(square[:-numlen] or 0) + int(square[-numlen:])

def keprekar_chain(number):
retlist = [number]
if len(set(str(number))) > 2:
while retlist[-1] != 6174:
pers = [int(''.join(x)) for x in
itertools.permutations(str(retlist[-1]))]
retlist.append(max(pers) – min(pers))
return retlist
else:
return []

if __name__ == “__main__”:
print(‘Keprekar numbers from 1 to 1000:’)
print(*[x for x in range(1,1001) if isKaprekar(x)])

print(‘Longest chain between 1000 and 9999′)
kep_list = []
for x in range(1000,10000):
tlist = keprekar_chain(x)
kep_list.append((len(tlist), tlist))

print(sorted(kep_list, key= lambda x: x, reverse=True))
```
11. Mike said

My previous solution for chains was intended to work for any number, not just 4-digit numbers. However, I had hard coded the 6174 value, so it obviously only works for 4-digit numbers. Here’s a version that works for other sizes of numbers.

The line pad = … creates a function that converts a number to a string, padded with leading zeros so it has the same length as the original n.

Also, I think Remco had the best isKaprekar function. Python version below. The divmod(n*n, 10**len(str(n))) returns a tuple with the two halves of n**2. The * in front of divmod unpacks the tuple to provide the arguments to add().

```#from operator import add

def makeint(s):
return int(''.join(s))

def chain(n):

ans = []
while n not in ans:
ans.append(n)
n = makeint(reversed(s)) - makeint(s)

return ans

def isKeprekar(n):
return n == add(*divmod(n*n, 10**(len(str(n)))))

# this returns a chain of maximum length
max((chain(n) for n in range(1000,10000)), key=len)

# this returns a list of all Keprekar numbers up to 1000
filter(isKeprekar, range(1,1001))

```
12. yaq said

;;mit scheme

```(define (get-next n)
(let ((asc (undigits (sort (digits n) <)))
(dsc (undigits (sort (digits n) >))))
(- dsc asc)))

(define (kaprekar-chains n chain)
(let ((next (get-next n)))
(if (= next 6174)
chain
(kaprekar-chains next (cons next chain)))))

(kaprekar-chains 2011 (cons 2011 '()))

(define (square x)
(* x x))

(define (get-firstN len)
(cond ((even? len)
(/ len 2))
(else
(- (/ (+ len 1) 2) 1))))

(define (isKaprekar? n)
(let ((result (digits (square n)))
(firstN (get-firstN (length (digits (square n))))))
(equal? (+ (undigits (list-head result firstN))
(undigits (list-tail result firstN)))
n)))

(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))

(define integers (integers-starting-from 1))

(define kapreka-numbers
(stream-filter isKaprekar? integers))

;;you can retrieve more, but it takes only first 10 numbers here.
```
13. David said

This is a solution in the concatenative language Factor.
(see http://www.factorcode.org)

``` USING: kernel arrays math math.order sequences sets sorting        lists lists.lazy ; IN: kaprekar```

``` ! *** Kaprekar sequences *** : vectorize ( n -- vec )      10 /mod swap ! output array is reverse order      10 /mod swap ! digits of n      10 /mod swap      4array ; : vectorized>int ( vec -- n )     <reversed> 0 [ swap 10 * + ] reduce ; : kaprekar-iteration ( n -- n )     vectorize [ <=> ] sort dup reverse [ vectorized>int ] bi@ - ; : eligible? ( n -- ? )     dup 0000 9999 between?     swap 100 /mod = not and ; : kaprekar-sequence ( n -- lazy-list )     dup eligible?         [ [ kaprekar-iteration ] lfrom-by [ 6174 = ] luntil ]         [ drop nil ] if ; : longest-kaprekar-chain ( -- n )     10000 iota [ kaprekar-sequence llength ] [ max ] map-reduce ; ! *** Kaprekar numbers *** : kaprekar-modulus ( n -- n )     1 swap     [ dup 0 > ]        [ [ 10 * ] dip 10 /i ]     while drop ; ```

```: kaprekar? ( n -- ? )     dup dup kaprekar-modulus [ sq ] dip /mod + = ; ```

Results from an interactive session:

USE: kaprekar

2011 kaprekar-sequence [ ] lmap>array .
{ 2011 1998 8082 8532 6174 }

longest-kaprekar-chain .
8

703 kaprekar? .
t

1000 [1,b] [ kaprekar? ] filter .
V{ 1 9 45 55 99 297 703 999 }

14. David said

Trying again. The sed script leaves much to be desired…

This is a solution in the concatenative language Factor.
(see http://www.factorcode.org)

```USING: kernel arrays math math.order sequences sets sorting
lists lists.lazy ;
IN: kaprekar

! *** Kaprekar sequences ***

: vectorize ( n -- vec )
10 /mod swap   ! output array is reverse order
10 /mod swap   ! digits of n
10 /mod swap
4array ;

: vectorized>int ( vec -- n )
<reversed> 0 [ swap 10 * + ] reduce ;

: kaprekar-iteration ( n -- n )
vectorize [ <=> ] sort  dup reverse  [ vectorized>int ] bi@ - ;

: eligible? ( n -- ? )
dup  0000 9999 between?
swap 100 /mod = not      and ;

: kaprekar-sequence ( n -- lazy-list )
dup eligible?
[ [ kaprekar-iteration ] lfrom-by [ 6174 = ] luntil ]
[ drop nil ] if ;

: longest-kaprekar-chain ( -- n )
10000 iota [ kaprekar-sequence llength ] [ max ] map-reduce ;

! *** Kaprekar numbers ***

: kaprekar-modulus  ( n -- n )
1 swap
[ dup 0 > ]
[ [ 10 * ] dip 10 /i ]
while drop ;

: kaprekar?  ( n -- ? )
dup dup kaprekar-modulus [ sq ] dip /mod + = ;
```

Session:

```USE: kaprekar

2011 kaprekar-sequence [ ] lmap>array .
{ 2011 1998 8082 8532 6174 }

longest-kaprekar-chain .
8

703 kaprekar? .
t

1000 [1,b] [ kaprekar? ] filter .
V{ 1 9 45 55 99 297 703 999 }
```