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/