29.05.2010, 14:00
общий
это ответ
Здравствуйте, Даниил Цветков.
Вот в приложении код программы, решающей Вашу задачу.
Удачи!
Приложение:
uses CRT;
const
sizeofInteger = sizeof(Integer); {будет 2, но ...}
function GetElement(aSeg, aOfs, row, col, rows: Integer): Integer;
{Получение значения элемента КВАДРАТНОЙ матрицы}
begin
GetElement := memw[aSeg:aOfs + ((row -1)*rows + (col-1))*sizeofInteger]
end;
procedure SetElement(aSeg, aOfs, row, col, rows, aValue: Integer);
{Установка значения элемента квадратной матрицы}
begin
memw[aSeg:aOfs + ((row -1)*rows + (col-1))*sizeofInteger] := aValue
end;
function IsSymmetrical(var m; const rows: Integer): boolean;
{ИСТИНА, если матрица симмметричная}
var s, o: Word;
i, j: Integer;
begin
IsSymmetrical := False;
s := Seg(m); o := Ofs(m);
for i := 1 to rows do
for j := 1 to rows do
if GetElement(s, o, i, j, rows) <>
GetElement(s, o, j, i, rows) then
Exit; {Выход из подпрограммы с установленным значением -
НЕ СИММ. = FALSE}
IsSymmetrical := TRUE;
end;
procedure matrSQR(var m; const rows: Integer);
var
s, o, sTemp, oTemp: Word;
i , j, k, el, b, e: Integer;
temp : pointer;
begin
s := Seg(m);
o := Ofs(m);
GetMem( temp, rows * rows * sizeofInteger);
sTemp := Seg(temp^);
oTemp := Ofs(temp^);
move(m, temp^, rows * rows * sizeOfInteger);
for i:=1 to rows do
for j:=1 to rows do
begin
el:= 0;
for k := 1 to rows do
begin
b := GetElement(sTemp, oTemp, i, k, rows);
e := GetElement(sTemp, oTemp, k, j, rows);
el := el + b*e;
{ GetElement(sTemp, oTemp, i, k, rows)*
GetElement(sTemp, oTemp, k, j, rows);}
SetElement(s, o, i, j, rows, el);
end;
end;
FreeMem(temp, rows * rows *sizeofInteger);
end;
procedure Print(var m; rows: Integer);
var k, n, p: Integer;
s, o: Word;
begin
s := Seg(m);
o := Ofs(m);
for k:=1 to rows do
begin
for n := 1 to rows do
begin
p := memw[s:o + ((k-1)*rows + (n-1))*sizeofInteger];
Write(p:5);
end;
WriteLn;
end;
end;
{Для тестирования заполняю симметричной}
procedure FillMatrics(var m; const rows: Integer);
var k,n, p: Integer;
s, o: Word;
begin
s := Seg(m);
o := Ofs(m);
{Через нетипированный параметр передается только адрес
переменной. Так что нужно вычислять положение
элементов по типу, номеру ряда и числу столбцов}
for k:=1 to rows do
for n := k to rows do begin
(* Вариант - случайными числами, например, так: *)
p := Random(10);
{ и цикл вложенный for n := 1 to rows do
и, естественно, только один вызов SetElement}
SetElement(s, o, k, n, rows, p);
SetElement(s, o, n, k, rows, p);
end;
end;
CONST
sz1 = 2;
sz2 = 6;
var
m1: array[1..sz1, 1..sz1] of Integer;
m2: Array[1..sz2, 1..sz2] of Integer;
BEGIN
ClrScr;
Randomize;
FillMatrics(m1, sz1);
WriteLn('Исходная матрица m1 ',sz1,'x',sz1);
Print(m1, sz1);
if IsSymmetrical(m1, sz1) then
begin
WriteLn('Симметричная - возводим в квадрат');
matrSQR(m1, sz1);
print(m1, sz1);
end
else WriteLn('Несимметричная');
WriteLn;
WriteLn('Для продолжения тестирования нажмите любую клавишу ...'); ReadKey;
WriteLn;
FillMatrics(m2, sz2);
WriteLn('Исходная матрица m2 ',sz2,'x',sz2);
Print(m2, sz2);
if IsSymmetrical(m2, sz2) then
begin
WriteLn('Симметричная - возводим в квадрат');
matrSQR(m2, sz2);
print(m2, sz2);
end
else WriteLn('Несимметричная');
Write('Нажмите любую клавишу ...'); ReadKey
END.