Как вывести максимальный элемент списка - Free Pascal
Формулировка задачи:
Program Stek;
uses
crt; {Для использования readkey и clrscr}
type
Tinf=real; {тип данных, который будет храниться в элементе стека}
List=^TList; {Указатель на элемент типа TList}
TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
data:TInf; {данные, хранимые в элементе}
next:List; {указатель на следующий элемент}
end;
{ тип данных - указатель на результат поиска }
pResult=^TResult;
{ тип данных - результат поиска }
TResult=record
Addr:List;
Position:integer;
end;
{Процедура добавляющая элемент в стек}
procedure AddElem(var stek1:List;znach1:TInf);
var
tmp:List;
begin
GetMem(tmp,sizeof(TList)); {выделяем в памяти место для нового элемента}
tmp^.next:=stek1; {указатель на следующий элемент "направляем" на вершину стека}
// tmp^.data:=znach1; {добавляем к элементу данные}
//randomize;
tmp^.data:=random; {добавляем к элементу данные}
stek1:=tmp; {вершина стека изменилась, надо перенести и указатели на неё}
end;
{ функция поиска максимального элемента в списке
выдает указатель на него и его позицию от начала }
function FindMax(var PBegin:List):pResult;
var
q:List;
Max:real;
MaxIndex:integer;
cnt:integer;
begin
if PBegin<>nil then
begin
q:=PBegin;
Max:=q^.data;
MaxIndex:=1;
cnt:=1;
while q^.next<>nil do
begin
q:=q^.next;
cnt:=cnt+1;
if Max<q^.data then
begin
Max:=q^.data;
MaxIndex:=cnt;
end;
end;
FindMax^.Addr:=q;
FindMax^.Position:=MaxIndex;
end
else FindMax:=nil;
end;
{Процедура вывода стека}
procedure Print(stek1:List);
begin
if stek1=nil then {проверка на пустоту стека}
begin
writeln('Стек пуст.');
exit;
end;
while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
begin {а это произойдёт как только он перейдёт по ссылке последнего элемента}
Writeln(stek1^.data:2, ' '); {выводить данне}
stek1:=stek1^.next; {и переносить указатель вглубь по стеку}
end;
//Writeln('Максимальное значение списка',a[m]:2);
end;
{Процедура освобождения памяти занятой стеком}
Procedure FreeStek(stek1:List);
var
tmp:List;
begin
while stek1<>nil do {пока stek1 не станет указывать в "пустоту" делать}
begin
tmp:=stek1; {указатель tmp направим на вершину стека}
stek1:=stek1^.next; {вершину стека перенесём на следующий за данной вершиной элемент}
FreeMem(tmp,SizeOf(Tlist)); {освободим память занятую под старую вершину}
end;
end;
{Поиск элемента в стеке по значению}
Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
if stek1<>nil then {если стек не пуст, то}
while (Stek1<>nil) and (znach1<>stek1^.data) do {пока stek1 не укажет в "пустоту" или пока мы не нашли нужный нам элемент}
stek1:=stek1^.next; {переносить указатель}
SearchElemZnach:=stek1;{функция возвращает указатель на найденный элемент}
end; {в случае если элемент не найден, она вернёт nil}
{Процедура удаления элемента по указателю}
Procedure DelElem(var stek1:List;tmp:List);
var
tmpi:List;
begin
if (stek1=nil) or (tmp=nil) then {если стек пуст или указатель никуда не указывает, то выходим}
exit;
if tmp=stek1 then {если мы удаляем элемент который является вершиной стека, то}
begin
stek1:=tmp^.next;{следует перенести вершину и}
FreeMem(tmp,SizeOf(TList)); {высвободить память из под элемента}
end
else {в случае, если удаляемый элемент не вершина стека, то}
begin
tmpi:=stek1; {ставим указатель на вершину стека}
while tmpi^.next<>tmp do {доходим до элемента стоящего "перед" тем, который нам следует удалить}
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next; {указатель элемента переносим на следующий элемент за удаляемым}
FreeMem(tmp,sizeof(TList)); {удаляем элемент}
end;
end;
{Процедура удаления элемента по значению}
procedure DelElemZnach(var Stek1:List;znach1:TInf);
var
tmp:List;
begin
if Stek1=nil then {Если стек пуст, то выводим сообщение и выходим}
begin
Writeln('Стек пуст');
exit;
end;
tmp:=SearchElemZnach(stek1,znach1); {tmp указывает на удаляемый элемент}
if tmp=nil then {если элемент не был найден, то выводим сообщение и выходим}
begin
writeln('Элемент с искомым значением ' ,znach1, ' отсутствует в стеке.');
exit;
end;
DelElem(stek1,tmp); {удаляем элемент из стека }
Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
{Удаление элемента по порядковому номеру (вершина имеет номер 1)}
Procedure DelElemPos(var stek1:List;posi:integer);
var
i:integer;
tmp:List;
begin
if posi<1 then {проверка на ввод информации}
exit;
if stek1=nil then {если стек пуст}
begin
Write('Стек пуст');
exit
end;
i:=1; {будет считать позиции}
tmp:=stek1;
while (tmp<>nil) and (i<>posi) do {пока tmp не укажет в "пустоту" или мы не найдём искомый элемент}
begin
tmp:=tmp^.next; {переходим на следующий элемент}
inc(i) {увеличиваем значение счётчика}
end;
if tmp=nil then {если элемента нет выводим соответствующие сообщения и выходим}
begin
Writeln('Элемента с порядковым номером ' ,posi, ' нет в стеке.');
writeln('В стеке ' ,i-1, ' элемента(ов).');
exit
end;
DelElem(stek1,tmp); {если мы не вышли, то элемент есть и его следует удалить}
Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
{Процедура сортировки "пузырьком" с изменением только адресов}
procedure SortBublLink(nach:List);
var
tmp,pered,pered1,pocle,rab:List; {все рабочие ссылки}
begin
rab:=nach; {становимся на вершину стека}
while rab<>nil do{пока не конец стека делать}
begin
tmp:=rab^.next; {переходим к следующему за сортируемым элементу}
while tmp<>nil do {пока не конец стека делать}
begin
if tmp^.data<rab^.data then {если следует произвести замену, то}
begin
pered:=nach; {становимся в вершину стека}
pered1:=nach; {становимся в вершину стека}
if rab<>nach then {если мы не стоим на изменяемом элементе, то}
while pered^.next<>rab do pered:=pered^.next; {станем на элементе перед изменяемым}
while pered1^.next<>tmp do pered1:=pered1^.next; {станем на элементе перед изменяемым, который находится за
первым изменяемым}
pocle:=tmp^.next; {запоминаем адрес элемента после второго изменяемого}
if rab^.next=tmp then {если элементы "соседи", то}
begin
tmp^.next:=rab; {меняем ссылки, тут если не понятно рисуйте на листочке}
rab^.next:=pocle
end
else {в случае если элементы не соседи, то}
begin
tmp^.next:=rab^.next;{меняем ссылки, тут если не понятно рисуйте на листочке}
rab^.next:=pocle;
end;
if pered1<>rab then{советую просмотреть на листочке}
pered1^.next:=rab;
if rab<>nach then{советую просмотреть на листочке}
pered^.next:=tmp
else{всё советую просмотреть на листочке}
nach:=tmp;
pered1:=tmp;{советую просмотреть на листочке}
tmp:=rab;{советую просмотреть на листочке}
rab:=pered1;{советую просмотреть на листочке}
end;
tmp:=tmp^.next; {переходим на следующий элемент}
end;
rab:=rab^.next;{переходим на следующий элемент}
end;
end;
{Процедура сортировки "пузырьком" с изменением только данных}
procedure SortBublInf(nach:list);
var
tmp,rab:List;
tmps:Tinf;
begin
GetMem(tmp,SizeOf(Tlist)); {выделяем память для рабочего "буфера" обмена}
rab:=nach; {рабочая ссылка, становимся на вершину стека}
while rab<>nil do {пока мы не дойдём до конца стека делать}
begin
tmp:=rab^.next; {перейдём на следующий элемент}
while tmp<>nil do {пока не конец стека делать}
begin
if tmp^.data<rab^.data then {проверяем следует ли менять элементы}
begin
tmps:=tmp^.data; {стандартная замена в 3 операции}
tmp^.data:=rab^.data;
rab^.data:=tmps
end;
tmp:=tmp^.next {переход к следующему элементу}
end;
rab:=rab^.next {переход к следующему элементу}
end
end;
var
Stk, {переменная, которая всегда будет указывать на "вершину" стека}
tmpl:List; {рабочая переменная}
znach:Tinf; {данные вводимые пользователем}
nn,ip:integer;
ch:char; {для работы менюшки}
MaxL1:pResult;
begin
Stk:=nil;
repeat {цикл для нашего меню}
clrscr; {очистка экрана, далее идёт вывод самого меню}
Write('Программа для работы со ');
Textcolor(4);
Writeln('стеком.');
Textcolor(7);
Writeln('Выберите желаемое действие:');
Writeln('1) Добавить элемент.');
Writeln('2) Вывод стека.');
Writeln('3) Удаление элемента по значению.');
Writeln('4) Удаление элемента по порядковому номеру.');
Writeln('5) Поиск элемента по значению');
Writeln('6) Сортировка стека методом "Пузырька", меняя только данные.');
Writeln('7) Сортировка стека с изменением адресов.');
Writeln('8) Выход.');
ch:=readkey; {ожидаем нажатия клавиши}
case ch of {выбираем клавишу}
'1':begin
// write('Введите значение добавляемого элемента: ');
write('Введите количество элементов для добавления в список: ');
readln(nn); {считываем значение добавляемого нового элемент}
randomize;
for ip:= 1 to nn do
begin
AddElem(Stk,nn);
end;
MaxL1:= FindMax(Stk);
writeln('L1 maximal element: ');
writeln(MaxL1^.Addr^.data:2);
readkey;{ожидаем нажатия клавиши}
end;
'2':begin
clrscr; {очистка экрана}
Print(Stk); {вызов процедуры вывода}
readkey; {ожидаем нажатия клавиши}
end;
'3':begin
Write('Введите значение удаляемого элемента: ');
readln(nn); {ввод значения удаляемого элемента}
DelElemZnach(Stk,nn); {вызов процедуры удаления элемента по значению}
readkey;{ожидаем нажатия клавиши}
end;
'4':begin
Write('Введите порядковый номер удаляемого элемента: ');
readln(nn); {ввод позиции удаляемого файла}
DelElemPos(Stk,nn);{вызов процедуры удаления элемента по значению}
readkey;{ожидаем нажатия клавиши}
end;
'5':begin
write('Введите значение искомого элемента: ');
readln(nn); {ввод искомого значения}
tmpl:=SearchElemZnach(Stk,nn); {вызываем процедуру поиска элемента по значению}
if tmpl=nil then {проверяем найден ли элемент и выводим соответствующие сообщения}
write('Искомый элемент отсутствует в стеке')
else
write('Элемент ',tmpl^.data,' найден');
readkey;{ожидаем нажатия клавиши}
end;
'6':begin
if Stk=nil then {проверяем не пустой ли стек}
begin
Write('Стек пуст.');
readkey{ожидаем нажатия клавиши}
end
else
begin
SortBublInf(Stk);{вызов процедуры сортировки стека с изменением данных}
Write('Стек отсортирован.');
readkey;{ожидаем нажатия клавиши}
end;
end;
'7':begin
if Stk=nil then{проверяем не пустой ли стек}
begin
Write('Стек пуст.');
readkey{ожидаем нажатия клавиши}
end
else
begin
SortBublLink(Stk);{вызов процедуры сортировки стека с изменением адресов}
Write('Стек отсортирован.');
readkey;{ожидаем нажатия клавиши}
end;
end;
end;
until ch='8';
FreeStek(Stk); {освобождаем память занятую стеком}
end.Решение задачи: «Как вывести максимальный элемент списка»
textual
Листинг программы
program test; type RType = record a: integer; b: char; end; PType = ^RType; var X: PType; begin //new(X); X^.a := 10; X^.b := 'S'; //dispose(X); end.
Объяснение кода листинга программы
В данном коде определен тип данных RType, который является записью (record) и содержит две поля: a типа integer и b типа char. Также определен указатель на тип RType — PType. Затем объявлена переменная X типа PType. В комментариях указано, что можно использовать оператор new для выделения памяти под переменную X, но в данном коде он не используется. Затем поля X^.a и X^.b присваиваются значения 10 и 'S' соответственно. Знак ^ используется для обращения к полям записи, удерживаемой указателем. В конце комментария указано, что можно использовать оператор dispose для освобождения памяти, выделенной под переменную X, но в данном коде он также не используется. Таким образом, код создает переменную X типа PType, заполняет ее поля значениями 10 и 'S', но не освобождает память после ее использования.