S01.txt
*******************************
program sub1;
type adresa=^nod;
     nod=record
               inf:integer;
               adr:adresa;
         end;
var v,sf:adresa;
    n:integer;
function prim(x:integer):boolean;
var i:integer;
    p:boolean;
begin
     p:=true;
     for i:=2 to round(sqrt(x))do
         if x mod i=0 then
            begin
                 p:=false;
                 break;
            end;
     prim:=p;
end;
procedure add_sf(x:integer);
var n:adresa;
begin
     new(n);
     n^.inf:=x;
     n^.adr:=nil;
     if v=nil then
        v:=n
     else
         sf^.adr:=n;
     sf:=n;
end;
procedure afis(v:adresa);
var nc:adresa;
begin
     nc:=v;
     while nc<>nil do
           begin
                write(nc^.inf,' ');
                nc:=nc^.adr;
           end;
     writeln;
end;
procedure pct_a;
var i,nr:integer;
begin
     nr:=0;
     add_sf(2);
     inc(nr);
     i:=1;
     while nr<n do
           begin
                inc(i,2);
                if prim(i) then
                   begin
                        add_sf(i);
                        inc(nr);
                   end;
           end;
     afis(v);
end;

procedure scrie;
var f:text;
    nc:adresa;
begin
     assign(f,'date.out');
     rewrite(f);
     nc:=v;
     while nc<>nil do
           begin
                write(f, nc^.inf,' ');
                nc:=nc^.adr;
           end;
     writeln(f);
     close(f);
end;

begin
     write('n= ');read(n);
     pct_a;

end.

S02.txt
*******************************
program sub2;
var v:array[1..100]of integer;
    cifre:array[0..9]of integer;
    r,vmin,vmax:array[1..10]of integer;
    min,max,nrmax,nrmin:integer;
    j,n,i,nrpp:integer;
procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'date.in');
     reset(f);
     read(f,n);
     for i:=1 to n do
         read(f,v[i]);
     close(f);
end;

function pp(x:integer):boolean;
begin
     pp:=int(sqrt(x))*int(sqrt(x))=x;
end;
begin
     citire;
     max:=v[1];
     min:=v[1];
     for i:=1 to n do
         begin
              if max<v[i] then
                 max:=v[i];
              if min>v[i] then
                 min:=v[i];
         end;
     nrmax:=0;
     nrmin:=0;
     repeat
           r:=max mod 10;
           inc(nrmax);
           vmax[nrmax]:=r;
           max:=max div 10;
     until max=0;
     repeat
           r:=min mod 10;
           inc(nrmin);
           vmin[nrmin]:=r;
           min:=min div 10;
     until min=0;
     for i:=0 to 9 do
         cifre[i]:=0;
     for i:=1 to nrmax do
         inc(cifre[vmax[i]);
     for i:=1 to nrmin do
         inc(cifre[vmin[i]);
     for i:=9 downto 0 do
         if cifre[i]>0 then
            for j:=1 to cifre[i] do
                write(i);
     writeln;
     for i:=1 to n do
         if pp(v[i])=true then
            inc(nrpp);
     writeln('Tabloul are ',nrpp,' patrate perfecte');
end.

S03.txt
*******************************
program sub3;
type adresa=^nod;
     nod=record
               inf:integer;
               adr:adresa;
         end;
var v,sf:adresa;
    n:integer;
procedure add_end(var v,sf:adresa;x:integer);
var n:adresa;
begin
     new(n);
     n^.inf:=x;
     n^.adr:=n;
     if v=nil then
        v:=n
     else
         sf^.adr:=n;
     sf:=n;
end;
procedure create;
var i:integer;
begin
     write('n= ');read(n);
     for i:=1 to n do
         begin
              write('x= ');read(x);
              if x>0 then
                 add_end(v,sf,x);
         end;
end;

procedure pct_a;
var f:text;
    nc:adresa;
begin
     assign(f,'date.out');
     rewrite(f);
     nc:=v;
     while nc<>nil do
           begin
                write(f,nc^.inf,'');
                nc:=nc^.adr;
           end;
     writeln(f);
     close(f);
end;

begin
     create;
     pct_a;

end.

S05.txt
*******************************
program sub5;
var v:array[1..1000]of integer;
    n:integer;
procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'date.in');
     reset(f);
     read(f,n);
     for i:=1 to n do
         read(f,v[i]);
     close(f);
end;
procedure pct_a;
var i,j:integer;
    estemultime:boolean;
begin
     estemultime:=true;
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if v[i]=v[j]then
                begin
                     estemultime:=false;
                     break;
                end;
     if estemultime then
        write('Este multime')
     else
         writeln('Nu este multime');
end;
function maxim:integer;
var i,m:integer;
begin
     m:=v[1];
     for i:=2 to n do
         if m<v[i] then
            m:=v[i];
     maxim:=m;
end;
{procedure pct_b;
const p:array[1..25]of integer=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,61,71,73,79,83,89,97);
var i,m:integr;
begin
     m:=max;
     for i:=1 to 25 do
         if m mod p[i]=0 then
            write(p[i],'');
     writeln;
end;}
begin
     citire;
     pct_a;
     {pct_b;}
     readln;
