Добрый день!
Надо довести до совершенство решение задачи, тема который для меня тёмный лес:
Написать программу, содержащую процедуру, которая меняет местами первый
и второй элементы не пустого списка.
Если элементы не найдены, то выдать на экран соответствующие сообщение.
задача уже решалась на форуме, однако хотелось бы увидеть оптимальное решение, учитывая возможности FP
моё решение
{$mode objfpc}заранее благодарен.
type
data=^node;
node=record i:integer; next:data; end;
function ch(var p:data):boolean;
var wp:data;
begin
if p^.next<>nil then begin
wp:=p^.next; p^.next:=wp^.next; wp^.next := p;
p:=wp;
ch:=true;
end else
ch:=false;
end;
procedure print(const p:data);
var p0:data;
begin
p0:=p;
if (p0^.next<>nil) then begin
repeat
writeln(p0^.i); p0:=p0^.next;
until (p0^.next=nil);
writeln(p0^.i);
end;
end;
procedure init(var p:data);
var p0,p1:data; i:integer;
begin
new(p);
p^.next:=nil; p^.i:=0;
p0:=p;
readln(i);
if i<>0 then begin
p0^.i:=i;
readln(i);
while i<>0 do begin
new(p1);
p1^.i:=i; p1^.next:=nil;
p0^.next:=p1;
p0:=p1;
readln(i);
end;
end;
end;
procedure free(p:data);
var p0:data;
begin
repeat
p0:=p^.next;
dispose(p);
p:=p0;
until (p=nil);
end;
var
sp:data;
begin
init(sp);
if ch(sp) then print(sp) else writeln('error');
free(sp);
end.
В таком случае (для "разобраться") - чем не устраивает текущая реализация?
Хотя я бы ее изменил немного:
{$mode objfpc}
type
data = ^node;
node = record
i: integer;
next: data;
end;
function ch(var p: data): boolean;
var wp: data;
begin
result := false;
if p^.next<>nil then begin
wp := p^.next; p^.next := wp^.next; wp^.next := p;
p := wp;
result := true;
end;
end;
procedure print(p: data);
begin
while p <> nil do begin
write(p^.i:4);
p := p^.next;
end;
writeln;
end;
procedure init(var p: data);
var
p_new, tail: data;
i: integer;
begin
// здесь будет храниться "хвост списка" - указатель на последний элемент. Пока это nil
tail := nil;
repeat
readln(i); // читаем число с клавиатуры
if i > 0 then begin // если оно не нулевое
// (можно написать <> 0, тогда можно будет работать с отр. числами)
new(p_new); // выделяем память под новый элемент
p_new^.next := nil; // поле next нового элемента - ноль, оно еще никуда не указывает
p_new^.i := i; // заполняем информационное поле
// если "хвост" = 0, то есть p_new - это первый элемент списка
// то P (параметр процедуры) нужно изменить: p_new это начало списка
if tail = nil then p := p_new
else tail^.next := p_new;
// если же это уже последующий элемент,
// то поле next "хвостового" элемента указывает на только что созданный
tail := p_new;
// и только что созданный элемент в любом случае становится "хвостовым"
// (последним на данный момент в списке)
end;
until i = 0; // условие выхода из цикла
end;
procedure free(var p: data);
var p_old: data;
begin
while p <> nil do begin
p_old := p;
p := p^.next;
dispose(p_old);
end;
end;
var
sp: data;
begin
init(sp);
if ch(sp) then print(sp) else writeln('error');
free(sp);
end.
Комментарии добавлены...
А насчет
free(sp);
Менять надо не ее, а функцию Ch:
// сначала проверяем, не нулевой ли p, и только если есть - обращаемся к p^.next
if (p <> nil) and (p^.next<>nil) then begin
я тут ещё одну процедурку пытаюсь реализовать(меняет местами первый и пятый элемент) но то ли вечер, то ли ещё что-то, но не получается... да и текст кривой идёт...
{остальной текст программы в посте volvo...}но в результате числа после пяти теряются:(
function replace1a5(var d0:data):boolean;
var
wp, wp0, d:data; i:integer;
begin
result:=true;
if d0<>nil then begin
wp0:=d0; d:=d0;
i:=0;
while ((i<4) and result) do
if wp0^.next=nil then result:=false
else begin
inc(i); wp0:=wp0^.next;
end;
if result then begin
wp:=wp0^.next;{4}
wp0^.next:=d;{4->1}
d^.next:=wp^.next;{1->6}
wp^.next:=d0^.next;{5->2}
d0:=wp;{!показываем что у нас новый первый элемент!}
end;
end else
result:=false;
end;
compiler, давай переменным "говорящие" имена. Иначе ты сам себя путаешь. Смотри, насколько все проще:
function replace1a5(var p:data):boolean;Чертишь на листочке бумаги список, связи между элементами, и смотришь, что с чем надо поменять чтобы новый порядок элементов в списке был таким, какой тебе нужен...
var
p_4, p_5, p_6: data;
i: integer;
begin
result:=true;
p_4 := p; // Будем искать указатель на 4-ый элемент списка ...
i := 1;
while (i < 4) and result do
if p_4^.next = nil then result := false
else begin
inc(i); p_4 := p_4^.next;
end;
if result then begin
// если мы здесь - то список содержит как минимум 4 элемента,
// и p_4 как раз указывает на 4-ый
// Значит, запоминаем пятый
p_5 := p_4^.next;
// и если пятый - ненулевой, то запоминаем шестой
if p_5 <> nil then
p_6 := p_5^.next
else begin
// иначе - ошибка, пятый - нулевой, нечего менять
result := false; exit;
end;
// собственно, сами замены - тут все прозрачно, разберешься я думаю...
p_4^.next := p;
p_5^.next := p^.next;
p^.next := p_6;
p := p_5;
end;
end;
А вот ищё одна задача....
6. Написать программу, содержащую процедуру, которая вставляет новый элемент перед каждым вхождением заданного элемента. Если элементы не найдены, то выдать на экран соответствующие сообщение.
моё решение..
function pastbef(var p_b:data; const i_p, i_s:integer):boolean;но уж больно оно мне не нравится, может, можно решить лучше?
var
p_old, p_new, p:data;
begin
p:=p_b;
result:=false;
p_old:=nil;
while p<>nil do begin
if p^.i=i_s then begin
result:=true;
new(p_new);
p_new^.next:=p;
p_new^.i:=i_p;
if p_old=nil then p_b:=p_new
else p_old^.next:=p_new;
end;
p_old:=p;
p:=p^.next;
end;
end;
function create_item(link: data;, заодно и процедура Init сокращается в 2 раза, и дальнейшая поддержка программы/добавление функциональности упростится... То есть, если смотреть на ВСЮ программу, то можно изменить, если же речь только о новой функции - то я бы оставил как есть (ну, за исключением имен переменных, я бы назвал по-другому)...
var head, tail: data; val: integer): data;
begin
new(result);
with result^ do begin
next := link;
i := val;
end;
// уже при добавлении элемента можно определить,
// добавляется ли ПЕРВЫЙ или последующий элемент
// вот и делаем абсолютно то же самое, что и раньше, только здесь,
// не загромождая основную программу и другие функции/процедуры
// если "хвост" (а ведь можно передать и не сам хвост, а просто значение,
// после которого надо добавить элемент) нулевой, то устанавливаем
// начало списка, иначе - устанавливаем поле next бывшего предыдущего элемента
if tail = nil then head := result
else tail^.next := result;
end;
// А переменные я бы назвал вот так:
function pastbef(var p_begin: data;
const new_val, exist_val: integer): boolean;
var
p, p_save: data;
begin
p := p_begin;
result := false;
p_save := nil;
while p <> nil do begin
if p^.i = exist_val then begin
result := true;
create_item(p, p_begin, p_save, new_val);
end;
p_save := p;
p := p^.next;
end;
end;
Извините, а можно поинтересоваться зачем нужно в начале текста программы писать:
{$mode objfpc}???