Welcome, guest! Login / Register - Why register?
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

Your Name: Code Language: