простая задача на списки, fp Опции

[compiler]

Добрый день!
Надо довести до совершенство решение задачи, тема который для меня тёмный лес:
Написать программу, содержащую процедуру, которая меняет местами первый
и второй элементы не пустого списка.
Если элементы не найдены, то выдать на экран соответствующие сообщение.
задача уже решалась на форуме, однако хотелось бы увидеть оптимальное решение, учитывая возможности 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.

заранее благодарен.

[volvo]

В таком случае (для "разобраться") - чем не устраивает текущая реализация?

Хотя я бы ее изменил немного:

{$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.

Сообщение отредактировано: volvo - 26.01.2008 13:29