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

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

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

 
 Ответить  Открыть новую тему 
> Списки
Guest
сообщение 8.05.2005 19:21
Сообщение #1


Гость






Пожалуйста подскажите!

Как из списка удалить за каждым вхождением элемента Х один элемент,если он есть и отличен от Х.
 К началу страницы 
+ Ответить 
volvo
сообщение 8.05.2005 19:24
Сообщение #2


Гость






Описание списка и реализацию остальных функций/процедур для работы со списком - в студию...
 К началу страницы 
+ Ответить 
Guest
сообщение 8.05.2005 19:37
Сообщение #3


Гость






Цитата(volvo @ 8.05.05 19:24)
Описание списка и реализацию остальных функций/процедур для работы со списком - в студию...

type ref=^Elem;
Elem = RECORD
Inf: integer;
Next: ref;
end;
var L, p: ref;
x: integer;
const Strelka = '->';

Procedure Print_List(p: ref);
begin
while p<>nil do
begin
write(Car(p),Strelka);
p:=Cdr(p);
end;
writeln
end;


Begin
L:=nil;
write('Element: ');
readln(x);
while x<>0 do
begin
L:=Cons(x,L);
write('Element: ');
readln(x);
end;
Print_List(p);

END.
 К началу страницы 
+ Ответить 
volvo
сообщение 8.05.2005 19:57
Сообщение #4


Гость






Sorry, но Car(p), Cdr(p), Cons(x, L) не являются стандартными функциями... Так что мне эта реализация не говорит ни о чем...
 К началу страницы 
+ Ответить 
Guest
сообщение 9.05.2005 12:29
Сообщение #5


Гость






Цитата(volvo @ 8.05.05 19:57)
Sorry, но Car(p), Cdr(p), Cons(x, L) не являются стандартными функциями... Так что мне эта реализация не говорит ни о чем...

Код
type ref=^Elem;
    Elem = RECORD
       Inf: integer;
       Next: ref;
       end;
var L, p: ref;
   x: integer;
const Strelka = '->';

function Car(L:ref):integer;
begin  Car:=L^.inf  end;

function Cdr(L:ref):ref;
begin  Cdr:=L^.next  end;

function Cons(x:integer; L:ref):ref;
var p: ref;
begin
new(p);
p^.inf:=x;
p^.next:=L;
cons:=p;
end;

Procedure Print_List(p: ref);
begin
 while p<>nil do
 begin
   write(Car(p),Strelka);
   p:=Cdr(p);
 end;
 writeln
end;

Procedure Delete(var p: ref);
var  r: ref; e:integer;
begin
 write('Vvedite E = ');
 readln(e);
{  while p<>nil do
 begin
   if p=E then write('error')
   else
     begin }
       r:=e^.next;
       e^.next:=r^.next;
       r^.next:=nil;
{      end;
 end;    }
end;

Begin
 L:=nil;
 write('Element: ');
 readln(x);
 while x<>0 do
 begin
   L:=Cons(x,L);
   write('Element: ');
   readln(x);
 end;
 Print_List(L);
 Delete(p);
 Print_List(L);
END.
 К началу страницы 
+ Ответить 
volvo
сообщение 9.05.2005 13:47
Сообщение #6


Гость






Тогда что-то вроде этого:

procedure DeleteAfter(var p: ref);
var to_delete: ref;
begin
to_delete := Crd(p);
p^.next := Crd(to_delete);
dispose(to_delete);
end;

{ А вот та самая процедура: }
Procedure Delete_After(var p: ref);
var
curr: ref;
X: integer;
begin
write('Vvedite X = '); readln(X);
curr := p;
while curr <> nil do begin
if curr^.inf = X then begin
{ если следующий есть и он не равен X ... }
if (Cdr(curr) <> nil) and (Cdr(curr)^.Inf <> X) then
DeleteAfter(curr) { ... то удалить его }
end;
curr := Cdr(curr);
end;
end;


Кстати, процедура Delete, насколько я вижу, компилироваться не будет... :no:
 К началу страницы 
+ Ответить 
Guest
сообщение 10.05.2005 6:41
Сообщение #7


Гость






Да моя процедура конечно не компилировалась.
Огромное спасибо за помощь :D !!
 К началу страницы 
+ Ответить 

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

 



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