Number 6174 or Kaprekar constant in R

Not always is the answer 42 as explained in Hitchhiker’s guide. Sometimes it is also 6174.

2019-02-17 10_38_38-Presentation1 - PowerPoint

Kaprekar number is one of those gems, that makes Mathematics fun. Indian recreational mathematician D.R.Kaprekar, found number 6174 – also known as Kaprekar constant – that will return the subtraction result when following this rules:

  1.  Take any four-digit number, with minimum of two different numbers (1122 or 5151 or 1001 or 4375 and so on.)
  2. Sort the taken number and sort it descending order and ascending order.
  3. Subtract the descending number from ascending number.
  4. Repeat step 2. and 3. until you get the result 6174

In practice, e.g.: number 5462, the steps would be:

6542 - 2456 = 4086
8640 -  468 = 8172
8721 - 1278 = 7443
7443 - 3447 = 3996
9963 - 3699 = 6264
6642 - 2466 = 4176
7641 - 1467 = 6174

or for number 6235:

6532 - 2356 = 4176
7641 - 1467 = 6174

Based on different number, the steps might vary.

Function for Kaprekar is:

kap <- function(num){
    #check the len of number
    if (nchar(num) == 4) {
        kaprekarConstant = 6174
        while (num != kaprekarConstant) {
          nums <- as.integer(str_extract_all(num, "[0-9]")[[1]])
          sortD <- as.integer(str_sort(nums, decreasing = TRUE))
          sortD <- as.integer(paste(sortD, collapse = ""))
          sortA <- as.integer(str_sort(nums, decreasing = FALSE))
          sortA <- as.integer(paste(sortA, collapse = ""))
          num = as.integer(sortD) - as.integer(sortA)
          r <- paste0('Pair is: ',as.integer(sortD), ' and ', as.integer(sortA), ' and result of subtraction is: ', as.integer(num))
          print(r)
         }
    } else {
      print("Number must be 4-digits")
    }
}

 

Function can be used as:

kap(5462)

and it will return all the intermediate steps until the function converges.

[1] "Pair is: 6542 and 2456 and result of subtraction is: 4086"
[1] "Pair is: 8640 and 468  and result of subtraction is: 8172"
[1] "Pair is: 8721 and 1278 and result of subtraction is: 7443"
[1] "Pair is: 7443 and 3447 and result of subtraction is: 3996"
[1] "Pair is: 9963 and 3699 and result of subtraction is: 6264"
[1] "Pair is: 6642 and 2466 and result of subtraction is: 4176"
[1] "Pair is: 7641 and 1467 and result of subtraction is: 6174"

And to make the matter more interesting, let us find the distribution, based on all valid four-digit numbers, and append the number of steps needed to find the constant.

First, we will find the solutions for all four-digit numbers and store the solution in dataframe.

Create the empty dataframe:

#create empty dataframe for results
df_result <- data.frame(number =as.numeric(0), steps=as.numeric(0))
i = 1000
korak = 0

And then run the following loop:

# Generate the list of all 4-digit numbers
while (i <= 9999) {
   korak = 0
   num = i
   while ((korak <= 10) & (num != 6174)) {
      nums <- as.integer(str_extract_all(num, "[0-9]")[[1]])
      sortD <- as.integer(str_sort(nums, decreasing = TRUE))
      sortD <- as.integer(paste(sortD, collapse = ""))
      sortA <- as.integer(str_sort(nums, decreasing = FALSE))
      sortA <- as.integer(paste(sortA, collapse = ""))
      num = as.integer(sortD) - as.integer(sortA)

     korak = korak + 1
    if((num == 6174)){
     r <- paste0('Number is: ', as.integer(i), ' with steps: ', as.integer(korak))
     print(r)
     df_result <- rbind(df_result, data.frame(number=i, steps=korak))
   }
 }
i = i + 1
}

 

