Re: Aufgabe::Gib mir Hundert

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Liebe Freundinnen und Freunde der Unterhaltungsarithmetik,

1/2 + 3 * 4 * 7 + 8  + 5 * 9/6 = 100 oder
2 * 5 * 6 * 7/4 - 8 + 9/3 = 100

sind auch nicht im Getippsel enthalten. Es gibt eine einfache Zahlenpumpe

Clear[zahlenPumpe]; (* Zahlenpumpe ohne Klammern *)
zahlenPumpe[Z_Integer , nov_Integer] :=
 Module[{lZ, l, lR = {}, i, j, k, o, p, r},
   lZ = {Subscript[x, 1], Subscript[x, 2], Subscript[x, 3], Subscript[
     x, 4], Subscript[x, 5], Subscript[x, 6], Subscript[x, 7],
     Subscript[x, 8], Subscript[x, 9]};
   For[i = 0, i < nov, i++,
    l = lZ;
    r = 0;
    o = 0;
    While[Length[l] > 0,
     j = RandomInteger[{1, Length[l]}];
     (* exclude for search efficiency division by 1 and \
multiplication by 1 *)
     k  = If[Length[l] == Length[lZ] ||
        StringMatchQ[ToString[l[[j]]], ToString[lZ[[1]]]],
       RandomInteger[{1, 2}], RandomInteger[{1, 4}]];
     o = Which[k == 1, o + l[[j]], k == 2, o - l[[j]], k == 3,
       o /. p -> p l[[j]], k == 4, o /. p -> p/l[[j]]];
     If[r = (o /. Thread[Rule[lZ, Range[1, Length[lZ]]]]); r == Z,
      Break[]];
     p = l[[j]];
     l = Drop[l, {j}];
     ];
    (* Print[i, ": ", o, ", ", r]; *)
    If[r == Z,
     AppendTo[lR, o]
     ]
    ];
   (* Print["Lösungen auf " <> ToString[Z] <> ": ", Length[Union[
   lR]]]; *)
   Union[lR] (* is this an arithmetical Union *)
   ] /; nov > 0

die noch dazu die Division durch 1 oder die Multiplikation mit 1  
unterdrückt (um ein solches Glied kann man letztendlich allen Lösungen  
erweitern, die keine 1 enthalten (und damit weitere Lösungen erzeugen)).  
Wenn man die Zahlenpumpe simpel (und ineffizient) laufen lässt, um  
Anschauungsmaterial zu gewinnen für einen vernünftigen Algorithmus und die  
Vorstellung verwendet, dass man aufhören will, wenn ein Durchlauf von 100  
000 Versuchen keine weiteren Ergebnisse bringt,

(* Run until a big shot does not deliver new instances.
        If a shot runs empty, the While stops in error!
        If it nothing new, completeness is not ensured *)
a = {}; c = {}; n = 0;
While[c = Union[a, zahlenPumpe[100, 100000]]; c != a,
  a = c;
  Print["Run: ", n++, " LengthU: ", Length[a]];
  ];
a

dann erlebt man eine Überraschung: nach 191 Durchläufen hat der  
Formalismus 3771 Lösungen gefunden und immer noch nicht gehalten:

Run: 0 LengthU: 111
Run: 1 LengthU: 181
Run: 2 LengthU: 255
Run: 3 LengthU: 325
Run: 4 LengthU: 378
Run: 5 LengthU: 451
<snip>
Run: 182 LengthU: 3706
Run: 183 LengthU: 3715
Run: 184 LengthU: 3721
Run: 185 LengthU: 3730
Run: 186 LengthU: 3736
Run: 187 LengthU: 3741
Run: 188 LengthU: 3750
Run: 189 LengthU: 3754
Run: 190 LengthU: 3766
Run: 191 LengthU: 3771

$Aborted

dann wurde abgebrochen, um über die Effizienz nachzudenken. Jedenfalls, um  
die Aufgabe behandelbar zu halten, sollten nur Lösungen in Betracht  
gezogen werden, die nach einer Anwendung von Union[] erhalten bleiben. Das  
folgende Beispiel enthält also nur 2 verschiedene Ausdrücke:

In[1]:= Union[{x1 + x2 + x3, x2 + x1 + x3, x2 * x3 + x1,
  x1 + x3 * x2}]

Out[1]= {x1 + x2 + x3, x1 + x2 x3}

Union[] beachtet die Rechenregeln und stellt eine kanonische  
lexikographische Ordnung her, trotzdem gibt es anscheinend mindestens 3771  
Lösungen.

Da man das Klammerverbot hat (Bedingung (iii)) könnte ein sinnvoller  
Algorithmus darin bestehen, die Addition bzw. Subtraktion als Trennzeichen  
zu verwenden und den verbleibenden Termen, die dann Produkte und  
Quotienten sind, mit Faktorisierungen zu Leibe zu rücken - mit anderen  
Worten, mit der Verteilung der Strichrechnung die Zahlen und die  
Punktrechnung zu steuern.

Gruss
Udo.


On Mon, 10 Mar 2008 17:10:30 +0100, Stefan Welke <spwelke@XXXXXXX.com> wrote:

