All pastes #440898 Raw Edit

Unnamed

public text v1 · immutable
·published 2007-04-15 11:23 UTC
rendered paste body
program VienpusisSarasas;
{--------------------------------------------------------------------------------}
type list=^cell;
     cell=record
            inf:integer;  // informacija
           next:list;     // kitas elementas
            key:integer;  // raktas
           end;
{--------------------------------------------------------------------------------}
procedure Create(var vStart:list; limit:integer; var count:integer); //procedura sugeneruoja sarasa limit dydzio su elementais nuo 1 iki limit
   var i:integer;
       vTemp:list;
    begin
    New(vTemp);
    vStart:=vTemp;
    vTemp^.inf:=1;
    vTemp^.key:=1;
    count:=1;
    for i:=2 to limit do
      begin
      new(vTemp^.next);
      vTemp:=vTemp^.next;
      vTemp^.inf:=i;
      vTemp^.key:=i;
      count:=count+1;
      end;
    end;
{--------------------------------------------------------------------------------}
procedure PushDown(var vStart:list; key:integer; var count:integer);
   var i:integer;
       vTemp,vFwd,vPrev:list;
 begin
    if key>count then Writeln('Sarase nera tiek elementu.') else begin   //apsauga nuo blogo indekso
    New(vTemp);
    New(vFwd);
    New(vPrev);
    vTemp:=vStart;

    if key=1 then //bus du variantai: kai naikinamas 1as elementas, ir kai naikinami visi elementai
    begin
     for i:=2 to count do  //ciklas skirtas eiles numeriams normalizuoti
      begin
      vStart:=vStart^.next; //iskart pereina prie antro nes pirma ir taip reikes trinti
      vStart^.key:=vStart^.key-1;
      end;
     vStart:=vTemp;  //gryztama prie pirmo elemento kad butu galima ji istrinti
   //  Dispose(vStart);
     New(vStart);

     vStart:=vTemp^.next; //dabar pirmas elementas yra buves antras elementas
    end else //antars variantas:kai trinamas ne pirmas elementas
    begin

     for i:=1 to key-1 do  // key-1 nes jei reiktu pirmo elemento tai nieko daryt nereiktu //surandamas tas elementas
      begin
      vPrev:=vStart;
      vStart:=vStart^.next;
      end;
      
      vPrev^.next:=vStart^.next;  //nurodo kad elementas esantis pries istrintaji elementa rodys i elementa esanti po istrintojo elemento
      vFwd:=vStart;      //nukopijuoja vStart i vFwd kad vFwd galetu normalizuoti likusi sarasa, taip nepakeiciant vStart kuris dar bus reikalingas dispousinant elementa, ir vTemp, kuris bus reikalingas grazinant sarasa i pradzia
      
      for i:=key to count-1 do //normalizuoja
      begin
      vFwd:=vFwd^.next;
      vFwd^.key:=vFwd^.key-1;
      end;
      
      Dispose(vStart);   //atlaisvina cele ir grazina vStart i pradzia
      New(vStart);
      
      vStart:=vTemp;
    end;
    count:=count-1;
   end;
 end;
{--------------------------------------------------------------------------------}
procedure Destroy(var vStart:list; var count:integer); //count variable nes kad butu aisku kad elementu liko 0
  var vTemp:list;
          i,strong_count:integer;
 begin
  New(vTemp);
 if count=1 then   // jei vienas elementas
  begin
  Dispose(vStart);
  count:=count-1;
 end else
 begin
  if count>1 then  //jei daugiau nei vienas elementas
   strong_count:=count; //kad nesukliudytu pilnai atlikti ciklo
  for i:=1 to strong_count do
   begin
    vTemp:=vStart;
     if i<>strong_count then vStart:=vStart^.next;
    Dispose(vTemp);
    count:=count-1;  //kad butu aiskiau
   end;
  end;
  Dispose(vStart);
 end;
{--------------------------------------------------------------------------------}
var vStart:list;
     count:integer;
{--------------------------------------------------------------------------------}
begin
  Create(vStart, 8000,count);
  PushDown(vStart, 2, count);
  WriteLn(vStart^.next^.inf);
  Destroy(vStart,count);
  ReadLn();
end.
{
Sudaryti vienpusi saraša. Parašyti paprograme, kuri iš sarašo pašalina eiles numeriu nurodyta sarašo elementa.
Jeigu saraše nera tiek elementu, turi buti išvestas atitinkamas pranešimas.
}