## Two Kaprekar Exercises

### March 22, 2011

We begin with the function that makes a single step in a Kaprekar chain:

`(define (step n)`

(let* ((ds (normalize n))

(big (undigits (sort > ds)))

(little (undigits (sort < ds))))

(- big little)))

That function calls a function that adds leading zeros if needed:

`(define (normalize n)`

(let loop ((ds (digits n)))

(if (= (length ds) 4) ds

(loop (cons 0 ds)))))

Then it is easy to compute the chain; we stop at either 6174 or 0, where 0 occurs only if all the digits are the same:

`(define (chain n)`

(let loop ((ns (list n)))

(if (member (car ns) '(0 6174))

(reverse ns)

(loop (cons (step (car ns)) ns)))))

Here’s an example:

`> (chain 2011)`

(2011 1998 8082 8532 6174)

The longest Kaprekar chain has seven steps; we compute eight because our chain includes both the beginning and ending numbers:

`> (apply max (map length (map chain (range 1 10000))))`

8

Determining if a number is a Kaprekar number is a simple translation of the stated algorithm to Scheme:

`(define (kaprekar? k)`

(let* ((n (length (digits k)))

(k2 (* k k))

(ds (reverse (digits k2)))

(left (undigits (reverse (drop n ds))))

(right (undigits (reverse (take n ds)))))

(= (+ left right) k)))

Here’s an example:

`(kaprekar? 703)`

#t

There are eight Kaprekar numbers less than a thousand:

`(filter kaprekar? (range 1 1000))`

(1 9 45 55 99 297 703 999)

We used take, drop, range, filter, sort, digits and undigits from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/jUEoq05B.

Pages: 1 2

[…] 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):

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:

In F#

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/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])`

3rd time’s a charm. ;)

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().

;;mit scheme

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)

Session: