Определение количества абитуриентов, проживающих в городе Минске

procedure SpisokFromFile(var f: fl; var nach: link);
var
  flag:boolean; {true=файл существуе }
  spisok: link;
begin
  clrscr;
  flag:=true;
    write('Введите имя файла c данными: ');
    readln(FlName);
    assign(f, FlName); {существование файла не обязательно}
    reset(f);
    if IOResult<>0 then
    begin
      Writeln('Такого файла не существует, повторите ввод.');
      flag:=false;
      readln
    end;
  until flag;
    {чтение файла}
    z.next := nil; {на всякий случай...}
    if nach = nil then
    begin
      new(nach);
      nach^ := z;
      spisok := nach;
      nach^.next:=nil;
    end
    else
    begin
      new(spisok^.next);
      spisok:=spisok^.next;
      spisok^ := z;
      spisok^.next:=nil;
    end;
  end;
  close(f);
end;

uses crt;
type
       link = ^kom;
       kom  = record
               fio : string[15];
             adres : string[40];
               mat : integer;
               fiz : integer;
               rus : integer;
               srb : real;
              next : link;
          end;
       fl = file of kom;
var
     spisok, nach, nach2 : link;
                       z : kom;
           i, n, menu, m : integer;
                       a : char;
                       f : fl;
                  FlName : string;
 
{Ââîä ñïèñêà ñ êëàâèàòóðû}
procedure create(var sp1, nach1:link; var z : kom);
begin
  write('Ôàìèëèÿ È. Î. ñòóäåíòà: ');  {Ââîä äàííûõ ñ êëàâèàòóðû}
  readln(z.fio);                      {Ôàìèëèè, àäðåñà, îöåíîê ïî ïðåäìåòàì}
  write('Àäðåñ ïðîæèâàíèÿ: ');
  readln(z.adres);
  repeat
    write('Îöåíêè (ìàò, ôèçèêà, ðóññ-é) ÷åðåç ïðîáåë: ');
    readln(z.mat, z.fiz, z.rus);
  until (z.mat in [0..5])and(z.fiz in [0..5])and(z.rus in [0..5]); {ïðîâåðêà îöåíêè ïî 5-òè áàëüíîé ñèñòåìå}
  writeln;
  z.srb := (z.mat+z.rus+z.fiz)/3;       {ñðåäíèé áàëë}
  z.next := nil;
  if nach1 = nil then     {ôîðìèðîâàíèå ñïèñêà ñîãëàñíî ââåäåíûì äàííûì ñ êëàâèàòóðû}
  begin
    new(nach1);
    nach1^ := z;
    sp1 := nach1;   {çàïîìèíàåì ïåðâûé ýäåìåíò ñïèñêà}
    nach1^.next:=nil;
  end
  else
  begin
    new(sp1^.next); {âûäåëåíèå ïàìÿòè}
    sp1:=sp1^.next;  {ïåðåõîäèì ê ñëåäóþùåé ÿ÷åéêå â ñïèñêå}
    sp1^ := z;       {ïðèñâîåíèå ÿ÷åéêå ñïèñêà ââåäåíûõ äàííûõ}
    sp1^.next:=nil;
  end;
end;{ create }
 
procedure hapka;
begin
  write('|------------------------------------------------------------------------------|');
  write('|   | Ôàìèëèÿ È. Î. |         Àäðåñ ïîñòîÿííîãî ìåñòà      |    Îöåíêè :  | Ñð.|');  {Ïå÷àòü øàïêè òàáëèöè}
  write('| ¹ |   ñòóäåíòà    |                æèòåëüñòâà            |Ìàò.|Ôèç.|Ðóñ.|áàëë|');
  write('|------------------------------------------------------------------------------|');
end;
 
procedure stroka(sp1 : link);
begin
  gotoXY(5,whereY);write('|',sp1^.fio);
  gotoXY(21,whereY);write('|',sp1^.adres);          {ïå÷àòü ñòðîêè èç ñïèñêà}
  gotoXY(60,whereY);write('|  ',sp1^.mat);
  gotoXY(65,whereY);write('|  ',sp1^.fiz);
  gotoXY(70,whereY);write('|  ',sp1^.rus);
  gotoXY(75,whereY);write('|',sp1^.srb:0:2,'|');
end;
 
{Âûâîä ñïèñêà íà ýêðàí }
procedure print(nach1 : link);
var
  sp1 : link;
begin
  sp1:=nach1;
  i:=0;
  if sp1=nil then writeln('Ñïèñîê ïóñò!') {ïðîâåðêà åñëè ëè â ñïèñêå äàííûå}
  else
  hapka;
  while sp1<>nil do    {ñîáòâåííî ïå÷àòü ñïèñêà}
  begin
    i:=i+1;
    write('| ',i,')');
    stroka(sp1);
    sp1:=sp1^.next;
  end;
    write('|------------------------------------------------------------------------------|');
    writeln;
end; { print }
 
{Äîáàâëåíèå ýëåìåíòà â ñïèñîê }
procedure add(var nach1 : link; z : kom; num:integer);
var
   sp1, sp2 : link;
   i : integer;
begin
  write('Ôàìèëèÿ È. Î. ñòóäåíòà: ');  {Ââîä äàííûõ ñ êëàâèàòóðû}
  readln(z.fio);                      {Ôàìèëèè, àäðåñà, îöåíîê ïî ïðåäìåòàì}
  write('Àäðåñ ïðîæèâàíèÿ: ');
  readln(z.adres);
  repeat
    write('Îöåíêè (ìàò, ôèçèêà, ðóññ-é) ÷åðåç ïðîáåë: ');
    readln(z.mat, z.fiz, z.rus);
  until (z.mat in [0..5])and(z.fiz in [0..5])and(z.rus in [0..5]); {ïðîâåðêà îöåíêè ïî 5-òè áàëüíîé ñèñòåìå}
  z.srb := (z.mat+z.rus+z.fiz)/3;       {ñðåäíèé áàëë}
  write('Ââåäèòå ïîçèöèþ â ñïèñêå äëÿ íîâîãî ýëåìåíòà: ');
  readln(num);
  new(sp1);   {âûäåëåíèå ïàìÿòè}
  sp1^ :=z;   {äîáàâëåíèå ýëåìåíòà â ñïèñîê}
  if nach1=nil then
  begin
    nach1:= sp1;
    sp1^.next:=nil;
  end
  else
  if num=1 then       {âñòàâêà â íà÷àëî ñïèñêà ââåäåííîãî ýëåìåíòà}
  begin
    sp1^.next:=nach1;   {ñäâèãàåì ñïèñîê íà îäèí ýëåìåíòà}
    nach1:= sp1;        {äîáàâëÿåì ýëåìåíò â ñïèñîê}
  end
  else            {åñëè æå ââåäåíà íå ïåðâàÿ ïîçèöèÿ äëÿ äîáàâëåíèÿ}
  begin
    i:=0;
    sp2:= nach1;
    while (i<>num-2) and (sp2^.next<>nil) do {ïîèñê ïîçèöèè äëÿ äîáàâëåíèÿ ýëåìåíòà}
    begin
      i:= i+1;
      sp2:= sp2^.next;
    end;
    sp1^.next:=sp2^.next;
    sp2^.next:= sp1;      {äîáàâëåíèå ýëåìåíòà â ñïèñîê}
  end;
end; { add }
 
{Óäàëåíèå ýëåìåíòà èç ñïèñêà}
procedure del(var nach1 : link; num : integer);
var
   sp1, sp2 : link;
   i : integer;
begin
   if nach1<>nil then
   begin
     if num=1 then   {óäàëåíèå ïåðâîãî ýëåìåíòà èç ñïèñêà}
     begin
       sp1:=nach1;
       nach1:=nach1^.next;
       dispose(sp1);  {îñâîáîæäåíèå ïàìÿòè(óäàëåíèå ýëåìåíòà)}
     end
     else
     begin       {åñëè ââåäåíà íå ïåðâàÿ ïîçèöèÿ äëÿ óäàëåíèÿ}
       i:=0;      {èùåì ââåäåííóþ ïîçèöèþ, ÷òîáû óäàëèòü ýëåìåíò}
       sp2:=nach1;
       while (i<>num-2) and (sp2^.next<>nil) do {ïîèñê ââåäåííîé ïîçèöèè äëÿ óäàëåíèÿ ýëåìåíòà}
       begin
         i:=i+1;
         sp2:=sp2^.next;
       end;
       if sp2^.next<>nil then
       begin
         sp1:=sp2^.next;
         sp2^.next:=sp1^.next;
         dispose(sp1); {îñâîáîæäåíèå ïàìÿòè(óäàëåíèå ýëåìåíòà)}
       end;
     end;
   end;
end; { del }
 
{Ïîèñê ýëåìåíòà â ñïèñêå}
Procedure FindElement(nach : link; m : integer);
var
  sp1, sp2 : link;
  i : integer;
  z : kom;
  eps : real; {äîáàâëåíèå ïåðåìåííîé real íàèìåíîâàíèå srb, ÷òîáû ó z áûëî z.srb}
begin
  clrscr;
  eps:=0.01;  {ò.ê. ïåðåìåííûå íå öåëîãî òèïà ðàâíû áûâàþò î÷åíü ðåäêî, òî ââåä¸ì òî÷íîñòü}
  sp1 := nach;  {óêàçûâàåò íà ïåðâóþ çàïèñü}
  i:=0;
  if sp1=nil then writeln('Ñïèñîê ïóñò');
    case m of    {Ïîèñê ýëåìåíòà â ñïèñêå ïî ñîîòâåòñòâóþùåìó óñëîâèþ}
      1 : begin
            write('Ôàìèëèÿ È. Î. ñòóäåíòà: ');           {ïî ôàìèëèè}
            readln(z.fio);
            writeln;
            while sp1 <> nil do                {ïåðåáåðàåì ñïèñîê}
            begin
              if sp1^.fio = z.fio then          {åñëè íàõîäèì ñîâïàäåíèå}
              begin
                i:=i+1;                         {ïå÷àòàåì ñïèñîê}
                if i=1 then hapka;
                write('| ',i,')');
                stroka(sp1);
                sp1:=sp1^.next;
              end
              else                             {åñëè íåò äâèãàåìñÿ äàëüøå ïî ñïèñêó}
              sp1 := sp1^.next;
            end;
            if i=0 then                   {åñëè ñîâïàäåíèé íå íàéäåíî, ïå÷àòàåì íàäïèñü}
            begin
              writeln;
              writeln('Â ñïèñêå íåòó ñòóäåíòà ñ òàêîé ôàìèëèåé');
              writeln;
            end
            else
              write('|------------------------------------------------------------------------------|');
              writeln;
          end;
      2 : begin
            write('Àäðåñ ïðîæèâàíèÿ: ');                  {ïî àäðåñó}
            readln(z.adres);
            writeln;
            while sp1 <> nil do
            begin
              if sp1^.adres = z.adres then
              begin
                i:=i+1;
                if i=1 then hapka;
                write('| ',i,')');
                stroka(sp1);
                sp1:=sp1^.next;
              end
              else
                sp1 := sp1^.next;
            end;
              if i=0 then
              begin
                writeln;
                writeln('Â ñïèñêå íåòó ñòóäåíòà ñ òàêèì àäðåñîì');
                writeln;
              end
              else
                write('|------------------------------------------------------------------------------|');
                writeln;
          end;
      3 : begin
            write('Ñðåäíèé áàëë: ');                      {ïî ñðåäíåìó áàëëó}
            readln(z.srb);
            writeln;
            while sp1 <> nil do
            begin
              if abs(sp1^.srb-z.srb)<=eps then
              begin
                i:=i+1;
                if i=1 then hapka;
                write('| ',i,')');
                stroka(sp1);
                sp1:=sp1^.next;
              end
              else
                sp1 := sp1^.next;
            end;
            if i=0 then
            begin
              writeln;
              writeln('Â ñïèñêå íåòó ñòóäåíòà ñ òàêèì ñðåäíèì áàëëîì');
              writeln;
            end
            else
              write('|------------------------------------------------------------------------------|');
              writeln;
          end;
    end;
end;
 
{Ñîçäàíèå íîâîãî ñïèñêà nach2 îòñîðòèðîâàííîãî ïî àëôàâèòó (ñîðòèðîâêà ïî ôàìèëèè)}
procedure AddInSortSpisok(z: kom; var nach2: link);
var
  sp1, sp2, t: link ;