end.

S06.txt
*******************************
program sub6;
type adresa=^nod;
     nod=record
               inf:integer;
               adr:adresa;
          end;
var v,sf:adresa;
    n:integer;
function np(x:integer):boolean;
var s,i:integer;
begin
     s:=0;
     for i:=1 to x div 2 do
         if x mod i=0 then
            s:=s+i;
     np:=s=x;
end;
procedure pct_a;
var f:text;
begin
     write('n= ');read(n);
     assign(f,'date.out');
     rewrite(f);
     write(f,n,' ');
     if np(n) then
        writeln(f,'Este numer perfect')
     else
         writeln(f,'nu este numar perfect');
     close(f);
end;
procedure add_sf(x:integer);
var n:adresa;
begin
     new(n);
     n^.inf:=x;
     n^.adr:=nil;
     if v=nil then
        v:=n
     else sf^.adr:=n;
     sf:=n;
end;
procedure creare;
var i,x:integer;
begin
     for i:=1 to n do
         begin
              x:=random(1000);
              add_sf(x);
         end;
end;
procedure pct_b;
var f:text;
    nc:adresa;
begin
     assign(f,'date.out');
     append(f);
     creare;
     nc:=v;
     while nc<>nil do
           begin
                write(f,nc^.inf,'');
                nc:=nc^.adr;
           end;
     close(f);
end;
begin
     randomize;
     pct_a;
     pct_b;
end.

S07.txt
*******************************
program sub7;
var a:array[1..100,1..100]of integer;
    m,n:integer;
procedure citire;
var f:text;
    i,j:integer;
begin
     assign(f,'date.in');
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
         for j:=1 to m do
             read(f,a[i,j]);
     close(f);
end;
function invers(x:integer):integer;
var xi,r :integer;
begin
     x:=0;
     while x<>0 do
     begin
          r:=x mod 10;
          x:=x div 10;
          xi:=xi*10+r;
     end;
     invers:=xi;
end;

function prim(x:integer):boolean;
var b:boolean;
    d:integer;
begin
     b:=true;
     for d:=2 to int(sqrt(x)) do
     if x mod d = 0 then
       begin
            b:=false;
            break;
       end;
     prim:=b;
end;
procedure pct_a;
var i,j:integer;
    b:boolean;