> petsie@XXXXXXX.de wrote:
> > Das kann doch geradewegs getippselt werden:
> >
> > In[1]:=
> > test[n_]:=Block[{ziffern=Subsets[ToString/@Range[9],{n}],
> >       operatoren=Tuples[{"+","-","*","/"},n-1]},
> >     Select[
> >
> > Flatten[Outer[StringJoin@@Flatten[{Transpose[{Most[#1],#2}],Last[#1]}]&,
> >           ziffern,operatoren,1]],ToExpression[#]==100&]]
> >
> > In[2]:=
> > Union@Flatten[test/@Range[3,9]]
> >
> > Out[2]=
> > {"1*2+3*4+5*6+7*8", "1-2*3+4*5*6*7/8",
> >   "1-2*3+4*5*6-7-8", "1+2*3*4*5-6-7-8",
> >   "1*2*3*4+5+6-7+8*9", "1*2*3*4+5+6+7*8+9",
> >   "1*2*3-4*5+6*7+8*9", "1*2*3+4+5+6+7+8*9",
> >   "1-2*3-4-5+6*7+8*9", "1-2*3-4+5*6+7+8*9",
> >   "1-2*3+4*5+6+7+8*9", "1-2+3*4*5-6+7*8-9",
> >   "1-2+3*4*5+6*7+8-9", "1+2*3*4*5/6+7+8*9",
> >   "1+2*3+4*5-6+7+8*9", "1+2-3*4-5+6*7+8*9",
> >   "1+2-3*4+5*6+7+8*9", "1+2+3-4*5+6*7+8*9",
> >   "1+2+3+4+5+6+7+8*9", "1-2-3+4*5*6-7-9",
> >   "1-2+3-4+5*6+8*9", "1-2+3+4*5+6+8*9",
> >   "1+2*3*4*5*6/8+9", "1*2*3*4/6*7+8*9",
> >   "1+2+3*4+6+7+8*9", "1/2/3*4*6*7+8*9",
> >   "1-2+3*4*7+8+9", "1+2-3+4*7+8*9",
> >   "1+2+3*5*6+7", "1*2+3*5*6+7-8+9",
> >   "1*2+3+5*6-7+8*9", "1*2+3+5*6+7*8+9",
> >   "1+2/3*5*6+7+8*9", "1+2*3*5+6+7*9",
> >   "1+2*3+5*6+7*9", "1*2+3*5*6+8",
> >   "1+2+3*5*7-8", "1*2/3*6*7+8*9",
> >   "1+2+3*6+7+8*9", "1+2*3*6+7*9",
> >   "1+2*4*5-6-7+8*9", "1+2*4*5-6+7*8+9",
> >   "1+2*4*5+6*7+8+9", "1+2+4+5*6+7*9",
> >   "1*2-4+5*6+8*9", "1*2+4*5+6+8*9",
> >   "1-2*4+5*7+8*9", "1+3+4*5*6*7/8-9",
> >   "1+3+4*5*6-7-8-9", "1*3+4+5*6+7*9",
> >   "1+3*4*5+6*8-9", "1+3+4*6*7-8*9",
> >   "1+3+4*6+8*9", "1*3*5*6-7+8+9",
> >   "1*3*5+6+7+8*9", "1-3*5+6*7+8*9",
> >   "1-3+5*6+8*9", "1+3*5*6+9",
> >   "1+4+5*6-7+8*9", "1+4+5*6+7*8+9",
> >   "1+4*5+7+8*9", "1*4*7+8*9",
> >   "2+3*4+5*6+7*8", "2*3*4+5+6-7+8*9",
> >   "2*3*4+5+6+7*8+9", "2*3-4*5+6*7+8*9",
> >   "2*3+4+5+6+7+8*9", "2*3*4/6*7+8*9",
> >   "2+3*5*6+7-8+9", "2+3+5*6-7+8*9",
> >   "2+3+5*6+7*8+9", "2+3*5*6+8",
> >   "2/3*6*7+8*9", "2-4+5*6+8*9",
> >   "2+4*5+6+8*9", "3+4+5*6+7*9",
> >   "3*5*6-7+8+9", "3*5+6+7+8*9", "4*7+8*9"}
> >
> > In[3]:=
> > Length@%
> >
> > Out[3]=
> > 79
> >
> > viele Grüße,
> > Peter
> >
> > Udo und Susanne Krause schrieb:
> >
> > > Liebe Freundinnen und Freunde der Unterhaltungsarithmetik,
> > >
> > > man gebe alle Kombinationen aus den neun Ziffern 1, 2, 3, 4, 5, 6, 7,
> > > 8, 9
> > > und den vier Grundrechenarten (Addition, Multiplikation, Subtraktion,
> > > Division) an, die unter folgenden Bedingungen 100 ergeben:
> > >
> > > (i)    jede Ziffer kommt höchstens einmal vor
> > > (ii)    die Operatoren können mehrfach vorkommen in einer Lösung
> > > (iii)    Klammern werden nicht gesetzt
> > > (iv)    nicht alle Operatoren kommen in jeder Lösung vor,
> > >
> > > beispielsweise 4 * 7 + 8 * 9 = 100
> > >            1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 * 9 = 100.
> > >
> > > Gruss und Dank an M. Engelskirchen für die Anregung
> > > Udo.
> Hallo,
>
> ich vermisse aber einige Lösungen aus der Menge mit vier Zahlen
>
> {"4+2*6*8", "4+2*8*6", "4+6*2*8", "4+6*8*2", "4+8*2*6", "4+8*6*2", \
> "4*7+8*9", "4*7+9*8", "7*4+8*9", "7*4+9*8", "8*9+4*7", "8*9+7*4", \
> "9*8+4*7", "9*8+7*4", "2*6*8+4", "2*8*6+4", "6*2*8+4", "6*8*2+4", \
> "8*2*6+4", "8*6*2+4", "2*6*9-8", "2*9*6-8", "3*4*9-8", "3*9*4-8", \
> "4*3*9-8", "4*9*3-8", "6*2*9-8", "6*9*2-8", "9*2*6-8", "9*3*4-8", \
> "9*4*3-8", "9*6*2-8"},
>
> wovon einige Doppelungen entbehrlich sind.
>
> MfG
>
> Stefan Welke



--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/