Процедуры и функции, Найти среднее арифметическое действительных корней трёх квадратных ура Опции

[kapa]

вот мой вариант но тут что то не так
помогите плз




program Lab5_1;{Найти среднее арифметическое действительных корней трёх квадратных уравнений}
uses crt ;
var z,x,y,SRA:real;
var a1, b1, c1, a2, b2, c2,a3,b3,c3: real ;
procedure K(a,b,c:real;var x1,x2,k:real);
function dskt(var b,a,c:integer):real;
begin
if (dskt>0) or (dskt<0) then
k:=2;
else
k:=1;
end;
begin
case dskt of
dskt>0:x1:=(-b+sqrt(dskt))/2a;
dskt>0:x2:=(-b-sqrt(dskt))/2a;
dskt=0:x1:=(-b+sqrt(dskt))/2a
else
x1:=0;
x2:=0;
end;
begin
dskt:=sqr(b)-4*(a)*©;
end;
begin
clrscr;
writeln('Введите значение коэфициэнтов первого квадратного уравнения ');
readln(a1,b1,c1);
z:=dskt(a1,b1,c1);
writeln('Введите значение коэфициэнтов второго квадратного уравнения ');
readln(a2,b2,c2);
x:=dskt(a2,b2,c2);
writeln('Введите значение коэфициэнтов третьего квадратного уравнения ');
readln(a3,b3,c3);
y:=dskt(a3,b3,c3);
S:=
writeln('Среднее арифметическое действительных корней трёх квадратных уравнений=',SRA);
readkey ;
end .

[Федосеев Павел]

У тебя структура программы выбрана верно, но в самой реализации допущены ошибки.
Поэтому для решения задачи, предлагаю разбить её на ряд небольших задач.

Итак, постановка задачи

Найти среднее арифметическое действительных корней трёх квадратных уравнений

Будем решать последовательно. Для начала, создадим и отладим функцию для решения квадратных уравнений. Назовём её SqrEquat (у тебя её "звали" просто "K").
Действия функции:
1) если корня два (дискримминант больше 0), то функция будет возвращать два корня x1 и x2, а само значение функции будет равно 2;
1) если корень один (дискримминант равен 0), то функция будет возвращать два корня x1 и x2, просто одинаковых (x1==x2), а само значение функции будет равно 1;
2) если действительных корней нет, то возвращаться будет два корня равных нулю (x1==x2==0), а само значение функции будет равно 0.
Делаем тестовую программу.

program test;
function SqrEquat( a, b, c : real; {коэффициенты квадратного уравнения}
                           var x1, x2 : real) {корни уравнения}
                          : integer; {функция возвращает количество действительных корней уравнения}
begin
.....................{реализация функции}
end;

var
  n : integer;
  x1, x2 : real;
begin
  n:=SqrEquat(4, 20, 24, x1, x2);
  case n of
    0: WriteLn('There are not a real roots.');
    1: WriteLn('There is a single root x= ', x1);
    2: WriteLn('There are double roots x1=', x1, ', x2=', x2);
  end; 
end.

После получения работающего кода функции, его можно скопировать в "настоящую" программу, где на основе корней уравнения выполняются дальнейшие расчёты. Например,

............................
var
  i, n, SumN : integer;
  x1, x2,
  a, b, c,
  SumX : real;
begin
  SumN:=0;{количество действительных корней во всех уравнениях}
  SumX:=0;{сумма всех действительных корней во всех уравнениях}
  for i:=1 to 3 do begin
    writeln('Введите значение коэфициэнтов ', i, '-го квадратного уравнения: ');
    readln(a,b,c);
    n:=SqrEquat(a, b, c, x1, x2);
    case n of
      1: SumX:=SumX+x1;
      2: SumX:=SumX+x1+x2;
    end;
    SumN:=SumN+n;
  end;
  if SumN<>0 then
    WriteLn('The average of a real roots is ', SumX/SumN);
  else
    WriteLn('There are not a real roots.');
end.

Сообщение отредактировано: Федосеев Павел - 8.05.2012 15:24

[Гость]

У тебя структура программы выбрана верно, но в самой реализации допущены ошибки.
Поэтому для решения задачи, предлагаю разбить её на ряд небольших задач.

Итак, постановка задачи

Будем решать последовательно. Для начала, создадим и отладим функцию для решения квадратных уравнений. Назовём её SqrEquat (у тебя её "звали" просто "K").
Действия функции:
1) если корня два (дискримминант больше 0), то функция будет возвращать два корня x1 и x2, а само значение функции будет равно 2;
1) если корень один (дискримминант равен 0), то функция будет возвращать два корня x1 и x2, просто одинаковых (x1==x2), а само значение функции будет равно 1;
2) если действительных корней нет, то возвращаться будет два корня равных нулю (x1==x2==0), а само значение функции будет равно 0.
Делаем тестовую программу.

program test;
function SqrEquat( a, b, c : real; {коэффициенты квадратного уравнения}
                           var x1, x2 : real) {корни уравнения}
                          : integer; {функция возвращает количество действительных корней уравнения}
begin
.....................{реализация функции}
end;

var
  n : integer;
  x1, x2 : real;
begin
  n:=SqrEquat(4, 20, 24, x1, x2);
  case n of
    0: WriteLn('There are not a real roots.');
    1: WriteLn('There is a single root x= ', x1);
    2: WriteLn('There are double roots x1=', x1, ', x2=', x2);
  end; 
end.

После получения работающего кода функции, его можно скопировать в "настоящую" программу, где на основе корней уравнения выполняются дальнейшие расчёты. Например,

............................
var
  i, n, SumN : integer;
  x1, x2,
  a, b, c,
  SumX : real;
begin
  SumN:=0;{количество действительных корней во всех уравнениях}
  SumX:=0;{сумма всех действительных корней во всех уравнениях}
  for i:=1 to 3 do begin
    writeln('Введите значение коэфициэнтов ', i, '-го квадратного уравнения: ');
    readln(a,b,c);
    n:=SqrEquat(a, b, c, x1, x2);
    case n of
      1: SumX:=SumX+x1;
      2: SumX:=SumX+x1+x2;
    end;
    SumN:=SumN+n;
  end;
  if SumN<>0 then
    WriteLn('The average of a real roots is ', SumX/SumN);
  else
    WriteLn('There are not a real roots.');
end.

спасибо большое)))