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

[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 .

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

Пожалуйста, пользуйся кнопкой CODE при вставке текста программы.

Смотри ошибки компиляции:
1) Syntax error, ";" expected but "ELSE" found с указанием на строку означает - что перед else не ставится ";".
2) в case используются только перечислимые типы, а dskt - тип real. Варианты выбора - тоже значения или диапазоны перечислимых типов. Т.е. в данном случае case заменяется на несколько if.
3) dskt=0:x1:=(-b+sqrt(dskt))/2a - наверное 2*a

Ну и далее, по мере исправления...

[-kapa-]

Пожалуйста, пользуйся кнопкой CODE при вставке текста программы.

Смотри ошибки компиляции:
1) Syntax error, ";" expected but "ELSE" found с указанием на строку означает - что перед else не ставится ";".
2) в case используются только перечислимые типы, а dskt - тип real. Варианты выбора - тоже значения или диапазоны перечислимых типов. Т.е. в данном случае case заменяется на несколько if.
3) dskt=0:x1:=(-b+sqrt(dskt))/2a - наверное 2*a

Ну и далее, по мере исправления...

суть не в этом сама суть программы мне не понятна чтобы работала в норме с заданием

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

вот мой вариант

сама суть программы мне не понятна чтобы работала в норме с заданием

Если грамматические и синтаксические ошибки устраивают, то в чём собственно вопрос?
Как структура - правильно - решение уравнения вынесено в процедуру.

Начни отладку пошагам - сначала отладь решение квадратных уравнений с выводом корней на экран.
Потом делай это в цикле 3 раза

const
  N = 3;
........
  S:=0;
  for i:=1 to N do begin
    {1. ввод коэффициентов a, b, c}
..................
    {2. решение квадратного уравнения и получение его корней x1, x2}
    SqrEquat(a, b, c, x1, x2);
    {3. сложение корней}
    S:=S+x1+x2;
  end;
  S:=S/(N*2); {вычисление среднего арифметического}

Сообщение отредактировано: Федосеев Павел - 7.05.2012 23:41

[Гость]

Если грамматические и синтаксические ошибки устраивают, то в чём собственно вопрос?
Как структура - правильно - решение уравнения вынесено в процедуру.

Начни отладку пошагам - сначала отладь решение квадратных уравнений с выводом корней на экран.
Потом делай это в цикле 3 раза

const
  N = 3;
........
  S:=0;
  for i:=1 to N do begin
    {1. ввод коэффициентов a, b, c}
..................
    {2. решение квадратного уравнения и получение его корней x1, x2}
    SqrEquat(a, b, c, x1, x2);
    {3. сложение корней}
    S:=S+x1+x2;
  end;
  S:=S/(N*2); {вычисление среднего арифметического}

если честно мне не понятно

[TarasBer]

если честно мне не понятно

Если честно, то нам уже самим не очень понятно, что именно вам не понятно.

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

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

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

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

Будем решать последовательно. Для начала, создадим и отладим функцию для решения квадратных уравнений. Назовём её 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 19: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.

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

[kapa]

вот все к чему я смог прийти
program koren;{Íàéòè ñðåäíåå àðèôìåòè÷åñêîå äåéñòâèòåëüíûõ êîðíåé òð¸õ êâàäðàòíûõ óðàâíåíèé}
uses crt;
var SRA,X1,X2,q,w,e,S:real;
i,K:integer;
F:boolean;
procedure squart(A,B,C:real; var Y1,Y2:real;VAr F:boolean);
var D:real;
begin
D:=B*B-4*A*C;
if D>=0 then
begin
Y1:=(-B+SQRT(D))/(2*A);
Y2:=(-B-SQRT(D))/(2*A);
F:=True;
end
else
begin
F:=False;
Y1:=0;
Y2:=0;
end;
end;
begin
clrscr;
K:=0;
S:=0;
begin
write('Ââåäèòå êàæäûé ÷ëåí òðåõ êâàäðàòíûõ óðàâíåíèé ');
for i:=1 to 3 do
readLn(q,w,e);
squart(q,w,e,X1,X2,F);
writeln(X1,X2,F);
if F=True
then
begin
K:=K+2;
S:=X1+X2+S;
end;
end;
SRA:=S/K;
writeln(SRA);
readkey;
End.

помогите пожалуйста найти и исправить недочеты

[TarasBer]

Используй же тег CODE, тебе же сказали, нам нихрена не доставляет форматировать код руками.

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

Спойлер (Показать/Скрыть)

program Average;
function SqrEquat( a, b, c : real; {коэффициенты квадратного уравнения}
                           var x1, x2 : real) {корни уравнения}
                          : integer; {функция возвращает количество действительных корней уравнения}
var
  D : Real;
begin
  D:=Sqr(b)-4*a*c;
  if D>=0 then
  begin
    x1:=(-b-Sqrt(D))/(2*a);
    x2:=(-b+Sqrt(D))/(2*a);
    if D=0 then
      SqrEquat:=1
    else
      SqrEquat:=2;
  end
  else
  begin
    x1:=0;
    x2:=0;
    SqrEquat:=0;
  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);
    WriteLn(n:3, x1:8:2, x2:8:2);
    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.

Сообщение отредактировано: Федосеев Павел - 16.05.2012 23:22