Как вывести максимальный элемент списка - 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.
Решение задачи: «Как вывести максимальный элемент списка»
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', но не освобождает память после ее использования.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д