стеки (большой код прилагаеться)

[mishammm]

всем привет, мне нужно было сделать такую вот програмку: нужно было в табличке вывести всех студентов средняя оценка которых выше 4, но всё это нужно было сделать в стеках.
вот моя програмка:
{$r-}

uses crt;
type ptr=^item;
     item=record
       data:string;
       next:ptr;
       end;
    masiv=array[1..1] of integer;
    matrix=array[1..1] of string;
    mas=^masiv; mat=^matrix;
var head,current:ptr;
    str:string;
    n,i:integer;
    key:char;
    ma,pr,oc,ag:mas; prz:mat;
    a,b,c,d:real;





procedure enter(val:string);
 begin
  new(current);
  current^.data:=val;
  current^.next:=head;
  head:=current;
 end;




procedure entmas(var v:mas);
 begin
  getmem(v,n*sizeof(integer));
  writeln('‚ўe¤iвм oжi*ЄЁ § ЇаҐ¤¬Ґвг');
  for i:=1 to n do readln(v^[i]);
end;
procedure del(var val:string);
 begin
  current:=head;
  val:=head^.data;
  head:=current^.next;
  dispose(current);
  end;



procedure lin;
 var i:integer;
 begin for i:=1 to 64 do write('_');
 writeln; end;




procedure lin2;
 var i:integer;
 begin for i:=1 to 64 do write('=');
 writeln;
  end;



function rah(h:mas):real;
var i,s:integer;
 begin s:=0;
 for i:=1 to n do begin
  s:=s+h^[i];
  end;
 rah:=s/n;
  end;

  function rah2(q:mas):real;
  var i,s:integer;
  begin
  s:=0;
  for i:=1 to  n do
  begin
  If (q^[i]>=4)  then
  s:=s+q^[i];
  end;
  rah2:=s/n;
  end;

BEGIN

clrscr;
head:=nil;
repeat
clrscr;
writeln('1. vvod');
writeln('2. vivod');
writeln('3. ‚sortirovka stydentov');
writeln('4. vixod);
key:=readkey;
case key of
 '1':begin
     writeln('vvedi kilkist stydentiv');
     readln(n);
     for i:=1 to n do begin
      writeln('vvedi prizv stydenta');
      readln(str);
      enter(str); end;
      writeln('vvedite ocenki');
      entmas(ma); entmas(pr); entmas(oc); entmas(ag);
     end;



 '2':begin
     lin2;
     getmem(pr,n*sizeof(integer));
     write('||   Familiya    || ');
     for i:=1 to n do begin
      del(str); prz^[i]:=str;
      end;

      for i:=n downto 1 do begin write(prz^[i]:12);
      write(' | ');
      end;

      writeln('seredne');


     writeln;
     lin;
     write('||  matanaliz  ||');
     for i:=1 to n do begin
      write(ma^[i]:12,' | ');

     end;

      write(' ',rah(ma):3:2,' |');

     writeln;
     lin;
     write('|| programirovaie ||');
     for i:=1 to n do begin
      write(pr^[i]:12,' | ');
     end;

      write(' ',rah(pr):3:2,' |');

     writeln;
     lin;
     write('||       Os      ||');
     for i:=1 to n do begin
      write(oc^[i]:12,' | ');
     end;

       write(' ',rah(oc):2:2,' |');
     writeln;
     lin;
     write('||    Algebra    ||');
     for i:=1  to n do write('             | ');
     writeln;
     write('||  i geometria  ||');
     for i:=1 to n do begin
      write(ag^[i]:12,' | ');



     end;

       write(' ',rah(ag):3:2,' |');

     readln;
     end;





 '3':begin

 lin2;
     getmem(pr,n*sizeof(integer));
     write('||   familiya   || ');
     for i:=1 to n do begin
      del(str); prz^[i]:=str;
      end;

      for i:=n downto 1 do begin write(prz^[i]:12);
      write(' | ');
      end;

      writeln('seredne');


     writeln;
     lin;
     write('||  matanaliiz  ||');
     for i:=1 to n do begin
      write(ma^[i]:12,' | ');

     end;

      write(' ',rah(ma):3:2,' |');

     writeln;
     lin;
     write('|| proga ||');
     for i:=1 to n do begin
      write(pr^[i]:12,' | ');
     end;

      write(' ',rah(pr):3:2,' |');

     writeln;
     lin;
     write('||       Ћ‘      ||');
     for i:=1 to n do begin
      write(oc^[i]:12,' | ');
     end;

       write(' ',rah(oc):2:2,' |');
     writeln;
     lin;
     write('||    Ђ«ЈҐЎа*    ||');
     for i:=1  to n do write('             | ');
     writeln;
     write('||  i ЈҐ®¬Ґваiп  ||');
     for i:=1 to n do begin
      write(ag^[i]:12,' | ');



     end;

       write(' ',rah(ag):3:2,' |');

     readln;
     end;
    end;

until key='4';

END.

но выводит ту самую таблику, не сортирует ее либо выбивает ошибку на dispose(current) плиз помогите мне разобраться. спасибо

[Stilet]

Мне кажется эта программа совсем никуда не годится, и ее нужно переписать наново полностью.
Предлагаю пересмотреть решения на основе этого:
http://www.programmersforum.ru/showthread.php?t=83300

[mishammm]

uses 
    crt;
    const 
          n=4;
          
    
type

    pitem = ^item;
 
    item = record
        data: integer;
        prev: pitem;
        next:pitem;
    end;
    
    student=record
     N:byte;
     Prizv:string[20];
     matan:byte;
     prog:byte;
     OS:byte;
     alg:byte;
     end;
 
var
    top, p: pitem;
     k: integer;
     tabl:array[1..n] of student;
    key:char;
   znach1:integer; st:pitem;
    i:integer;
    
     
     
      
 
procedure add(top:pitem; el:integer);
begin
    new(p);
    top:=nil;
    p^.data := el;;
    p^.next := top;
    top := p
end;


procedure Line(m:integer);
var i:integer;
begin
for i:=1 to m do
write('-');
writeln;
end;





procedure print;
begin
    
    p := top;
    while p <> nil do begin
        
        p := p^.next;
    end;
    writeln;
end;

BEGIN
 top := nil;
  repeat
   writeln('1) add elements');
   writeln('2) output');
   writeln('3) exit');
   writeln('press key 1..3');
   key:=readkey;
   case key of
   '1':begin
   
   for i:=1 to  n do
   begin
   writeln('enter data item' , i);
   
   
    tabl[i].N := i;
      readln(tabl[i].Prizv, tabl[i].matan, tabl[i].prog, tabl[i].OS, tabl[i].alg);
      add(znach1,st);
      end;
          End;

вот так попробывал написать. но надо только процедуру добавления переделать. не могли бы мне помочь кто пожалуйста. у меня процедура стирает все данные и нужно опять вводить новые, а надо чтобы оно к существующеим элементам добавляло новык элементы

[Son Of Pain]

Видимо, процедура добавления должна выглядеть так )

