Free pascalis 2008 metu egzai

http://www.egzaminai.lt/failai/511_uzduotys_2008_VBE_IT.pdf

14 psl yra uzduotis ir reikia kaip nors ja realizuoti

as bandau bet nesigauna

program Bevardë207;

type mas= array [1..100] of integer ;

var a,b:text;

i,mars,kel,y,n,sum,sk,min,j,tarp,suma,sumis,skc:integer;

M,K,G:mas;

begin

assign(a,'U1.txt');

reset(a);

assign(b,'U1rez.txt');

rewrite(b);

readln(a,n); sum:=0;

for i:=1 to n do begin

read(a,mars,kel);

M:=mars;

K:=kel;

end;

for i := 1 to n-1 do

begin

min := i;

for j := i+1 to n do

if M[min]>M[j]

then min := j;

tarp := M;

M := M[min];

M[min] := tarp;

end;

suma:=0; writeln;

for i:=1 to n do if M<>M[i+1] then begin write(M,' ');

suma:=suma+1;

G[suma]:=M;

end;

skc:=0;

for i:=1 to suma do begin

skc:=skc+1;

for y:=1+skc to n do begin

if G=M[y] then begin sumis:=sumis+K[y];

end;

end;

writeln(' ');

write(sumis,' ');

sumis:=0;

end;

end.

Na turėtų būt geras kodas, bet netikrinau čia senesnis mano darbas ;)

program Tyrimai;

Const   Cduom = 'Duom.txt';    //Duomenø failas
       Crez  = 'rez.txt';     //Rezultatø failas
       Cmax  = 100;

Type    Mas   = array[1..Cmax] of integer;

Var     B, F : text;   //Kintamieji tekstiniams failams
       n : integer;   //Kiek stebëta marðrutø
       ilipo,         //ilipusiø ir iðlipusiø þmoniø
       islipo : Mas    // skaièius vedamas á ðiuos masyvus
{------------------------Funkcijos ir procedûros-------------------------------}
{Funkcija suskaièiuoti kuriame marðrute vaþiavo daugiausia þmoniø}
Function Daugiausia : integer;
var max, i : integer;
begin
max := 0;
   for i := Cmax downto 1 do
       if ilipo[i] >= max then
       begin
        max := ilipo[i];
        Daugiausia := i;
       end;


end;


{Marðrutai kada vaþiavo bent vienas þmogus}
Procedure BentVienas;
var i : integer;
begin
   For i := 1 to Cmax do if ilipo[i] > 0 then Write(F,i:6);
   WriteLn(F);
end;

{Procedûra raðanti á failà vaþiavusius ir iðlipusius þmones marðrutuose}
Procedure Vaziavo(A : Mas);
var i : integer;
begin
   For i := 1 to Cmax do if ilipo[i] > 0 then Write(F,A[i]:6);
   WriteLn(F);
end;

{Procedûra duomenims ir failo suvesti á masyvus}
Procedure Duomenys;
var i, mar, x : integer;
begin
Assign(B,Cduom); Reset(B);
   ReadLn(B,n);
       For i := 1 to n do
       begin
           ReadLn(B,mar,x);
           If x > 0 then ilipo[mar] := ilipo[mar] + x
                    else islipo[mar]  := islipo[mar]  + x;
       end;
Close(B);
end;


{--------------------------Pagrindinë programa---------------------------------}

begin
 Duomenys;                   {Procedûra duomenims ir failo suvesti á masyvus}
Assign(F,Crez); ReWrite(F);   {Rezultatø failo atidarymas ir peraðymas}
 Bentvienas;                 {Marðrutai kada vaþiavo bent vienas þmogus}
 Vaziavo(ilipo);             //Procedûra raðanti á failà
 Vaziavo(islipo);            //vaþiavusius ir iðlipusius þmones marðrutuose
 WriteLn(F,Daugiausia:6);    {Áraðo marðrutà kada vaþiavo daugiausia þmoniø}
Close(F);
end.

program Tyrimai;
const Cduom = 'U1.txt';
     Crez = 'U1rez.txt';
     Cmax = 100;
type masyvas = array[1..Cmax] of integer;
var A, B,C : masyvas;// A stoteles numeris, B/C ilipe/islipe keleiviai
   n : integer;
   fr : text;
{--------------------duomenų skaitymo iš failo procedūra-----------------------}
procedure skaitymas;
var i, st, kel : integer; // st stoteles nr, kel keliaiviai
   fd : text;
begin
   assign(fd, Cduom); reset(fd);
   readln(fd, n);
   for i := 1 to n do
       begin
           readln(fd, st, kel);
           A[st] := 1;
           if kel > 0
               then B[st] += kel
               else C[st] += kel;
       end;
   close(fd);
end;
{-----funkcija maršruto, kuriuo vežta daugiausia keleivių, numeriui rasti------}
function daugiausia : integer;
var i, max : integer;
begin
   max := 0;
   daugiausia := 0;
   for i := 1 to n do
       if max < B[i]
           then begin
                   max := B[i];
                   daugiausia := i;
                end;
end;
{---------------procedūra maršrutų numeriams spausdinti didėjimo tvarka--------}
procedure marsrutai;
var i : integer;
begin
   for i := 1 to Cmax do
       if A[i] <> 0
           then write(fr, '   ', i);
   writeln(fr);
end;
{---------procedura kitiems rezultatams surasyti i faila-----------------------}
procedure kiti_rezultatai;
var i : integer;
begin
   for i := 1 to Cmax do
       if A[i] <> 0
           then write(fr, '   ', B[i]);
   writeln(fr);
   for i := 1 to Cmax do
       if A[i] <> 0
           then write(fr, '   ', C[i]);
   writeln(fr);
   writeln(fr, '   ', daugiausia);
end;
begin
 assign(fr, Crez); rewrite(fr);
 skaitymas;
 marsrutai;
 kiti_rezultatai;
 close(fr);
end.