IPB
ЛогинПароль:

> 

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

> простая задача на списки, fp
сообщение
Сообщение #1


Человек
*****

Группа: Пользователи
Сообщений: 1 050
Пол: Мужской
Реальное имя: Станислав

Репутация: -  3  +


Добрый день!
Надо довести до совершенство решение задачи, тема который для меня тёмный лес:
Написать программу, содержащую процедуру, которая меняет местами первый
и второй элементы не пустого списка.
Если элементы не найдены, то выдать на экран соответствующие сообщение.

задача уже решалась на форуме, однако хотелось бы увидеть оптимальное решение, учитывая возможности 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.
заранее благодарен.


--------------------
Спасибо!
Удачи!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






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

Хотя я бы ее изменил немного:
{$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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Человек
*****

Группа: Пользователи
Сообщений: 1 050
Пол: Мужской
Реальное имя: Станислав

Репутация: -  3  +


Цитата(volvo @ 26.01.2008 1:02) *
В таком случае (для "разобраться") - чем не устраивает текущая реализация?
мне надо решить целый цикл таких задач и хотелось бы научится писать правильно...

спасибо за твой код, но не мог бы ты добавить комментарии к init() и когда стоит передавать список через var, а когда просто так?


--------------------
Спасибо!
Удачи!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
compiler   простая задача на списки   26.01.2008 2:26
volvo   Можно предложить тебе список в виде Generic-объект…   26.01.2008 2:52
compiler   Можно предложить тебе список в виде Generic-объек…   26.01.2008 3:16
volvo   В таком случае (для "разобраться") - чем…   26.01.2008 6:02
compiler   В таком случае (для "разобраться") - чем…   26.01.2008 17:13
volvo   Комментарии добавлены... А насчет Если тебе на…   26.01.2008 17:37
compiler   Комментарии добавлены... теперь, вроде, разобрался…   26.01.2008 18:00
volvo   Менять надо не ее, а функцию Ch: // сначала пров…   26.01.2008 18:05
compiler   Менять надо не ее, а функцию Ch:огромное спасибо…   26.01.2008 19:10
compiler   я тут ещё одну процедурку пытаюсь реализовать(меня…   27.01.2008 3:31
volvo   compiler, давай переменным "говорящие" и…   27.01.2008 3:57
compiler   [b]compiler, давай переменным "говорящие…   27.01.2008 4:13
compiler   А вот ищё одна задача.... 6. Написать программу, с…   30.01.2008 1:29
volvo   Чем, можно узнать? Смотри, тут уже такое дело: са…   30.01.2008 2:03
compiler   Чем, можно узнать?не знаю.. много переменных(что-…   30.01.2008 2:19
Yevgeny   Извините, а можно поинтересоваться зачем нужно в н…   30.01.2008 2:14
volvo   Это с чего вдруг? По умолчанию как раз используетс…   30.01.2008 3:06
compiler   ...там есть ключ -Mfpc...хм.. действительно есть..…   30.01.2008 3:30


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.04.2024 0:34
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name