16.11.2013, 10:24 | #1 (permalink) |
Member
Регистрация: 16.11.2013
Сообщений: 22
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Написание программы через процедуры и функции. Паскаль
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. Рассчитываю на вашу помощь |
16.11.2013, 10:24 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Вы можете посмотреть похожие на вашу темы Написание программы для вычисления формулы Подпрограммы. Процедуры и функции Паскаль. Процедуры, функции, параметры Задача на процедуры и функции Delfi |
16.11.2013, 11:06 | #2 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну, прежде всего - в любом случае задачи решены неверно. Возьмем первую. Вам надлежит определить произведение нечетных цифр данного числа, например, для числа 236871 это будет 3*7*1=21. А Вы вместо этого ищете произведение нечетных чисел, не превосходящих заданное число. Ну и т.д.
Ладно, подумаю, как тут лучше организовать. Чтобы и удовлетворить идиотским требованиям, и чтобы правильно было. |
16.11.2013, 11:27 | #3 (permalink) |
Member
Регистрация: 16.11.2013
Сообщений: 22
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Вторая задача:
Код:
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. |
16.11.2013, 11:39 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну вот первая.
Некоторые пояснения. 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. |
16.11.2013, 11:47 | #5 (permalink) |
Member
Регистрация: 16.11.2013
Сообщений: 22
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Да, Паскаль ABS
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
16.11.2013, 12:00 | #6 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Тьфу, чтоб ему провалиться! Только 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. |
16.11.2013, 12:45 | #9 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну вот так у меня получилось третья. Замечу, что введенное ограничение диапазона в 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. |
16.11.2013, 12:57 | #10 (permalink) |
Member
Регистрация: 16.11.2013
Сообщений: 22
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Ясно, спасибо большое
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|