Помощь - Поиск - Пользователи - Календарь
Полная версия: дружественные числа
Форум «Всё о Паскале» > 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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.