Решить уравнение - Pascal (80478)

Узнай цену своей работы

Формулировка задачи:

Ребят, не могли бы помочь? Очень нужно доделать, либо переделать программу. В общем, есть задание: Решить уравнение (ba)!x^2+2*(dc)!x+(mk)!=0, где b,a-сумма модулей и количество элементов, расположенных в матрице z(6,6) ниже побочной диагонали; d,c-сумма модулей и количество элементов, расположенных в матрице w(11,11) ниже побочной диагонали; m,k-сумма модулей и количество элементов, расположенных в матрице v(12,12) ниже побочной диагонали. Знакопеременные массивы сформировать случайным образом. Вот программа: 
//  (ba)!x^2+2*dc)!x+(mk)!=0
//  z 6-6  w 11-11  v 12-12
 
program lab6zachas;
 
uses
  crt;
 
const
  ZA = 6;
  WA = 11;
  VA = 12;
  Y = 1;
 
var
  z: array [1..ZA, 1..ZA] of integer;
  w: array [1..WA, 1..WA] of integer;
  v: array [1..VA, 1..VA] of integer;
  
  a, b, c, d, k, m, x1, x2: integer;
  rez, factba, factdc, factmk: LongInt;
  i, j: byte;
 
//
function fact(n: integer): LongInt;
var
  r: LongInt;
  i: integer;
begin
  r := 1;
  if n = 1 then fact := 1
  else
    for i := 2 to n do
    begin
      r := r * i;
    end;
  fact := r;
end;
 
//
procedure xnadva(g, h, j: LongInt; var res: LongInt);
var
  D: LongInt;
begin
  if (g = 0) then
  begin
    writeln('Не квадратное уравнение.');
    halt;
  end;
  D := h * h - 4 * g * j;
  if (D = 0) then
  begin
    writeln('x = ', -h / 2.0 / g);
    halt;
  end;
  if (D > 0) then
  begin
    writeln('x1 = ', (-h + Sqrt(D)) / 2.0 / g);
    writeln('x2 = ', (-h - Sqrt(D)) / 2.0 / g);
  end
   else
  begin
    writeln('x1 = (', -h / 2.0 / g, ',', Sqrt(-D) / 2.0 / g, ')');
    writeln('x2 = (', -h / 2.0 / g, ',', -Sqrt(-D) / 2.0 / g, ')');
  end;
end;

begin
  randomize;
  a := 0;
  b := 0;
  
  //Z
  for i := 1 to ZA do
  begin
    for j := 1 to ZA do
    begin
      z[i, j] := random(Y) - random(Y);
      write(z[i, j]:5);
    end;
    writeln;
  end;
  
  writeln;
  writeln;
  
  //W
  for i := 1 to WA do
  begin
    for j := 1 to WA do
    begin
      w[i, j] := random(Y) - random(Y);
      write(w[i, j]:5);
    end;
    writeln;
  end;
  
  writeln;
  writeln;
  
  //V
  for i := 1 to VA do
  begin
    for j := 1 to VA do
    begin
      v[i, j] := random(Y) - random(Y);
      write(v[i, j]:5);
    end;
    writeln;
  end;
  
  writeln;
  writeln;
  
  //Zmod
  for i := 1 to ZA do
  begin
    write(' ':5 * (ZA - i + 1));
    for j := ZA - i + 2 to ZA do
    begin
      write(z[i, j]:5);
      a := a + 1;
      b := b + abs(z[i, j]);
    end;
    writeln();
  end;
  
  writeln(a); // Вывод кол-ва
  writeln(b); // Вывод суммы модулей
  
    //Wmod
  for i := 1 to WA do
  begin
    write(' ':5 * (WA - i + 1));
    for j := WA - i + 2 to WA do
    begin
      write(w[i, j]:5);
      c := c + 1;
      d := d + abs(w[i, j]);
    end;
    writeln();
  end;
  
  writeln(c); // Вывод кол-ва
  writeln(d); // Вывод суммы модулей
  
    //Vmod
  for i := 1 to VA do
  begin
    write(' ':5 * (VA - i + 1));
    for j := VA - i + 2 to VA do
    begin
      write(v[i, j]:5);
      m := m + 1;
      k := k + abs(v[i, j]);
    end;
    writeln();
  end;
  
  writeln(m); // Вывод кол-ва
  writeln(k); // Вывод суммы модулей
  
    // (ba)! x^2 + 2(dc)! x + (mk)! = 0
    // (ba)! = factba
    // (dc)! = factdc
    // (mk)! = factmk
  
  factba := fact(a * b);
  factdc := fact(d * c);
  factmk := fact(m * k);
  
  writeln(factba);
  writeln;
  writeln(factdc);
  writeln;
  writeln(factmk);
  
  xnadva(factba, factdc, factmk, rez);
  
  readln;
end.
В общем, ребят, помогите пожалуйста её изменить.Очень вас прошу. Я что-то не пойму, что с ней не так. Заранее, спасибо большое!

Решение задачи: «Решить уравнение»

textual
Листинг программы 
uses crt;
 
type BigReal = record mant: extended; expt: int64 end;
     Matrix = array of array of longint;
     rt = array [1..2] of BigReal;
 
procedure WriteBigReal(a: BigReal);
begin
  if a.mant >= 0
    then write('+')
    else write('-');
  write(abs(a.mant):0:17, 'e');
  if a.expt >= 0 then write('+');
  write(a.expt)
end;
 
procedure Normalize(var a: BigReal);
begin
  if a.mant = 0
    then a.expt := 0
    else begin
      while abs(a.mant) >= 10 do
        begin
          inc(a.expt);
          a.mant /= 10
        end;
      while abs(a.mant) < 1 do
        begin
          dec(a.expt);
          a.mant *= 10
        end
    end
end;
 
procedure Scale(var a: BigReal; n: int64);
var i: int64;
begin
  i := 1;
  while i <= n do
    begin
      inc(i);
      inc(a.expt);
      a.mant /= 10
    end
end;
 
function IntToBigReal(n: longint): BigReal;
begin
  Result.mant := n;
  Normalize(Result)
end;
 
procedure align(var a, b: BigReal);
var diff: int64;
begin
  diff := a.expt - b.expt;
  if diff > 20
    then begin
      b.mant := 0;
      b.expt := a.expt
    end
    else if diff < -20
      then begin
        a.mant := 0;
        a.expt := b.expt
      end
      else if diff > 0
        then Scale(b, diff)
        else if diff < 0
          then Scale(a, -diff)
end;
 
operator *(a, b: BigReal)c: BigReal;
begin
  c.mant := a.mant * b.mant;
  c.expt := a.expt + b.expt;
  normalize(c)
end;
 
operator /(a, b: BigReal)c: BigReal;
begin
  if b.mant = 0
    then begin
      write('Ошибка: попытка деления на ноль.');
      readln;
      halt
    end;
  c.mant := a.mant / b.mant;
  c.expt := a.expt - b.expt;
  normalize(c)
end;
 
operator +(a, b: BigReal)c: BigReal;
begin
  align(a, b);
  c.mant := a.mant + b.mant;
  c.expt := a.expt;
  normalize(c)
end;
 
operator -(a, b: BigReal)c: BigReal;
begin
  align(a, b);
  c.mant := a.mant - b.mant;
  c.expt := a.expt;
  normalize(c)
end;
 
function SqrtBigReal(a: BigReal): BigReal;
begin
  if a.mant < 0
    then begin
      write('Ошибка: попытка вычисления квадратного корня из отрицательного числа.');
      readln;
      halt
    end;
  if odd(a.expt)
    then begin
      dec(a.expt);
      a.mant *= 10
    end;
  Result.mant := sqrt(a.mant);
  Result.expt := a.expt div 2;
end;
 
function Factorial(n: longint): BigReal;
const one: BigReal = (mant: 1; expt: 0);
var i: integer;
begin
  if n < 0
    then begin
      write('Ошибка: попытка вычисления факториала от отрицательного числа.');
      readln;
      halt
    end;
  Result := one;
  for i := 2 to n do
    begin
      Result.mant := Result.mant * i;
      Normalize(Result)
    end;
end;
 
const q = 1; //количество значащих цифр в элементах массива
      r = round(exp(q * ln(10))) - 1;
 
procedure Generate(var x: Matrix);
var i, j: longint;
begin
  for i := low(x) to high(x) do
    for j := low(x[low(x)]) to high(x[low(x)]) do
      x[i, j] := -r + random(2 * r + 1)
end;
 
procedure WriteMatrix(s: string; var x: Matrix);
var i, j: longint;
begin
  writeln('Матрица ', s, ':');
  textcolor(LightGray);
  for i := 0 to high(x) do
    begin
      for j := 0 to high(x[0]) do
        begin
          write(x[i, j]:q + 2);
          if j = high(x) - i then textcolor(Yellow)
        end;
      textcolor(LightGray);
      writeln
    end
end;
 
procedure Preprocessing(s: string; var x: Matrix; x_r: integer; var quantity, sum_abs: longint);
var c: char;
    i, j: integer;
