Hallo Manfred,
letztens wurde
In[1]:= Clear[fS, fA, fR]
fS[L_Integer, {x_Integer, y_Integer}, R_Integer] :=
(L < x + y < R && x y < R);
fA[L_Integer, {x_Integer, y_Integer}, R_Integer] :=
(IntegerQ[x/y] && L < x - y < R && L < x/y < R);
fR[L_Integer, {x_Integer, y_Integer}, R_Integer] :=
If[fA[L, {x, y}, R], {{x, y}, x + y, x - y, x y, x/y},
{{y, x}, y + x, y - x, y x, y/x}]
In[5]:= With[{L = 1, R = 5001}, g = Floor[(R - 1)/(L + 1)];
fR[L, #, R]& /@ Select[Flatten[Table[{i, j}, {i, L + 1, g}, {j, i,
g}],
1], (fS[L, #, R] && (fA[L, #, R] || fA[L, Reverse[#], R]))&]
] // Timing // Short
Out[5]//Short=
{32.,{{{4,2},6,2,8,2},{{6,2},8,4,12,3},<<3052>>,{{100,50},150,50,5000,2}}}
gesagt. Wenn man sich die Aufgabe nocheinmal ansieht und feststellt,
dass es dabei in Wirklichkeit fast nichts zu rechnen gibt und deshalb
In[6]:= Clear[unPrime, divisorsR, fF]
unPrime[i_Integer, j_Integer] :=
Select[Range[i, j], (!PrimeQ[#])&];
divisorsR[i_Integer, j_Integer] :=
Select[Rest[Most[Divisors[i]]], (i # < j)&];
fF[{x_Integer, y_Integer}] := {{x, y}, x + y, x - y, x y, x/y};
In[10]:= With[{L = 1, R = 5001}, g = Floor[(R - 1)/(L + 1)];
fF[#]& /@ Flatten[Outer[List, {#}, divisorsR[#, R]]& /@ unPrime[L + 1,
g], 2]
] // Timing // Short
Out[10]//Short=
{0.141,{{{4,2},6,2,8,2},<<3053>>,{{2500,2},2502,2498,5000,1250}}}
eintippt, dann gewinnt man bei R = 1001 ca. den Faktor 42 für
die Lösungsgeschwindigekeit oder eben bei R = 5001
In[11]:= 32./0.141
Out[11]= 226.95
Gruss
Udo.
--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
|