Fifteen seconds later, I got the dataframe with solutions for all valid (valid solutions are those that comply with step 1 and have converged within 10 steps) four-digit numbers.

2019-02-17 16_07_56-RStudio

Now we can add some distribution, to see how solutions are being presented with numbers. Summary of the solutions shows in average 4,6 iteration (mathematical subtractions) were needed in order to come to number 6174.

2019-02-17 16_15_49-RStudio

But adding the counts to steps, we get the most frequent solutions:

table(df_result$steps)
hist(df_result$steps)

2019-02-17 16_33_50-RStudio

With some additional visual, you can see the results as well:

library(ggplot2)
library(gridExtra)

#par(mfrow=c(1,2))
p1 <- ggplot(df_result, aes(x=number,y=steps)) + 
geom_bar(stat='identity') + 
scale_y_continuous(expand = c(0, 0), limits = c(0, 8))

p2 <- ggplot(df_result, aes(x=log10(number),y=steps)) + 
geom_point(alpha = 1/50)

grid.arrange(p1, p2, ncol=2, nrow = 1)

And the graph:

2019-02-17 16_29_39-Plot Zoom

A lot of numbers converges on third step, meaning that every 4th or 5th number.  We would need to look into the steps of the solutions, what these numbers have in common. This will follow! So stay tuned.

Fun fact: For the time of writing this blog post, the number 6174 was not constant in R base. 🙂

As always, code is available at Github.

 

Happy Rrrring 🙂

Advertisements
Tagged with: , , , ,
Posted in Uncategorized
5 comments on “Number 6174 or Kaprekar constant in R
  1. […] leave a comment for the author, please follow the link and comment on their blog: R – TomazTsql. R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data […]

    Like

  2. kaalamai says:

    Beautiful property! I just rewrote the code for fun using R base only and smaller functions. I case someone likes it:

    “`
    KaprC <- 6174L

    as_vector 0, x < 10000)

    strsplit(gsub('(.)', '\\1,', sprintf('%04d', x)), split = ',')[[1]]
    }

    as_integer <- function(x) {
    stopifnot(class(x) == 'character', length(x) == 4, all(grepl('[0-9]', x)))

    as.integer(paste0(x, collapse = ''))
    }

    kaprekar_step <- function(x) {
    hi <- as_integer(sort(as_vector(x), decreasing = TRUE))
    lo <- as_integer(sort(as_vector(x), decreasing = FALSE))

    hi – lo
    }

    kaprekar_distance <- function(x) {
    if (x == KaprC) return(0) else return(1 + kaprekar_distance(kaprekar_step(x)))
    }

    N <- 1:9999
    ix <- which(sapply(N, function (x) kaprekar_step(x) == 0))

    N <- N[-ix]
    D <- data.frame(N = N, D = sapply (N, kaprekar_distance))

    summary(D)
    hist(D$D)

    “`

    Like

  3. kaalamai says:

    Ow! The code is broken. I try again with the pre tag.

    KaprC <- 6174L
    
    as_vector  0, x < 10000)
    
        strsplit(gsub('(.)', '\\1,', sprintf('%04d', x)), split = ',')[[1]]
    }
    
    as_integer <- function(x) {
        stopifnot(class(x) == 'character', length(x) == 4, all(grepl('[0-9]', x)))
    
        as.integer(paste0(x, collapse = ''))
    }
    
    kaprekar_step <- function(x) {
        hi <- as_integer(sort(as_vector(x), decreasing = TRUE))
        lo <- as_integer(sort(as_vector(x), decreasing = FALSE))
    
        hi - lo
    }
    
    kaprekar_distance <- function(x) {
        if (x == KaprC) return(0) else return(1 + kaprekar_distance(kaprekar_step(x)))
    }
    
    N  <- 1:9999
    ix <- which(sapply(N, function (x) kaprekar_step(x) == 0))
    
    N <- N[-ix]
    D <- data.frame(N = N, D = sapply (N, kaprekar_distance))
    
    summary(D)
    hist(D$D)
    
    

    Like

  4. kaalamai says:

    Broken again. Sorry.

    Like

  5. kaalamai says:

    Last try.

    KaprC <- 6174L
    
    as_vector <- function(x) {
        stopifnot(class(x) == 'integer', x > 0, x < 10000)
    
        strsplit(gsub('(.)', '\\1,', sprintf('%04d', x)), split = ',')[[1]]
    }
    
    as_integer <- function(x) {
        stopifnot(class(x) == 'character', length(x) == 4, all(grepl('[0-9]', x)))
    
        as.integer(paste0(x, collapse = ''))
    }
    
    kaprekar_step <- function(x) {
        hi <- as_integer(sort(as_vector(x), decreasing = TRUE))
        lo <- as_integer(sort(as_vector(x), decreasing = FALSE))
    
        hi - lo
    }
    
    kaprekar_distance <- function(x) {
        if (x == KaprC) return(0) else return(1 + kaprekar_distance(kaprekar_step(x)))
    }
    
    N  <- 1:9999
    ix <- which(sapply(N, function (x) kaprekar_step(x) == 0))
    
    N <- N[-ix]
    D <- data.frame(N = N, D = sapply (N, kaprekar_distance))
    
    summary(D)
    hist(D$D)
    
    

    Like

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 )

