Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
shakgan
1 / 1 / 0
Регистрация: 12.11.2013
Сообщений: 33
#1

Добавление в класс обратную матрицу - Delphi

18.03.2017, 12:41. Просмотров 117. Ответов 0
Метки нет (Все метки)

Добрый день форумчане, возникла проблема с классами, в них мало что помню, курсач весит. И так есть код программы создания класса и матрицы, вот :
Delphi
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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils;
 
type
    MATRIX = class(Tobject)
        private
            countRow : integer;                                                 // количество колонок
            countCol : integer;                                                 // количество строк
            arr : array of array of integer;                                    // динамическии массив
            procedure setCountRow(pcountRow : integer);                         // установка количества строк
            function getCountRow : integer;                                     // получение количества строк
            procedure setCountCol(pcountCol : integer);                         // установка количества колонок
            function getCountCol : integer;                                     // получение количества колонок
        public
            constructor Create(prow : integer; pcol : integer);                 // конструктор
            destructor Destroy;                                                 // деструктор
            property row : integer read getCountRow write setCountRow;          // своиство для работы с кол - вом строк
            property col : integer read getCountCol write setCountCol;          // своиство для работы с кол - вом колонок
            procedure inputData(a : integer);                                   // ввод данных в матрицу
            procedure outputData(s : string);                                   // вывод данных из матрицы на экран
            procedure invertStr;
     
 
    end;
 
//==============================================================================
// установка количества строк
procedure MATRIX.setCountRow(pcountRow : integer);
begin
    self.countRow := pcountRow;
end;
//==============================================================================
// получение количества строк
function MATRIX.getCountRow : integer;
begin
    result := countRow;
end;
//==============================================================================
// установка количества колонок
procedure MATRIX.setCountCol(pcountCol : integer);
begin
    self.countCol := pcountCol;
end;
//==============================================================================
// получение количества колонок
function MATRIX.getCountCol : integer;
begin
    result := countCol;
end;
//==============================================================================
// выделим память под динамическии массив
constructor MATRIX.Create(prow : integer; pcol : integer);
var
    i : integer;
begin
    row := prow;
    col := pcol;
    setlength(arr, row);
    for i := 0 to row - 1 do
        setlength(arr[i], col);
end;
//==============================================================================
// деструктор
destructor MATRIX.Destroy;
begin
    arr := NIL;
end;
//==============================================================================
// ввод данных в матрицу
// a = 1 - ввод с клавиатуры
// a = 2 - ввод случаиными числами
procedure MATRIX.inputData(a : integer);
var
    i, j : integer;
begin
    for i := 0 to row - 1 do
        for j := 0 to col - 1 do
        begin
            if(a = 1) then
            begin
                write('Vvedite A[', i + 1, ', ', j + 1, '] element matritsi: ');
                readln(arr[i, j]);
            end
            else
                arr[i, j] := random(100);
        end;
end;
//==============================================================================
// вывод данных из матрицы на экран
procedure MATRIX.outputData(s : string);
var
    i, j : integer;
begin
    writeln;
    writeln(s);
    writeln;
    for i := 0 to row - 1 do
    begin
        for j := 0 to col - 1 do
            write(arr[i, j]:5);
        writeln;
        writeln;
    end;
end;
//==============================================================================
// инвертирование элементов строк матрицы
procedure MATRIX.invertStr;
var
    i, j, tmp : integer;
begin
    for i := 0 to row - 1 do
        for j := 0 to col div 2 do
        begin
            tmp := arr[i, j];
            arr[i, j] := arr[i, col - 1 - j];
            arr[i, col - 1 - j] := tmp;
        end;
end;
//==============================================================================
//==============================================================================
function menuMATRIX : integer;
var
    sel : integer;
begin
    repeat
        writeln;
        writeln('1 - Zapolnenie matritsi');
        writeln('2 - Vivod matritsi na ekran');
        writeln('3 - Invertirovanie strok ');
        writeln('4 - perestanovka');
        writeln('5 - Vihod');
        write('VIBOR: ');
        readln(sel);
    until(sel > 0) and (sel < 5);
    result := sel;
end;
//==============================================================================
 
//==============================================================================
function menuInput : integer ;
var
    sel : integer;
begin
    repeat
        writeln;
        writeln('1 - Zapolnenie s klaviaturi');
        writeln('2 - Zapolnenie sluchaynimi chislami');
        writeln('3 - Vihod');
        write('VIBOR: ');
        readln(sel);
    until((sel > 0) and (sel < 4));
    result := sel;
end;
//==============================================================================
// главное меню
function menu : integer;
var
    sel : integer;
begin
    repeat
        writeln;
        writeln('1 - Sosdanie objecta MATR');
        writeln('2 - VIHOD ');
        write('VIBOR: ');
        readln(sel);
    until((sel > 0) and (sel < 4));
    result := sel ;
end;
//==============================================================================
// программа - драивер, тестирующая класс
var
    x : MATRIX;
    n, m, i : integer;
    sel, sel_1, sel_2 : integer ;