procedure add(var top:pitem; el:integer);
begin
	new(p);
	p^.next:=top;
	p^.prev:=nil;
	p^.data := el;
	if top <> nil then
		top^.prev := p;
	top := p;
end;

[mishammm]

спасибо помогите плиз еще тут с одной ошибкой у меня на этой строке

add(znach1,st);

выбивает Нельзя преобразовать тип integer к ^item. в коде выше написано каким типом я обьявлял эти 2 переменные. спасибо![/QUOTE]

[Son Of Pain]

Поменяй параметры местами.

[mishammm]

спасибо,заработало, но процедура всё же не работает. оно опять вводит данные стирая прошлые а нужно чтобы добавило новые к существующим (
ввели данные, фамилию и 4 оценки. нажали на 2 вывело основную таблицу и по условию отсортированную, дальше нам нужно снова нажать на 1 чтобы ввести дополнительные данные а оно стирает всё и по новой

[Son Of Pain]

Покажи код полностью.
В том куске, который есть выше, переменные znach1 и st нигде не инициализируются, как минимум.

[mishammm]

вот код целиком:

uses 
    crt;
    const 
          n=4;
          
    
type

    pitem = ^item;
 
    item = record
        data: integer;
        prev: pitem;
        next:pitem;
    end;
    
    student=record
     N:byte;
     Prizv:string[20];
     matan:byte;
     prog:byte;
     OS:byte;
     alg:byte;
     end;
 
var
    top, p: pitem;
     k: integer;
     tabl:array[1..n] of student;
    key:char;
   znach1:integer; st:pitem;
    i:integer;
    
     
     
      
 
procedure add(top:pitem; el:integer);
begin
    new(p);
p^.next:=top;
P^.prev:=nil;
    p^.data := el;;
   If top <>nil then
   top^.prev:=p;
   top:=p;
end;


procedure Line(m:integer);
var i:integer;
begin
for i:=1 to m do
write('-');
writeln;
end;





procedure print;
begin
    
    p := top;
    while p <> nil do begin
        
        p := p^.next;
    end;
    writeln;
end;

BEGIN
 top := nil;
  repeat
   writeln('1) add elements');
   writeln('2) output');
   writeln('3) exit');
   writeln('press key 1..3');
   key:=readkey;
   case key of
   '1':begin
   
   for i:=1 to  n do
   begin
   writeln('enter data item' , i);
   
   
    tabl[i].N := i;
      readln(tabl[i].Prizv, tabl[i].matan, tabl[i].prog, tabl[i].OS, tabl[i].alg);
      add(st,znach1);
      end;
          End;
          
          
          
          
          
          
      '2':begin
      Line(69);
  writeln('|   | Призвіще | Matematuchnuy | Programyvannya | OS | Algebra | cer|');
  writeln('|   |          |    analis     |                |    |  i geom.|    |');
  Line(69);
  
  for i := 1 to n do
  begin
  print;
  
  write('|', tabl[i].N: 2, ' |', tabl[i].Prizv: 10, '|');
    write(tabl[i].matan: 15, '|', tabl[i].prog: 16, '|', tabl[i].OS: 4, '|', tabl[i].alg: 9, '|',
     ((tabl[i].matan + tabl[i].prog + tabl[i].OS + tabl[i].alg) / n): 0: 2, '|');
    writeln;
    Line(69);
  end;
  writeln;
  writeln('vidcortov');
  Line(69);
  for i := 1 to n do
  begin
    if ((tabl[i].matan + tabl[i].prog + tabl[i].OS + tabl[i].alg) / 4 >= 4) then
    begin
      write('|', tabl[i].N: 2, ' |', tabl[i].Prizv: 10, '|');
      write(tabl[i].matan: 15, '|', tabl[i].prog: 16, '|', tabl[i].OS: 4, '|', tabl[i].alg: 9, '|', ((tabl[i].matan + tabl[i].
      prog + tabl[i].OS + tabl[i].alg) / n): 0: 2, '|');
      writeln;
      Line(69);
    end;
  end;
  
     End;
     end;
     until key= '3';
     End.

я вызвал в 1 пункте меню процедуру add после считывание данных

[Son Of Pain]

1) Должно быть

procedure add(var top:pitem; el:integer);

2) все же определись, что ты добавляешь: вместо st должно быть top, а вместо znach1 - не понятно что )
3) процедура print пустая, это так задумано?