Chaotisches Verhalten bei Iterationen

Chaotisches Verhalten entsteht schon bei vergleichsweise einfachen Prozessen. Wir betrachten hier eine einfache Iteration auf Zahlen. Zunächst werden nur ganze Zahlen untersucht, im zweiten Abschnitt widmen wir uns dann dem Nachkommaanteil bei der Iteration gebrochener Zahlen.

Iterationen mit ganzen Zahlen

Wir betrachten hier die Verteilung der Ziffern einer Zahlenfolge, die entsteht, wenn man eine Zahl mit einer festen Konstanten multipliziert. Dies kann eine recht langweilige Angelegenheit sein, etwa wenn man die Zahl 1 fortgesetzt mit 10 multipliziert:

NestList[10*#&,1,10]//TableForm

Eine ganz andere Situation entsteht, wenn man statt mit 10, der Basiszahl des zugrundeliegenden Zahlensystems, eine Startzahl (hier 1) mit 3 mutlipliziert:

NestList[3*#&,1,15] // TableForm

Die Funktion ArrayPlot erlaubt es die Ziffernfolgen recht einfach graphisch darzustellen. Dazu erzeugen wir zuerst eine Liste der generierten Zahlen:

liste =NestList[3*#&,1,20];

Als nächstes wandeln wir die einzelnen Zahlen in eine Liste von Ziffern um:

data = IntegerDigits[#]& /@ liste;

Dies Liste stellen wir nun mit ArrayPlot graphisch dar und wählen dazu eine, wie ich meine, recht ansprechende Farbskala aus. Hier zunächst die Farbskala (0 entspricht Dunkelblau und 9 entspricht Rot):

ArrayPlot[{Range[0,9]},ColorFunction->"TemperatureMap"]

ArrayPlot[data,ColorFunction->"TemperatureMap"]

Weil das so schön funktioniert bauen wir da eine Funktion daraus auf:

darstellen[func_,start_,iterationen_]:=Module[{temp={}},
temp=NestList[func,start,iterationen]; (* Ergebnisliste erzeugen *)
temp= IntegerDigits[#]& /@ temp;                   (* In Ziffernfolgen wandeln *)
ArrayPlot[temp,ColorFunction->"TemperatureMap"]
]

Diese Funktion berechnet also unter allen generierten Zahlen die jweiligen Häufigkeiten der einzelnen Ziffern. Nun ist es einfacher, unterschiedliche Funktionen schnell “in Augenschein” zu nehmen:

darstellen[#*3&,1,300]

Nun kann man auf einfache Art und Weise gleich mehrere Funktionen “testen”:

GraphicsGrid @ Partition[Table[darstellen[#*i&,1,300],{i,3,9,2}],2]

Schon “von weitem” betrachtet sieht es so aus als würden in einigen Grafiken Rot und Blau dominieren. Also lohnt unter Umständen ein Blick auf die Ziffernhäufigkeit. Dazu stellen wir die Häufigkeit der einzelnen Ziffenr als Balkendiagramm dar. Der Weg dorthin ist erstaunlich einfach. Als erstes erzeugen wir wieder die Ziffernfolgen aus den iterierten Zahlen und entfernen gleich alle inneren Listen, so daß wie die Zahlen alle hintereinandergeschrieben erhalten:

liste = IntegerDigits @ NestList[#*3&,1,100] // Flatten;

Jetzt einfach nur noch die Ziffern zählen und graphisch darstellen:

BarChart[BinCounts[liste,{0,10,1}],ChartLabels->Range[0,9]]

Das sieht doch vielversprechend aus. Also bauen wir auch dafür eine Funktion. Wohlgemerkt: diese Funbktion berechnet die kumulativen (!) Häfuigkeiten der Ziffern, nicht die einer einzelnen Iterierten.

diagrammErzeugen[function_,start_, iterationen_]:= Module[{temp={}, data, labels},
temp = IntegerDigits @ NestList[function,start,iterationen] // Flatten;(* Alle Ziffern erzeugen*)
data = BinCounts[temp,{0,10}]; (* Einsortieren *)
labels = Table[{data[[i]],Text @ data[[i]],Above},{i,1,10}]; (*Labels erzeugen - sieht besser aus *)
BarChart[Labeled @@@ labels ,ChartLabels->Range[0,9], ChartStyle->"TemperatureMap"]
]

GraphicsRow @ {diagrammErzeugen[#*3&,1,500],darstellen[#*3&,1,500]}

Die Unterschiede sind zwar da, aber scheinen sich mit der Zeit heraus zu nivellieren:

GraphicsRow @ {diagrammErzeugen[#*3&,1,2000],darstellen[#*3&,1,2000]}

Die einzelnen Ziffern sind also doch recht gleichmäßig verteilt. Trotzdem gibt es Auffälligkeiten. Bei genauer Betrachtung fällt auf, daß die Ziffern 1 und 3 bei den bisher betrachteten Fällen am häufigsten auftraten. Da schauen wir mal genauer hin und erzeugen die Rohdaten für die Balkengrafik in einem Schritt:

result = Table[
BinCounts[ (* Berechnen der Ziffernhäufigkeitne*)
Flatten @IntegerDigits @ NestList[#*3&,1,i],{0,10}], (*Ziffernliste erzeugen*)
{i,100,1000,100}];

Position[#,Max[#]]& /@ result // Flatten

Also doch. Da wir mit den Ziffern (natürlich) bei 0 anfangen zu zählen, besagt das letzte Ergebnis, daß, von zwei Ausnahmen abgesehen, stets die Ziffer 1 am häufigsten vorkam. Bei den beiden Ausnahmen war es die Ziffer 3. Anders gesagt, keine andere Ziffer als 1 und 3 war jemals “Spitzenreiter” bei der Häufigkeit der Ziffern.

Noch ausgeprägter ist dieses Phänomen bei Iterationen mit 2, also den Zweierpotenzen hier ist stets ab 100 Iterationen stets die Ziffer 2 die am häufigsten vorkommende Ziffer bei 100 Iterationen ist es allerding die 4:

result = Table[BinCounts[
Flatten @IntegerDigits@NestList[#*2&,1,i],{0,10}],
{i,100,1000,100}];

Position[#,Max[#]]& /@ result // Flatten

Man dar sich aber davon nicht verleiten lassen. Es gibt sehr wohl Zweierpotenzen bei denen etwa die Ziffer 6 di häufigste Ziffer ist. Allerdings habe ich festgestellt, da´ab der Zahl 2^5300 die Ziffer 4 der Spitzenreiter ist. Vielleicht habe Sie ja mal Lust so eine Zweierpotenz zu suchen, Bis 2^10000 habe ich gesucht.

Als nächstes könnte es auch mal interessant zu sein nicht die kumulativen Häufigkeiten, also die Ziffernhäufigkeit unter Betrachtung aller berechnete Iterierten, zu untersuchen, sonder die Häufigkeit innerhalb der Einzelnen Zahl. Bei 2^5300 kommt übrigens die Ziffer 8 am häufigsten vor:

BinCounts[IntegerDigits[2^5300],{0,10}]

Iterationen mit gebrochenen Zahlen

Wir stellen nun eine ähnliche Überlegung wie zuvor an, jedoch mit dem gebrochenen Anteil einer Zahl und beschränken uns hier auf die Darstellung von Zahlen im Zweiersystem. Als erstes betrachten wir den Nachkommaanteil einer einfachen iterierten Funktion:

f[x_]:=FractionalPart[3 x/2]

Die Funktion f berechnet den Nachkommaanteil einer einer mit 1.5 multiplizierten Zahl. Wir betrachten nun die Iterierten, hier im Zweiersystem. Iterieren wir f zehn mal, so erhalten wir:

BaseForm[#,2]& /@ NestList[f,1.,10]

In diesem Fall sollte man erwarten, dass die Ziffernfolge  der definierten Funktion im Dualsystem eine gewisse Regelmäßigkeit aufweist.  überraschenderweise ist dies jedoch nicht der Fall. Um dies zu verdeutlichen, stellen wir als nächstes diese Ziffernfolge in der Dualdarstellung grafisch dar:

ZeigeIterierte[f_,anzahl_,start_]:=Module[{temp=NestList[f,N[start,100],anzahl]},
ArrayPlot[First[#]& /@ RealDigits[temp,2,anzahl], ImageSize-> Small]
]

Hierbei zeigt sich, daß für unterschiedliche iterierte Funktionen in der Folge der Ziffern chaotisches Verhalten auftritt,  eine Regelmäßigkeit der einzelnen Ziffern ist in keiner Weise zu erkennen:

ZeigeIterierte[f,200,1]

g[n_]:= FractionalPart[(Sqrt[2`100])n]

ZeigeIterierte[g,200,1]

h[n_]:=  FractionalPart[π n /2]

Schließen werden hier noch einmal drei unterschiedliche Funktionen, nebeneinander grafisch dargestellt. Dabei erkennt man bei der zweiten, ihr betrachteten Funktion (Iteration von(Sqrt[2])n) gewisse Strukturen in der Abfolge der Ziffern in der Dualdarstellung der jeweiligen Iterierten. Wir werden diesen Fall gleich noch einmal genauer betrachten. Es

funcs={f,g,h};

GraphicsRow @ (ZeigeIterierte[#,100,1]& /@ funcs)

Sollen mehrere Funktionen, die von einem Parameter abhängen, parallel untersucht werden, so ist es hilfreich diese Funktion direkt parameterabhängig zu definieren. Soll etwa eine Funktion definiert werden, die durch die die Vereinbarung (Subscript[f, i])(n):= FractionalPart[i(3/(n+1))] gegeben ist, so ist diese in Mathematica wie folgt definieren:

makef[n_]:=Function[i,FractionalPart[i (3/(n+2))]]

Die Funkton makef erzeugt dabei gewissermaßen die parameterabhängigen Funktionen (Subscript[f, i]).

f2=makef[2]

f2[2]

Damit kann nun in einfacher Art und Weise die Struktur der Iterierten für diese Funktionenschar untersucht werden.

funcs = Table[makef[i],{i,2,6}];

ZeigeIterierte[#,200,1]& /@ funcs

Als nächstes soll nun die Häufigkeit der einzelnen Ziffern, die in den jeweiligen Iterierten, auftreten analysiert werden.  Hierzu ist es lediglich notwendig  die Ziffern in der jeweiligen Dualdarstellung der Zahlen zu berechnen und anschließend grafisch darzustellen. Dies wird mit der folgenden Funktion realisiert.

ZiffernHaeufigkeit[f_,start_,anzahl_] := Module[{temp=NestList[f,start,anzahl],iterierte},
iterierte= First[#]& /@RealDigits[temp,2];
ListPlot[{Count[#,0]& /@ iterierte,Count[#,1]& /@ iterierte},Joined-> True,AxesOrigin-> {0,0}]
]

Als erstes betrachten wir hierbei die eingangs untersuchte Zahlenfolge. Wie man an der grafischen Darstellung erkennt, besteht keine offensichtliche Regelmäßigkeit im Auftreten der einzelnen Ziffern in der Zahldarstellung.

ZiffernHaeufigkeit[f,1,250]

Ganz anders stellt sich die Situation bei der zweiten, oben betrachteten, Zahlenfolge dar, wie in der folgenden Darstellung deutlich zu erkennen ist. Der wesentliche Unterschied ist eben, daß schon mit einer viel größeren zahl von Nachkommastellen begonnen wird, da die Iterationsfunktion eben eine Wurzel enthält.

ZiffernHaeufigkeit[g,1.,250]