This notebook is a try to solve a simple enigma.

Enigma

enigma

Find solutions of this equation \(A\% . BCD = EF\) for \(\{A, B, C, D, E, F\} \in \{0, 1, 2, 3, 4, 5, 6, 7, 8, 9\}\) and \(A \not= B \not= C \not= D \not= E \not= F\)

Solution verification

verif_solution <- function(solution, verbose=FALSE){
  
  xA <- solution[1]/100
  xB <- solution[2]*100 + solution[3]*10 + solution[4]
  xC <- solution[5]*10 + solution[6]
  
  verif <- xA * xB == xC
  
  if(verbose){
    message(paste0(solution[1], "% x ",  xB," = ", xC))
  }
  
  return(verif)
}

Brute force search algorithm

brute_force_search <- function(maxtry=10^6, tryall=FALSE, verbose=FALSE){
  
  digits <- 0:9
  npick <- 6
  verif <- FALSE
  ntry <- 0
  nsol <- 0
  solutions <- c()
  
  while(!verif){
    ntry <- ntry + 1
    solution <- sample(digits, npick)
    verif <- verif_solution(solution)
    
    if(tryall){
      if(verif){
        solutions <- rbind(solutions, solution)
        dimnames(solutions)[[1]][dim(solutions)[1]] <- ntry
        solutions <- unique.array(solutions)
        if(verbose){
          if(nsol < dim(solutions)[1]){
            message(paste0("Found ", dim(solutions)[1]), 
                    " solutions at iteration ", ntry)
            nsol <- dim(solutions)[1]
          }
        }
      }
      verif <- FALSE
    }else{
      solutions <- solution
    }
    
    if(ntry>=maxtry){
      verif <- TRUE
    }
    
  }
  return(solutions)
}

Find one solution

solution <- brute_force_search()
verif_solution(solution, verbose = TRUE)
5% x 920 = 46
[1] TRUE

Try to find all solutions

max_attempts <- 10^6
solution <- brute_force_search(maxtry=max_attempts, tryall = TRUE, verbose = TRUE)
Found 1 solutions at iteration 5000
Found 2 solutions at iteration 11397
Found 3 solutions at iteration 14051
Found 4 solutions at iteration 31378
Found 5 solutions at iteration 40749
Found 6 solutions at iteration 41524
Found 7 solutions at iteration 42208
Found 8 solutions at iteration 47983
Found 9 solutions at iteration 56673
Found 10 solutions at iteration 70050
Found 11 solutions at iteration 89959
Found 12 solutions at iteration 104960
Found 13 solutions at iteration 123473
Found 14 solutions at iteration 125458
Found 15 solutions at iteration 130855
Found 16 solutions at iteration 166400
Found 17 solutions at iteration 169721
Found 18 solutions at iteration 175334
Found 19 solutions at iteration 182424
Found 20 solutions at iteration 182784
Found 21 solutions at iteration 185595
Found 22 solutions at iteration 194981
Found 23 solutions at iteration 225318
Found 24 solutions at iteration 292750
Found 25 solutions at iteration 341471
Found 26 solutions at iteration 350793
n_solutions_found <- dim(solution)[1]
solution
       [,1] [,2] [,3] [,4] [,5] [,6]
5000      5    7    2    0    3    6
11397     5    9    6    0    4    8
14051     8    9    2    5    7    4
31378     6    4    5    0    2    7
40749     5    4    6    0    2    3
41524     2    6    5    0    1    3
42208     5    2    6    0    1    3
47983     5    7    8    0    3    9
56673     5    7    6    0    3    8
70050     8    9    5    0    7    6
89959     4    9    2    5    3    7
104960    4    9    5    0    3    8
123473    5    9    2    0    4    6
125458    5    3    8    0    1    9
130855    5    6    8    0    3    4
166400    5    3    6    0    1    8
169721    5    6    2    0    3    1
175334    6    3    5    0    2    1
182424    5    3    4    0    1    7
182784    5    8    6    0    4    3
185595    5    2    8    0    1    4
194981    5    3    2    0    1    6
225318    5    8    2    0    4    1
292750    8    4    5    0    3    6
341471    2    8    5    0    1    7
350793    5    6    4    0    3    2

Theoretical solutions

The number of solutions is limited. We know we can only choose 6 unique digits from a set of 10 elements. Indeed there is n(n-1)…(n-k+1) / k! combinaisons to multiply with !k to get the number of permutations. Among theses permutations, there are some true answers.

perm <- function(n,k){choose(n,k) * factorial(k)}
n_permutations <- perm(10, 6)
message(paste("We have", n_permutations, "possibilities to check"))
We have 151200 possibilities to check

Expectation to find all solutions

iterations_expectation <- c()
for(i in n_solutions_found:1){
  solution_i_iteration_expectation <- n_permutations/i
  iterations_expectation <- c(iterations_expectation, solution_i_iteration_expectation)
}
message(paste("We can find all solutions with around", 
              round(sum(iterations_expectation)), "iterations"))
We can find all solutions with around 582788 iterations

Statistical result plot function

plot_solution <- function(xsol, nmax, theoretical_sol){
  
  x <- c(as.integer(dimnames(xsol)[[1]]), nmax)
  y <- c(1:dim(xsol)[1], dim(xsol)[1])
  z <- c(cumsum(theoretical_sol), nmax)
  hardness <- data.frame(attempts=x, solutions=y, theoretical_iterations=z)
  nsol <- dim(xsol)[1]
  
  title <- paste0("Equation [A]% x [BCD] = [EF] for ![ABCDEF] in [0-9] converges to ", 
                  nsol, " solutions")
  graph <- ggplot2::ggplot(hardness, aes(attempts, solutions))+
    ggplot2::geom_step()+
    ggplot2::geom_line(aes(x=theoretical_iterations), col="steelblue")+
    ggplot2::ggtitle(title)
  
  return(graph)
}

Statistical convergence

plot_solution(solution, max_attempts, iterations_expectation)

Generate all permutations

#possibilities <- t(utils::combn(0:9, 6)) # combinaisons
possibilities <- gtools::permutations(n=10, r=6, v=0:9) # permutations
# Dimensions of possibilities
print(dim(possibilities))
[1] 151200      6
# 10 first possibilities
head(possibilities, n=10)
      [,1] [,2] [,3] [,4] [,5] [,6]
 [1,]    0    1    2    3    4    5
 [2,]    0    1    2    3    4    6
 [3,]    0    1    2    3    4    7
 [4,]    0    1    2    3    4    8
 [5,]    0    1    2    3    4    9
 [6,]    0    1    2    3    5    4
 [7,]    0    1    2    3    5    6
 [8,]    0    1    2    3    5    7
 [9,]    0    1    2    3    5    8
[10,]    0    1    2    3    5    9

Among possibilities search algorithm

among_possibilities_search <- function(possibilities){
  solutions <- c()
  for(i in 1:nrow(possibilities)){
    solution <- possibilities[i,]
    verif <- verif_solution(solution)
    if(verif){
      solutions <- rbind(solutions, solution)
    }
  }
  dimnames(solutions)[[1]] <- 1:dim(solutions)[1]
  dimnames(solutions)[[2]] <- LETTERS[1:6]
  return(solutions)
}

Find true solutions among all permutations

true_solution <- among_possibilities_search(possibilities)
message(paste("Found", dim(true_solution)[1], 
              "different solutions among theoretical possibilities"))
Found 26 different solutions among theoretical possibilities
true_solution
   A B C D E F
