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}]]

y0q4s Generation of Step NumbersNest[GenMap, {{5}}, n] “>

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?

Let’s block ads! (Why?)

Recent Questions – Mathematica Stack Exchange