begin
  setlength(x, x_r, x_r);
  generate(x);
  WriteMatrix(s, x);
  quantity := x_r * (x_r - 1) div 2;
  writeln('Количество элементов матрицы ниже побочной диагонали: ', quantity);
  sum_abs := 0;
  for i := 1 to high(x) do
    for j := high(x) - i + 1 to high(x) do
      sum_abs += abs(x[i, j]);
  writeln('Сумма их модулей: ', sum_abs);
  write('Нажмите <Enter> для продолжения работы', #13);
  {c := }readkey;
  writeln('                                      ')
end;
 
procedure CompileRoots(a, b, c: BigReal; var x: rt; var n: integer);
const mone: BigReal = (mant: -1; expt: 0);
      two: BigReal = (mant: 2; expt: 0);
      mtwo: BigReal = (mant: -2; expt: 0);
      four: BigReal = (mant: 4; expt: 0);
var d, d1: BigReal;
begin
  if (b.mant = 0) and (c.mant <> 0)
    then n := 4
    else if (a.mant = 0) and (b.mant = 0) and (c.mant = 0)
      then n := 3
      else if (a.mant = 0) and (b.mant <> 0)
        then begin
          n := 1;
          c.mant *= -1;
          x[1] := c / b
        end
        else begin
          d := b * b - four * a * c;
          if d.mant < 0
            then n := 0
            else if d.mant = 0
              then begin
                n := 1;
                x[1] := (b / a) / mtwo
              end
              else begin
                n := 2;
                d := SqrtBigReal(d);
                x[1] := ((b - d) / a) / mtwo;
                x[2] := ((b + d) / a) / mtwo;
              end
        end
end;
 
const z_r = 6;
      w_r = 11;
      v_r = 12;
 
var z, w, v: Matrix;
    a, b, c, d, k, m: longint;
    p2, p1, p0: BigReal;
    roots: rt;
    n, i: integer;
begin
  randomize;
  Preprocessing('Z', z, z_r, a, b);
  Preprocessing('W', w, w_r, c, d);
  Preprocessing('V', v, v_r, k, m);
  p2 := Factorial(a * b);
  p1 := Factorial(c * d);
  p0 := Factorial(k * m);
  writeln('Уравнение:');
  WriteBigReal(p2);
  writeln(' * x^2');
  WriteBigReal(p1);
  writeln(' * x');
  WriteBigReal(p0);
  writeln(' = 0');
  CompileRoots(p2, p1, p0, roots, n);
  case n of
    1: begin
         writeln('Уравнение имеет один корень:');
         write('x[1] = ');
         WriteBigReal(roots[1]);
         writeln
       end;
    2: begin
         writeln('Уравнение имеет два корня:');
         for i := 1 to 2 do
           begin
             write('x[', i, '] = ');
             WriteBigReal(roots[i]);
             writeln
           end
       end;
    3: writeln('Уравнение имеет бесконечное множество корней')
    else writeln('уравнение не имеет корней')
  end;
  write('Нажмите <Enter> для выхода');
  readln
end.

Объяснение кода листинга программы

  1. Объявляются пользовательские типы данных:
    • BigReal - запись, представляющая большие числа
      • mant - вещественное число большой точности
      • expt - целочисленное число
    • Matrix - массив массивов целых чисел
    • rt - массив из двух переменных типа BigReal
  2. Описываются процедуры и функции для работы с большими числами:
    • WriteBigReal - процедура для вывода большого числа в виде экспоненты
    • Normalize - процедура для нормализации большого числа
    • Scale - процедура для масштабирования большого числа
    • IntToBigReal - функция для преобразования целого числа в большое число
    • align - процедура для выравнивания двух больших чисел
    • Перегруженные операторы для умножения, деления, сложения и вычитания больших чисел
    • SqrtBigReal - функция для нахождения квадратного корня из большого числа
    • Factorial - функция для вычисления факториала
  3. Объявляются константы и процедуры для работы с матрицей:
    • q - количество значащих цифр в элементах массива
    • r - округленное значение для матрицы
    • Generate - процедура для генерации матрицы
    • WriteMatrix - процедура для вывода матрицы в консоль
    • Preprocessing - процедура для предварительной обработки матрицы
    • CompileRoots - процедура для вычисления корней уравнения
  4. Основная часть программы:
    • Объявляются переменные и константы типа Matrix и longint
    • Генерируется три матрицы Z, W, V
    • Вычисляются факториалы от элементов матриц
    • Выводится уравнение и производится вычисление корней
    • Программа завершается после ввода данных пользователем. Этот код выполняет функции работы с большими числами и матрицами, а также вычисление корней уравнения.

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

5   голосов , оценка 3.6 из 5
Похожие ответы