begin
     b:=false;
     for i:=1 to n do
         for j:=1 to n do
             if (prim(a[i,])and(prim(invers(a[i,j])))then
                writeln(a[i,j],',');
     b:=true;
     if not b then
        writeln('Nu este')
end;
begin
     citire;
     pct_a;
end.

S08.txt
*******************************
program sub8;
var v:array[1..100]of integer;
    r,n:integer;
procedure citire;
var f:text;
begin
     assign(f,'date.in');
     reset(f);
     n:=0;
     while (not eof) do
           begin
                inc(n);
                read(f,v[n]);
                close(f);
           end;
end;
function prog_arit:boolean;
var i:integer;
    b:boolean;
begin
     b:=true;
     r:=v[2]-v[1];
     for i:=2 to n-1 do
         if v[i+1]-v[i]<r then
            begin
                 b:=false;
                 break;
            end;
     prog_arit:=b;
end;
procedure pct_b;
begin
     if prog_arit then
        writeln('Progr. arit. Primul termen ',v[1],' cu ratia ',r);
end;


begin
     citire;
     pct_b;
end.

S09.txt
*******************************
program sub9;
var a,at:array[1..10,1..10]of integer;
    n:integer;
procedure citire;
var i,j:integer;
    f:text;
begin
     assign(f,'date.in');
     reset(f);
     read(f,n);
     for i:=1 to n do
         for j:=1 to n do
             read(f,a[i,j]);
     close(f);
end;
procedure trans;
var i,j,t:integer;
begin
     at:=a;
     for i:=2 to n-1 do
         for j:=i+1 to n do
             begin
                  j:=at[i,j];
                  at[i,j]:=at[j,i];
                  at[j,i]:=t;
             end;
end;
procedure pct_a;
var i,j:integer;
begin
     trans;
     for i:=1 to n do
         begin
              for i:=1 to n do
                  write(at[i,j],'');
              writeln;
         end;
end;

begin
     citire;
     pct_a;
end.

S10.txt
*******************************
program sub10;
var a:array[1..20,1..20]of integer;
    n,m:integer;
procedure citire;
var f:text;
    i,j:integer;
begin
     assign(f,'date.in');
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
         for j:=1 to m do
             read(f,a[i,j]);
     close(f);
end;
procedure pct_a;
var i,j,x:integer;
begin
     write('x= ');read(x);
     for j:=x+1 to m do
         for i:=1 to n do
             a[i,j-1]:=a[i,j];
     if x<=m then
        dec(m);
     for i:=1 to n do
         begin
              for j:=1 to m do
                  write(a[i,j],'');
              writeln;
         end;
end;

begin
     citire;
     pct_a;
end.

S11.txt
*******************************
program sub11;
uses crt;
type nume=string[20];
var v:array[1..10]of nume;
    n:integer;
    s:string;
procedure citire;
var f:text;
    poz,i:integer;
begin
     assign(f,'date.in');reset(f);
     readln(f,s);
     close(f);
     s:=s+'';
     while s<>'' do
           begin
                inc(n);
                poz:=pos('',s);
                v[n]:=copy(s,^,poz-1);
                delete(s,^,poz);
           end;
end;
function majuscule(x:nume):nume;
var i:integer;
    nm:nume;
begin
     nm:='';
     for i:=1 to lenght(x) do
         nm:=nm:=upcase(x[i]);
     majuscule:=nm;
end;
procedure sort;
var i,j:integer;
    t:nume;
begin
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if majuscule(v[i])>majuscule(v[j]then
                begin
                     t:=v[i];
                     v[i]:=v[j];
                     v[j]:=t;
                end;
end;
procedure pct_a;
var i:integer;
begin
     sort;
     for i:=1 to n do
         write(v[i]+'');
     writeln;
end;
procedure pct_b;
var nf,i,l:integer;
begin
     nf:=0;
     for i:=1 to n do
         begin
              l:=lenght(v[i]);
              if upcase(v[i][l])='A' then
                 nf:=nf+1;
         end;
     writeln('sunt ',nf,' fete');
end;

begin
     citire;
     pct_a;
     pct_b;
end.

S12.txt
*******************************
program sub12;
var v:array[1..100]of longint;
    n:integer;
    cp:array[1..10]of integer;
procedure citire;
var f:text;
begin
     assign(f,'date.in');
     reset(f);
     while not eof(f) do
           begin
                inc(n);
                read(f,v[n]);
           end;
     close(f);
end;
function autopomorf(x:longint):boolean;
var p:integer;
begin
     if x<10 then
        p:=10
     else
         if x<100 then
            p:=100
         else
             if x<1000 then
                p:=1000
             else
                 if x<10000 then
                    p:=10000;
     autopomorf:=(x*(x-1)mod p=0);
end;
procedure pct_a;
var i,na:integer;
begin
     na:=0;
     for i:=1 to n do
         if autopomorf(v[i])then
            begin
                 inc(na);
                 write(v[i],' ');
            end;
     writeln;
     writeln('S-au gasit ',na,' nr');
end;
begin
     citire;
     pct_a;

end.

S14.txt
*******************************
program sub14;
var v:array[1..100] of longint;
    n:integer;
    fib:array[1..50] of longint;
procedure citire;
var f:text;
begin
     assign(f,'date14.in');
     reset(f);
     n:=0;
     while (not eof(f)) do
     begin
          inc(n);
          read(f,v[n]);
     end;
     close(f);
end;
procedure gen_fib;
var i:integer;
begin
     fib[1]:=1;
     fib[2]:=1;
     for i:=3 to 50 do
     fib[i]:=fib[i-1]+fib[i-2];
end;
procedure pct_a;
var i,j:integer;
begin
     for i:=1 to n do
     for j:=1 to 50 do
     begin
          if v[i]=fib[j]  then
          begin
               write(v[i], ' ');
               break;
           end;
      if v[i]< fib[j] then
      break;
     end;
     writeln;
end;
procedure pct_b;
var j,i,t:integer;
    tv:longint;
    uc:array[1..100] of integer;
begin
     for i:=1 to n do
     uc[i]:=v[i] mod 10;
     for i:=1 to n-1 do
     for j:= i+1 to n do
     if uc[i]> uc[j] then
     begin
          t:=uc[i]; uc[i]:=uc[j]; uc[j]:=t;
          tv:=v[i]; v[i]:=v[j]; v[j]:=tv;
      end;
          for i:=1 to n do
          write (v[i],  '  ');
      writeln;
end;
begin
     citire;
     gen_fib;
     pct_a;
     pct_b;
     readln;
end.


S15.txt
*******************************
program sub15;
var v:array[1..100] of integer;
    n:integer;
type adresa=^nod;
     nod=record
     inf:integer;
     adr:adresa;
     end;
var vf,sf:adresa;


procedure citire;
var f:text;
begin
     assign(f,'date15.in');
     reset(f);
     while not eof(f) do
     begin
         inc(n);
         read(f,v[n]);
     end;
     close(f);
end;

procedure pct_a;
var i,s:integer;
    ma:real;
begin
     s:=0;
     for i:=1 to n do
     s:=s+v[i];
     ma:=s/n;
     writeln('Media este ', ma:10:2);
end;

procedure add_sf(x:integer);
var n:adresa;
begin
     new(n);
     n^.inf:=x;
     n^.adr:=nil;
     if vf=nil then vf:=n
     else
         sf^.adr:=n;
         sf:=n;
end;

procedure  creare;
var i:integer;
begin
     for i:=1 to n do
     add_sf(v[i]);
     sf^.adr:=vf;
end;

procedure  afisare(st:adresa);
var nc:adresa;
begin
     nc:=st;
     repeat
           write(nc^.inf , ' ');
           nc:=nc^.adr;
    until nc=st;
    writeln;
end;

function adr_min:adresa;
var nm,nc:adresa; min:integer;
begin
     nc:=vf;
     min:=nc^.inf; nm:=vf;
     repeat
           if ( nc^.inf< min) then
           begin
                nm:=nc;
                min:=nc^.inf;
            end;
            nc:=nc^.adr;
    until nc=vf;
    adr_min:=nm;
end;

procedure pct_b;
var nm:adresa;
begin
     creare;
     nm:=adr_min;
     afisare(nm);
end;
begin
     citire;
     pct_a;
     pct_b;
end.

S16.txt
*******************************
program sub16;
uses crt;
var a:array[1..20,1..20]of real;
    n,m:integer;{n linii, m coloane}
procedure citire;
var i,j:integer;
    f:text;
begin
     assign(f,'date.in');
     reset(f);
     read(f,n,m);
     for i:=1 to n do
         for j:=1 to m do
             read(f,a[i,j]);
     close(f);
end;
procedure pct_a;
var i:integer;
begin
     for i:=1 to m-1 do
         write(a[1,i]:8:1);
     for i:=1 to n-1 do
         write(a[i,m]:8:1);
     for i:=n downto 2 do
         write(a[n,i]:8:1);
     for i:=m downto 2 do
         write(a[i,1]:8:1);
end;
function min(j:integer):integer;
var i,t:integer;
begin
     t:=2;
     for j:=2 to n do
         if a[i,j]<a[j,i] then
            t:=i;
     min:=t;
end;
function max(i,j:integer):boolean;
var k:integer;
begin
     max:=true;
     for k:=1 to m do
         if a[k,j]>a[i,j] then
            begin
                 max:=false;
                 break;
            end;
end;
procedure pct_b;
var i,j:integer;
begin
     for i:=1 to m do
         begin
         i:=min(j);
         if max(i,j) then
            begin
                 write(i,' ',j);
                 break;
            end;
         end;
end;

begin
     citire;
     pct_a;
     pct_b;
     readln;
end.

S17.txt
*******************************
program sub17;
var v:array[1..100] of integer;
    n:integer;
type adresa=^nod;
     nod=record
     inf:integer;
     adr:adresa;
     end;
var vf,sf:adresa;

procedure citire;
var f:text;
begin
     assign(f,'date17.in');
     reset(f);
     while not eof(f) do
     begin
          inc(n);
          read(f,v[n]);
          end;
      close(f);
end;

procedure pct_a;
var i:integer;
begin
     for i:=1 to n div 2 do
     write(v[2*i],' ');
         writeln;
end;



procedure add_vf(x:integer);
var n:adresa;
begin
     new(n);
     n^.inf:=x;
     n^.adr:=vf;
     if vf=nil then
     sf:=n;
     vf:=n;
end;

procedure creare;
var i:integer;
begin
     for i:=1 to n do
     add_vf(v[i]);
end;

procedure afisare;
var nc:adresa;
begin
     nc:=vf;
     while nc<>nil do
     begin
          write(nc^.inf, ' ');
          nc:=nc^.adr;
          end;
   writeln;
end;

procedure pct_b;
begin
     creare;
     afisare;
 end;

begin
     citire;
     pct_a;
     pct_b;
end.

S18.txt
*******************************
program sub18;
uses crt;
var v:array[1..100]of longint;
    n:integer;
    j:integer;
    f:text;

{varianta lu cristi
procedure citire;
var x:longint;

begin
     inc(j);
     write('X',j,'= ');readln(x);
     if x<> 0 then
        citire;
     if x>99 then
        begin
             inc(n);
             v[n]:=x;
       end;}

procedure pct_a;
var x:longint;
    i:integer;
begin
     repeat
           write('x= ');
           readln(x);
           if (x<>0) and (x>99) then
              begin
                   inc(n);
                   v[n]:=x;
              end;
     until x=0;
     for i:=1 to n div 2 do
         begin
              x:=v[i];
              v[i]:=v[n-i+1];
              v[n-i+1]:=x;
         end;
     assign(f,'date.out');
     rewrite(f);
     for i:=1 to n do
         write(f,v[i],' ');
         writeln(f);
     close(f);
end;
procedure pct_b;
var i,l:integer;
    s:string;
begin
     assign(f,'date.out');
     append(f);
     for i:=1 to n do
         begin
              str(v[i],s);
              l:=length(s);
              if l mod 2 = 0 then
                 delete(s, l div 2,2)
              else
                  delete(s, l div 2+1,1);
              write(f,s,'');
         end;
     close(f);
end;


begin
     pct_a;
     pct_b;

end.

S19.txt
*******************************
program sub19;
type cuvant=string[20];
     cv=record
              s:cuvant;
              l,nv:integer;
        end;
     vector=array[1..20]of cv;
var v:vector;
    n:integer;
    sir:string;
procedure citire;
var f:text;
    ps,i:integer;
begin
     assign(f,'date19.in');
     reset(f);
     readln(f,sir);
     sir:=sir+' ';
     while sir<>'' do
           begin
                ps:=pos(' ',sir);
                inc(n);
                v[n].s:=copy(sir,1,ps-1);
                delete(sir,1,ps);
           end;
end;
procedure getlim;
var i:integer;
begin
     for i:=1 to n do
         v[i].l:=length(v[i].s);
end;
procedure pct_a;
var vv:vector;
    i,j:integer;
    t:cv;
begin
     getlim;
     vv:=v;
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if vv[i].l>vv[j].l then
                begin
                     t:=vv[i];
                     vv[i]:=vv[j];
                     vv[j]:=t;
                end;
     for i:=1 to n do
         write(vv[i].s,' ');
     writeln;
end;
function maj(x:cuvant):cuvant;
var i:integer;
    nc:cuvant;
begin
     nc:='';
     for i:=1 to length(x) do
         nc:=nc+upcase(x[i]);
     maj:=nc;
end;
function nr_voc(x:cuvant):integer;
var i,nr:integer;
begin
     nr:=0;
     for i:=1 to length(x) do
         if x[i] in ['A','E','I','U'] then
            inc(nr);
     nr_voc:=nr;
end;
procedure pct_b;
var i:integer;
begin
     for i:= 1to n do
         begin
              v[i].s:=maj(v[i].s);
              v[i].nv:=nr_voc(v[i].s);
         end;
     for i:=1 to n do
         write('(',v[i].s,',',v[i].nv,')');
     writeln;
end;

begin
     citire;
     pct_a;
     pct_b;

end.

S20.txt
*******************************
program sub20;
type gap=record
     li,ls:integer;
     end;
var v:array[1..100]of gap;
    n:integer;
procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'date20.in');
     reset(f);
     read(f,n);
     for i:=1 to n do
         read(f,v[i].li,v[i].ls);
     close(f);
end;
procedure pct_a;
var i,limax,lsmin:integer;
begin
     limax:=v[1].li;
     lsmin:=v[1].ls;
     for i:=2 to n do
         begin
              if v[i].ls>limax then
                 limax:=v[i].li;
              if v[i].ls<limax then
                 lsmin:=v[i].ls;
         end;
     if limax<=lsmin then
        writeln(limax,' ',lsmin)
     else
         writeln('Nu se intersecteaza');

end;
procedure sort;
var i,j:integer;
    t:gap;
begin
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if v[i].li>v[j].li then
                begin
                     t:=v[i];
                     v[i]:=v[j];
                     v[j]:=t;
                end;
end;
procedure pct_b;
var i,lsmax,ni:integer;
begin
     ni:=1;
     lsmax:=v[1].ls;
     for i:=2 to n do
         if v[i].li>lsmax then
            begin
                 inc(ni);
                 lsmax:=v[i].ls;
            end
         else
             if v[i].ls>lsmax then
                lsmax:=v[i].ls;
     writeln(ni);
end;

begin
     citire;
     pct_a;
     sort;
     pct_b;
end.

S22.txt
*******************************
program sub22;
var a:array[1..20,1..20]of integer;
type muchie=record
                  x,y:integer;
            end;
var vm:array[1..190]of muchie;
    m,n:integer;
procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'graf22.in');
     reset(f);
     read(f,n,m);
     for i:=1 to m do
         read(f,vm[i].x,vm[i].y);
     close(f);
