Generation of Step Numbers

I am working on Project Euler 178 but got stuck in trying to optimize my code. The following text comes from the problem:

Consider the number $45656$. It can be seen that each pair of consecutive digits of $45656$ has a difference of one. A number for which every pair of consecutive digits has a difference of one is called a step number. A pandigital number contains every decimal digit from $0$ to $9$ at least once. How many pandigital step numbers less than $10^{40}$ are there?

I thought of computing the entirety of step numbers with less than $40$ digits and subsequently selecting the pandigital ones. The first way to generate these numbers that came to my mind was to define a function

Generate[Ls_] := Module[{F = First[Ls], L = Ls},
Which[F == 9,
Return[{Prepend[L, F - 1]}],
F == 0,
Return[{Prepend[L, F + 1]}],
F != 0 && F != 9,
Return[{Prepend[L, F + 1], Prepend[L, F - 1]}
]
]


which takes in input a list of lists, for instance {{5}}, and returns a list of lists with a prepended digit that differs by one from the original one, in this case {{4,5},{6,5}}. The first two cases handle the case in which the digit is $0$ or $9$. I'll handle the problem with the first digit being zero later. From here, I thought of nesting this by defining another function

GenMap[Ls_] := Flatten[Map[Generate, Ls], 1]


that should be nested to obtain the result. For instance,

Startingfromfive = Nest[GenMap, {{5}}, 15];


would generate the list of digits of the various $15$ digit step numbers that end with the digit $5$.

This solution is clearly non optimal and has performance problems, due to the fact that the number of lists that need to be handled grows incredibly fast: Startingfromfive is a list of $22001$ lists of $15$ elements each. The computation time seems to be growing exponentially, as can be seen from the following plot:

ListPlot[Table[First[Timing[Nest[GenMap, {{5}}, n];]], {n, 1, 20}]]


My machine gets up to $n=25$ in about $3$ minutes, showing the unfeasability for $n=40$ with the aforementioned method. I tried compiling the function, but it doesn't seem to show a substantial improvement.

Can this code be optimized or do I need to use a completely different approach?

• Sadly, I would guess that your approach is doomed. Also doomed would be an attempt to construct all the pandigital step function, even with a super efficient algorithm. I'm not sure about the ethics of answering project euler questions here, but FWIW I would take it as a combinatorial problem, with most of the actual code involving Binomial. – aardvark2012 Oct 29 '17 at 1:29
• RecurrenceTable can be used to count step numbers of given length ending with each possible digit. One can then discard the counts that do not correspond to pandigitals. Apparently one should not post PE solution code so I'll leave it at that. – Daniel Lichtblau Dec 26 '17 at 23:51

This code is faster than yours, but unable to solve the full problem.

StepGen[v_?VectorQ] :=
With[{a = Last[v]},
Which[
a == 0, {Flatten[{v, 1}]},
a == 9, {Flatten[{v, 8}]},
True, {Flatten[{v, a - 1}], Flatten[{v, a + 1}]}
]]

StepGen[m_?MatrixQ] := Flatten[Map[StepGen, m], 1]


For example,

Nest[StepGen, {{5}}, 15] // Length
(*  22001  *)


Using this function or your own, try counting the number of pandigital step numbers beginning with digits 1 through 9 for small values of the number of digits n. Do you notice any symmetries that can lead to short-cuts?

Consider generating pandigital step numbers with a data structure containing two elements. The first element is a list of unused digits, the second element is the final digit of the soon-to-be pandigital step number. For example, an initial input would be {{0,2,3,4,5,6,7,8,9},1} for step numbers beginning with 1. The next iteration returns {{{0,3,4,5,6,7,8,9},2},{{2,3,4,5,6,7,8,9},0}}. Use Tally to save time and memory. When the list of unused digits is empty, iterations stop, and the tally counts how many pandigital step numbers began with 1. There are details to work out, but that's the challenge!

Good luck.