Написание программы через процедуры и функции. Паскаль

[Тетрадь]

Написание программы через процедуры и функции. Паскаль

Нужно написать программы через процедуры и функции с Параметрами.
1)Дано натуральное число. Верно ли, что произведение нечетных цифр данного числа меньше некоторого заданного числа.
2)Составьте программу получения в порядке убывания всех делителей данного числа.
3)Задано целое число N. Найти ближайшее к нему совершенное число.

Я написал, но требуют чтобы функции и процедуры были написаны с Параметрами

1)

program pro1;
procedure max;
var
   a, i: integer;
   p: real;
begin
     writeln('Введите число');
     readln(a);
     p := 1;
     for i := 1 to a do begin
                        if (i mod 2 <> 0) then p := p * i;
                        end;
     writeln('произведение нечетных чисел = ', p);
     if (p < a) then writeln('Произведение меньше')
                else writeln('Произведение больше введенного числа');
end;

begin max;
end.

2)

program pro1;
procedure max;
var
   a, i: integer;
   p: real;
begin
     writeln('Введите число');
     readln(a);
     p := 1;
     for i := 1 to a do begin
                        if (i mod 2 <> 0) then p := p * i;
                        end;
     writeln('произведение нечетных чисел = ', p);
     if (p < a) then writeln('Произведение меньше')
                else writeln('Произведение больше введенного числа');
end;

begin max;
end.

3)

program pro2;
procedure max;
var
   sum: longint;
   a,i: integer;
begin
     writeln('Введите число');
     readln(a);
     for i:=a downto 1 do if a mod i = 0 then sum:=sum+i ;
     writeln ('совершенное число = ', sum);
end;
begin max;
end.

Первую наверно лучше было написать через функцию.
Рассчитываю на вашу помощь

 

[Vladimir_S]

Рассчитываю на вашу помощь

Ну, прежде всего - в любом случае задачи решены неверно. Возьмем первую. Вам надлежит определить произведение нечетных цифр данного числа, например, для числа 236871 это будет 3*7*1=21. А Вы вместо этого ищете произведение нечетных чисел, не превосходящих заданное число. Ну и т.д.
Ладно, подумаю, как тут лучше организовать. Чтобы и удовлетворить идиотским требованиям, и чтобы правильно было.

 

[Тетрадь]

Вторая задача:

program pro2;
var
   a,i: integer;
begin
     writeln('Введите число');
     readln(a);
     for i:=a downto 1 do if a mod i = 0 then writeln('=', i);
end.

 

[Vladimir_S]

Ну вот первая.
Некоторые пояснения.
1. Вы не указали тип Паскаля. Если это мерзкий АВС, то LongInt замените на Integer.
2. Обратите внимание, что сравнение произведения нечетных цифр следует производить НЕ с исходным числом, а с некоторым другим наперед заданным числом. В программе оно обозначено С.
3. Отрабатывается ситуация, когда введенное число вообще не содержит нечетных цифр. Для этого в функцию введен булевский флажок b, и в конце программы в этом случае выдается сообщение о том, что нечетных цифр нет.

Var
 A,C:LongInt;

Function Odd_Dig(R:LongInt):LongInt;
var
 i,m:Byte;
 S,P,d:LongInt;
 b:boolean;
begin
 S:=R;
 P:=1;
 b:=false;
 Repeat
  d:=S div 10;
  m:=S mod 10;
  if (m mod 2)=1 then
   begin
    P:=P*m;
    b:=true;
   end;
  S:=d;
 Until d=0;
 If b then Odd_Dig:=P else Odd_Dig:=0;
end;

Begin
 Write('A = ');
 Readln(A);
 Write('C = ');
 Readln(C);
 If Odd_Dig(A)=0 then
  Writeln('No odd digits!')
 else
  Writeln(Odd_Dig(A)<C);
 Readln
End.

 

[Тетрадь]

Да, Паскаль ABS

 

[Vladimir_S]

Да, Паскаль ABS

Тьфу, чтоб ему провалиться! Только ABC, а не ABS. Ладно, вот так можно оформить вторую:

var
 a,i:Integer;

Procedure DVD(R,q:Integer);
begin
 if (R mod q)=0 then
  begin
   if q=1 then write(q) else write (q,', ');
  end;
end;

Begin
 write('a = ');
 readln(a);
 for i:=a downto 1 do DVD(a,i);
 writeln;
 readln
End.

И да, если это АВС, то вроде Readln в конце программ можно не ставить. Впрочем, тут не уверен - проверьте.

 

[Тетрадь]

Забыл написать, что программы должны писаться через циклы

 

[Vladimir_S]

Забыл написать, что программы должны писаться через циклы

Так. И какие еще указули Вы забыли? Циклы в обеих программах присутствуют.

 

[Vladimir_S]

Ну вот так у меня получилось третья. Замечу, что введенное ограничение диапазона в 10000 связано с тем, что программа очень долго добирается до следующего после 8128 идеального числа 33550336. Но Вы можете попробовать это ограничение снять, поставив, например, вместо 10000 40000000, и, соответственно, Dmin=80000000 (например). Может быть, у Вас и пойдет, мой DOS-Pascal на таких числах затыкается.

var
 a,j,D,Dmin,Id_near:Integer;

Function Ideal(R:Integer):Boolean;
 var i,Sum:Integer;
begin
 Sum:=0;
 For i:=R-1 downto 1 do
  if (R mod i)=0 then Inc(Sum,i);
 Ideal:=(R=Sum);
end;

Begin
 Write('a (<10000) = ');
 Readln(a);
 Dmin:=20000;
 j:=1;
 Repeat
  Inc(j);
  If Ideal(j) then
   begin
    D:=Abs(a-j);
    if D<Dmin then
     begin
      Id_near:=j;
      Dmin:=D;
     end;
   end;
 Until (D>Dmin) or (j=10000);
 Writeln('Nearest Ideal is ',Id_near);
 readln
End.

 

[Тетрадь]

Ясно, спасибо большое