end;
procedure vm_ma;
var i:integer;
begin
     for i:=1 to m do
         begin
              a[vm[i].x,vm[i].y]:=1;
              a[vm[i].y,vm[i].x]:=1;
         end;
end;
procedure afis_ma;
var i,j:integer;
begin
     for i:=1 to n do
         begin
              for j:=1 to n do
                  write(a[i,j]:2);
              writeln;
         end;
end;
procedure pct_a;
begin
     citire;
     vm_ma;
     afis_ma;
end;

type varf=record
                nr,g:integer;
          end;
var vv:array[1..20]of varf;
var i,s:integer;

function grad(x:integer):integer;
var i,s:integer;
begin
     s:=0;
     for i:=1 to n do
         s:=s+a[i,x];
     grad:=s;
end;
procedure sort;
var i,j:integer;
    t:varf;
begin
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if vv[i].g<vv[j].g then
                begin
                     t:=vv[i];
                     vv[i]:=vv[j];
                     vv[j]:=t;
                end;
end;
procedure pct_b;
var i:integer;
begin
     for i:=1 to n do
         begin
              vv[i].nr:=i;
              vv[i].g:=grad(i);
         end;
     sort;
     for i:=1 to n do
         write(vv[i].nr,' ');
     writeln;
end;
begin
     pct_a;
     pct_b;
