Операция над матрицей. Использование процедур

@PFanthem · Регистрация: 11.10.2014

Студворк — интернет-сервис помощи студентам

Дано матричное выражение H=5*B+(2X^T*X)^T*X^T*Y
Размерность матриц В подбирается самостоятельно
Но что-то неправильно после строки "Install;", неправильно считает H.
Помогите отредактировать.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Program As;
Uses Crt;
Type
  Matrix = Record
    Mass:array[1..10, 1..10] of Integer;
    line:Integer;   {Количество строк в матрице}
    column:Integer; {Количество столбцов в матрице}
  End;
{ Процедура транспонирования матриц }
Procedure flip(var A:Matrix);
Var i,j:Integer;
    Stakan:Integer;
Begin
    For i:= 1 to A.line Do Begin
        For j:= 1 to A.column Do Begin
            if(i = j)Then continue;
Stakan:=A.Mass[i,j];
A.Mass[i,j]:=A.Mass[j,i];
A.Mass[j,i]:=Stakan;
        End;
    End;
   Stakan:=A.column;A.column:=A.Line;A.Line:=Stakan;
End;
{ Процедура умножения матрицы на число}
Procedure multiplication(var A:Matrix;Mnoj:Integer);
Var i,j:Integer;
Begin
    For i:=1 to A.line Do Begin
        For j:=1 to A.column Do Begin
            A.Mass[i,j]:=A.Mass[i,j]*Mnoj;
        End;
    End;
End;
{ Процедура перемножение матриц }
Procedure matrix_multiplication(A:Matrix;B:Matrix; 
var Result:Matrix);
Var i,j,k:Integer;
    Summa:Integer;
Begin
    if( A.column <> B.line) Then
    Begin
    Writeln('В матрице А количество столбцов должно быть количеству строк в матрице B');
        Exit;
    End;
    Result.line:= A.line;
    Result.column:= B.column;
    For i:= 1 to A.line Do
       For j:= 1 to B.column Do
       Begin
             Summa:=0;
             For k:= 1 to A.column Do
                 Summa:=Summa+A.Mass[i,k]*B.Mass[k,j];
             Result.Mass[i,j]:=Summa;
        End;
End;
{ Процедура сложение матриц }
Procedure matrix_plus(A:Matrix;B:Matrix;var Result:Matrix);
    Var i,j:Integer;
Begin
   if( ( A.line <> B.line ) or ( A.column <> B.column ) )Then Begin
       Writeln('Размерности матриц A и B должны совпадать');
       Exit;
   End;
   Result.line:=   A.line;
   Result.column:= A.column;
   For i:=1 to A.line Do
       For j:=1 to B.column Do
           Result.Mass[i,j]:= A.Mass[i,j]+B.Mass[i,j];
End;
{ Процедура вычитания матриц }
Procedure matrix_minus(A:Matrix;B:Matrix;var Result:Matrix);
    Var i,j:Integer;
Begin
   if( ( A.line <> B.line ) or ( A.column <> B.column ) )then Begin
       Writeln('Размерности матриц A и B должны совпадать');
       Exit;
   End;
   Result.line:= A.line;
   Result.column:= A.column;
   For i:=1 to A.line Do
       For j:=1 to B.column Do
           Result.Mass[i,j]:= A.Mass[i,j]-B.Mass[i,j];
End;
{ Процедура инициализации матриц }
Procedure Equalization(A:Matrix;var Result:Matrix);
    Var i,j:Integer;
Begin
    Result.line:=   A.line;
    Result.column:= A.column;
    For i:=1 to A.line Do
        For j:=1 to A.column Do
            Result.Mass[i,j]:=A.Mass[i,j];
End;
{ Процедура вывода матриц } 
Procedure Print(str:string;A:Matrix);
Var i,j:Integer;
Begin
    ClrScr;
    Write(str);
    For i:=1 to A.Line Do
        For j:=1 to A.column Do Begin
          gotoxy(j*6, i+2);
          Write( A.Mass[i,j] );
       End;
    Readkey;
End;
Var
   X,Y,B,A:Matrix;
   vs_pom, vs_pom2, vs_pom3:Matrix;
{ Инициализация элементом матриц и  размерностей матриц }
Procedure Install;
Var i,j:Integer;
Begin
    X.line:=   4;    X.column:= 2;
    Y.line:=   4;    Y.column:= 1;
    B.line:=   3;    B.column:= 1;
    A.line:=  5;    A.column:= 5;
    For i:=1 to X.line Do
        For j:=1 to X.column Do
            X.Mass[i,j]:=1;
    For i:=1 to Y.line Do
        For j:=1 to Y.column Do
            Y.Mass[i,j]:=2;
    For i:=1 to B.line Do
        For j:=1 to B.column Do
            B.Mass[i,j]:=3;
    For i:=1 to A.line Do
        For j:=1 to A.column Do
            A.Mass[i,j]:=4;
