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.
Programming Praxis 
[…] today’s Programming Praxis exercise,our goal is to determine the longest possible Kaprekar chain and the […]
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 = [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]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.
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)
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)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]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))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[0], reverse=True)[0])
sorry, forgot formatting.
#!/usr/bin/python3import 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[0], reverse=True)[0])
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[0], reverse=True)[0])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): pad = '{{:0{}}}'.format(len(str(n))).format ans = [] while n not in ans: ans.append(n) s = sorted(pad(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));;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. (stream-head kapreka-numbers 10)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 }
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 }