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. }