begin
    x := NIL;
    n := 0;
    m := 0;
    repeat
        if(x <> NIL) then
            x.Destroy;
 
        sel := menu;
        if(sel <> 3) then
        begin
                writeln;
                repeat
                    write('Vvedite kolichestvo strok(> 0): ');
                    {$I-}
                    readln(n);
                    {$I+}
                until((n > 0) and (IOResult = 0));
 
                repeat
                    write('Vvedite kolichestvo kolonok(> 0): ');
                    {$I-}
                    readln(m);
                    {$I+}
                until((m > 0) and (IOResult = 0));
        end;
        case sel of
            1:
            begin
                x := MATRIX.Create(n, m);
 
                repeat
                    sel_1 := menuMATRIX;
                    case sel_1 of
                        1:
                        begin
                            sel_2 := menuInput;
                            case sel_2 of
                                1:
                                    x.inputData(1);
                                2:
                                    x.inputData(2);
                            end;
                        end;
                        2:
                            x.outputData('Nachalnay matritsa imeet vid: ');
                        3:
                        begin
                            x.outputData('Do invertirovaniya matritsa imeet vid: ');
                            x.invertStr;
                            x.outputData('Posle invertirovaniya matritsa prinyala vid: ');
                        end;
                    end;
                until(sel_1 = 4);
            end;
 
                    end;
                until(sel_1 = 6);
end.
И код создание обратной матрицы
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
167
168
169
170
171
uses crt;
const t=0.000001;{ограничиваем числа, близкие к нолю, на них делить}
type Tmatr=array[1..4,1..4]of real;
 
procedure Per(n,k:integer;a:Tmatr;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:Tmatr;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:Tmatr;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;
Procedure Peresch(n,p:integer;var b:Tmatr;det1:real;var e:Tmatr);{вычисление дополнений}
var i,m,k,j:integer;
    z:real;
    d,c:Tmatr;
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:Tmatr; n:integer;var at:Tmatr);{транспонирование матрицы}
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:Tmatr; n:integer;var c:Tmatr);{проверка - умножение прямой матрицы на обратную}
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[k,j]:=c[k,j]+z;
      end;
   end;
end;
procedure Vyvod(var a:Tmatr; n:integer);{вывод матриц на экран}
var k,j:integer;
begin
for k:=1 to n do
  begin
    for j:=1 to n do
    write(a[k,j]:7:2);
    writeln;
  end;
end;
var n,k,j,i,p:integer;{n-размер матрицы,k-счетчик по строкам,j-счетчик по столбцам,p-счетчик перестановок}
    a,at,b,c,e:Tmatr;{a-исходная, at-транспонированная, b-матрица дополнений, e-обратная, с-проверка}
    det,det1:real;{det-определитель исходной матрицы,det1-определители-дополнения}
    f:byte;{признак несуществования обратной матрицы}
begin
clrscr;
n:=4;
for k:=1 to n do
for j:=1 to n do
   begin
    write('a[',k,',',j,']=');
    readln(a[k,j]);
   end;
clrscr;
writeln('Исходная матрица:');
Vyvod(a,n);
Opr(n,p,a,det,f); {vychislenie opredelitelja}{считаем определитель}
if f=1 then exit;
Transp(a,n,b);  {транспонируем матрицу}
Peresch(n,p,b,det1,e);  {считаем дополнения}
writeln('Obratnaja matrica:');
for k:=1 to n do
for j:=1 to n do
e[k,j]:=e[k,j]/det; {создаем обратную матрицу}
Vyvod(e,n);
writeln('Proverka:');
Proverka(a,e,n,c);  {делаем проверку}
Vyvod(c,n);
readln
end.
. Не помню откуда этот код у меня на компе. При любых попытках перенести выдает разного рода ошибка.

Помогите добать данный код в функцию класса. В заранее благодарен.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.03.2017, 12:41
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Добавление в класс обратную матрицу (Delphi):

Вывести на экран обратную матрицу
Уважаемый народ! Тут такое дело, в консольном приложении...

Необходимо найти обратную матрицу N*N
n≤100; матрица содержит целые числа в диапазоне (-100;100); хранится в...

Найти транспонированную и обратную матрицу
Доброго времени суток. Прошу помощи в нахождении обратной и транспонированой...

Используя DLL найти матрицу обратную данной 2х2
плиз помогите исправить ошибки...мне необходимо было создать функцию в DLL,но...

Добавление данных в КЛАСС (Делфи)
Помогите новичку пожалуйста! Есть код с классом и данными типа record. Нужно...

Как убрать обратную польскую запись?
У меня есть программа, которая считает выражение, ведённое в поле edit1 и...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.03.2017, 12:41
Привет! Вот еще темы с решениями:

Все элементы массива, меньшие 1, заменить на их обратную величину
Здравствуйте. Помогите решить:Все элементы массива, меньшие 1, заменить на их...

Возвести матрицу А в 6 степень, получить матрицу В, используя рекурсию
В общем задача у меня такая: возвести матрицу А в 6 степень, получить матрицу...

Найти матрицу Х из матричного уравнения (решать,используя обратную матрицу)
Ребят,помогите,пожалуйста сделать.Я вот делал,но неправильно.

Поместить матрицу в Excel, и вычислить обратную матрицу
В общем суть проблемы такова: у меня есть код, приведенный ниже. Там есть...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru