01 семестр / К экзамену-зачёту / Все задачи с экзамена в формате PAS / Alex / HZ

program b5;
uses crt;

type
t = ^elem;
elem = record
       i:    real;
       next: t;
       end;

procedure AddElem(var beg:t; val:real);
var
x:t;
begin
     New(x);
     x^.next := beg;
     beg := x;
     x^.i := val;
end;

function GetNum(beg:t):word;
var
i:word;
x:t;
begin
     x := beg;
     i := 0;
     while x^.next <> nil do
     begin
           x := x^.next;
           inc(i);
      end;
      GetNum := i+1;
end;

function GetVal(beg:t; i:word):real;
var
n:word;
x:t;
begin
      x := beg;
      for n := 2 to i do
           x := x^.next;
      GetVal := x^.i;
end;

procedure DeleteRand(var beg:t; i:word);
var
n:word;
x,prev:t;
begin
     if i = 1 then
     begin
          x := beg^.next;
          Dispose(beg);
          beg := x;
     end
     else
     begin
          x := beg;
          for n := 2 to i do
          begin
               prev := x;
               x := x^.next;
          end;
          prev^.next := x^.next;
          Dispose(x);
     end;
end;

var
i,n:word;
beg:t;
r:real;
begin
     clrscr;
     write('‚ўҐ¤ЁвҐ Є®«-ў® н«Ґ¬Ґ­в®ў б⥪ : ');
     readln(i);

     beg := nil;

     for n := 1 to i do
     begin
          write('‚ўҐ¤ЁвҐ н«Ґ¬Ґ­в #',n,': ');
          readln(r);
          AddElem(beg,r);
     end;

     for n := 1 to i do
         if GetVal(beg,n) < 0 then
         begin
              DeleteRand(beg,n);
              dec(n);
         end;

     writeln('ЌҐ®ваЁж вҐ«м­лҐ:');
     for n := 1 to GetNum(beg) do
          writeln(GetVal(beg,n):5:3);
end.