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

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

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

Нужно написать программы через процедуры и функции с Параметрами.
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.

Код:

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.

Код:

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.

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

Цитата:

Сообщение от Тетрадь (Сообщение 970137)

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

Ну, прежде всего - в любом случае задачи решены неверно. Возьмем первую. Вам надлежит определить произведение нечетных цифр данного числа, например, для числа 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.

Ну вот первая.
Некоторые пояснения.
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

Цитата:

Сообщение от Тетрадь (Сообщение 970162)

Да, Паскаль 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 в конце программ можно не ставить. Впрочем, тут не уверен - проверьте.

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

Цитата:

Сообщение от Тетрадь (Сообщение 970169)

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

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

Ну вот так у меня получилось третья. Замечу, что введенное ограничение диапазона в 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.

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