End;
Begin
   Install;
   Equalization(X, vs_pom);
   multiplication(vs_pom, 2);
   Print('2X',vs_pom);
   Flip(vs_pom);
   Print('(2*X)T',vs_pom);
   matrix_multiplication(vs_pom,X,vs_pom2);
   Print('((2*X)T)*X',vs_pom2);
   Flip(vs_pom2);
   Print('(((2*X)T)*X)T',vs_pom2);
   matrix_multiplication(vs_pom2,X,vs_pom3);
   Print('(((2*X)T)*X)T*Xt',vs_pom3);
   Equalization(Y, Y);
   matrix_multiplication(vs_pom3,Y,vs_pom);
   Print('(((2*X)T)*X)T*Xt*Y',vs_pom);
   Equalization(B, vs_pom2);
   multiplication(vs_pom2, 5);
   Print('5B',vs_pom3);
   matrix_plus(vs_pom3,vs_pom2, vs_pom);
   Print('H =5B+(((2*X)T)*X)T*Xt*Y',vs_pom);
End.

@Puporev · 23.11.2014, 08:22

Сообщение от PFanthem

Размерность матриц В подбирается самостоятельно

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

Pascal
1
2
Type Matrix:array[1..10, 1..10] of Integer;
var n:Integer;{размер матриц}

При транспонировании нужно создать новую матрицу, поскольку исходная тоже нужна.

Pascal
1
2
3
4
5
6
7
Procedure flip(A:Matrix;var B:Matrix);
Var i,j:Integer;
Begin
For i:= 1 to n Do
For j:= 1 to n Do
B[i,j]:=A[j,i];
End;

Добавлено через 1 минуту
Для чего описана процедура вычитания матриц, если этого нет в условии?

Добавлено через 16 минут
Процедуру создания матриц вообще бы написал так.

Pascal
1
2
3
4
5
6
7
Procedure create_matrix(var A:Matrix);
Var i,j:Integer;
Begin
For i:= 1 to n Do
For j:= 1 to n Do
A[i,j]:=random(9);
End;

А начало программы так.

Pascal
1
2
3
4
5
6
7
8
9
begin
repeat
write('Введите размер матриц от 2 до 10 n=');
readln(n);
until n in [2..10];
create_matrix(B);
create_matrix(X);
create_matrix(Y);
..........................

А дальше вызывать процедуры в порядке арифметики и создавать новые матрицы и так до матрицы Н.
1. создаем матрицу Xt
2. создаем матрицу 2*Xt*Х
3. создаем матрицу (2*Xt*Х)t
4. создаем матрицу (2*Xt*Х)t*Y
5. создаем матрицу H=5*B+(2*Xt*Х)t*Y

@bormant · 24.11.2014, 12:47

Сообщение от Puporev

При транспонировании нужно создать новую матрицу, поскольку исходная тоже нужна.

но для этого не нужно менять саму процедуру, достаточно завести переменную для aT:

Pascal
1
2
3
4
5
var
  ...
  at: Matrix;
...
  at:=a; flip(at);

Добавлено через 29 минут

Сообщение от Puporev

они должны быть квадратные и одного размера

Это не так.

Условие согласованности множителей: число столбцов в первом сомножителе равно числу строк во втором.
Результат имеет число строк первого множителя и столбцов второго.

Условие согласованности суммы/разности: число строк и столбцов одинаково.
Результат имеет число строк и столбцов как в слагаемых.

Умножение на число и сложение/вычитание размерность не изменяет.

Обозначим операции над размерностями через [].

Пусть [x] = [(mX,nX)], тогда [xT] = [(nX,mX)]

Далее:
[2 * xT * x] = [(nX,mX)*(mX,nX)] = [(nX,nX)]
[(2 * xT * x)T] = [(nX,nX)]
[(2 * xT * x)T * xT] = [(nX,nX)*(nX,mX)] = [(nX,mX)]
То есть, имеем тождество для любых mx,nx.

Далее:
[(2 * xT * x)T * xT * Y] = [(nX,mX)*(mY,nY)] = [(nX,nY)]
Очевидно, множители согласованы при mY=mX.

Отсюда следует [b] = [(nX,nY)], т.е. mB=nX, nB=nY.

В сухом остатке, для согласованности выражения достаточно выполнения условий: mY=mX, mB=nX, nB=nY.

@Puporev · 24.11.2014, 12:51

А ты читай все, а не выдергивай.

Сообщение от Puporev

Поскольку матрицы транспонируются, умножаются и складываются

возьми матрицу 5х3 получи транспонированную, а потом попробуй их сложить.

@bormant · 24.11.2014, 16:46

Сообщение от Puporev

возьми матрицу 5х3 получи транспонированную, а потом попробуй их сложить.

