Математическая задача Опции

[Игорь]

Помогите пожалуйста с задачей:

Определить, является ли заданное натуральное число совершенным, т.е. Равным сумме всех своих (положительных) делителей, кроме самого этого числа (напр. Число 6 совершенно: 6=1+2+3).

[volvo]

Если "в лоб" -

Var
  i, n: LongInt;
  s: LongInt;
BEGIN
  Write( 'Enter the number:' );
  ReadLn(n);

  s := 1;
  For i := 2 To (n div 2) Do
    If (n mod i) = 0 Then Inc(s, i);

  If s = n Then
    WriteLn( 'Yes.' )
  Else
    WriteLn( 'No.' );
END.

Но может существует и другое решение.
А вообще-то их не так уж много (я знаю всего 5 из тех, которые помещаются в LongInt). Может, имеет смысл проверять напрямую?

[Игорь]

Большое спасибо! А как по этому составить flow-схему и диаграмму Насси-Шнейдермана?

[xds]

Решение "в лоб" для n = 33550336 уже немного задумывается. Слегка оптимизируем:

Код

program PerfNum;

label
 Cont;

var
 n, l, r, d, s: LongInt;

begin
 Write('n>');
 Readln(n);
 l := 1;
 r := n div 2;
 s := 1;
 while l < r do
   begin
     for d := l + 1 to r - 1 do
       if n mod d = 0 then
         begin
           l := d;
           r := n div d;
           if l = r then Inc(s, l) else Inc(s, l + r);
           goto Cont;
         end;
     Break;
   Cont:
   end;
 if (n <> 1) and (s = n) then
   Writeln('Число ', n, ' - совершенное')
 else
   Writeln('Число ', n, ' не является совершенным');
end.

Сообщение отредактировано: xds - 15.10.2004 17:03

[xds]

Впрочем, если n типа LongInt, то почему бы не так:

program PerfNum2;

var
  n: LongInt;

begin
  Write('n>');
  Readln(n);
  if (n = 6) or (n = 28) or (n = 496) or (n = 8128) or (n = 33550336) then
    Writeln('Число ', n, ' - совершенное')
  else
    Writeln('Число ', n, ' не является совершенным');
end.

:P

[Caries]

Решение "в лоб" для n = 33550336 уже немного задумывается.  Слегка оптимизируем:

Вопрос: вот в некоторых книгах пишут что goto использовать не рекомендуется, можно ли в данном случае обойтись без него?

[Флогримм]

Вопрос: вот в некоторых книгах пишут что goto использовать не рекомендуется, можно ли в данном случае обойтись без него?

не рекомендуется использовать сложные, запутанные структуры с гоуту, а когда оно один-два раза в программе применяется, ИМХО, ничего страшного

и ваапче енто есть мнение расхожее

[Altair]

Нет, или мы пишем код на Паскале, по принципу структурного программирования, или мы берем тогда Бейсик
Убрать GOTO на фиг!

[Caries]

Та же программа. Но с условием поиска совершенного числа меньше введенного юзверем.
Требуется при выводе совершенного числа вывести также его делители(т.е показать что в сумме они дают само число)
Как это можно сделать? Я затрудняюсь.
Вот код исходной программы котрую нужно модифицировать:

Код

Program semestr;
var i,n,s,z:Integer;
begin
writeln('DANNAJA PROGRAMMA HAXODIT COBEPSHEHHIE CHISLA');
WRITELN('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
writeln('vvedite chislo');
readln(n);
if n<6 then writeln('sovversh chisel net')
else
writeln('Perfect Chisla menshie n');
for z:=6 to n do begin
s:=1;
for i:=2 to (z div 2) do
if (z mod i) = 0 then inc(s,i);
If s=z then
writeln(z) end;
readln;
end.

Заранее спасибо

Сообщение отредактировано: Caries - 15.12.2004 21:51

[Caries]

неужели никто не знает?

[FreeMan]

В цикле дели на 10 и выводи остаток от деления

while x<>0 do begin
writeln(x mod 10);
x:=x div 10;
end;

[Гость_Caries]

Можно поподробнее?

[FreeMan]

Program semestr;
var i,n,s,z:Integer;
begin
writeln('DANNAJA PROGRAMMA HAXODIT COBEPSHEHHIE CHISLA');
WRITELN('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
writeln('vvedite chislo');
readln(n);
if n<6 then writeln('sovversh chisel net')
else
writeln('Perfect Chisla menshie n');
for z:=6 to n do begin
s:=1;
for i:=2 to (z div 2) do
if (z mod i) = 0 then inc(s,i);
If s=z then begin
writeln(z);
while s<>0 do begin
writeln(s mod 10, '  ');
s:=s div 10;
end;
end;
end;
readln;
end. 

так вроде.

[Caies]

Закомпилил. Выдает чепуху при вводе напрример 8 выдаст 6 6. Вы сами компилили?

[Гость_Caries]

Может я просто неграмотно описал то что требуется? сейчас выводит просто числа в ряд 6 , 28,
Требуется чтобы выводилось так
6=1+2+3
28=1+2+4+7+14 и тд.

[FreeMan]

замени

while s<>0 do begin
writeln(s mod 10, '  ');
s:=s div 10;
end;

на

while s<>1 do begin
for i:=1 to s do if s mod i=0 then begin 
write(i,'  ');
s:=s div i;
end;
end;

Закомпилил. Выдает чепуху при вводе напрример 8 выдаст 6 6. Вы сами компилили?

Я код не проверяю... Но в данном случае сработала, как задумано, просто я не понял вопрос.
З.Ы. Можно на "ты"

[Guest]

Млин. При 6 все нормально выдает 1 2 3
если вводим 9 то выдаст 1 2 3 1 7 1 2

[volvo]

Guest
Попробуй вот так:

Program semestr;
var i,n,s,z:Integer;
  elem_ix: integer;
  elem: array[1 .. 200] of integer;
begin
  writeln('DANNAJA PROGRAMMA HAXODIT COBEPSHEHHIE CHISLA');
  WRITELN('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');

  write('vvedite chislo'); readln(n);
  if n<6 then writeln('sovversh chisel net')
  else writeln('Perfect Chisla menshie n');

  for z:=6 to n do begin
  s:=1;

  elem_ix := 0;
  for i:=2 to (z div 2) do
  begin
    if (z mod i) = 0 then
      begin
        inc(s,i);
        inc(elem_ix); elem[elem_ix] := i;
      end;
  end;
    If s=z then begin
      write(z, ' = ');

      write('1+');
      for i := 1 to elem_ix do
        begin
          write(elem[i]);
          if i <> elem_ix then write('+')
        end;
      writeln
    end;
  {readln;}
  end;
end.