Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by kenny ( 15 years ago )
program L14_17;
uses crt;
type
pt=^spisok;
spisok=record
data:integer;
next:pt;
end;
var
t,first:pt;
c,a:integer;
procedure d_spisok(var first,t:pt);
var
n,i:integer;
Begin
If t=nil then {esli spisok pust}
begin
new(t);
first:=t;
Writeln('Vvedite chislo');
Read(t^.data);
t^.next:=nil;
end
else {esli v spiske uzhe est elementy}
Begin
New(t^.next);
t:=t^.next;
t^.next:=nil;
Writeln('Vvedite chislo');
Read(t^.data);
end;
Writeln('Element dobavlen');
end;
procedure prosmotr_spiska(var first,t:pt);
Begin
t:=first; {prosmatrivaem spisok s pervogo elementa}
while t<>nil do
Begin
Writeln(t^.data,'');
t:=t^.next; {perehodim na sleduyushiy element}
end;
end;
procedure empty(var t:pt);
begin
t:=nil;
end;
function search(t:pt; a:integer):pt; {vozvrashaet ukazatel na ickomiy element}
Begin
if t=nil then
search:=nil
else
Begin
while (t^.data<>a) and (t<>nil) do {idem po spisku poka ne naidem iskomiy element}
t:=t^.next;
search:=t;
end;
end;
procedure delete(var t:pt; a:integer);
var
s,right: pt;
begin
if t=nil then
writeln('Spisok pust')
else
begin
s:=search(t,a); {s - ukazatel na iskomiy element spiska}
if s=nil then
writeln('Takoy element ne naiden')
else
begin
right:=s^.next; {perenosim v right pravuyu chast spiska}
if t<>s then {esli element ne perviy}
begin
while t^.next<>s do
t:=t^.next;
t^.next:=right;
end
else {esli element perviy}
first:=right;
Writeln('Element udalen');
end;
end;
end;
procedure podschet(var t:pt; a:integer);
var
temp:integer;
begin
t:=first;
if t=nil then
writeln('Spisok pust')
else
begin
temp:=0;
While t<>nil do
Begin
if t^.data=a then
temp:=temp+1;
t:=t^.next;
end;
Writeln('Kolichestvo takih elementov v spiske=',temp);
end;
end;
Begin
clrscr;
while true do
Begin
Writeln('1-sozdanie pustogo spiska 2-dobavlenie elementa v spisok 3-prosmotr spiska');
Writeln('4-udalenie zadannogo elementa 5-podschet vhozhdeniy elemnta 0-vihod iz programmi');
Read(c);
clrscr;
case c of
1: Begin
empty(t);
Writeln('Spisok sozdan');
end;
2: d_spisok(first,t);
3: prosmotr_spiska(first,t);
4: Begin
Writeln('Kakoy element nado udalit?');
Read(a);
t:=first;
delete(t,a);
end;
5: Begin
Writeln('Kakie element nado poschitat?');
Read(a);
podschet(t,a);
end;
0: exit
else
Writeln('Takoi komandy net');
end;
Readkey;
clrscr;
end;
readkey;
end.
Revise this Paste