1  2 6 5 0 1 3
2  2 8 5 0 1 7
3  4 9 2 5 3 7
4  4 9 5 0 3 8
5  5 2 6 0 1 3
6  5 2 8 0 1 4
7  5 3 2 0 1 6
8  5 3 4 0 1 7
9  5 3 6 0 1 8
10 5 3 8 0 1 9
11 5 4 6 0 2 3
12 5 6 2 0 3 1
13 5 6 4 0 3 2
14 5 6 8 0 3 4
15 5 7 2 0 3 6
16 5 7 6 0 3 8
17 5 7 8 0 3 9
18 5 8 2 0 4 1
19 5 8 6 0 4 3
20 5 9 2 0 4 6
21 5 9 6 0 4 8
22 6 3 5 0 2 1
23 6 4 5 0 2 7
24 8 4 5 0 3 6
25 8 9 2 5 7 4
26 8 9 5 0 7 6
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKVGhpcyBub3RlYm9vayBpcyBhIHRyeSB0byBzb2x2ZSBhIHNpbXBsZSBlbmlnbWEuCgojIyBFbmlnbWEKPGltZyBzcmM9InBlcmNlbnRhZ2UucG5nIiBhbHQ9ImVuaWdtYSIvPgo8YnIgLz48YnIgLz4KRmluZCBzb2x1dGlvbnMgb2YgdGhpcyBlcXVhdGlvbiAkQVwlIC4gQkNEID0gRUYkIGZvciAkXHtBLCBCLCBDLCBELCBFLCBGXH0gXGluIFx7MCwgMSwgMiwgMywgNCwgNSwgNiwgNywgOCwgOVx9JCBhbmQgJEEgXG5vdD0gQiBcbm90PSBDIFxub3Q9IEQgXG5vdD0gRSBcbm90PSBGJCAKCiMjIFNvbHV0aW9uIHZlcmlmaWNhdGlvbgpgYGB7cn0KdmVyaWZfc29sdXRpb24gPC0gZnVuY3Rpb24oc29sdXRpb24sIHZlcmJvc2U9RkFMU0UpewogIAogIHhBIDwtIHNvbHV0aW9uWzFdLzEwMAogIHhCIDwtIHNvbHV0aW9uWzJdKjEwMCArIHNvbHV0aW9uWzNdKjEwICsgc29sdXRpb25bNF0KICB4QyA8LSBzb2x1dGlvbls1XSoxMCArIHNvbHV0aW9uWzZdCiAgCiAgdmVyaWYgPC0geEEgKiB4QiA9PSB4QwogIAogIGlmKHZlcmJvc2UpewogICAgbWVzc2FnZShwYXN0ZTAoc29sdXRpb25bMV0sICIlIHggIiwgIHhCLCIgPSAiLCB4QykpCiAgfQogIAogIHJldHVybih2ZXJpZikKfQpgYGAKCiMjIEJydXRlIGZvcmNlIHNlYXJjaCBhbGdvcml0aG0KYGBge3J9CmJydXRlX2ZvcmNlX3NlYXJjaCA8LSBmdW5jdGlvbihtYXh0cnk9MTBeNiwgdHJ5YWxsPUZBTFNFLCB2ZXJib3NlPUZBTFNFKXsKICAKICBkaWdpdHMgPC0gMDo5CiAgbnBpY2sgPC0gNgogIHZlcmlmIDwtIEZBTFNFCiAgbnRyeSA8LSAwCiAgbnNvbCA8LSAwCiAgc29sdXRpb25zIDwtIGMoKQogIAogIHdoaWxlKCF2ZXJpZil7CiAgICBudHJ5IDwtIG50cnkgKyAxCiAgICBzb2x1dGlvbiA8LSBzYW1wbGUoZGlnaXRzLCBucGljaykKICAgIHZlcmlmIDwtIHZlcmlmX3NvbHV0aW9uKHNvbHV0aW9uKQogICAgCiAgICBpZih0cnlhbGwpewogICAgICBpZih2ZXJpZil7CiAgICAgICAgc29sdXRpb25zIDwtIHJiaW5kKHNvbHV0aW9ucywgc29sdXRpb24pCiAgICAgICAgZGltbmFtZXMoc29sdXRpb25zKVtbMV1dW2RpbShzb2x1dGlvbnMpWzFdXSA8LSBudHJ5CiAgICAgICAgc29sdXRpb25zIDwtIHVuaXF1ZS5hcnJheShzb2x1dGlvbnMpCiAgICAgICAgaWYodmVyYm9zZSl7CiAgICAgICAgICBpZihuc29sIDwgZGltKHNvbHV0aW9ucylbMV0pewogICAgICAgICAgICBtZXNzYWdlKHBhc3RlMCgiRm91bmQgIiwgZGltKHNvbHV0aW9ucylbMV0pLCAKICAgICAgICAgICAgICAgICAgICAiIHNvbHV0aW9ucyBhdCBpdGVyYXRpb24gIiwgbnRyeSkKICAgICAgICAgICAgbnNvbCA8LSBkaW0oc29sdXRpb25zKVsxXQogICAgICAgICAgfQogICAgICAgIH0KICAgICAgfQogICAgICB2ZXJpZiA8LSBGQUxTRQogICAgfWVsc2V7CiAgICAgIHNvbHV0aW9ucyA8LSBzb2x1dGlvbgogICAgfQogICAgCiAgICBpZihudHJ5Pj1tYXh0cnkpewogICAgICB2ZXJpZiA8LSBUUlVFCiAgICB9CiAgICAKICB9CgogIHJldHVybihzb2x1dGlvbnMpCn0KYGBgCgoKIyMgRmluZCBvbmUgc29sdXRpb24KYGBge3J9CnNvbHV0aW9uIDwtIGJydXRlX2ZvcmNlX3NlYXJjaCgpCnZlcmlmX3NvbHV0aW9uKHNvbHV0aW9uLCB2ZXJib3NlID0gVFJVRSkKYGBgCgojIyBUcnkgdG8gZmluZCBhbGwgc29sdXRpb25zCmBgYHtyfQptYXhfYXR0ZW1wdHMgPC0gMTBeNgpzb2x1dGlvbiA8LSBicnV0ZV9mb3JjZV9zZWFyY2gobWF4dHJ5PW1heF9hdHRlbXB0cywgdHJ5YWxsID0gVFJVRSwgdmVyYm9zZSA9IFRSVUUpCm5fc29sdXRpb25zX2ZvdW5kIDwtIGRpbShzb2x1dGlvbilbMV0Kc29sdXRpb24KYGBgCgoKIyMgVGhlb3JldGljYWwgc29sdXRpb25zClRoZSBudW1iZXIgb2Ygc29sdXRpb25zIGlzIGxpbWl0ZWQuIFdlIGtub3cgd2UgY2FuIG9ubHkgY2hvb3NlIDYgdW5pcXVlIGRpZ2l0cyBmcm9tIGEgc2V0IG9mIDEwIGVsZW1lbnRzLiBJbmRlZWQgdGhlcmUgaXMgbihuLTEp4oCmKG4taysxKSAvIGshIGNvbWJpbmFpc29ucyB0byBtdWx0aXBseSB3aXRoICFrIHRvIGdldCB0aGUgbnVtYmVyIG9mIHBlcm11dGF0aW9ucy4gQW1vbmcgdGhlc2VzIHBlcm11dGF0aW9ucywgdGhlcmUgYXJlIHNvbWUgdHJ1ZSBhbnN3ZXJzLgpgYGB7cn0KcGVybSA8LSBmdW5jdGlvbihuLGspe2Nob29zZShuLGspICogZmFjdG9yaWFsKGspfQpuX3Blcm11dGF0aW9ucyA8LSBwZXJtKDEwLCA2KQptZXNzYWdlKHBhc3RlKCJXZSBoYXZlIiwgbl9wZXJtdXRhdGlvbnMsICJwb3NzaWJpbGl0aWVzIHRvIGNoZWNrIikpCgpgYGAKCiMjIEV4cGVjdGF0aW9uIHRvIGZpbmQgYWxsIHNvbHV0aW9ucwpgYGB7cn0KaXRlcmF0aW9uc19leHBlY3RhdGlvbiA8LSBjKCkKZm9yKGkgaW4gbl9zb2x1dGlvbnNfZm91bmQ6MSl7CiAgc29sdXRpb25faV9pdGVyYXRpb25fZXhwZWN0YXRpb24gPC0gbl9wZXJtdXRhdGlvbnMvaQogIGl0ZXJhdGlvbnNfZXhwZWN0YXRpb24gPC0gYyhpdGVyYXRpb25zX2V4cGVjdGF0aW9uLCBzb2x1dGlvbl9pX2l0ZXJhdGlvbl9leHBlY3RhdGlvbikKfQptZXNzYWdlKHBhc3RlKCJXZSBjYW4gZmluZCBhbGwgc29sdXRpb25zIHdpdGggYXJvdW5kIiwgCiAgICAgICAgICAgICAgcm91bmQoc3VtKGl0ZXJhdGlvbnNfZXhwZWN0YXRpb24pKSwgIml0ZXJhdGlvbnMiKSkKYGBgCgojIyBTdGF0aXN0aWNhbCByZXN1bHQgcGxvdCBmdW5jdGlvbgpgYGB7cn0KcGxvdF9zb2x1dGlvbiA8LSBmdW5jdGlvbih4c29sLCBubWF4LCB0aGVvcmV0aWNhbF9zb2wpewogIAogIHggPC0gYyhhcy5pbnRlZ2VyKGRpbW5hbWVzKHhzb2wpW1sxXV0pLCBubWF4KQogIHkgPC0gYygxOmRpbSh4c29sKVsxXSwgZGltKHhzb2wpWzFdKQogIHogPC0gYyhjdW1zdW0odGhlb3JldGljYWxfc29sKSwgbm1heCkKICBoYXJkbmVzcyA8LSBkYXRhLmZyYW1lKGF0dGVtcHRzPXgsIHNvbHV0aW9ucz15LCB0aGVvcmV0aWNhbF9pdGVyYXRpb25zPXopCiAgbnNvbCA8LSBkaW0oeHNvbClbMV0KICAKICB0aXRsZSA8LSBwYXN0ZTAoIkVxdWF0aW9uIFtBXSUgeCBbQkNEXSA9IFtFRl0gZm9yICFbQUJDREVGXSBpbiBbMC05XSBjb252ZXJnZXMgdG8gIiwgCiAgICAgICAgICAgICAgICAgIG5zb2wsICIgc29sdXRpb25zIikKICBncmFwaCA8LSBnZ3Bsb3QyOjpnZ3Bsb3QoaGFyZG5lc3MsIGFlcyhhdHRlbXB0cywgc29sdXRpb25zKSkrCiAgICBnZ3Bsb3QyOjpnZW9tX3N0ZXAoKSsKICAgIGdncGxvdDI6Omdlb21fbGluZShhZXMoeD10aGVvcmV0aWNhbF9pdGVyYXRpb25zKSwgY29sPSJzdGVlbGJsdWUiKSsKICAgIGdncGxvdDI6OmdndGl0bGUodGl0bGUpCiAgCiAgcmV0dXJuKGdyYXBoKQp9CmBgYAoKIyMgU3RhdGlzdGljYWwgY29udmVyZ2VuY2UKYGBge3IgZmlnLndpZHRoPTEwfQpwbG90X3NvbHV0aW9uKHNvbHV0aW9uLCBtYXhfYXR0ZW1wdHMsIGl0ZXJhdGlvbnNfZXhwZWN0YXRpb24pCmBgYAoKIyMgR2VuZXJhdGUgYWxsIHBlcm11dGF0aW9ucwpgYGB7cn0KI3Bvc3NpYmlsaXRpZXMgPC0gdCh1dGlsczo6Y29tYm4oMDo5LCA2KSkgIyBjb21iaW5haXNvbnMKcG9zc2liaWxpdGllcyA8LSBndG9vbHM6OnBlcm11dGF0aW9ucyhuPTEwLCByPTYsIHY9MDo5KSAjIHBlcm11dGF0aW9ucwojIERpbWVuc2lvbnMgb2YgcG9zc2liaWxpdGllcwpwcmludChkaW0ocG9zc2liaWxpdGllcykpCiMgMTAgZmlyc3QgcG9zc2liaWxpdGllcwpoZWFkKHBvc3NpYmlsaXRpZXMsIG49MTApCmBgYAoKIyMgQW1vbmcgcG9zc2liaWxpdGllcyBzZWFyY2ggYWxnb3JpdGhtCmBgYHtyfQphbW9uZ19wb3NzaWJpbGl0aWVzX3NlYXJjaCA8LSBmdW5jdGlvbihwb3NzaWJpbGl0aWVzKXsKICBzb2x1dGlvbnMgPC0gYygpCiAgZm9yKGkgaW4gMTpucm93KHBvc3NpYmlsaXRpZXMpKXsKICAgIHNvbHV0aW9uIDwtIHBvc3NpYmlsaXRpZXNbaSxdCiAgICB2ZXJpZiA8LSB2ZXJpZl9zb2x1dGlvbihzb2x1dGlvbikKICAgIGlmKHZlcmlmKXsKICAgICAgc29sdXRpb25zIDwtIHJiaW5kKHNvbHV0aW9ucywgc29sdXRpb24pCiAgICB9CiAgfQogIGRpbW5hbWVzKHNvbHV0aW9ucylbWzFdXSA8LSAxOmRpbShzb2x1dGlvbnMpWzFdCiAgZGltbmFtZXMoc29sdXRpb25zKVtbMl1dIDwtIExFVFRFUlNbMTo2XQogIHJldHVybihzb2x1dGlvbnMpCn0KYGBgCgojIyBGaW5kIHRydWUgc29sdXRpb25zIGFtb25nIGFsbCBwZXJtdXRhdGlvbnMKYGBge3J9CnRydWVfc29sdXRpb24gPC0gYW1vbmdfcG9zc2liaWxpdGllc19zZWFyY2gocG9zc2liaWxpdGllcykKbWVzc2FnZShwYXN0ZSgiRm91bmQiLCBkaW0odHJ1ZV9zb2x1dGlvbilbMV0sIAogICAgICAgICAgICAgICJkaWZmZXJlbnQgc29sdXRpb25zIGFtb25nIHRoZW9yZXRpY2FsIHBvc3NpYmlsaXRpZXMiKSkKdHJ1ZV9zb2x1dGlvbgpgYGAKCg==