pascal užduotis

Sveiki gal kas galėtumėt padėti pabaigti išspręsti šią užduotį? Labai ačiū.

Dalis sprendimo:

program metro;
type Tmas = array[1..100] of integer;
const n = 100;
var rf : text;
//------------------------------------------------------------------------------
procedure Duomenys ( var st, sti, stis : Tmas);
var i, m, nr, d, il, isl : integer;
  df: text;
begin
 for i := 1 to n do st[i] := 0;         //stoteliu numeriai
 for i := 1 to n do sti[i] := 0;        //ilipanciu skaicius
 for i := 1 to n do stis[i] := 0;       //islipanciu skaicius
 Assign( df, 'u1.txt'); Reset( df );
 Readln( df, m );
 for i := 1 to m do
   begin
      Readln( df, nr, d, il, isl);
       st[ nr] := 1;                     //jei stoteleje kazkas ilipo ar islipo, pradini 0 keiciame 1
      sti[ nr ] := sti[nr] + il;         // sumuojame ilipancius nr stoteleje
     stis[ nr ] := stis[nr] + isl;       // sumuojame islipancius nr stoteleje
   end;
 Close( df );
end;
//------------------------------------------------------------------------------
procedure stoteles ( st, sti, stis : Tmas);
var i : integer;
begin
 for i := 1 to n do                     //jei stoteleje ilipo ar islipo, jos reiksme 1
    if st[i]= 1 then write( rf, i:6);   // jos numeri spausdiname
 writeln( rf );
end;
//------------------------------------------------------------------------------
procedure srautas ( st, sti, stis : Tmas; var stsr : Tmas);
var i : integer;
begin


end;
//------------------------------------------------------------------------------
function Daugiausia( stsr : Tmas) : Integer;
var i, d : integer;
begin

end;
//------------------------------------------------------------------------------
function Is_viso( sti : Tmas) : Integer;
var i, s : integer;
begin

end;
//------------------------------------------------------------------------------

var st, sti, stis, stsr : Tmas;
begin
 Assign(rf,'u1rez.txt'); Rewrite( rf );
    Duomenys ( st, sti, stis );
    Stoteles ( st, sti, stis);
 close( rf );
end.

Užduotis:

program Metro;

const Fduom = 'U1.txt';
     Frez = 'U1rez.txt';
     Cm = 100;

type TMas = array[1..Cm] of integer;

var St, Din, Dout : TMas;

//------------------------------------------------------------------------------

procedure Duomenys;

var fd : text;
   m, i : integer;
   nr, d, s1, s2 : integer;

begin
for i := 1 to Cm do St[i] := 0;
Din := St; Dout := St;
assign(fd, Fduom); reset(fd);
readln(fd, m);
for i := 1 to m do begin
readln(fd, nr, d, s1, s2);
st[nr] := 1;
Din[nr] := Din[nr] + s1;
Dout[nr] := Dout[nr] + s2;
end;
close(fd);
end;

//------------------------------------------------------------------------------

procedure Stotys(var fr : text);

var i : integer;

begin
for i := 1 to Cm do
if St[i] = 1 then write(fr, i:6);
writeln(fr);
end;

//------------------------------------------------------------------------------

procedure Keleiviai(var fr : text; var A, B : TMas);

var i : integer;

begin
for i := 1 to Cm do
if St[i] = 1 then write(fr, A[i] + B[i]:6);
writeln(fr);
end;

//------------------------------------------------------------------------------

function Apsilanke : integer;

var i, dn, ds, sum : integer;

begin
dn := 0; ds := 0; sum := 0;
for i := 1 to Cm do begin
sum := Din[i] + Dout[i];
if sum > ds then begin
dn := i;
ds := sum;
end;
end;
Apsilanke := dn;
end;

//------------------------------------------------------------------------------

function Pasinaudojo : integer;

var i, dd : integer;

begin
dd := 0;
for i := 1 to Cm do
dd := dd + Din[i];
Pasinaudojo := dd;
end;

//------------------------------------------------------------------------------

var fr : text;

begin
 Duomenys;
 assign(fr, Frez); rewrite(fr);
 Stotys(fr);
 Keleiviai(fr, Din, Dout);
 writeln(fr, Apsilanke:6);
 writeln(fr, Pasinaudojo:6);
 close(fr);
 Readln;
end.

čia mano sprendimas pažėk gal kas pravers

program metro;
const Cduom = 'U1.txt';
     Crez = 'U1rez.txt';
     Cmax1 = 1000;
     Cmax2 = 100;
type masyvas = array[1..Cmax1] of integer;
var n, m, i : integer;
   E, S, St : masyvas;//E/S ijejusiu/isejusiu keleiviu skaicius S stoteles numeris
   fr : text;
{---------------------nuskaitymo procedura-------------------------------------}
procedure skaitymas;
var fd : text;
   i, d, n, ieje, iseje : integer;
begin
   assign(fd, Cduom); reset(fd);
   readln(fd, m);
   for i := 1 to m do
       begin
           readln(fd, n, d, ieje, iseje);
           St[n] := 1;
           E[n] += ieje;
           S[n] += iseje;
       end;
   close(fd);
end;
{-----funkcija skaicuojanti kiek keleiviu apsilanke kiekvienoje stotyje--------}
function keleiviai (E, S : integer): integer;
var i : integer;
begin
   keleiviai := e + s;
end;
{-------------stotele kurioje  apsilankė  daugiausia  keleivių  per  savaitę---}
function stotele : integer;
var i, max : integer;
begin
   max := 0;
   for i := 1 to Cmax2 do
       if stotele < (E[i] + S[i])
           then begin
                    stotele := i;
                    max := (E[i] + S[i])
                end;
end;
{----------kiek per savaitę iš viso žmonių mieste naudojosi metro--------------}
function metro : integer;
var i : integer;
begin
   metro := 0;
   for i := 1 to Cmax2 do
       metro += E[i];
end;
{-------------------pagrindine programa----------------------------------------}
begin
   skaitymas;
   assign(fr, Crez); rewrite(fr);
   for i := 1 to Cmax2 do
       if St[i] <> 0
           then write(fr, i, '    ');
   writeln(fr);
   for i := 1 to Cmax2 do
       if St[i] <> 0
           then write (fr, keleiviai(E[i], S[i]), '    ');
   writeln(fr);
   writeln(fr, stotele);
   writeln(fr, metro);
   close(fr);

end.

program Metro;

Const       Cduom = 'U1.txt';          //duomenø failas
           Crez  = 'U1rez.txt';       //rezultatø failas
           Cmax  = 100;

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

Var         B, F  : text;     //Rezultatø ir duomenø failo kintamieji
           n     : integer;  //Stoteliø skaièius
           islipo,           //iðlipusiø þmoniø skaièius
           ilipo,            //álipusiø þmoniø skaièius
           numeris : Mas;    //stoteles numeris

{---------------------------Funckijos ir procedûros---------------------------}
{Fukcija skaièiuojanti visø ilipusiø þmoniø skaièiø}
Function isviso : integer;
var sum, i : integer;
begin
sum := 0;                     //ilipusiø zmoniu suma
   For i := 1 to Cmax do
       sum := sum + ilipo[i];
   isviso := sum;
end;

{Skaièiuojama ir áraðoma kurioje stotelëje vaþiavo daugiausia þmoniø}
Function Daugiausia : integer;
var max, i, nr : integer;
begin
max := islipo[1] + ilipo[1];
   For i := 2 to Cmax do
       if islipo[i] + ilipo[i] > max then
       begin
           max := islipo[i] + ilipo[i];
           nr := i;
       end;
   Daugiausia := nr;
end;

{Skaièiuojama ir áraðoma kiek keleiviø praëjo pro kontrolieriø}
Procedure praejo;
var i, viso : integer;
begin
   for i := 1 to Cmax do
       if numeris[i] > 0 then
       begin
           viso := islipo[i] + ilipo[i];
           Write(F,viso:6);
       end;
       WriteLn(F);
end;

{Spausdinamos stoteles i rezultatø failà didëjimo tvarka}
Procedure Stoteles;
var i : integer;
begin
   for i := 1 to Cmax do
       if numeris[i] > 0 then
           Write(F,numeris[i]:6);
           WriteLn(F);
end;

{duomenys skaitomi ir suvedami á masyvus}
Procedure Duomenys;
var i, dien, nr, ilip, islip : integer;
begin
for i := 1 to Cmax do         //nulinami masyvai
begin
ilipo[i]  := 0;
islipo[i] := 0;
end;
   Assign(B,Cduom); Reset(B);
       ReadLn(B,n);
           For i := 1 to n do
           begin
               ReadLn(B,nr,dien,ilip,islip);
               numeris[nr] := nr;
               ilipo[nr]  := ilipo[nr] + ilip;
               islipo[nr] := islipo[nr] + islip;
           end;
   Close(B);
end;


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

begin
 Duomenys;                          //Skaitomi duomenys
 Assign(F, Crez); ReWrite(F);       { Atidaromas ir pariuoðiamas }
   Stoteles;                        { rezultatø failas skaitymui }
   Praejo;
   WriteLn(F,Daugiausia:6);
   WriteLn(F,isviso:6);
 Close(F);
end.

Ačiū labai :)

Sveiki, turiu dar vieną užduoti. Na man tai neišeina jos išspręsti, bet čia turėtu būti labai panašu kaip ir metro sprendimas. Gal kas pagelbės ir išspręs. Ačiū.

Ar niekas negalėtu išspręsti "Kolekcija" užduotį?

program kolekcija;
const duom = 'U1duom.txt';
     rez = 'U1rez.txt';
     max = 100;
type masyvas = array[1..100] of integer;
var L, J, Lm, Jm : masyvas;
   n, m : integer;
{-------------------procedura failo nuskaitymui--------------------------------}
procedure skaitymas;
var fd : text;
   i, nr, mr : integer;
begin
   assign(fd, duom); reset(fd);
   readln(fd, n, m);
   for i := 1 to n do   // nuskaitoma linos kolekcija
       begin
           read(fd, nr);
           L[nr] += 1;
       end;
   readln(fd);
   for i := 1 to m do    // nuskaitoma jurgio kolekcija
      begin
           read(fd, mr);
           J[mr] += 1;
       end;
   close(fd);
end;
{--------------mainu procedura-------------------------------------------------}
procedure mainai;
var i, nr, yra  : integer;
begin
   for i := 1 to max do
       begin
           if (L[i] > 1) and (J[i] = 0)
               then begin
                       nr := i;
                       Lm[nr] := 1;
                    end;
           if (J[i] > 1) and (L[i] = 0)
               then begin
                       nr := i;
                       Jm[nr] := 1;
                    end;
       end;
end;
{---------------------procedura failo spausdinimui-----------------------------}
procedure spausdinimas;
var fr : text;
   i : integer;
   jt, lt : boolean;
begin
   assign(fr, rez); rewrite(fr);
   jt := false;
   lt := false;
   for i := 1 to max do
      if Lm[i] = 1
       then begin
               write(fr, i, ' ');
               lt := true; // ar lina turi zaisliuku mainymuisi
            end;
   if not lt
               then write(fr, '0');
   writeln(fr);
   for i := 1 to max do
      if Jm[i] = 1
       then begin
               write(fr, i, ' ');
               jt := true; // ar lina turi zaisliuku mainymuisi
            end;
   if not jt
       then write(fr, '0');
   writeln(fr);
   for i := 1 to max do
       if (L[i] > 0) or (J[i] > 0)
           then write(fr, i, ' ');
   close(fr);
end;
begin
 skaitymas;
 mainai;
 spausdinimas;
end.