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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.05.2015, 22:23   #1
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
Восклицание помогите пожалуйста с заданием

Для матрицы А=|aij|, где i изменяется от 0 до N-1, j - от 0 до N-1, написать
подпрограммы, выполняющие следующие преобразования:
-транспонирование матрицы относительно главной диагонали
-скалярное произведение заданной строки и заданного столбца
-вычисление обратной матрицы
Программа должна обеспечить выбор конкретного преобразования.

Последний раз редактировалось Триш; 18.05.2015 в 23:29.
Триш вне форума Ответить с цитированием
Старый 19.05.2015, 00:08   #2
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

ну и в чём проблема?
Изображения
Тип файла: jpg dream2.jpg (34.4 Кб, 158 просмотров)
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 19.05.2015, 07:32   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
Триш
Твои попытки увидеть можно?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.05.2015, 19:15   #4
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию

Вот попытки, помогите найти ошибки
Код:
Program lab;
const
  nmax=5;{Максимальный размер матрицы}
type
  mas=array[1..nmax,1..nmax] of real;
var
   a:mas;
   n,i,j,r,mi,mj:integer;{mi-выбранная строка, mj-выбранный столбец}
procedure trans;
var 
  a,b:mas;
  i,j,n:integer; 
  prom:real;
begin
  writeln;
  a:=b;
  for i:=2 to n do {сам процесс транспонирования}
    for j:=1 to i-1 do
      begin
       prom:=b[i,j];
       b[i,j]:=b[j,i];
       b[j,i]:=prom;
      end;
  writeln('результат транспонирования: '); {вывод матрицы после преобразований}
  for i:=1 to n do
   begin
     for j:=1 to n do
       write(b[i,j]:3);
     writeln;
   end;
end;
procedure obrat;
  const t=0.000001;{ограничиваем числа, близкие к нолю, на них делить}

  procedure Per(n,k:integer;a:mas;var p:integer);{перестановка строк с макс. главным элементом}
    var z:real;
     j,i:integer;
    begin
      z:=abs(a[k,k]);
      i:=k;
      p:=0;
      for j:=k+1 to n do
        begin
          if abs(a[j,k])>z then
            begin
              z:=abs(a[j,k]);
              i:=j;
              p:=p+1;
            end;
        end;
      if i>k then
        for j:=k to n do
          begin
            z:=a[i,j];
            a[i,j]:=a[k,j];
            a[k,j]:=z;
          end;
    end;
  function znak(p:integer):integer;{изменение знака при перестановке строк матрицы}
    begin
      if p mod 2=0 then
        znak:=1 else znak:=-1;
    end;
  function znak1(i,m:integer):integer;{изменение знака при перестановке строк при нахождении дополнений}
    begin
      if (i+m) mod 2=0 then
      znak1:=1 else znak1:=-1;
    end;
  procedure opr(n,p:integer;a:mas;var det:real;var f:byte);{нахождение определителя матрицы}
    var k,i,j:integer;
      r:real;
    begin
      det:=1.0;f:=0;
      for k:=1 to n do
        begin
          if a[k,k]=0 then per(k,n,a,p);
            det:=znak(p)*det*a[k,k];
            if abs(det)<t then
              begin
                f:=1;
                writeln('Обратной матрицы нет!');
                readln;
                exit;
             end;
            for j:=k+1 to n do
              begin
                r:=a[j,k]/a[k,k];
                for i:=k to n do
                  a[j,i]:=a[j,i]-r*a[k,i];
              end;
        end;
    end;
  procedure opr1(n,p:integer;d:mas;var det1:real);{нахождение определений для дополнений}
  var 
    k,i,j:integer;
    r:real;
  begin
    det1:=1.0;
    for k:=2 to n do
      begin
        if d[k,k]=0 then per(n,k,d,p);
          det1:=znak(p)*det1*d[k,k];
          for j:=k+1 to n do
            begin
              r:=d[j,k]/d[k,k];
              for i:=k to n do
                d[j,i]:=d[j,i]-r*d[k,i];
            end;
      end;
  end;
продолжение дальше

Последний раз редактировалось Poma][a; 19.05.2015 в 19:18.
Триш вне форума Ответить с цитированием
Старый 19.05.2015, 19:15   #5
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию

Код:
Procedure Peresch(n,p:integer;var b:mas;det1:real;var e:mas);{вычисление дополнений}
  var 
    i,m,k,j:integer;
    z:real;
    d,c:mas;
   begin
     for i:=1 to n do
       for m:=1 to n do
       begin
         for j:= 1 to n do {перестановка строк}
           begin
             z:=b[i,j];
             for k:=i downto 2 do
               d[k,j]:=b[k-1,j];
               for k:=i+1 to n do
                 d[k,j]:=b[k,j];
                 d[1,j]:=z;
           end;
         for k:=1 to n do {перестановка столбцов}
           begin
             z:=d[k,m];
             for j:=m downto 2 do
               c[k,j]:=d[k,j-1];
               for j:=m+1 to n do
                 c[k,j]:=d[k,j];
                 c[k,1]:=z;
           end;
        Opr1(n,p,c,det1);{вычисление определителей}
        e[i,m]:=det1*znak1(i,m);{вычисление дополнений}
       end;
  end;
  procedure Transp(a:mas; n:integer;var at:mas);{транспонирование матрицы}
  var 
    k,j:integer;
  begin
    for k:= 1 to n do
      for j:=1 to n do
        at[k,j]:=a[j,k];
  end;
  Procedure Proverka(a,b:mas; n:integer;var c:mas);{проверка - умножение прямой матрицы на обратную}
  var 
    k,j,i:integer;
    z:double;
  begin
    for k:=1 to n do
      for j:=1 to n do
        begin
          c[k,j]:=0;
          for i:=1 to n do
            begin
              z:=a[i,j]*b[k,i];
              c[i,j]:=c[i,j]+z;
            end;
        end;
  end;
  procedure Vyvod(var a:mas; n:integer);{вывод матриц на экран}
  var 
    i,j:integer;
  begin
    for i:=1 to n do
      begin
        for j:=1 to n do
          write(a[i,j]:7:2);
          writeln;
      end;
  end;
  var 
    n,j,i,p:integer;{n-размер матрицы,i-счетчик по строкам,j-счетчик по столбцам,p-счетчик перестановок}
    a,at,b,c,e:mas;{a-исходная, at-транспонированная, b-матрица дополнений, e-обратная, с-проверка}
    det,det1:real;{det-определитель исходной матрицы,det1-определители-дополнения}
    f:byte;{признак несуществования обратной матрицы}
  begin
    writeln('Исходная матрица:');
    Vyvod(a,n);
    Opr(n,p,a,det,f); {считаем определитель}
    if f=1 then exit;
      Transp(a,n,b); {транспонируем матрицу}
      Peresch(n,p,b,det1,e); {считаем дополнения}
      writeln('Obratnaja matrica:');
      for i:=1 to n do
        for j:=1 to n do
          e[i,j]:=e[i,j]/det; {создаем обратную матрицу}
      Vyvod(e,n);
      writeln('Proverka:');
      Proverka(a,e,n,c); {делаем проверку}
      Vyvod(c,n);
      readln;
  end;
procedure skal;  
  var 
    a:mas;
    mi,mj,n,i:integer;  
    Rez:real;  
  begin  
    for i:= 1 to n do  
      begin  
        Rez := Rez + a[mi,i] * a[i,mj];  
      end;
    writeln('Скалярное произведение равно: ',Rez:0:3);  
  end; 
begin
  writeln('Введите размер матрицы');
  readln(n);
  randomize;
  writeln('Получили матрицу');  
  for i := 1 to n do  
    begin  
      for j := 1 to n do  
        begin  
          a[i,j] := (Random * 10);  
          write(a[i,j]:5:2);  
        end;
    writeln;
    end;
  writeln;
  r:=1;
  while (r>=1) and (r<=3) do
     begin
       writeln('Выбиерите действие');
       writeln('1 - Транспонирование матрицы*');
       writeln('2 - Нахождение обратной матрицы*');
       writeln('3 - Скалярное произведение заданной строки и заданного столбца*');
       writeln('4 - Выход из программы');
       readln(r);
       case r of
         1: trans;
         2: obrat;
         3: begin;
              writeln('Выберите строку');
              readln(mi);
              writeln('Выберите столбец');
              readln(mj);
              skal;
            end;  
              
       end;
     end;
 
 end.

Последний раз редактировалось Триш; 19.05.2015 в 19:41.
Триш вне форума Ответить с цитированием
Старый 19.05.2015, 19:30   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Ух йо!... Ты где сей код взял?
И чем кстати он тебя не устраивает?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.05.2015, 19:42   #7
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию

Процедуры не хотят брать значение матрицы.
Триш вне форума Ответить с цитированием
Старый 19.05.2015, 20:11   #8
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
procedure trans;
var
a,b:mas;
Потому что они локально обьявлены. Убери эти описания вообще а в тел процедуры работай только с "а".
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.05.2015, 23:50   #9
Триш
Пользователь
 
Регистрация: 13.05.2015
Сообщений: 18
По умолчанию

Спасибо большое) Разобрался
Триш вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Исправте, пожалуйста, прогу. Я дно в паскале=( kostyan199731 Паскаль, Turbo Pascal, PascalABC.NET 1 16.05.2015 19:29
Перевод нужен срочно помогите ) в течение 2 часов от Паскаля на Турбо СИ нужно помогите Жанибек Помощь студентам 14 01.04.2015 17:23
Помогите создать програму для роботы с файлами, пожалуйста помогите нужно очень срочно Сергей Человек Фриланс 3 06.07.2009 19:30
Помогите Помогите Пожалуйста Решить Одну Задачку в Паскале!!! VisTBacK Помощь студентам 6 19.09.2008 13:44