Помощь - Поиск - Пользователи - Календарь
Полная версия: дружественные числа
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Rom1k
два натуральных числа называют дружественными,если каждое из них равно сумме всех делителей другого, кроме самого этого числа.
найти все пары дружественных чисел,лежащих в диапазоне от 200 до 300

помогите пожалуйста.даже догадок нет(
volvo
Все пары - это очень громко сказано... В заданном диапазоне всего одна пара таких чисел: 220 и 284...

На таком маленьком интервале проще будет перебрать все числа, и найти дружественные...
В чем затруднения? Не знаешь, как считать сумму делителей числа?
мисс_граффити
в поиск...
вот, например:
Дружественные числа
Rom1k
uses crt;
var
   count,i,j,s : word;
begin
   count := 0;

   for i := 200 to 300  do begin
      s := 0;
      for j := 1 to i div 2 do begin
         if i mod j = 0 then begin
            writeln(j,' - delitel ',i);
            s := s + j;
         end;
         if s = i then begin
            writeln('Chislo ',i,' ravno summe svoih delitelei');
            readln;
            inc(count);
         end;
      end;
   end;
   readln
end.



ну вот,беру этот код. ищу от 200 до 300, а как именно найти эти пары дружественных чисел?
Rom1k
кто-нибудь может подсказать?
volvo
Если на "сделать чтоб работало" - то вот так:

uses crt;

function sum(i: longint): longint;
var j, s: longint;
begin
      s := 0;
      for j := 1 to i div 2 do begin
         if i mod j = 0 then begin
            s := s + j;
         end;
      end;
      sum := s;
end;

var
   i, j: longint;
begin
   for i := 200 to 300  do begin
     for j := i to 300 do begin
       if (sum(i) = j) and (sum(j) = i) then
         writeln(i, ' and ', j);
     end;
   end;
   readln
end.

, но это очень неэффективное решение, скажем, даже не пытайся найти все "дружественные пары" в интервале 1 .. 100000 таким вот кодом, результатов будешь ждать очень долго... Существует гораздо более быстрый метод...
Rom1k
Цитата(volvo @ 24.03.2008 18:28) *



спасибо. но мне только в интервале от 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 раз). Ибо вычисление суммы делителей я стал производить несколько иначе (отчасти как у Декарта и Ферма) - кому интересно - оставляйте заявки - покажу, но текст боольшой )
volvo
1) ну и чем твое решение лучше приведенных выше?
2) Турбо-Паскаль, стандартные установки, ничего не меняешь - твоя программа НЕ компилируется.

Цитата
кому интересно - оставляйте заявки - покажу
С учетом вышесказанного - уже неинтересно.
Цитата
Лично мне удалось значительно улучшить алгоритм в итоге (в 5,5 раз)
Угу. Только ты сначала выложил явно специально замедленный алгоритм, а потом будешь его ускорять, да? Смотри:

var counter: longint; { <--- делаем раз }
Begin
  counter := 0; x := 0; { <--- делаем два }
  WriteLn('Пары дружественных чисел: ');
  j:=201; { <--- делаем три } l:=300;
  While j<=l do
  begin
    if j mod 2 = 0 then x:=drug(j) else drug1(j);
    if j<x then 
    Begin
      inc(counter); { <--- делаем четыре }
      if x mod 2 = 0 then xx:=drug(x) else xx:=drug1(x);
      if j=xx then Write('{',j,',',x,'} ');
    end;
    inc(j);
  end;
  writeln(counter, ' iteration(s)... '); { <--- делаем пять }
End.
И запускаем. Что видим? 45 iteration(s)... Хорошо... А теперь:
    if j mod 2 = 0 then x:=drug(j) else x := drug1(j); { <--- делаем шесть }
, и запускаем снова: 23 iteration(s). Интересно, правда? А ведь каждая итерация - это вычисление функций... А ты даже это не соизволил проверить...
shemetec23
var
  x: integer;

function SumDev(i: integer): longint;
var
  s, k: integer;
begin
  s := 0;
  for k := 1 to i div 2 do 
  begin
    if i mod k = 0 then begin
      s := s + k;
    end;
    SumDev := s;
  end;
end;

begin
  for x := 1 to 10000000 do 
  begin
    if (SumDev(x) <> x) and (x = SumDev( SumDev(x) ) ) then writeln(x, ' ', SumDev(x)); 
  end;
  
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.