Google photo

You are commenting using your Google 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 )

Connecting to %s

Categories
Follow TomazTsql on WordPress.com
Programs I Use
Programs I Use
Programs I Use
Rdeči Noski – Charity

Rdeči noski

100% of donations made here go to charity, no deductions, no fees. For CLOWNDOCTORS - encouraging more joy and happiness to children staying in hospitals (http://www.rednoses.eu/red-noses-organisations/slovenia/)

€2.00

Top SQL Server Bloggers 2018
TomazTsql

Tomaz doing BI and DEV with SQL Server and R, Python and beyond

Discover

A daily selection of the best content published on WordPress, collected for you by humans who love to read.

Revolutions

Tomaz doing BI and DEV with SQL Server and R, Python and beyond

tenbulls.co.uk

attaining enlightenment with sql server, .net, biztalk, windows and linux

SQL DBA with A Beard

He's a SQL DBA and he has a beard

Reeves Smith's SQL & BI Blog

A blog about SQL Server and the Microsoft Business Intelligence stack with some random Non-Microsoft tools thrown in for good measure.

SQL Server

for Application Developers

Business Analytics 3.0

Data Driven Business Models

SQL Database Engine Blog

Tomaz doing BI and DEV with SQL Server and R, Python and beyond

Search Msdn

Tomaz doing BI and DEV with SQL Server and R, Python and beyond

R-bloggers

Tomaz doing BI and DEV with SQL Server and R, Python and beyond

Ms SQL Girl

Julie Koesmarno's Journey In Data, BI and SQL World

R-bloggers

R news and tutorials contributed by hundreds of R bloggers

Data Until I Die!

Data for Life :)

Paul Turley's SQL Server BI Blog

sharing my experiences with the Microsoft data platform, SQL Server BI, Data Modeling, SSAS Design, Power Pivot, Power BI, SSRS Advanced Design, Power BI, Dashboards & Visualization since 2009

Grant Fritchey

Intimidating Databases and Code

Madhivanan's SQL blog

A modern business theme

Alessandro Alpi's Blog

SQL Server, Azure and DLM in a nutshell :D

Paul te Braak

Business Intelligence Blog

Sql Server Insane Asylum (A Blog by Pat Wright)

Information about SQL Server from the Asylum.

Gareth's Blog

A blog about Life, SQL & Everything ...

SQLPam's Blog

Life changes fast and this is where I occasionally take time to ponder what I have learned and experienced. A lot of focus will be on SQL and the SQL community – but life varies.

%d bloggers like this: