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.

About these ads

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 = [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[0], reverse=True)[0])

  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[0], reverse=True)[0])

  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[0], reverse=True)[0])
    
  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):
    	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))
    
    
  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.
    (stream-head kapreka-numbers 10)
    
  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 }
    

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 577 other followers

%d bloggers like this: