Совершенные числа, и что-то еще про цикл. Опции

[Ромка]

Составить программу для графического изображения делимости чисел от 1 до n (n - исходное данное). В каждой строке надо печатать число и сколько плюсов, сколько делителей у этого числа. Например, если исходное данное - число 4, то на экране должно быть напечатано:


1+

2++

3++

4+++

Составить программу получения всех совершенных чисел, меньших заданного числа n. Число называется совершенным, если равно сумме всех своих положительных делителей, кроме самого этого числа. Например, 28 - совершенно, так как 28=1+2+4+7+14.
Даны натуральные числа n, m. Получить все меньшие n натуральные числа, квадрат суммы цифр которых равен m.
Даны натуральные числа n и m. Найти все пары дружественных чисел, лежащих в диапазоне от n до m. Два числа называются дружественными, если каждое из них равно сумме всех делителей другого (само число в качестве делителя не рассматривается).

[volvo]

Правила читать будем? FAQ и поиск зачем?
Совершенные числа

[Ромка]

ne nashol !!!

[Altair]

плохо искал.

[Ромка]

Rebjat, mozhet prosto pomozhete... Esli vam vsjo jasno i do boli ponjatno...

[Altair]

Поиск совершенных чисел.

Определенный интерес для любителей представляет программа поиска совершенных чисел. Ее схема проста: в цикле для каждого числа проверять сумму его делителей и сравнивать ее с самим числом, - если они равны, то это число совершенное.

Код

VAR I,N,Summa: LONGINT;
  Delitel: INTEGER;
begin FOR I:=3 TO 34000000 DO BEGIN Summa:=1;
 FOR Delitel:=2 TO SQRT(I)
 DO BEGIN N:=(I DIV Delitel);
       IF N*Delitel=I THEN Summa:=Summa + Delitel + (I DIV Delitel);
  END;
 IF INT(SQRT(I))=SQRT(I) THEN Summa:=Summa-INT(SQRT(I));
  IF I=Summa THEN WRITELN(I,’ - ‘,Summa);
  END;
END.

Проверка: простое-ли число.
(вполне подходит для не самых больших чисел)

Код

function isPrime(X: word): boolean;
var
i: integer;
Begin
isPrime:=false;
for i:=2 to trunc(sqrt(x)) do
if x mod i = 0 then Exit;
isPrime:=true
End;

это з фака.... пожалуй этого должно хватить

[Ромка]

pishel ordinal expression expected na etoj stroke DO BEGIN N:=(I DIV Delitel);

[Altair]

так:

VAR I,N,Summa: LONGINT;
  Delitel: INTEGER;
begin
 FOR I:=3 TO 34000000 DO
 BEGIN
  Summa:=1;
  FOR Delitel:=2 TO trunc(SQRT(I)) DO
  BEGIN
   N:=(I DIV Delitel);
   IF N*Delitel=I THEN Summa:=Summa + Delitel + (I DIV Delitel);
  END;
  IF INT(SQRT(I))=SQRT(I) THEN Summa:=Summa-trunc(SQRT(I));
  IF I=Summa THEN WRITELN(I,' - ',Summa);
 END;
END.

[Altair]

еще один пост на транслите и тема будет закрыта!

[Ромка]

ссори, не заметил твоё мсг. всё транслиту - нет !!
давно пора, в XXI веке живем, есть поддержка всех языков...

Сообщение отредактировано: Oleg_Z - 20.02.2005 22:29

[Ромка]

Даны натуральные числа n и m. Найти все пары дружественных чисел, лежащих в диапазоне от n до m. Два числа называются дружественными, если каждое из них равно сумме всех делителей другого (само число в качестве делителя не рассматривается).
Что-то никак не получается...

[Altair]

а ты покажи что получается...
Код в студию, что уже написанно.

[Ромка]

Код

uses crt;
var n,m,del1,del2,per,vtor,summ1,summ2:integer;
begin
readln (n,m);
summ1:=0;
summ2:=0;
for per:=n to m do
for vtor:=n to m  do
begin
for del1:= n to m do
for del2:= n to m do
if (per mod del1=0) then inc (summ1);
if (vtor mod del2=0) then inc (summ2);
end;
if (summ1-per)=(summ2-vtor) then writeln (per,' ', vtor);
readkey;
end.

виснет... хэлп !!!!

[volvo]

Нет, она не виснет, она просто очень долго считает... Ты же пользуешься полным перебором - нерационально. Можно попробовать воспользоваться известной формулой для нахождения пар дружественных чисел (см. аттач)

[Ромка]

Спасибо. Ну может кто-то знает полегче вариант, а то этот я не осилю. я нуб...

[volvo]

может кто-то знает полегче вариант, а то этот я не осилю.

Чем легче вариант - тем дольше он будет работать... А тут главное - скорость... А сложного в этом абсолютно ничего нет...

Код

Function PowerTwo(n: Byte): LongInt;
 Begin
   PowerTwo := LongInt(2) shl Pred(n)
 End;

Function IsPrime(X: LongInt): Boolean;
 Var i: integer;
 Begin
   isPrime := False;
   For i := 2 To Trunc(Sqrt(x)) Do
     If x mod i = 0 Then Exit;
   isPrime := True
 End;

Var
 n: integer;
 p, q, r: longint;
 a, b: Longint;

Const
{ Интервал }
 _n = 10;
 _m = 1000;
begin
 For n := 2 To 15 Do
   Begin
     p := 3 * PowerTwo(Pred(n)) - 1;
     q := 3 * PowerTwo(n) - 1;
     r := 9 * PowerTwo(Pred(2*n)) - 1;

     If isPrime(p) and isPrime(r) and isPrime(q) Then
       Begin
         a := PowerTwo(n) * p * q;
         b := PowerTwo(n) * r;
         If (a > _n) and (a < _m) and
            (b > _n) and (b < _m) Then
           WriteLn('The pair is: ', a:10, ' and ', b: 10)
       End;
   End;
end.

[Ромка]

Спасибо, вы очень помогли!