Re: Re[2]: Aufgabe::autobiographische Zahl

[Rolf Mertig <rolfm@XXXXXXX.com>]

On Mon, 2006-11-27 at 23:00 +0100, Roman Maeder wrote:

> bemerkenswert. Das konvergiert in wenigen Schritten:
> 
> FixedPointList[
>   Fold[ReplacePart[#1, Count[#1, #2], #2 + 1] &, #, Range[0, 9]] &, 
>   Range[0, 9]] // TableForm
> 
> Out[1]//TableForm= 0   1   2   3   4   5   6   7   8   9
> 
>                    1   2   2   1   1   1   1   1   1   1
> 
>                    0   7   1   0   0   0   0   1   0   0
> 
>                    7   2   1   0   0   0   0   1   0   0
> 
>                    6   2   1   0   0   0   1   0   0   0
> 
>                    6   2   1   0   0   0   1   0   0   0
> 
> 
> in den einzelnen Schritten wird ja beim Zählen jeder Ziffer immer die
> gerade veränderte Liste genommen, es stehen also jeweils vorne schon
> die neuen Zahlen, hinten noch die alten. Wenn ich das in einem Schritt
> mache, also jeweils alle Ziffern zähle, und dann daraus die neue Liste
> bilde, geht's nicht, es ergibt sich ein Zweierzyklus:
> 
> NestList[Function[list, Count[list, #] & /@ Range[0, 9]], Range[0, 9], 20] //
> TableForm
> 
> Out[2]//TableForm= 0   1    2   3   4   5   6   7   8   9
> 
>                    1   1    1   1   1   1   1   1   1   1
> 
>                    0   10   0   0   0   0   0   0   0   0
> 
>                    9   0    0   0   0   0   0   0   0   0
> 
>                    9   0    0   0   0   0   0   0   0   1
> 
>                    8   1    0   0   0   0   0   0   0   1
> 
>                    7   2    0   0   0   0   0   0   1   0
> 
>                    7   1    1   0   0   0   0   1   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
>                    7   1    0   1   0   0   1   0   0   0
> 
>                    6   3    0   0   0   0   0   1   0   0
> 
> 
> auch wenn ich vom Ende her inkrementell zähle, geht's:
> 
> FixedPointList[
>     Fold[ReplacePart[#1, Count[#1, #2], #2 + 1] &, #, Range[9, 0, -1]] &,
>     Range[0, 9]] // TableForm
> 
> Out[3]//TableForm= 0   1   2   3   4   5   6   7   8   9
> 
>                    1   9   1   1   1   1   1   1   1   1
> 
>                    7   2   0   0   0   0   0   0   0   1
> 
>                    6   2   1   0   0   0   0   1   0   0
> 
>                    6   2   1   0   0   0   1   0   0   0
> 
>                    6   2   1   0   0   0   1   0   0   0
> 
> 
> 
> wenn wir schon dabei sind:
> 
> gesucht ist eine 9-stellige Zahl, in der jede Ziffer von 1 bis 9 einmal
> vorkommt, so dass die Anfangszahl, gebildet aus den ersten k Ziffern, durch k
> teilbar ist. Mit 987654321 geht's schon fast, es geht gut für k=1,2,...6,
> aber 9876543 ist nicht durch 7 teilbar (jede solche Zahl ist natürlich
> durch 9 teilbar, als kleiner Tipp).
> 
> Roman

Sicherlich geht das irgendwie eleganter, aber in ein paar Sekunden kommt
mit folgendem Code
381654729
heraus:

Timing[dlist = Permutations[Range[9]]; 
   Do[(*Print["i = ", i, "  length = ",
        Length[dlist]]; *)
        dlist = Select[dlist, 
         Mod[FromDigits[Take[#1, i]], i] === 0 & ], 
      {i, 2, 9}];
      FromDigits /@ dlist]