Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.05.2015, 21:59   #1
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию Программа паскаль

Всем доброго времени суток.
Программа выдает ошибку 201 при попытке запуска процедуры skalar остальное работает

Код:
program Project1;

uses
  crt;

type
  matrix = array of array of Integer;

var
  a, tempMatrix: matrix;
  i, j, dt, size, k, mode, mi, mj, rez: Integer;

//Выводит матрицу на экран
procedure PrintMatrix(m: matrix; n: Integer);
var
  i, j: Integer;
begin
  for i := 0 to n - 1 do
  begin
    for j := 0 to n - 1 do
      Write(m[i, j]:3);
    WriteLn;
  end;
end;

// Возвращает транспонированую матрицу
function TransposeMatrix(m: matrix; n: Integer): matrix;
var
  i, j: Integer;
  b: matrix;
begin
  SetLength(b, n, n);
  for i := 0 to n - 1 do
  begin
    for j := 0 to n - 1 do
    begin
      b[i, j] := m[j, i];
    end;
  end;
  TransposeMatrix := b;
end;

// Вычеркивает строку и столбец из матрицы
{
 Например, имеем матрицу
1 2 3
4 5 6
7 8 9

и если вызвать эту функцию, то она вернет
RearrangeMatrix(matr, 3, 0, 0)

5 6 0
8 9 0
0 0 0
Никакого сверхъестественного алгоритма нет здесь :)
}
function RearrangeMatrix(a: matrix;  m{размер матрицы}, i{индекс строки}, j{индекс столбца} : Integer): matrix;
var
  ki, kj, di, dj: Integer;
  b: matrix;
begin
  SetLength(b, m, m);
  di := 0;
  for ki := 0 to m - 2 do
  begin
    if (ki = i) then di := 1;
    dj := 0;
    for kj := 0 to m - 2 do
    begin
      if (kj = j) then dj := 1;
      b[ki, kj] := a[ki + di, kj + dj];
    end;
  end;
  RearrangeMatrix := b;
end;

{
 Вычисляет определитель матрицы
}
function Determinant(a: matrix; n: Integer): Integer;
var
  i, d, k: Integer;
  b: matrix;
begin
  d := 0; // хранит значение определителя
  k := 1; // нужен, чтобы умножать на -1 чередующиеся значения определителей (см. алгоритм нахождения определителя с использованием миноров)
  if (n = 1) // если размер матрицы 1,
    then d := a[0, 0] // значит определитель = единственный элемент матрицы
  else if (n = 2) // ещё один частный случай, размер матрицы = 2
    then d := (a[0, 0] * a[1, 1]) - (a[1, 0] * a[0, 1]) // стандартный алгоритм
  else
    for i := 0 to n - 1 do // этот алгоритм описан http://math.semestr.ru/kramer/examples.php
    begin
      b := RearrangeMatrix(a, n, i, 0); //берем "маленькую" матрицу, с вычеркнутым столбцом/строчкой
      PrintMatrix(b, n);
         // да, функция вызывает саму себя, но вызывается для "маленькой" матрицы.
  	   //Т.е. если исходная матрица имеет размер = 4, то эта функция будет вызываться
         //несколько раз для "маленькой" матрицы размером 3,
         //и в свою очередь несколько раз для маленькой матрицы размером 2 и т.п.
      d := d + k * a[i, 0] * Determinant(b, n - 1);
      //см. алгоритм по ссылке выше.
      k := -k;
    end;
  Determinant := d;
end;

// Возвращает матрицу миноров
function MinorMatrix(a: matrix; n: Integer): matrix;
var
  b: matrix;
begin
  SetLength(b, n, n);
  for i := 0 to n - 1 do
  begin
    for j := 0 to n - 1 do
    begin
            //Матрица миноров такая же по размеру, как и исходная матрица
    		//Например, хотим найти элемент минорной матрицы первой строки и третьего столбца
    		//Вычеркиваем первую строку и третий столбец, находим определитель этой матрицы
    		//Это и будет результат (элемент минорной матрицы)
      b[i, j] := Determinant(RearrangeMatrix(a, n, i, j), n - 1);
    end;
  end;
  MinorMatrix := b;
end;

procedure skal(a:matrix);
var
  i: integer;


begin
  for i := 1 to size do  
  begin
    Rez := Rez + a[mi, i] * a[i, mj];  
  end;
  writeln('Skalyarnoe proizvedenie ravno: ', Rez);  
end;
  begin

Последний раз редактировалось Аватар; 28.05.2015 в 22:02.
Триш вне форума Ответить с цитированием
Старый 28.05.2015, 21:59   #2
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию

Код:
//Вводим размер
  Write('Input size = ');
  Readln(size);
 

{mode := 1;
  while (mode >= 1) and (mode <= 2) do
begin}  
  
  
  //Вводим режим
  Writeln('Please, input mode : ');
  Writeln('1 - Transpose Matrix');
  Writeln('2 - Back Matrix');
  Writeln('3 - Skalar');
  Write('Mode : ');
  Readln(mode);
  
  SetLength(a, size, size);
  
  //Заполняем рандомно матрицу
  randomize;
  for i := 0 to size - 1 do
    for j := 0 to size - 1 do
      a[i, j] := random(5);
  
  //Выводим на экран исходную матрицу
  WriteLn('Source matrix : ');
  PrintMatrix(a, size);
  case mode of
    
    //Если выбрали режим Транспонирования
    1:
      begin
        //То, собственно, выводим транспонированную матрицу :)
        WriteLn('Transposed matrix : ');
        PrintMatrix(TransposeMatrix(a, size), size);
      end;
    //Если выбрали режим обратной матрицы
    2: 
      begin
        
        dt := Determinant(a, size);
        
        //WriteLn('Determinant = ',dt);
        //PrintMatrix(MinorMatrix(a, size), size);
        k := 1;
        //Чтобы найти обратную матрицу, нужно
        {
         1. Найти матрицу миноров
         2. Транспонировать её
         3. Найти определитель (нашли его выше, переменная dt)
         4. Умножить каждый элемент матрицы (из пункта 2) на 1/детерминант (поделить на детерминант, проще говоря)
        }
        // Нашли минорную, транспонировали...
        tempMatrix := TransposeMatrix(MinorMatrix(a, size), size);
        WriteLn('Back matrix : ');
        for i := 0 to size - 1 do
        begin
          for j := 0 to size - 1 do
          begin
         	  // Не создавая новой матрицы просто выводим результат
         	  // Не стал делить, а просто вывожу как-бы дроби, иначе результаты получаются не очень красивые
         	  // дроби все-таки
            write(tempMatrix[i, j] * k);
            write('/');
            write(dt);
            
            //пробелы - для красоты
            write('    ');
            if k = 1 then write(' ');
            k := -k;
          end;
          Writeln;
        end;
        
      end;
    3: 
      begin;
        writeln('vyberite stroku');
        readln(mi);
        writeln('vyberite stolbec');
        readln(mj);
        skal(a);
      end;
  else begin
      Writeln('Wrong mode : ', mode);
    end;
    ReadKey;
  end;

end.

Последний раз редактировалось Аватар; 28.05.2015 в 22:03.
Триш вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Паскаль ABC. Программа на языке Паскаль. Helen1 Паскаль, Turbo Pascal, PascalABC.NET 6 13.01.2018 21:46
Программа Паскаль Despot777 Паскаль, Turbo Pascal, PascalABC.NET 1 15.09.2013 12:22
Паскаль программа buryj Помощь студентам 5 24.06.2012 19:30
Паскаль программа ololo111 Помощь студентам 7 18.06.2012 16:22
Программа Паскаль Raudi_s Помощь студентам 3 15.12.2009 15:22