begin
  new(t);
  t^ := z; {íîâûé ýëåìåíò}
  sp1 := nach2;
  sp2 := nil;
  while (sp1<>nil) and (sp1^.fio<z.fio) do {èùåì ìåñòî ïðèâÿçêè ïî ôàìèëèè}
  begin
    sp2 := sp1;
    sp1:= sp1^.next;
  end;
  t^.next := sp1; {âñòàâêà, ïðèâÿçêà íà íóæíîå ìåñòî "ìåæäó" p è pr}
  if sp2 = nil then nach2 := t {áóäåò ïåðâûé ýë-ò â ñïèñêå}
              else
                sp2^.next := t;
end;
 
{Ñîðòèðîâêà ñïèñêà nach2 èç ñòóäåíòîâ ïðîæèâàþùèõ â Ìèíñêå è ñî ñðåäíèì áàëîì âûøå 4}
procedure NewSpisokPorjadok(nach : link; var nach2 : link); {Íîâûé ñïèñîê}
var
  sp1 : link; {Óêàçàòåëåì íà íà÷àëî nach2 òîëüêî ñî ñòóäåíòàìè Ìèíñêà ïî âîçðàñòàíèþ ôàìèëèè}
begin
  nach2 := nil;  {Íîâûé óïîðÿäî÷åííûé ñïèñîê}
  sp1:= nach;
  while sp1 <> nil do
  begin
    z := sp1^;
    if (z.srb>=4) and (pos('Minsk',z.adres) > 0) then  {Îïðåäåëåíèå êîëè÷åñòâà àáèòóðèåíòîâ,}
    AddInSortSpisok(z, nach2);                            {ïðîæèâàþùèõ â ãîðîäå Ìèíñêå}
    sp1:= sp1^.next;                              {è ñäàâøèõ ýêçàìåíû ñî ñðåäíèì áàëëîì íå íèæå 4}
  end;
end;
 
{Îòêðûâàåò ñïèñîê èç ôàéëà}
procedure SpisokFromFile(var f: fl; var nach: link);
var
  flag:boolean; {true=ôàéë ñóùåñòâóå }
  sp1: link;
begin
  clrscr;
  repeat
    flag:=true;
    write('Ââåäèòå èìÿ ôàéëà c äàííûìè: ');
    readln(FlName);
    assign(f, FlName); {ñóùåñòâîâàíèå ôàéëà íå îáÿçàòåëüíî}
    reset(f);
    if IOResult<>0 then
    begin
      writeln('Òàêîãî ôàéëà íå ñóùåñòâóåò, ïîâòîðèòå ââîä.');
      flag:=false;
    end;
  until flag;
  nach := nil;
  sp1:= nil;
  while not eof(f) do       {ôîðìèðîâàíèå ñïèñêà èç ôàéëà}
  begin
    read(f, z);    {÷òåíèå ôàéëà}
    z.next := nil; {íà âñÿêèé ñëó÷àé...}
    if nach = nil then
    begin
      new(nach);
      nach^ := z;
      sp1 := nach;
      nach^.next:=nil;
    end
    else
    begin
      new(sp1^.next);
      sp1:=sp1^.next;
      sp1^ := z;
      sp1^.next:=nil;
    end;
  end;
  close(f);
end;
 
{Ñîõðàíÿåò ñïèñîê â ôàéë}
procedure SpisokToFile(var f: fl; var nach: link);
var
  sp1: link;
begin
  clrscr;
  write('Ââåäèòå èìÿ ôàéëà c äàííûìè: ');
  readln(FlName);
  assign(f, FlName); {ôàéë ìîæåò è íå ñóùåñòâîâàòü}
  rewrite(f);         {åñëè â ñïèñêå áûëè äàííûå, îíè áóäóò çàìåíåíû íîâûìè, ñòàðûå óòåðÿíû}
  sp1:= nach;
  while sp1<>nil do   {ñîõðàíåíèå ñïèñêà â ôàéë}
  begin
    z := sp1^;
    write(f, z);
    sp1:=sp1^.next;
  end;
  close(f);
end;
 
begin
  clrscr;
  nach := nil;
  spisok:= nil;
  menu:=1;
  while menu<>0 do
  begin
    writeln('1 - Ôîðìèðîâàíèå ñïèñêà.');
    writeln('2 - Âûâîä ñïèñêà íà ýêðàí.');
    writeln('3 - Äîáàâëåíèå ýëåìåíòà â ñïèñîê.');
    writeln('4 - Óäàëåíèå ýëåìåíòà èç ñïèñêà.');
    writeln('5 - Ïîèñê ýëåìåíòà ñïèñêà ïî ñîîòâåòñòâóþùåìó ïîëþ.');
    writeln('6 - Ñîðòèðîâêà ñïèñêà ïî àëôàâèòó (Ñòóäåíòû èç Ìèíñêà ñäàâøèå ýêçàìåíû âûøå 4).');
    writeln('7 - Çàïèñü â ôàéë è çàãðóçêà èç ôàéëà.');
    writeln('0 - Âûõîä');
    writeln;
    write('Ââåäèòå ïóíê ìåíþ: ');
    readln(menu);
    if (menu in [1..7,0]) then {ïðîâåðêà ïðàâèëüíîñòè ââîäà äàííûõ}
    begin
      case menu of  {Îñíîâíîå ìåíþ ïðîãðàììû}
        1 : begin
              clrscr;
              repeat
                create(spisok,nach,z);
                write('Äëÿ âûõîäà íàæìèòå E èëè e');
                readln(a);
              until (a = 'E') or (a = 'e');
            end;
        2 : begin
              clrscr;
              print(nach);
            end;
        3 : begin
              add(nach,z,n);
              writeln;
            end;
        4 : begin
              writeln;
              write('Ââåäèòå íîìåð ýëåìåíòà, êîòîðûé íåîáõîäèìî óäàëèòü: ');
              readln(n);
              writeln;
              del(nach,n);
            end;
        5 : begin
              clrscr;
              writeln('Âûáèðèòå ïîëå ïî êîòîðîìó íåîáõîäèìî ïðîèçâåñòè ïîèñê: ');
              writeln;
              writeln('1 - Ïîèñê ïî Ôàìèëèè.');
              writeln('2 - Ïîèñê ïî Àäðåñó.');
              writeln('3 - Ïîèñê ïî Ñðåäíåìó áàëëó.');
              writeln('0 - Âûõîä.');
              writeln;
              repeat
                write('Âûáåðèòå ïóíê ìåíþ: ');
                readln(m);
                writeln;
                if m in [1..3,0] then
                begin
                  case m of
                    1 : FindElement(nach,m);
                    2 : FindElement(nach,m);
                    3 : FindElement(nach,m);
                  end;
                end
                else
                begin
                  writeln('Äîñòóïíû òîëüêî ïóíêòû 1, 2, 3, 0'); {Ïîäìåíþ ïðîãðàììû}
                  writeln;
                end;
              until m in [1..3,0];
            end;
        6 : begin
              clrscr;
              AddInSortSpisok(z,nach2);
              NewSpisokPorjadok(nach,nach2);
              if nach2 = nil then
              begin
                writeln('Ñïèñîê íå ñîäåðæèò Ìèí÷àí ñ ñðåäíèì áàëëîì âûøå 4');
                writeln;
              end
              else
              begin
                writeln('         Ñïèñîê ñòóäåíòîâ Ìèí÷àí ñî ñðåäíèì áàëëîì âûøå 4 ïî ýêçàìåíàì:');
                print(nach2);
              end;
            end;
        7 : begin
               clrscr;
               repeat
                 writeln('1 - Îòêðûòü ôàéë');
                 writeln('2 - Ñîõðàíèòü ôàéë');
                 writeln;
                 write('Âûáåðèòå äåéñòâèå ñ ôàéëîì: ');
                 readln(m);
                 if m in [1,2] then {Ïîäìåíþ ïðîãðàììû}
                 begin
                   case m of
                     1 : SpisokFromFile(f,nach);
                     2 : SpisokToFile(f,nach);
                   end;
                 end
                 else
                   begin
                     writeln;
                     writeln('Íå âåðíûé ââîä, äîòóïíû òîëüêî ïóíêòû 1, 2');
                     writeln;
                   end;
                 writeln;
               until m in [1,2];
            end;
      end; {case}
    end
    else
    begin
      writeln;
      writeln('Äîñòóïíû òîëüêî ïóíêòû ìåíþ 1,2,3,4,5,6,7,0');
      writeln;
    end;
  end; {while}
end.