Программа
TYPE Element=integer; { Тип элемента матрицы }
{ Структура списка представляющего строку матрицы: }
RefElement=^RefElementType;
RefElementType=record
j:word; { Номер элемента в строке }
E:Element; { Значение элемента }
Next:RefElement { Следующий элемент }
end;
{ Структура списка, представляющего строки матрицы }
RefLine=^RefLineType;
RefLineType=record
i:word; { Номер строки матрицы }
Line:RefElement; { Ссылка на строку матрицы }
Next:RefLine { Следующая строка }
end;
Matrix=record
H,W:word; { Размерность матрицы "высота" и "ширина" }
M:RefLine { Матрица }
end;
PROCEDURE CopyFileToDisplay(FileName:string); { Процедура копирования файла на экран }
Var S:String; { Строка для чтения файла }
var F:text; { Файловая переменная }
Begin
Assign(F,FileName); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла }
while not SeekEOF(F) do { Цикл чтения файла }
begin
ReadLn(F,S); { Чтение строки файла }
WriteLn(Copy(S,1,79)) { Вывод начальной части строки на экран }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE InsertInLine(j:word; Buf:Element; var L:RefElement); { Вставка элемента в строку матрицы }
Var BufRef:RefElement; { Вспомогательная ссылка на элемент строки для организации вставки и удаления }
Begin
if L=nil { Проверка "НЕсуществования" элементов в оставшейся части строки }
then if Buf<>0 { Вставка элемента, если он не ноль: }
then begin
New(L); { Создание элемента }
L^.j:=j; { Определение его номера в строке }
L^.Next:=nil; { Оформление "хвоста" строки элементов }
L^.E:=Buf; { Определение значения элемента }
end
else { Ничего не делаем, если элемент - ноль }
else if L^.j=j { Сравнение номера элемента строки с требуемым }
then { Переопределение элемента строки: }
if Buf<>0 { Если элемент не нулевой, }
then L^.E:=Buf { то - переопрделение существовавшего }
else begin { иначе - удаление существовавшего }
BufRef:=L^.Next;
Dispose(L);
L:=BufRef
end
else if L^.j>j { Если текущий элемент по номеру превосходит искомый, }
then if Buf<>0 { то - провека вставляемого на ноль }
then begin { и вставка ненулевого **** }
New(BufRef);
BufRef^.E:=Buf;
BufRef^.Next:=L;
L:=BufRef;
L^.j:=j
end
else { **** или ничего не делаем, если элемент нулевой }
else InsertInLine(j,Buf,L^.Next); { вставка элемента в продолжение строки элементов }
End;
PROCEDURE InsertInMatrix(i,j:word; Buf:Element; var M:RefLine); { Вставка элемента в матрицу }
Var BufRef:RefLine; { Вспомогательная ссылка на строку матрицы для вставки новых строк }
Begin
if M=nil { Проверка наличия строк в оставшейся части списка }
then begin { Строк нет и, следовательно, вставляем новую строку: }
New(M);
M^.i:=i;
M^.Next:=nil;
M^.Line:=nil;
InsertInLine(j,Buf,M^.Line) { Вставка элемента в созданную строку матрицы }
end
else { Строки есть и пытаемся найти строку по номеру: }
if M^.i=i { Номер строки совпадает с требуемым }
then InsertInLine(j,Buf,M^.Line) { Вставка элемента в найденую строку }
else if M^.i>i { Номер строки превосходит требуемый }
then if Buf<>0 { Создание новой строки, если элемент не нулевой: }
then begin
New(BufRef);
BufRef^.Next:=M;
M:=BufRef;
M^.Line:=nil;
M^.i:=i;
InsertInLine(j,Buf,M^.Line) { Вставка элемента в созданную строку }
end
else
else InsertInMatrix(i,j,Buf,M^.Next) { Вставка элемента в продолжение списка строк }
End;
PROCEDURE ReadMatrix(FileName:string; var M:Matrix); { Процедура чтения матрицы из файла }
Var F:text; { Файловая переменная }
i,j:word; { Счетчики строк и столбцов }
Buf:Element; { Буфер чтения элемента из файла }
Begin
Assign(F,FileName); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла для чтения }
for i:=1 to M.H do { Цикл чтения строк матрицы }
begin
for j:=1 to M.W do { Цикл чтения строки элементов }
begin
Read(F,Buf); { Чтение элемента }
InsertInMatrix(i,j,Buf,M.M) { Запись элемента в матрицу }
end;
ReadLn(F) { Пропуск конца строки файла }
end;
Close(F); { Закрытие файла }
End;
FUNCTION GetMatrixElement(i,j:word; M:Matrix):Element; { Выборка элемента матрицы }
Var BufRefLine:RefLine; { Вспомогательная ссылка на строку }
BufRefElement:RefElement; { Вспомогательная ссылка на элемент }
Begin
BufRefLine:=M.M; { Установка ссылки на первую строку матрицы }
while BufRefLine<>nil do { Цикл движения по списку строк }
if BufRefLine^.i<i then BufRefLine:=BufRefLine^.Next { Переход на следующую строку }
else Break; { Досрочный выход из цикла при обнаружении требуемой
строки или превышени номера текущей строки над искомым }
if BufRefLine=nil
then GetMatrixElement:=0 { Возврат нуля при отсутствии строки (нет "хвоста")}
else if BufRefLine^.i<>i
then GetMatrixElement:=0 { Возврат нуля при отсутствии строки (нет соответсвующего номера) }
else begin { Поиск элемента в строке: }
BufRefElement:=BufRefLine^.Line; { Установка ссылки на первый элемент строки }
while BufRefElement<>nil do { Цикл движения по строке }
if BufRefElement^.j<j
then BufRefElement:=BufRefElement^.Next { Переход на следующий элемент строки }
else Break; { Выход из цикла при отсутствии требуемого элемента }
if BufRefElement=nil
then GetMatrixElement:=0 { Возврат нуля при отсутствии элемента }
else if BufRefElement^.j=j
then GetMatrixElement:=BufRefElement^.E { Возврат значения элемента }
else GetMatrixElement:=0 { Возврат нуля }
end
End;
PROCEDURE WriteMatrix(FileName:string; M:Matrix); { Процедура записи матрицы в файл }
Var F:text; { Файловая переменная }
i,j:word; { Счетчики строк и столбцов }
Begin
Assign(F,FileName); { Связывание файловой переменной с именем файла }
Rewrite(F); { Открытие файла для записи }
for i:=1 to M.H do { Цикл вывода строк матрицы }
begin
for j:=1 to M.W do Write(F,GetMatrixElement(i,j,M):3,' '); { Цикл вывода строки }
WriteLn(F) { Вывод конца строки }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE CheckMatrix(FileName:string; var H,W:word); { Проверка матрицы в файле }
Var F:text; { Указатель на файловую переменную }
W2:word; { Счетчик элементо в строке }
Buf:word; { Буфер для чтения элемента }
Begin
Assign(F,FileName); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла для чтения }
H:=0; { Сброс счетчика строк }
W:=0; { Сброс счетчика элементов в первой строке }
W2:=0; { Сброс счетчика элементов строк }
while not SeekEOLn(F) do { Цикл чтения первой строки файла }
begin
W:=W+1; { Набор числа элементов первой строки }
Read(F,buf) { Чтение элемента }
end;
if not EOF(F) then ReadLn(F); { Чтение конца первой строки }
if W>0 { Проверка определенности первой строки }
then begin
H:=1; { Определение счетчика строк }
while not SeekEOF(F) do { Цикл чтения оставшихся строк файла }
begin
W2:=0; { Сброс элементов в строке }
H:=H+1; { Набор числа строк }
while not SeekEOLn(F) do { Цикл чтения строки файла }
begin
W2:=W2+1; { Набор числа элементов строки }
Read(F,Buf) { Чтение элемента }
end;
if not EOF(F) then ReadLn(F); { Пропуск конца строки }
if W2<>W { Сравнения числа элементов текущей строки с первой }
then begin
W:=0; H:=0; { Сброс размерности матрицы }
Break { Выход из цикла }
end
else;
end
end
else;
Close(F) { Закрытие файла }
End;
PROCEDURE Mirror(M:Matrix); { Копирование наддиагональных элементов }
Var i,j:word; { Счетчики строк и столбцов }
Begin
for i:=1 to M.H do { Цикл копирования строк }
for j:=i+1 to M.W do { Цикл копирования строки }
InsertInMatrix(j,i,GetMatrixElement(i,j,M),M.M) { Копирование элемента }
End;
PROCEDURE DisposeElementList(var L:RefElement); { Процедура удаления списка }
Begin
if L<>nil then begin { Если переменная существует, то }
DisposeElementList(L^.NEXT); { удаление хвоста списка }
Dispose(L); { удаление переменной }
L:=nil { Переопределение ссылки }
end
End;
PROCEDURE DisposeLineList(var M:RefLine); { Удаление строк матрицы }
Begin
if M<>nil { Если строка существует, то }
then begin
DisposeLineList(M^.Next); { Уничтожение оставшихся строк }
DisposeElementList(M^.Line); { Уничтожение строки }
Dispose(M); { Уничтожение головного элемента строки }
M:=nil { Сброс ссылки }
end;
End;
PROCEDURE MatrixDispose(var M:Matrix); { Удаление матрицы }
Begin
M.H:=0; M.W:=0; { Сброс размерности }
DisposeLineList(M.M); { Удаление строк матрицы }
End;
CONST InFileName='!_input.txt'; { Файл с иходной матрицей }
OutFileName='!_output.txt'; { Файл с результирующей матрицей }
VAR M:Matrix;
BEGIN
M.M:=nil; M.H:=0; M.W:=0; { "Сброс" матрицы }
CheckMatrix(InFileName,M.H,M.W); { Проверка определенности и корректности
матрицы (возвращается ее размерностсь) }
if (M.H>0) and (M.H=M.W) { Проверка "квадратности" матрицы }
then begin
ReadMatrix(InFileName,M); { Чтение матрицы }
Mirror(M); { Преобразование матрицы }
WriteMatrix(OutFileName,M); { Запись матрицы }
WriteLn;
CopyFileToDisplay(OutFileName);{ Вывод файла результата на экран }
WriteLn;
MatrixDispose(M); { Уничтожение матрицы }
end
else WriteLn('Матрица не определена или не квадратная!')
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию