Помощь - Поиск - Пользователи - Календарь
Полная версия: Совершенные числа
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Ромка
Составить программу для графического изображения делимости чисел от 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 веке живем, есть поддержка всех языков...
Ромка
Даны натуральные числа 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
Цитата(Ромка @ 21.02.05 20:06)
может кто-то знает полегче вариант, а то этот я не осилю.

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

Код
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.
Ромка
Спасибо, вы очень помогли!
is there a legitimate canadian p
cialis naproxen
buy zithromax z-pak without pres
Low Testosterone Bph Propecia
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.