end.

S23.txt
*******************************
program sub23;
var a:array[1..20,1..20] of integer;
    n:integer;
    c,viz:array[1..20] of integer;
   li,ls:integer;

procedure citire;
var f:text;
    i,j:integer;
begin
     assign(f,'graf23.in');
     reset(f);
     read(f,n);
     for i:=1 to n do
     for j:=1 to n do
     read(f,a[i,j]);
     close(f);
end;

function nr_muchii:integer;
var i,j,s:integer;
begin
     s:=0;
     for i:=1 to n do
     for j:=1 to n do
     s:=s+a[i,j];
     nr_muchii:=s div 2;
end;

procedure pct_a;
var i,j,nrm:integer;
begin
     nrm:=nr_muchii;
     writeln('graful are' , nrm, 'muchii:, ');
     for i:=1 to n-1 do
     for j:=i+1 to n do
     if a[i,j]=1 then write('(',i,',',j,')');
     writeln;
end;


procedure pune(x:integer);
begin
        inc(ls);
        c[ls]:=x;
end;

procedure scoate(var x:integer);
begin
     x:=c[li];
     inc(li);
end;

procedure  init_coada;
begin
     ls:=0;
     li:=1;
end;

function coada_vida:boolean;
begin
     COADA_VIDA:=(li>ls);
