Консультация № 161641
28.02.2009, 22:01
0.00 руб.
0 1 1
Здравствуйте, уважаемые эксперты. Помогите пожалуйста с 2-мя задачами:
1) Переделать программу с использованием процедур.
2) Переделать пргграмму с использованием процедур и функций.
Только нельзя использовать глобальные переменные в обоих программах!!!
Исходники программ в приложении.
С уважением, Евгений.

Приложение:
1)Program lab9_10;
uses crt;
var a:array[1..999] of real;
i,n:integer;
m:real;
begin
clrscr;
m:=0;
writeln('');
write('Введите размер последовательности ');
readln(n);
for i:=1 to n do
begin
write('a(',i,')=');
readln(a[i]);
m:=m+a[i]; {суммируем}
end;
writeln;
m:=m/n; {считаем среднее арифметическое}
writeln('');
writeln('Среднее арифметическое равно ',m:8:2);
writeln('');
writeln('Результат (новая последовательность):');
for i:=1 to n do
begin
a[i]:=sqrt(sqr(a[i]-m)/(n-1));{составляем новую последовательность по формуле}
writeln('a(',i,')=',a[i]:5:2);
end;
readln
end.

2)Program Kvadratnoe_Yravnenie;
uses CRT;
var
a,b,c,d,x1,x2:real;
begin
writeln('Здравствуйте))) Пожалуйста введите коэффициенты квадратного уравнения');
write('a='); readln(a);
write('b='); readln(b);
write('c='); readln(c);
d:=b*b-4*a*c;
writeln('Дискриминант квадратного уравнения равен ',d:10:4);
if d<0 then writeln('Дискриминант меньше нуля, поэтому квадратное уравнение не имеет корней корней!!!')
else if d=0 then begin
writeln('Дискриминант равен нулю, поэтому квадратное уравнение имеет один корень!');
x1:=(-b)/2*a;
writeln('Единственный корень уравнения равен ',x1:10:4);
end
else if d>0 then begin
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
writeln('Дискриминант больше нуля, поэтому квадратное уравнение имеет два корня!!');
writeln('Первый корень равен ',x1:10:4);
writeln('Второй корень равен ',x2:10:4);
end;
readln;
end.

Обсуждение

Неизвестный
01.03.2009, 22:01
общий
это ответ
Здравствуйте, Евгений!

Код переделанных программ в приложении, комментарии, думаю, излишни.

С уважением, Дмитрий.

Приложение:
Program lab9_10;
uses crt;

type mas = array[1..999] of real;{чтобы передать массив в процедуру, его необходимо описать собственным типом}

procedure vvod(var a:mas; var n:integer; var summ:real);
var i:integer;
begin
summ:=0;
writeln('');
write('Введите размер последовательности ');
readln(n);
for i:=1 to n do
begin
write('a(',i,')=');
readln(a[i]);
summ:=summ+a[i]; {суммируем}
end;
end;
Procedure vivod(a:mas; m:real; n:integer);
var i:integer;
begin
writeln('');
writeln('Среднее арифметическое равно ',m:8:2);
writeln('');
writeln('Результат (новая последовательность):');
for i:=1 to n do
begin
a[i]:=sqrt(sqr(a[i]-m)/(n-1));{составляем новую последовательность по формуле}
writeln('a(',i,')=',a[i]:5:2);
end;
end;

var a:mas;
n:integer;
m:real;
begin
clrscr;
vvod(a,n,m);
writeln;
m:=m/n; {считаем среднее арифметическое}
vivod(a,m,n);
readln;
end.

2)
Program Kvadratnoe_Yravnenie;
uses CRT;

Function Enter_Koef(s:String):real;
begin
write(s,'=');
readln(Enter_Koef);
end;
Procedure writeRoot(s1,s2:String; a,b,d:real; dva:boolean);
begin
writeln(s1+' корень уравнения равен ',(-b+sqrt(d))/(2*a):10:4);
IF dva then
writeln(s2+' корень уравнения равен ',(-b-sqrt(d))/(2*a):10:4);
end;

var
a,b,c,d:real;
begin
writeln('Здравствуйте))) Пожалуйста введите коэффициенты квадратного уравнения');
a:=Enter_Koef('a');
b:=Enter_Koef('b');
c:=Enter_Koef('c');
d:=b*b-4*a*c;
writeln('Дискриминант квадратного уравнения равен ',d:10:4);
if d<0 then writeln('Дискриминант меньше нуля, поэтому квадратное уравнение не имеет действительных корней!!!')
else if d=0 then begin
writeln('Дискриминант равен нулю, поэтому квадратное уравнение имеет один корень!');
writeRoot('Единственный','',a,b,d,false);
end
else if d>0 then begin
writeln('Дискриминант больше нуля, поэтому квадратное уравнение имеет два корня!!');
writeRoot('Первый','Второй',a,b,d,true);
end;
readln;
end.
Форма ответа