Re: [Dmug] Aufgabe::vortex based math

[Udo und Susanne Krause via demug <demug@XXXXXXX.ch>]

Hallo,

> die vortexbasierte Mathematik (google it: vortex based math) nimmt die  
> Beobachtung, dass bei fortgesetzer Quersummenbildung der Potenzen von 2
> die Ziffern 3, 6 und 9 nicht erscheinen usw.

Man kann die erscheinenden oder nicht erscheinenden Stellen in anderen  
Basen anschauen

Remove[vertexDigit]
vertexDigit[o_Integer (* exponent of 2 *),
  b_Integer: 10 (* base *), nw_Integer: 0 (* Nullwert *)] :=
 Module[{x, \[Delta] = 1000},
   If[o < 0,
    (* periods are found, irreality not and the call crashes *)
    x = First[RealDigits[2^o, b, \[Delta]]];
    (* returning b means: number 2^o has more than 950 digits in the base  
b *)
    If[Take[x, -\[Delta]/20] == ConstantArray[0, \[Delta]/20],
     x = Plus @@ x,(* else *)
     Return[b]
     ], (* else *)
    x = 2^o
    ];
   FixedPoint[(Plus @@ (IntegerDigits[#, b] /. 0 -> nw)) &, x]
   ] /; 1 < b < 37 && -b < nw < b

der Nullwert interessiert später. Negative Potenzen von 2 können  
periodische RealDigit[] Darstellungen haben: Insofern ist die  
Summierbarkeit der Stellen der negativen Potenzen von 2 eine Eigenschaft,  
die von der Basis abhängt und insofern keine fundamentale Eigenschaft. Das  
Bildchen stellt man so her

In[172]:= res =
 Table[Complement[Range[bs],
   Union[vertexDigit[#, bs] & /@ Range[-200, 200]]], {bs, 2, 36}]

Out[172]= {{2}, {}, {3, 4}, {3}, {5, 6}, {3, 5, 6}, {3, 5, 6, 7,
  8}, {3, 5, 6, 7}, {3, 6, 9, 10}, {3, 5, 7, 9, 10}, {11, 12}, {3, 5,
  6, 7, 9, 10, 11, 12}, {13, 14}, {3, 5, 6, 7, 9, 10, 11, 12, 13,
  14}, {3, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16}, {3, 5, 6, 7, 9,
  10, 11, 12, 13, 14, 15}, {3, 5, 6, 7, 10, 11, 12, 14, 17, 18}, {3,
  5, 6, 7, 9, 11, 12, 13, 15, 17, 18}, {19, 20}, {3, 5, 6, 7, 9, 10,
  11, 13, 14, 15, 17, 18, 19, 20}, {3, 5, 6, 7, 9, 10, 12, 13, 14, 15,
   17, 18, 19, 20, 21, 22}, {3, 5, 7, 9, 11, 13, 15, 17, 19, 21,
  22}, {5, 7, 10, 11, 14, 15, 17, 19, 20, 21, 22, 23, 24}, {3, 5, 6,
  7, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 22, 23, 24}, {5,
  10, 15, 20, 25, 26}, {3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25,
  26}, {3, 6, 9, 12, 15, 18, 21, 24, 27, 28}, {3, 5, 6, 7, 9, 10, 11,
  12, 13, 14, 15, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27,
  28}, {29, 30}, {3, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19,
  20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30}, {3, 5, 6, 7, 9, 10, 11,
   12, 13, 14, 15, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
   30, 31, 32}, {3, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19,
  20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31}, {3, 5, 6, 7, 9, 10,
   11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 26, 27, 28, 30, 33,
   34}, {3, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 17, 19, 20, 21, 22,
  23, 24, 25, 27, 28, 29, 31, 33, 34}, {3, 5, 6, 7, 10, 12, 13, 14,
  15, 17, 19, 20, 21, 24, 25, 26, 27, 28, 30, 31, 33, 34, 35, 36}}


ArrayPlot[displ @@@ Transpose[{res, Range[2, 36]}],
 ColorRules -> {-1 -> Gray, 0 -> Red, 1 -> Green}, Mesh -> True,
 Frame -> True,
 FrameTicks -> {{{1, 2}, {9, 10}, {19, 20}, {29, 30}, {34, 35}},
   All}, PlotLabel -> "Vortex Based Math"]

Wenn der Basiswert selbst erscheint, war die Darstellung in RealDigits  
nicht endlich im Rahmen der Kontrolle in vertexDigit.

Es besteht augenscheinlich eine Graduierung:

In[178]:= vertexDigit /@ Table[6 o, {o, 57, 74}]
Out[178]= {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}

In[179]:= vertexDigit /@ Table[1 + 6 o, {o, 0, 17}]
Out[179]= {2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2}

In[180]:= vertexDigit /@ Table[2 + 6 o, {o, 0, 17}]
Out[180]= {4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4}

In[181]:= vertexDigit /@ Table[3 + 6 o, {o, 0, 17}]
Out[181]= {8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}

In[182]:= vertexDigit /@ Table[4 + 6 o, {o, 0, 17}]
Out[182]= {7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7}

In[183]:= vertexDigit /@ Table[5 + 6 o, {o, 0, 17}]
Out[183]= {5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5}

In[189]:= vertexDigit /@ Table[-6 o, {o, 57, 74}]
Out[189]= {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}

In[190]:= vertexDigit /@ Table[-1 - 6 o, {o, 0, 17}]
Out[190]= {5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5}

In[191]:= vertexDigit /@ Table[-2 - 6 o, {o, 0, 17}]
Out[191]= {7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7}

In[192]:= vertexDigit /@ Table[-3 - 6 o, {o, 0, 17}]
Out[192]= {8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}

In[193]:= vertexDigit /@ Table[-4 - 6 o, {o, 0, 17}]
Out[193]= {4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4}

In[194]:= vertexDigit /@ Table[-5 - 6 o, {o, 0, 17}]
Out[194]= {2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2}


Die Ziffer 0 trägt zur Quersummenbildung nicht bei. Es ist daher  
naheliegend, der Ziffer 0 einen anderen Wert (nullwert) zuzuweisen - dabei  
wird jede Null in den Stellen durch den Nullwert ersetzt - und die  
Eigenschaft erneut anzuschauen. Sie bleibt erhalten, sofern der Nullwert  
ein Vielfaches von 3 ist, mit einer Ausnahme:

In[75]:= vertexDigit[6 60, 10, 9]
Out[75]= 10

In[198]:= Plus @@ (IntegerDigits[2^360] /. 0 -> 9)
Out[198]= 631

In[199]:= Plus @@ (IntegerDigits[%] /. 0 -> 9)
Out[199]= 10

In[200]:= Plus @@ (IntegerDigits[%] /. 0 -> 9)
Out[200]= 10

hier kann die 10 nicht unterschritten werden, wenn jeweils vor der  
Quersummenbildung die 0 durch 9 ersetzt wird.

In[161]:= vertexDigit[#, 10, 9] & /@ Table[6 o, {o, 57, 74}]
Out[161]= {10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,  
10, 10}

In[187]:= vertexDigit[#, 10, 9] & /@ Table[1 + 6 o, {o, 57, 74}]
Out[187]= {2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2}

In[159]:= vertexDigit[#, 10, 9] & /@ Table[2 + 6 o, {o, 57, 74}]
Out[159]= {4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4}

In[158]:= vertexDigit[#, 10, 9] & /@ Table[3 + 6 o, {o, 57, 74}]
Out[158]= {8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}

In[157]:= vertexDigit[#, 10, 9] & /@ Table[4 + 6 o, {o, 57, 74}]
Out[157]= {7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7}

In[171]:= vertexDigit[#, 10, 9] & /@ Table[5 + 6 o, {o, 57, 74}]
Out[171]= {5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5}


wenn der Nullwert nw nicht 9 ist, sondern aus {6,3,0,-3,-6,-9} werden  
gleichwohl von vertexDigit[o,10,nw] in den angeschauten Beispielen immer  
die Werte 1 (10), 2, 4, 5, 7, 8 ausgegeben und 3,6 und 9 bleiben flüchtig.

Dies ist insofern glaubhaft, da

{1,2,4,5,7,8} - 9 -> {8,7,5,4,2,1}    IntegerDigits[-8] = 8
{1,2,4,5,7,8} - 6 -> {5,4,2,1,1,2}
{1,2,4,5,7,8} - 3 -> {2,1,1,2,4,5}

der Sinn der Betrachtung negativer Nullwerte ist unklar, jedoch:

{1,2,4,5,7,8} + 0 -> {1,2,4,5,7,8}
{1,2,4,5,7,8} + 3 -> {4,5,7,8,1,2}
{1,2,4,5,7,8} + 6 -> {7,8,1,2,4,5}
{1,2,4,5,7,8} + 9 -> {1,2,4,5,7,8} (10 -> 1 + 0 -> 1, 11 -> 1 + 1 -> 2,  
usw. )

Die Addition einer 9 fungiert als identische Abbildung in der Addition mit  
Quersummenbildung (sozusagen eine "einstellige Addition").

Andererseits können in den [Integer|Real]Digits von 2^o sehr viele Nullen  
enthalten sein, die durch den Nullwert ersetzt werden; nach der  
Quersummenbildung können Nullen entstehen, die durch den Nullwert ersetzt  
werden et cetera et cetera und insofern hat die Anzahl der Nullen für das  
Ergebnis interessanterweise eine Bedeutung, die der Bedeutung anderer  
Stellen gleichkommt.

Mit den besten Grüssen
Udo.
_______________________________________________
DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
http://www.mathematica.ch/mailman/listinfo/demug
Archiv: http://www.mathematica.ch/archiv.html