дружественные числа Опции

[Rom1k]

два натуральных числа называют дружественными,если каждое из них равно сумме всех делителей другого, кроме самого этого числа.
найти все пары дружественных чисел,лежащих в диапазоне от 200 до 300

помогите пожалуйста.даже догадок нет(

[AlexZerg]

Вот достаточно оптимальный алгоритм полного перебора:

Var l,j,x,xx:longint;
Function Drug(n1:longint):longint; {сумма делителей чётного}
Var i,k,Sq : longint;
Begin
 k:=3+(n1 div 2); Sq:=Trunc(Sqrt(n1));
 For i:=3 To Sq-1 Do
   IF n1 mod i = 0 Then
     Inc(k,(n1 div i)+i);
 IF n1 mod Sq = 0 Then
   If (n1 div Sq)<>Sq then Inc(k,(n1 div Sq)+Sq)
                      else Inc(k,Sq);
 Drug:=k;
End;
Function Drug1(n1:longint):longint; {сумма делителей нечётного}
Var i,k,NSq : longint;
Begin
 k:=1; i:=3;
 NSq:=Trunc(Sqrt(n1));
 Repeat
   IF n1 mod i = 0 Then
     Inc(k,(n1 div i)+i);
   Inc(i,2);
 Until i>NSq-1;
 IF n1 mod NSq = 0 Then
   If (n1 div NSq)<>NSq then Inc(k,(n1 div NSq)+NSq)
                        else Inc(k,NSq);
 Drug1:=k;
End; 
Begin
 WriteLn('Пары дружественных чисел: ');
 j:=200; l:=300;
 While j<=l do
   begin
    if j mod 2 = 0 then x:=drug(j) else drug1(j);
    if j<x then 
      Begin
       if x mod 2 = 0 then xx:=drug(x) else xx:=drug1(x);
       if j=xx then Write('{',j,',',x,'} ');
      end;
    inc(j);
   end;
End.

Однако и его можно улучшить, отбрасывая для конкретных чисел из диапазона перебора ненужные (например: если число 1001 не делится на 3, то нет смысла проверять делимость числа 1001 и на другие числа, делящиеся на 3), и, грамотно подойдя к вопросу, можно добиться ускорения до 50%.
Лично мне удалось значительно улучшить алгоритм в итоге (в 5,5 раз). Ибо вычисление суммы делителей я стал производить несколько иначе (отчасти как у Декарта и Ферма) - кому интересно - оставляйте заявки - покажу, но текст боольшой )

Сообщение отредактировано: AlexZerg - 10.11.2009 19:55