Это не относится к исходному выражению ТС: H=5*B+(2XT*X)T*XT*Y
В этом выражении нет сложений вида a+aT.
Для согласованности этого выражения достаточно выполнения трех условий: mY=mX, mB=nX, nB=nY.
Вывод этих условий приведён выше. Если есть вопросы, с удовольствием поясню.

Добавлено через 12 минут
Другими словами, размерности в этой задаче согласованы следующим образом:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
const
  { свободные значения }
  mB=5; nB=6; mY=7;
  { зависимые значения }
  nY=nB;
  mX=mY; nX=mB;
  mH=mB; nH=nB;
var
  h: array [1..mH,1..nH] of Real;
  b: array [1..mB,1..nB] of Real;
  x: array [1..mX,1..nX] of Real;
  y: array [1..mY,1..nY] of Real;
  xT: array [1..nX,1..mX] of Real;
  xx: array [1..nX,1..nX] of Real;

Добавлено через 3 часа 36 минут
Если нигде не ошибся, то можно так:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
type
  TElement = Real;
  PElement=^TElement;
  PMatrix = ^TMatrix;
  TMatrix = record
    size: Word;
    m, n: Integer;
    d: record end;
  end;
  PElArr = ^TElArr;
  TElArr = array [0..0] of TElement;
 
function mSize(am, an: Integer): Word;
begin
  mSize:=SizeOf(TMatrix)+am*an*SizeOf(TElement);
end;
 
function mNew(am, an: Integer): PMatrix;
var p: PMatrix; s: Word;
begin
  s:=mSize(am,an); GetMem(p,s);
  with p^ do begin size:=s; m:=am; n:=an; end;
  mNew:=p;
end;
 
function mDup(a: PMatrix): PMatrix;
var p: PMatrix;
begin
  GetMem(p,a^.size); Move(a^,p^,a^.size);
  mDup:=p;
end;
 
function mFree(a: PMatrix): Integer;
begin
  mFree:=0;
  FreeMem(a,a^.size);
end;
 
function mAt(a: PMatrix; i, j: Integer): PElement;
var p: PElement;
begin
  with a^ do mAt:=@(PElArr(@d)^[n*i+j]);
end;
 
function mAddSc(a: PMatrix; b: TElement): PMatrix;
var i: Integer; p: PElement;
begin
  with a^ do begin
    p:=@d;
    for i:=0 to Pred(m*n) do begin
      p^:=p^+b; Inc(PChar(p),SizeOf(TElement));
    end;
  end;
  mAddSc:=a;
end;
 
function mMulSc(a: PMatrix; b: TElement): PMatrix;
var i: Integer; p: PElement;
begin
  with a^ do begin
    p:=@d;
    for i:=0 to Pred(m*n) do begin
      p^:=p^*b; Inc(PChar(p),SizeOf(TElement));
    end;
  end;
  mMulSc:=a;
end;
 
function mTransp(a: PMatrix): PMatrix;
var i, j: Integer; p: PMatrix;
begin
  with a^ do begin
    p:=mDup(a);
    m:=p^.n; n:=p^.m;
    for i:=0 to Pred(m) do
      for j:=0 to Pred(n) do
        mAt(a,i,j)^:=mAt(p,j,i)^;
    mFree(p);
  end;
  mTransp:=a;
end;
 
function mAdd(a, b: PMatrix): PMatrix;
var p, pb: PElement; i, j: Integer;
begin
  if (a^.m<>b^.m) or (a^.n<>b^.n) then RunError(201);
  with a^ do begin
    p:=@d; pb:=@(b^.d);
    for i:=0 to Pred(m) do
      for j:=0 to Pred(n) do begin
        p^:=p^+pb^;
        Inc(PChar(p),SizeOf(TElement));
        Inc(PChar(pb),SizeOf(TElement));
      end;
  end;
  mAdd:=a;
end;
 
function mMul(a, b: PMatrix): PMatrix;
var s: Real; r: PMatrix; i, j, k: Integer;
begin
  if a^.n<>b^.m then RunError(201);
  r:=mNew(a^.m,b^.n);
  with r^ do
    for i:=0 to Pred(m) do
      for j:=0 to Pred(n) do begin
        s:=0;
        for k:=0 to Pred(a^.n) do s:=s+mAt(a,i,k)^*mAt(b,k,j)^;
        mAt(r,i,j)^:=s;
      end;
  mMul:=r;
end;
 
function mWrite(a: PMatrix; const s: String; wW, wD: Integer): PMatrix;
var i, j: Integer; p: PElement;
begin
  with a^ do begin
    p:=@d; WriteLn;
    if s<>'' then WriteLn(s);
    for i:=0 to Pred(m) do begin
      for j:=0 to Pred(n) do begin
        if wW<0 then Write(p^)
        else if wD<0 then Write(p^:wW)
        else Write(p^:wW:wD);
        Inc(PChar(p),SizeOf(TElement));
      end; WriteLn;
    end;
  end;
  mWrite:=a;
