Консультация № 178483
19.05.2010, 03:31
0.00 руб.
0 6 1
Здравствуйте, уважаемые эксперты!
Помогите пожалуйста с задачей:
Даны две квадратные матрицы разных порядков. Для каждой из матриц, если матрица симметрична, то заменить ее квадратом. Предусмотреть в подпрограммах обработку массивов различных размеров с произвольными типами индексов, но с фиксированным базовым типом. Размеры матриц задать константами.


Приложение:
Программу нужно составить для ТР7

Обсуждение

Неизвестный
19.05.2010, 07:46
общий
Э, нет. Давайте уточним сначала: что такое "произвольный тип индексов"? Я не знаю такого понятия! И что такое фиксированный базовый тип!
Тут у нас проходил подобный вопрос (с подобными терминами) - может и у Вас за-60-летняя в отпуске? Юдин задавал, вопрос № 178381.
Посмотрите, может и Вам такое нужно?
Неизвестный
27.05.2010, 04:49
общий
Boriss:
Совершенно верно. Только из отпуска она уже вышла
Неизвестный
29.05.2010, 07:50
общий
Извиняюсь, что совсем забыл про Ваш вопрос . Сейчас сделаю. Напомните: PascalABC?
Неизвестный
29.05.2010, 09:46
общий
Boriss:
Нет. Borland Pascal
Неизвестный
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.
Неизвестный
29.05.2010, 17:37
общий
Boriss:
Тут есть одна оговорка, о которой я не упомянул ранее (простите ради бога) - а именно динамической памятью пользоваться нельзя
Форма ответа