end;

procedure BF(start:integer);
var i,j:integer;
begin
     init_coada;
     pune(start);
     viz[start]:=1;
     while ( not coada_vida)  do
     begin
          scoate(i);
          for j:=1 to n do
          if (a[i,j]=1) and (viz[j]=0) then
          begin
               pune(j);
               viz[j]:=1;
         end;
     end;
end;

procedure pct_b;
var i:integer;
begin
     bf(1);
     for i:=1 to n do
     write(c[i], ' ' );
     writeln;
end;

begin
     citire;
     pct_a;
     pct_b;
end.

S24.txt
*******************************
program sub24;
type muchie=record
     x,y:integer;
     end;
var vm:array[1..100] of muchie;
    a,ml:array[1..20,1..20] of integer;
    m,n:integer;


procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'graf24.in');
     reset(f);
     read(f,n);
     while not eof(f) do
     begin
          inc(m);
          read(f,vm[m].x,vm[m].y);
       end;
      close(f);
end;

procedure  vm_ma;
var i:integer;
begin
      for i:=1 to m do
      begin
      a[vm[i].x,vm[i].y]:=1;
      a[vm[i].y,vm[i].x]:=1;
      end;
end;

function grad(x:integer):integer;
var i,g:integer;
begin
     g:=0;
     for i:=1 to n do
     g:=g+a[i,x];
     grad:=g;
end;

procedure pct_a;
var i,g:integer;
begin
     for i:=1 to n do
     begin
          g:=grad(i);
          writeln( 'd[',i,']=',g);
     end;
end;

procedure ma_ml;
var i,j,k:integer;
begin
     ml:=a;
     for k:=1 to n do
     for i:=1 to n do
     for j:=1 to n do
     if (ml[i,j]=0) then
     ml[i,j]:=ml[i,k]* ml[k,j];
end;

procedure pct_b;
var x,y:integer;
begin
     writeln('Indicati 2 varfuri');
     write('x='); readln(x);
     write('y='); readln(y);
     if ml[x,y]=1 then
     writeln( ' fac parte din aceeasi componenta conexa ' )
     else writeln( 'Nu fac parte din aceeasi componenta conexa ');
end;

begin
     citire;
     vm_ma;
     pct_a;
     ma_ml;
     pct_b;
     readln;
end.

S25.txt
*******************************
program sub25;
type arc=record
     x,y:integer;
     end;
var a:array[1..20,1..20]of integer;
    na:array[1..20,1..190] of integer;
    m,n:integer;
    va:array[1..190] of arc;

procedure citire;
var f:text;
    i:integer;
begin
     assign(f,'graf25.in');
     reset(f);
     read(f,n,m);
     for i:= 1 to m do
     read(f,va[i].x,va[i].y);
     close(f);
end;

procedure va_ma;
var i:integer;
begin
     for i:=1 to m do
     a[va[i].x,va[i].y]:=1;
end;

procedure pct_a;
var i,j:integer;
begin
     for i:=1 to n-1 do
     for j:=i+1 to n do
     if (a[i,j]=1) and (a[j,i]=1)  then
     write('(',i,',',j,')');
     writeln;
end;

procedure va_na;
var i:integer;
begin
     for i :=1 to m do
     begin
          na[va[i].x,i]:=1;
          na[va[i].y,i]:=-1;
     end;
end;

procedure pct_b;
var i,j:integer;
begin
     for i:=1 to n do
     begin
          for j:=1 to m do
          write(na[i,j]:3);
          writeln;
    end;
end;
begin
     citire;
     va_ma;
     pct_a;
     va_na;
     pct_b;
     readln;
end.