end;
 
function mRnd(a: PMatrix; b, c: TElement): PMatrix;
var i: Integer; p: PElement;
begin
  with a^ do begin
    p:=@d;
    for i:=0 to Pred(m*n) do begin
      p^:=Random*b+c; Inc(PChar(p),SizeOf(TElement));
    end;
  end;
  mRnd:=a;
end;
 
const
  mB=3; nB=5; mY=4;
  nY=nB;
  mX=mY; nX=mB;
  mH=mB; nH=nB;
var
  b, x, y, xt, x1, x2: PMatrix;
begin
  Randomize;
  b:=mRnd(mNew(mB,nB),10,-5); mWrite(b,'b =',6,1);
  x:=mRnd(mNew(mX,nX),10,-5); mWrite(x,'x =',6,1);
  y:=mRnd(mNew(mY,nY),10,-5); mWrite(y,'y =',6,1);
 
  b:=mMulSc(b,5);             mWrite(b,'5b =',6,1);
  xt:=mTransp(mDup(x));       mWrite(xt,'xT =',6,1);
  x1:=mMulSc(mDup(xt),2);     mWrite(x1,'2 xT =',6,1);
  x2:=mMul(x1,x);             mWrite(x2,'2 xT * x =',6,1);
  mTransp(x2);                mWrite(x2,'(2 xT * x)T =',6,1);
  mFree(x1); x1:=mMul(x2,xt); mWrite(x1,'(2 xT * x)T * xT =',8,1);
  mFree(x2); x2:=mMul(x1,y);  mWrite(x2,'(2 xT * x)T * xT * y =',8,0);
  mFree(x1); mAdd(b,x2);      mWrite(x2,'5b + (2 xT * x)T * xT * y =',8,0);
  mFree(x2); mFree(xt); mFree(y); mFree(x); mFree(b);
end.

Новые блоги и статьи Все статьи Все блоги /
И решил я переделать этот ноут в машину для распределенных вычислений Programma_Boinc 09.11.2025 И решил я переделать этот ноут в машину для распределенных вычислений Всем привет. А вот мой компьютер, переделанный из ноутбука. Был у меня ноут асус 2011 года. Со временем корпус превратился. . .	Мысли в слух kumehtar 07.11.2025 Заметил среди людей, что по-настоящему верная дружба бывает между теми, с кем нечего делить.	Новая зверюга volvo 07.11.2025 Подарок на Хеллоуин, и теперь у нас кроме Tuxedo Cat есть еще и щенок далматинца: Хочу еще Симбу взять, очень нравится. . .	Инференс ML моделей в Java: TensorFlow, DL4J и DJL Javaican 05.11.2025 Python захватил мир машинного обучения - это факт. Но когда дело доходит до продакшена, ситуация не так однозначна. Помню проект в крупном банке три года назад: команда data science натренировала. . .	Mapped types (отображённые типы) в TypeScript Reangularity 03.11.2025 Mapped types работают как конвейер - берут существующую структуру и производят новую по заданным правилам. Меняют модификаторы свойств, трансформируют значения, фильтруют ключи. Один раз описал. . .
Адаптивная случайность в Unity: динамические вероятности для улучшения игрового дизайна GameUnited 02.11.2025 Мой знакомый геймдизайнер потерял двадцать процентов активной аудитории за неделю. А виновником оказался обычный генератор псевдослучайных чисел. Казалось бы - добавил в карточную игру случайное. . .	Протоколы в Python py-thonny 31.10.2025 Традиционная утиная типизация работает просто: попробовал вызвать метод, получилось - отлично, не получилось - упал с ошибкой в рантайме. Протоколы добавляют сюда проверку на этапе статического. . .	C++26: Read-copy-update (RCU) bytestream 30.10.2025 Прошло почти двадцать лет с тех пор, как производители процессоров отказались от гонки мегагерц и перешли на многоядерность. И знаете что? Мы до сих пор спотыкаемся о те же грабли. Каждый раз, когда. . .	Изображения webp на старых x32 ОС Windows XP и Windows 7 Argus19 30.10.2025 Изображения webp на старых x32 ОС Windows XP и Windows 7 Чтобы решить задачу, использовал интернет: поисковики Google и Yandex, а также подсказки Deep Seek. Как оказалось, чтобы создать. . .	Passkey в ASP.NET Core identity stackOverflow 29.10.2025 Пароли мертвы. Нет, серьезно - я повторяю это уже лет пять, но теперь впервые за это время чувствую, что это не просто красивые слова. В . NET 10 команда Microsoft внедрила поддержку Passkey прямо в. . .

Опции темы