Re: [Dmug] Aufgabe::Digital Perfection

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

divisor7Q könnte auch  - nur zum Sagen - als

divisor7Q[o_Integer] := Last[IntegerDigits[o, 7]] == 0


angegeben werden, und wg. der Schönheit sollte


conwayQ[o_Integer?Positive] := Block[{l = IntegerDigits[o]},
   (DeleteDuplicates[l] == l) \[And] Apply[And, 
Divisible[FromDigits[Take[l, #]], #] & /@ Range[10]]
   ] /; IntegerLength[o] == 10


keine Vergleiche mit 0 mehr enthalten.


grüsse

Udo.


Am 24.10.2020 um 13:43 schrieb Susanne & Udo Krause via demug:
> Wenn die Teilbarkeit durch 7 schliesslich geprüft wird
>
>
> Clear[divisor7Q]
> divisor7Q[o_Integer] := True /; o == 0
> divisor7Q[o_Integer] := Block[{l = IntegerDigits[Abs[o]], v},
>    While[Last[l] == 0, l = Most[l]];
>    v = Most[l]; l = Last[l];
>    If[Length[v] == 0,
>     Abs[l] == 7, (* else *)
>     divisor7Q[FromDigits[v] - 2 l]
>     ]
>    ] /; o != 0
>
>
> > Am 18.10.2020 um 10:42 schrieb Susanne & Udo Krause via demug:
> > > Moin moin
> > >
> > >
> > > im Quantamagazine steht eine Aufgabe von J. H. Conway
> > >
> > > ------------------------------------------------------------------------ 
> > >
> > >
> > > https://www.quantamagazine.org/three-math-puzzles-inspired-by-john-horton-conway-20201015/ 
> > >
> > >
> > > ------------------------------------------------------------------------ 
> > >
> > >
> > > There is a mysterious 10 - digit decimal number, abcdefghij.
> > > Each of the digits is different, and they have the following 
> > > properties :
> > >
> > >
> > >  * a is divisible by 1
> > >  * ab is divisible by 2
> > >  * abc is divisible by 3
> > >  * abcd is divisible by 4
> > >  * abcde is divisible by 5
> > >  * abcdef is divisible by 6
> > >  * abcdefg is divisible by 7
> > >  * abcdefgh is divisible by 8
> > >  * abcdefghi is divisible by 9
> > >  * abcdefghij is divisible by 10
> > >
> > >
> > > What' s the number?
> > >
> > > ------------------------------------------------------------------------ 
> > >
> > >
> > > Ein Kandidat kann mit
> > >
> > >
> > > Clear[conwayQ]
> > > conwayQ[o_Integer?Positive] := Block[{l = IntegerDigits[o]},
> > >    (DeleteDuplicates[l] == l) && Union[Mod[FromDigits[Take[l, #]], 
> > > #] & /@ Range[10]] == {0}
> > >    ] /; Length[IntegerDigits[o]] == 10
> > >
> > >
> > > geprüft werden, z.B. dieses x:
> > >
> > >
> > > In[200]:= IntegerQ[x] && Positive[x]
> > >
> > > Out[200]= True
> > >
> > > In[201]:= conwayQ[x]
> > >
> > > Out[201]= True
> > >
> > >
> > > das iss'es doch.
> > >
> > >
> > > Grüsse
> > >
> > > Udo.
> > > _______________________________________________
> > > DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
> > > http://www.mathematica.ch/mailman/listinfo/demug
> > > Archiv: http://www.mathematica.ch/archiv.html
> > _______________________________________________
> > DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
> > http://www.mathematica.ch/mailman/listinfo/demug
> > Archiv: http://www.mathematica.ch/archiv.html
> _______________________________________________
> DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
> http://www.mathematica.ch/mailman/listinfo/demug
> Archiv: http://www.mathematica.ch/archiv.html
_______________________________________________
DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
http://www.mathematica.ch/mailman/listinfo/demug
Archiv: http://www.mathematica.ch/archiv.html