Динамические списки

[tgig]

Ребята, помогите пжлста! Мне нужно написать подпрограмму чтобы она умела проверять есть ли в списке хотя бы два одинаковых элемента..Я тут что-то выискала, соединила но как массив впихнуть не знаю((( еще процедуры вставки элемента в начало списка и удаления всех отрицательных элементов из списка!!! Заранее спасибо...

type link=^rec;
rec=record
inf:integer;
next:link;
end;
var start,p,q:link;
ch:char;
procedure sozd;
begin
start:=nil;
end;
procedure dob;
begin
start:=nil;
repeat
new(p);
write('vvedite zha4enie:');
readln(p^.inf);
p^.next:=start;
start:=p;
writeln('else?');
readln(ch);
until ch='n';
writeln ('spisok sozdan');
end;
procedure prosmotr;
begin
p:=start;
while p<>nil do
begin
write(p^.inf);
p:=p^.next;
end;
writeln('spisok nape4atan');
end;
procedure delete_otr(var t:link);
var n:link;
begin
if t<>nil then
begin
p:=t;
while p^.next<>nil do
begin
if p^.next^.inf<0 then
begin
n:=p^.next;
p^.next:=p^.next^.next;
dispose(n);
end
else p:=p^.next;
end;
end;
end;
procedure dva_odin;
var k,i,j,n:integer;

begin
k:=0;
for i:=1 to (n-1) do
for j:=2 to n do
begin
if a[i]=a[j] then k:=k+1;
if k=2 then
begin
write('da');
exit;
end;
end;
if k<2 then write('Net');
readln;
end;
begin
repeat
writeln('1 - sozdat spisok');
writeln('2 - dobavit element v na4alo');
writeln('3 - prosmotr spiska');
writeln('4 - udalit otricat elementy');
writeln('5 - proverit na nali4ie odinak elementov');
write('vash vibor:');
readln(ch);
case 'm' of
'1': begin sozd; end;
'2': begin dob; end;
'3': begin prosmotr; end;
'4': begin delete_otr; end;
'5': begin dva_odin; end;
end;
until ch='n';

[Stilet]

проверять есть ли в списке хотя бы два одинаковых элемента

Я бы действовал примерно так:
Сделал бы функцию типа

function aga(start:^rec;value:integer):boolean;
var q:^rec;
begin aga:=false; q:=start^.next;
 while q<>nil do begin
  if q^.inf=value then begin 
   aga:=true;
   exit;
  end;
  q:=q^.next;
 end; 
end;

И в цикле ее вызывал для проверки от текущего элемента.
т.е. если функция вернет TRUE значит есть такой же элемент со значением в Value

[Anatole]

как массив впихнуть не знаю

А какой массив? И зачем его впихивать и куда? Выбросте из кода всё, что касается масива.

[Anatole]

здесь не совсем коррекктно было написано

procedure dob;
begin
{start:=nil; Это ошибочный оператор, при повторном вызове процедуры он уничтожит ранее введённые данные}
repeat
new(p);
write('vvedite zha4enie:');
readln(p^.inf);
p^.next:=start;
start:=p;
writeln('else?');
readln(ch);
until ch='n';
writeln ('spisok sozdan');
end;

Эту сточку исправте

case 'm' of

на

case ch of

Процедуру удаления отрицательных элементов со списка я бы написал так:

procedure delete_otr;
var n:link;
begin
while (start<>nil) and (start^.inf < 0) do
  begin
  n:= start;
  start:=start^.next;
  Dispose(n); 
  end;
p := start;
While p^.next <> nil do
  begin
   if p^.next^.inf < 0 then
     begin
      n:=p^.next;
      p^.next := p^.next^.next;
      Dispose(n);   
     end else p := p^.next;
  end;
end;

[tgig]

Anatole, спасибо за поправки.

Stilet! А можно поподробней в каком цикле вызвать функцию???

[Stilet]

tgig

Приблизительно так:
У тебя есть процедура dva_odin
Вот я бы ее написал так, с учетом моей функции:

procedure dva_odin;
 strt:^rec;
begin
 strt:=<голова списка>
 while strs<>nil do begin
  if aga(strt,strt^.inf) then begin
    Write('Есть повторы');
    exit;
  end;
  strt:=strt^.next;
 end;
end;

p.S. не проверял.

[tgig]

Большое спасибо, Виталий! ))) Идея ясна, щас будем пробовать)))