Die palindromische Ordnung

Remove["Global`*"]

Ist a:=(Subscript[a, 1])(Subscript[a, 2])...(Subscript[a, n]) eine natürliche Zahl mit Ziffern (Subscript[a, i]), so heißt a Palindrom, genau dann, wenn a=(Subscript[a, 1])(Subscript[a, 2])...(Subscript[a, n]) =(Subscript[a, n])(Subscript[a, n-1])...(Subscript[a, 1])  gilt. So ist beispielsweise die Zahl 1771 ein Palindrom, 1771 jedoch nicht. 
Für jede natürliche Zahl n definieren wir folgende iterative Vorschrift:

(Subscript[a, 0]):=n. Falls (Subscript[a, n]) ein Palindrom ist stopt der Algorithmus, andernfalls setze (Subscript[a, n+1]):= (Subscript[a, n])+ R[(Subscript[a, n])], wobei die Zahl R[(Subscript[a, n])] dadurch entsteht, daß die Ziffernfolge von (Subscript[a, n]) umgekehrt wird. Die Frage ist nun, nach wievielen Iterationsschritten, wenn überhaupt, dieser Algorithmus terminiert. Die Anzahl n der Iterationen die benötigt werden, bis (Subscript[a, n]) ein Palindrom ist heißt dann palindromische Ordnung von a

Um dieses Problem im Mathematica zu untersuchen benötigen wir zunächst eine Funktion die die Ziffernfolge einer natürlichen Zahl umdreht. Da man die Ziffernfolge einer Zahl a einfach mit IntegerDigits[a] erhält ist diese Aufgabe einfach zu lösen.

a=1234567

liste = IntegerDigits[a]

rliste=Reverse[liste]

Um nun aus der umgekehrten Liste der Ziffernfolge der Zahl a wieder eine Zahl zu machen bedienen wir uns der Funktion Fold[...] um eine Funktion zu definieren, die eine Zahl liefert die die umgekhrte Ziffernfolge hat, wie die ursprümgliche Zahl a.

reverseInteger[n_]:=Fold[10#1+#2 &,0,Reverse[IntegerDigits[n]]]

reverseInteger[1234567]

Nun ist es einfach eine Funktion zu definieren, die testet, ob eine natürliche Zahl ein Palindrom ist oder nicht

testPalindrom[n_]:=n==reverseInteger[n]

testPalindrom[121]

testPalindrom[1772]

Jetzt können wir recht einfach die palindromische Ordnung natürlicher Zahlen bestimmen. Dazu definieren wir noch eine Funkton, die die Anzahl der Iterationen ausgibt, die nötig sind bis die Iterationsfolge ein Palindrom ergibt. Vorsichtshalber geben wir auch eine Maximalzahl von durzuführenden Iterationsschritten an.Die Funktion palindromOrdnung[n,maxiter] bestimmt die palindromische Ordnung der Zahl n mt einer Obergrenze von maxiter

palindromOrdnung[n_,maxiter_]:=Module[{temp=n,i=1},
While[testPalindrom[temp]==False&& i<maxiter,
temp=temp+ reverseInteger[temp];i++;
]; (* End while *)
If[i>=maxiter,Print["*** Maximum der Iterationen erreicht: ",n,": ",temp]; ,i]
]

palindromOrdnung[169,100]

palindromOrdnung[196,100]

Als nächstes suchen wir all jene Zahlen in einem Intervall, die zu einer vorgegbenen, maximalen Iterationstiefe nicht auf ein Palindrom führen. Dazu

palindromfunc[n_]:=n+reverseInteger[n]

Dann

palindromOrdnungTest[n_,max_]:=Length[NestWhileList[palindromfunc,n,Not[testPalindrom[#]]&,1,max]]

palindromOrdnungTest[196,200]

Die Zahl 196 ist der erste Kandidat, der anscheinend nicht auf ein Palindrom führt

temp=Table[palindromOrdnungTest[n,200],{n,2,300}]

ListPlot[temp, PlotRange-> All]

ListPlot[DeleteCases[Table[palindromOrdnungTest[n,200],{n,100,2000}],201], PlotRange->All, AxesOrigin->{0,0}]

ListPlot[Table[palindromOrdnungTest[n,200],{n,100,2000}], PlotRange->All, AxesOrigin->{0,0}, PlotLabel->Style["Palindromische Ordnung bis 2000",16], AxesLabel->{"n","Ordnung(n)"}]