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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задачи на списки
Nastas'ka
сообщение 20.10.2005 16:48
Сообщение #1


Гость






Уже месяц не могу решить задачу. а сдать надо было давно, может кто-нидь поможет sad.gif
Текст задачи: В списке L заменить первое вхождение списка L1 на список L2. Решить задачу на однонаправленный список, на двунаправленный и кольцевой.Простым методом и рекурсивным. Помогите хотя бы простым методом на однонаправленный список, дальше может сама разберусь ;)
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 20.10.2005 22:56
Сообщение #2


Гость






А у меня вот что получилось:
uses crt;
type
point = ^item;
item = record
number : integer;
next : point;
end;

var
L, L1, L2, temp : point;

procedure InitList(var first: point);
var
last: point;

procedure add_item(item: integer);
var p: point;
begin
new(p);
p^.number := item; p^.next := nil;
if first = nil then first := p
else last^.next := p;

last := p
end;

var
n, X: integer;

begin
write('n = '); readln(n);
first := nil; last := nil;

while n > 0 do begin

write('next item = '); readln(X);
add_item(X); dec(n);

end;
end;


procedure PrintList(L: point);
begin

write('list: < ');
while L <> nil do begin

write(L^.number, ' ');
L := L^.next

end;
WriteLn('>');
WriteLn;
end;

function CheckEquals(L, second: point): boolean;
var match: boolean;
begin
match := True;

while (second <> nil) and match do begin
match := (L^.number = second^.number) and
not((L^.next = nil) and (second^.next <> nil));

if match then begin
L := L^.next; second := second^.next;
end;
end;
CheckEquals := match
end;

var
before: point;

function FindFirstPtr(L, sub: point): point;
var found: boolean;
begin
FindFirstPtr := nil;

found := false; before := nil;
while (L <> nil) and not (found) do begin

found := CheckEquals(L, sub);
if not found then begin
before := L; L := L^.next;
end;

end;

if found Then FindFirstPtr := L
end;


procedure ChangeLists(Prev: point;
Var FromL, ToL: point; OldOne: point);
var p: point;
begin
p := FromL;
Prev^.next := ToL;

while OldOne^.next <> nil do begin
OldOne := OldOne^.next;
p := p^.next;
end;

while ToL^.next <> nil do
ToL := ToL^.next;

ToL^.next := p^.next;
end;

procedure ReformItem(a, b, p : point);
begin
a := p;
while (a<>nil) and (b<> nil) do begin
a^.number := b^.number;
a := a^.next;
b := b^.next;
end;
end;

Begin
clrscr;

writeln('L1 : ');
InitList(L1); PrintList(L1);
writeln('L2 : ');
InitList(L2); PrintList(L2);
writeln('L : ');
InitList(L); PrintList(L);

temp := FindFirstPtr(L, L1);

if temp = nil then writeln('No')
else begin
ChangeLists(before, temp, L2, L1);
PrintList(L);
end;

readln;
End.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 21.07.2025 11:10
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"