Logo referatele carte



loading...


Toate programele Pascal rezolvate - BAC







program cn1;

uses crt;

var n:longint;

begin

  clrscr;

  write('n=');readln(n);

  write('Cifrele numarului in ordine inversa sunt ');

  while n<>0 do begin

                  write(n mod 10,' ');

                  n:=n div 10

                end;

  readln;

end.

program cn2;

uses crt;

var n:longint;

    s,k:integer;

begin

  clrscr;

  write('n=');readln(n);

  s:=0;

  k:=0;

  while n<>0 do begin

                  k:=k+1;

                  s:=s+n mod 10;

                  n:=n div 10

                end;

  writeln('Numarul are ',k,' cifre');

  writeln('Suma cifrelor numarului este ',s);

  readln;

end.

program np1;

uses crt;

var n,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Divizorii sunt ');

  for i:=1 to n do if n mod i=0 then write(i,' ');

  readln;

end.

program np2;

uses crt;

var n,i:integer;

    prim:boolean;

begin

  clrscr;

  write('n=');readln(n);

  prim:=true;

  for i:=2 to round(sqrt(n)) do if n mod i=0 then prim:=false;

  if prim then write('Nr este prim')

          else write('Nr nu este prim');

  readln;

end.

program np3;

uses crt;

var n,k,i:integer;

    prim:boolean;

begin

  clrscr;

  write('n=');readln(n);

  write('Numerele prime mai mici decat ',n,' sunt ');

  for k:=2 to n-1 do

    begin

      prim:=true;

      for i:=2 to round(sqrt(k)) do if k mod i=0 then prim:=false;

      if prim then write(k,' ')

    end;

  readln;

end.

program np4;

uses crt;

var n,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Factorii primi sunt ');

  i:=1;

  while n<>1 do begin

                  i:=i+1;

                  while n mod i=0 do begin

                                       write(i,' ');

                                       n:=n div i

                                     end

                end;

  readln;

end.

program as1;

uses crt;

var n,p,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  p:=1;

  for i:=2 to n do p:=p*i;

  write(n,'! este ',p);

  readln;

end.

program as2;

uses crt;

var n,s,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  s:=0;

  for i:=1 to n do s:=s+i;

  write('Suma este ',s);

  readln;

end.

program as3;

uses crt;

var n,s,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  s:=0;

  for i:=1 to n do s:=s+i*i;

  write('Suma este ',s);

  readln;

end.

program as4;

uses crt;

var n,s,p,i,j:integer;

begin

  clrscr;

  write('n=');readln(n);

  s:=0;

  for i:=1 to n do begin

                     p:=1;

                     for j:=2 to i do p:=p*j;

                     s:=s+p

                   end;

  write('Suma este ',s);

  readln;

end.

program as5;

uses crt;

var x,n,p,i:integer;

begin

  clrscr;

  write('x=');readln(x);

  write('n=');readln(n);

  p:=1;

  for i:=1 to n do p:=p*x;

  write('Rezultatul este ',p);

  readln;

end.

program as6;

uses crt;

var a,b,aux:integer;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  aux:=a;

  a:=b;

  b:=aux;

  writeln('a=',a);

  writeln('b=',b);

  readln;

end.

program as7;

uses crt;

var a,b,c,max,min:integer;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  write('c=');readln(c);

  if a>b then max:=a

         else max:=b;

  if max<c then max:=c;

  if a<b then min:=a

         else min:=b;

  if min>c then min:=c;

  write('Rezultatul expresiei este ',max-min);

  readln;

end.

program as8;

uses crt;

var a,b,c,d:integer;

    x1,x2:real;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  write('c=');readln(c);

  if a=0 then write('Ecuatia nu este de grad 2')

         else

    begin

      d:=b*b-4*a*c;

      if d<0 then write('Ecuatia are radacini complexe')

             else begin

                    x1:=-1*b/(2*a)+sqrt(d)/(2*a);

                    x2:=-1*b/(2*a)-sqrt(d)/(2*a);

                    writeln('x1=',x1:3:1);

                    writeln('x2=',x2:3:1)

                  end

    end;

  readln;

end.

program as9;

uses crt;

var a,b,r:integer;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  while a mod b<>0 do begin

                        r:=a mod b;

                        a:=b;

                        b:=r

                      end;

  write('Cmmdc este ',b);

  readln;

end.

program as10;

uses crt;

var n,a,b,c:integer;

begin

  clrscr;

  write('n=');readln(n);

  a:=0;

  b:=1;

  write('Primele ',n,' numere din sirul lui fibonacci sunt ');

  write(a,' ',b,' ');

  n:=n-2;

  while n>0 do begin

                 c:=a+b;

                 write(c,' ');

                 n:=n-1;

                 a:=b;

                 b:=c

               end;

  readln;

end.

program t1;

uses crt;

var a:array[1..20] of integer;

    n,min,max,i:integer;

begin

  clrscr;

  write('Dimensiunea sirului=');readln(n);

  write('Introduceti sirul ');

  for i:=1 to n do read(a[i]);

  min:=a[1];

  for i:=2 to n do if a[i]<min then min:=a[i];

  max:=a[1];

  for i:=2 to n do if a[i]>max then max:=a[i];

  writeln('Minimul sirului este ',min);

  writeln('Maximul sirului este ',max);

  readln;readln;

end.

program t2;

uses crt;

var a:array[1..20] of integer;

    n,v,poz,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Valoarea cautata=');readln(v);

  poz:=0;

  for i:=1 to n do if a[i]=v then poz:=i;

  if poz=0 then write('Valoarea nu este in sir')

           else write('Valoarea se gaseste pe pozitia ',poz);

  readln;

end.

program t3;

uses crt;

var a:array[1..20] of integer;

    n,i,aux:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  for i:=1 to n div 2 do begin

                           aux:=a[i];

                           a[i]:=a[n-i+1];

                           a[n-i+1]:=aux

                         end;

  write('Sirul inversat este ');

  for i:=1 to n do write(a[i],' ');

  readln;

  readln;

end.

program t4;

uses crt;

var a:array[1..20] of integer;

    n,s,k,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  s:=0;

  k:=0;

  for i:=1 to n do if a[i] mod 2=0 then begin

                                          s:=s+a[i];

                                          k:=k+1

                                        end;

  writeln('Media aritmetica a numerelor pare este ',s/k:4:2);

  s:=0;

  k:=0;

  for i:=1 to n do if a[i] mod 2<>0 then begin

                                           s:=s+a[i];

                                           k:=k+1

                                         end;

  writeln('Media aritmetica a numerelor impare este ',s/k:4:2);

  readln;readln;

end.

program t5;

uses crt;

var a:array[1..20] of integer;

    n,i,aux:integer;

    ordonat:boolean;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  ordonat:=false;

  while ordonat=false do begin

                           ordonat:=true;

                           for i:=1 to n-1 do if a[i]>a[i+1] then

                                           begin

                                             aux:=a[i];

                                             a[i]:=a[i+1];

                                             a[i+1]:=aux;

                                             ordonat:=false

                                           end;

                         end;

  write('Sirul ordonat este ');

  for i:=1 to n do write(a[i],' ');

  readln;

end.

program t6;

uses crt;

var a,b,c:array[1..20] of integer;

    n,m,i,j,k:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Primul sir=');

  for i:=1 to n do read(a[i]);

  write('m=');readln(m);

  write('Al doilea sir=');

  for j:=1 to m do read(b[j]);

  i:=1;

  j:=1;

  k:=0;

  while (i<=n) and (j<=m) do

     begin

       k:=k+1;

       if a[i]<b[j] then begin

                           c[k]:=a[i];

                           i:=i+1

                         end

                    else begin

                           c[k]:=b[j];

                           j:=j+1

                         end

     end;

  if i>n then for i:=j to m do begin

                                 k:=k+1;

                                 c[k]:=b[i]

                               end

         else for j:=i to n do begin

                                 k:=k+1;

                                 c[k]:=a[j]

                               end;

  write('Sirul rezultat este ');

  for i:=1 to k do write(c[i],' ');

  readln;readln;

end.

program t7;

uses crt;

var a:array[1..20] of integer;

    n,v,m,i,j,poz:integer;

    gasit:boolean;

begin

  clrscr;

  write('Dimensiunea sirului ordonat crescator');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Valoarea cautata');readln(v);

  i:=1;

  j:=n;

  gasit:=false;

  poz:=0;

  while (i<=j) and (gasit=false) do

    begin

      m:=(i+j) div 2;

      if a[m]=v then begin

                       gasit:=true;

                       poz:=m

                     end

                else if a[m]>v then j:=m-1

                               else i:=m+1

    end;

  if gasit=false then writeln('Valoarea ',v,' nu se gaseste in sir')

                 else writeln('Se gaseste pe pozitia ',poz);

  readln;

end.

program t7;

uses crt;

var a:array[1..20] of integer;

    n,i,v:integer;

function cautare(i,j:integer):integer;

var m:integer;

begin

  if i<=j then begin

                 m:=(i+j) div 2;

                 if a[m]=v then cautare:=m

                           else if a[m]>v then cautare:=cautare(i,m-1)

                                          else cautare:=cautare(m+1,j)

               end

          else cautare:=0

end;

begin

  clrscr;

  write('Dimensiunea sirului ordonat crescator');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Valoarea cautata');readln(v);

  if cautare(1,n)=0 then writeln('Valoarea ',v,' nu exista in sir')

                    else writeln('Valoarea ',v,' se gaseste pe poz ',cautare(1,n));

  readln;

end.

program t8;

uses crt;

var n,ni,aux:integer;

begin

  clrscr;

  write('n=');readln(n);

  ni:=0;

  aux:=n;

  while n<>0 do begin

                  ni:=ni*10+n mod 10;

                  n:=n div 10

                end;

  n:=aux;

  if n=ni then write('Numarul este palindrom')

          else write('Numarul nu este palindrom');

  readln;

end.

program t9;

uses crt;

var a:array[1..10,1..10] of integer;

    n,m,min,max,i,j:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  writeln('Introduceti matricea');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  min:=a[1,1];

  for i:=1 to n do

  for j:=1 to m do if a[i,j]<min then min:=a[i,j];

  max:=a[1,1];

  for i:=1 to n do

  for j:=1 to m do if a[i,j]>max then max:=a[i,j];

  writeln('Minimul matricei este ',min);

  writeln('Maximul matricei este ',max);

  readln;readln;

end.

program t10;

uses crt;

var a:array[1..10,1..10] of integer;

    n,s,p,i,j:integer;

begin

  clrscr;

  write('n=');readln(n);

  writeln('Matricea');

  for i:=1 to n do

  for j:=1 to n do read(a[i,j]);

  s:=0;

  for i:=1 to n do s:=s+a[i,i];

  writeln('Suma elementelor de pe diagonala principala este ',s);

  p:=1;

  for i:=1 to n do p:=p*a[i,n-i+1];

  writeln('Produsul elementelor de pe diagonala secundara este ',p);

  s:=0;

  for i:=1 to n do s:=s+a[1,i]+a[n,i];

  for i:=2 to n-1 do s:=s+a[i,1]+a[i,n];

  writeln('Suma elementelor de pe margine este ',s);

  readln;readln;

end.

program t11;

uses crt;

var a:array[1..10,1..10] of integer;

    n,i,j:integer;

    simetric:boolean;

begin

  clrscr;

  write('n=');readln(n);

  writeln('Matricea');

  for i:=1 to n do

  for j:=1 to n do read(a[i,j]);

  simetric:=true;

  for i:=1 to n do

  for j:=1 to n do if a[i,j]<>a[j,i] then simetric:=false;

  if simetric=true then write('Matricea e simetrica')

                   else write('Matricea nu e simetrica');

  readln;readln;

end.

program t12;

uses crt;

var a:array[1..10,1..10] of integer;

    n,m,i,j,k,nr:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  writeln('Matricea');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  write('k=');readln(k);

  writeln('Liniile care contin ',k,' elemente de 0 sunt:');

  for i:=1 to n do begin

                     nr:=0;

                     for j:=1 to m do if a[i,j]=0 then nr:=nr+1;

                     if nr=k then begin

                                    for j:=1 to m do write(a[i,j],' ');

                                    writeln

                                  end

                   end;

  readln;

end.

program t13;

uses crt;

var a:array[1..10,1..10] of integer;

    n,m,s,max,poz,i,j:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  writeln('Matricea');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  for j:=1 to m do begin

                     s:=a[1,j];

                     max:=a[1,j];

                     poz:=1;

                     for i:=2 to n do begin

                                        s:=s+a[i,j];

                                        if a[i,j]>max then begin

                                                             max:=a[i,j];

                                                             poz:=i

                                                           end

                                      end;

                     a[poz,j]:=s

                   end;

  writeln('Matricea rezultata');

  for i:=1 to n do begin

                     for j:=1 to m do write(a[i,j],' ');

                     writeln

                   end;

  readln;readln;

end.

program t14;

uses crt;

var a:array[1..10,1..10] of integer;

    n,m,i,j:integer;

    palindrom:boolean;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  writeln('Matricea');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  writeln('Liniile matricei cu caracter de palindrom sunt ');

  for i:=1 to n do begin

                     palindrom:=true;

                     for j:=1 to m div 2 do

                       if a[i,j]<>a[i,m-j+1] then palindrom:=false;

                     if palindrom=true then

                       begin

                         for j:=1 to m do write(a[i,j],' ');

                         writeln

                       end

                   end;

  readln;readln;

end.

program t15;

uses crt;

var a,b,c:array[1..10,1..10] of integer;

    n,m,p,s,i,j,k:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  write('p=');readln(p);

  writeln('Prima matrice');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  writeln('A doua matrice');

  for i:=1 to m do

  for j:=1 to p do read(b[i,j]);

  for i:=1 to n do

  for j:=1 to p do begin

                     s:=0;

                     for k:=1 to m do s:=s+a[i,k]*b[k,j];

                     c[i,j]:=s

                   end;

  writeln('Produsul celor doua matrici este ');

  for i:=1 to n do begin

                     for j:=1 to p do write(c[i,j]:2,' ');

                     writeln

                   end;

  readln;readln;

end.

program sc1;

uses crt;

var s:string;

begin

  clrscr;

  write('Introduceti un cuvant ');

  readln(s);

  write('Cuvantul ',s,' contine ',length(s),' caractere');

  readln;

end.

program sc2;

uses crt;

var s:string;

    i,k:integer;

begin

  clrscr;

  writeln('Introduceti o linie de text');

  readln(s);

  k:=0;

  for i:=1 to length(s) do if s[i]=' ' then k:=k+1;

  writeln('Linia de text contine ',k+1,' cuvinte');

  readln;

end.

program sc3;

uses crt;

var s:string;

    v,c,i:integer;

begin

  clrscr;

  writeln('Introduceti o linie de text ');

  readln(s);

  for i:=1 to length(s) do

  if s[i]<>' ' then case s[i] of

                         'a','e','i','o','u','a':v:=v+1;

                         else c:=c+1

                    end;

  writeln('Linia de text contine ',v,' vocale');

  writeln('Linia de text contine ',c,' consoane');

  readln;

end.

program sc4;

uses crt;

var l,s:string;

    i:integer;

begin

  clrscr;

  writeln('Introduceti o linie de text');

  readln(l);

  s:='';

  for i:=1 to length(l) do if l[i]<>' ' then s:=s+upcase(l[i]);

  writeln('Sirul rezultat este ',s);

  readln;

end.

program sc5;

uses crt;

var a:array[1..20] of string;

    aux:string;

    n,i,j:integer;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin

                     write('cuvant',i,'=');

                     readln(a[i])

                   end;

  for i:=1 to n do

  for j:=i+1 to n do if a[i]>a[j] then begin

                                         aux:=a[i];

                                         a[i]:=a[j];

                                         a[j]:=aux

                                       end;

  writeln('Cuvintele ordonate crescator:');

  for i:=1 to n do write(a[i],' ');

  readln;

end.

program inr1;

uses crt;

type art=record nume:string;

                nr_loc:longint;

         end;

var a:array[1..20] of art;

    n,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin write('nume',i,'=');readln(a[i].nume);

                         write('nr_loc=');readln(a[i].nr_loc)

                   end;

  writeln('Toate orasele care au peste 100000 locuitori sunt:');

  for i:=1 to n do if a[i].nr_loc>=100000 then writeln(a[i].nume);

  readln;

end.

program inr2;

uses crt;

var a:array[1..20] of record titlu:string;

                             autor:string;

                             an_aparitie:1..2001;

                      end;

    n,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin write('Titlul',i,'=');readln(a[i].titlu);

                         write('Autor=');readln(a[i].autor);

                         write('An aparitie');readln(a[i].an_aparitie)

                   end;

  writeln('Cartile tiparite dupa 1980 sunt:');

  for i:=1 to n do if a[i].an_aparitie>=1980 then writeln(a[i].titlu);

  readln;

end.

program inr3;

uses crt;

type art=record nume:string;

                punctaj:integer

         end;

var a:array[1..20] of art;

    num:string;

    n,max,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin

                     write('nume',i,'=');readln(a[i].nume);

                     write('punctaj',i,'=');readln(a[i].punctaj)

                   end;

  max:=a[1].punctaj;

  num:=a[1].nume;

  for i:=2 to n do if a[i].punctaj>max then begin

                                              max:=a[i].punctaj;

                                              num:=a[i].nume

                                            end;

  writeln('Concurentul ',num,' a obtinut punctaj maxim ',max);

  readln;

end.

program inr4;

uses crt;

var a:array[1..20] of record nume:string;

                             nota1:1..10;

                             nota2:1..10;

                      end;

    n,i:integer;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin

                     write('Nume=');readln(a[i].nume);

                     write('Nota1=');readln(a[i].nota1);

                     write('Nota2=');readln(a[i].nota2)

                   end;

  writeln('Elevii admisi sunt');

  for i:=1 to n do

    if (a[i].nota1>=5) and (a[i].nota2>=5) then writeln(a[i].nume);

  Writeln('Elevi respinsi sunt');

  for i:=1 to n do

    if (a[i].nota1<5) or (a[i].nota2<5) then writeln(a[i].nume);

  readln;

end.

program inr5;

uses crt;

var a,b:record preala:integer;

               pimag:integer;

        end;

    pr,pi:integer;

begin

  clrscr;

  write('Partea reala din primul numar              ');readln(a.preala);

  write('Partea imaginara din primul numar          ');readln(a.pimag);

  write('Partea reala din cel de-al doilea numar    ');readln(b.preala);

  write('Partea imaginara din cel de-al doilea numar');readln(b.pimag);

  pr:=a.preala+b.preala;

  pi:=a.pimag+b.pimag;

  writeln('Suma celor doua numere este ',pr,'+',pi,'i');

  pr:=a.preala-b.preala;

  pi:=a.pimag-b.pimag;

  writeln('Diferenta celor doua numere este ',pr,'+',pi,'i');

  readln;

end.

program m1;

uses crt;

var a,b,c:set of 1..10;

    e:1..10;

    n,i:integer;

begin

  clrscr;

  write('Nr de elem din 1 multime');readln(n);

  write('Elementele:');

  a:=[];

  for i:=1 to n do begin read(e);

                         a:=a+[e]

                   end;

  write('Nr de elem din 2 multime');readln(n);

  write('Elementele:');

  b:=[];

  for i:=1 to n do begin read(e);

                         b:=b+[e]

                   end;

  c:=a+b;

  write('Reuniunea= ');

  for i:=1 to 10 do if i in c then write(i,' ');

  writeln;

  c:=a*b;

  write('Intersectia= ');

  for i:=1 to 10 do if i in c then write(i,' ');

  writeln;

  c:=a-b;

  write('Diferenta a-b= ');

  for i:=1 to 10 do if i in c then write(i,' ');

  writeln;

  if a<=b then writeln('a inclusa in b')

          else writeln('a nu este inclusa in b');

  readln;

end.

program m2;

uses crt;

var a:set of 1..100;

    e,max:1..100;

    n,i:integer;

begin

  clrscr;

  write('Nr de elemente din multime=');readln(n);

  a:=[];

  write('Elementele=');

  for i:=1 to n do begin

                     read(e);

                     a:=a+[e]

                   end;

  for i:=1 to 100 do if i in a then max:=i;

  write('Elementul maxim din multime este ',max);

  readln;readln;

end.

program m3;

uses crt;

var a:array[1..30] of 0..255;

    m:set of 0..255;

    n,i,k:integer;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul=');

  for i:=1 to n do read(a[i]);

  m:=[];

  for i:=1 to n do m:=m+[a[i]];

  k:=0;

  for i:=0 to 255 do if i in m then k:=k+1;

  if n=k then writeln('Toate elementele din sir sunt distincte')

         else writeln('Nu sunt distincte');

  readln;readln;

end.

program m4;

uses crt;

var a:set of char;

    s:string;

    n,i:integer;

    c:char;

begin

  clrscr;

  write('Introduceti cuvantul ');readln(s);

  n:=length(s);

  a:=[];

  for i:=1 to n do a:=a+[s[i]];

  write('Literele distincte din cuvant sunt ');

  for c:='a' to 'z' do if c in a then write(c,' ');

  readln;

end.

program s1;

uses crt;

var n,k:word;

function fact(n:word):word;

var p,i:word;

begin

  p:=1;

  for i:=2 to n do p:=p*i;

  fact:=p

end;

begin

  clrscr;

  repeat

  write('n=');readln(n);

  write('k=');readln(k);

  until k<=n;

  write('Comb din ',n,' luate cate ',k,' =',fact(n)/(fact(n-k)*fact(k)):2:0);

  readln;

end.

program s2;

uses crt;

var n,i:byte;

    s:longint;

function fact(k:word):word;

var p,i:word;

begin

  p:=1;

  for i:=1 to k do p:=p*i;

  fact:=p

end;

begin

  clrscr;

  write('n=');readln(n);

  s:=0;

  for i:=1 to n do s:=s+fact(i);

  write('Suma este ',s);

  readln;

end.

program s3;

uses crt;

var x,n:word;

function putere(x,n:word):longint;

var p,i:integer;

begin

  p:=1;

  for i:=1 to n do p:=p*x;

  putere:=p;

end;

begin

  clrscr;

  write('x=');readln(x);

  write('n=');readln(n);

  write('Rezultatul este ',putere(x,n));

  readln;

end.

program s4;

uses crt;

type sir=array[1..20] of integer;

var a:sir;

    n,i:integer;

function minim(a:sir;n:integer):integer;

var min,i:integer;

begin

  min:=a[1];

  for i:=2 to n do if a[i]<min then min:=a[i];

  minim:=min;

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Minimul sirului este ',minim(a,n));

  readln;readln;

end.

program s5;

uses crt;

type sir=array[1..20] of integer;

var a:sir;

    n,i:integer;

function suma(a:sir;n:integer):integer;

var s,i:integer;

begin

  s:=0;

  for i:=1 to n do s:=s+a[i];

  suma:=s;

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Suma elem sirului este ',suma(a,n));

  readln;readln;

end.

program s6;

uses crt;

type sir=array[1..20] of integer;

var a:sir;

    n,i,v:integer;

function gasit(a:sir;n,v:integer):boolean;

var b:boolean;

    i:integer;

begin

  b:=false;

  for i:=1 to n do if a[i]=v then b:=true;

  gasit:=b;

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Valoarea cautata');readln(v);

  if gasit(a,n,v) then write('Exista in sir')

                  else write('Nu exista in sir');

  readln;

end.

program s7;

uses crt;

var n:integer;

function suma(n:integer):integer;

var s:integer;

begin

  s:=0;

  while n<>0 do begin

                  s:=s+n mod 10;

                  n:=n div 10

                end;

  suma:=s

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Suma cifrelor este ',suma(n));

  readln;

end.

program s8;

uses crt;

var n,k:integer;

function cifra(n,k:integer):integer;

var i:integer;

begin

  for i:=1 to k-1 do n:=n div 10;

  cifra:=n mod 10

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Rang=');readln(k);

  write('Cifra este ',cifra(n,k));

  readln;

end.

program s9;

uses crt;

var a,b:integer;

function cmmdc(x,y:integer):integer;

begin

  while x<>y do if x>y then x:=x-y

                       else y:=y-x;

  cmmdc:=x

end;

function cmmmc(x,y:integer):integer;

var p:integer;

begin

  p:=x*y;

  while x<>y do if x>y then x:=x-y

                       else y:=y-x;

  cmmmc:=p div x

end;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  writeln('cmmdc=',cmmdc(a,b));

  writeln('cmmmc=',cmmmc(a,b));

  readln;

end.

program s10;

uses crt;

type multime=set of 1..10;

var a:multime;

    e:1..10;

    i,n:byte;

procedure tipareste(a:multime);

var i:byte;

begin

  for i:=1 to 10 do if i in a then write(i,' ');

end;

begin

  clrscr;

  write('n=');readln(n);

  write('elementele');

  a:=[];

  for i:=1 to n do begin

                     read(e);

                     a:=a+[e]

                   end;

  tipareste(a);

  readln;readln;

end.

program s11;

uses crt;

var a,b,s:array[1..20,1..20] of integer;

    n,m,i,j:integer;

procedure suma;

var i,j:integer;

begin

  for i:=1 to n do

  for j:=1 to m do s[i,j]:=a[i,j]+b[i,j];

end;

begin

  clrscr;

  write('n=');readln(n);

  write('m=');readln(m);

  writeln('Prima matrice');

  for i:=1 to n do

  for j:=1 to m do read(a[i,j]);

  writeln('A doua matrice');

  for i:=1 to n do

  for j:=1 to m do read(b[i,j]);

  suma;

  writeln('Suma celor 2 matrici este');

  for i:=1 to n do begin

                     for j:=1 to m do write(s[i,j]:3);

                     writeln

                   end;

  readln;readln;

end.

program f1;

var f,g:text;

    c:char;

begin

  assign(f,'sursa.txt');

  assign(g,'dest.txt');

  reset(f);

  rewrite(g);

  while not(eof(f)) do begin

                         read(f,c);

                         write(g,c)

                       end;

  close(f);

  close(g);

end.

program f2;

var f,g:text;

    a:array[1..20] of integer;

    n,i,aux:integer;

    ordonat:boolean;

begin

  assign(f,'in.txt');

  assign(g,'out.txt');

  reset(f);

  rewrite(g);

  i:=0;

  while not(eof(f)) do begin

                         i:=i+1;

                         read(f,a[i])

                       end;

  n:=i;

  ordonat:=false;

  while ordonat=false do

    begin

      ordonat:=true;

      for i:=1 to n-1 do if a[i]>a[i+1] then begin

                                               aux:=a[i];

                                               a[i]:=a[i+1];

                                               a[i+1]:=aux;

                                               ordonat:=false

                                             end

    end;

    for i:=1 to n do write(g,a[i],' ');

    close(f);

    close(g);

end.

program f3;

var f,g:text;

    a:array[1..10,1..10] of integer;

    n,s,i,j:integer;

begin

  assign(f,'in.txt');

  assign(g,'out.txt');

  reset(f);

  rewrite(g);

  readln(f,n);

  for i:=1 to n do

  for j:=1 to n do read(f,a[i,j]);

  s:=0;

  for i:=1 to n do s:=s+a[i,i];

  write(g,s);

  close(f);

  close(g);

end.

program f4;

var f:text;

    a,b,c:array[1..20] of integer;

    n,m,i,j,k:integer;

begin

  assign(f,'f1.txt');

  reset(f);

  i:=0;

  while not(eof(f)) do begin

                         i:=i+1;

                         read(f,a[i])

                       end;

  n:=i;

  close(f);

  assign(f,'f2.txt');

  reset(f);

  j:=0;

  while not(eof(f)) do begin

                         j:=j+1;

                         read(f,b[j])

                       end;

  m:=j;

  close(f);

  i:=1;j:=1;k:=0;

  while (i<=n) and (j<=m) do

    begin

      k:=k+1;

      if a[i]<b[j] then begin

                          c[k]:=a[i];

                          i:=i+1

                        end

                   else begin

                          c[k]:=b[j];

                          j:=j+1

                        end

    end;

  if i>n then for i:=j to m do begin

                                 k:=k+1;

                                 c[k]:=b[i]

                               end

         else for j:=i to n do begin

                                 k:=k+1;

                                 c[k]:=a[j]

                               end;

  assign(f,'f3.txt');

  rewrite(f);

  for i:=1 to k do write(f,c[i],' ');

  close(f);

end.

program f5;

var f,g:text;

    a,b,c:set of 0..9;

    e,i:0..9;

begin

  assign(f,'in.txt');

  assign(g,'out.txt');

  reset(f);

  rewrite(g);

  a:=[];

  while not(eoln(f)) do begin

                          read(f,e);

                          a:=a+[e]

                        end;

  b:=[];

  while not(eof(f)) do begin

                         read(f,e);

                         b:=b+[e]

                       end;

  c:=a+b;

  for i:=0 to 9 do if i in c then write(g,i,' ');

  close(f);

  close(g);end.

program f6;

var f,g:text;

    a,b:set of char;

    c:char;

begin

  assign(f,'prim.txt');

  assign(g,'doi.txt');

  reset(f);

  rewrite(g);

  a:=[];

  while not(eoln(f)) do begin

                          read(f,c);

                          a:=a+[c]

                        end;

  b:=[];

  while not(eof(f)) do begin

                         read(f,c);

                         b:=b+[c]

                       end;

  if a<=b then write(g,'DA')

          else write(g,'NU');

  close(f);

  close(g);

end.

program r1;

uses crt;

var n:integer;

function fact(n:integer):longint;

begin

  if n=1 then fact:=1

         else fact:=n*fact(n-1)

end;

begin

  clrscr;

  write('n=');readln(n);

  write(n,'!=',fact(n));

  readln;

end.

program r2;

uses crt;

var n:integer;

function fib(n:integer):integer;

begin

  if n=1 then fib:=0

         else if n=2 then fib:=1

                     else fib:=fib(n-1)+fib(n-2)

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Termenul de ordin ',n,' din sir este ',fib(n));

  readln;

end.

program r3;

uses crt;

var a,b:integer;

function cmmdc(a,b:integer):integer;

begin

  if a=b then cmmdc:=a

         else if a>b then cmmdc:=cmmdc(a-b,b)

                     else cmmdc:=cmmdc(a,b-a)

end;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  write('Cmmdc=',cmmdc(a,b));

  readln;

end.

program r3;

uses crt;

var a,b:integer;

function cmmdc(a,b:integer):integer;

begin

  if a mod b=0 then cmmdc:=b

               else cmmdc:=cmmdc(b,a mod b)

end;

begin

  clrscr;

  write('a=');readln(a);

  write('b=');readln(b);

  write('Cmmdc=',cmmdc(a,b));

  readln;

end.

program r4;

uses crt;

var x,n:integer;

function putere(x,n:integer):integer;

begin

  if n=1 then putere:=x

         else putere:=x*putere(x,n-1)

end;

begin

  clrscr;

  write('x=');readln(x);

  write('n=');readln(n);

  write('Rezultatul este ',putere(x,n));

  readln;

end.

program r5;

uses crt;

var n,k:integer;

function combinari(n,k:integer):integer;

begin

  if (k=0) or (k=n) then combinari:=1

                    else combinari:=combinari(n-1,k)+combinari(n-1,k-1)

end;

begin

  clrscr;

  write('n=');readln(n);

  write('k=');readln(k);

  write('Rezultatul este ',combinari(n,k));

  readln;

end.

program r6;

uses crt;

var n:longint;

function suma(n:longint):integer;

begin

  if n=0 then suma:=0

         else suma:=n mod 10 +suma(n div 10)

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Suma cifrelor este ',suma(n));

  readln;

end.

program r7;

uses crt;

var a:array[1..20] of integer;

    n,i:integer;

function maxim(i:integer):integer;

var aux:integer;

begin

  if i=n then maxim:=a[n]

         else begin

                aux:=maxim(i+1);

                if a[i]>aux then maxim:=a[i]

                            else maxim:=aux

              end

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  write('Maximul sirului este ',maxim(1));

  readln;readln;

end.

program r8;

uses crt;

var a:array[1..20] of integer;

    n,i:integer;

procedure invers(i:integer);

begin

  if i=1 then write(a[1],' ')

         else begin

                write(a[i],' ');

                invers(i-1)

              end

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Sirul');

  for i:=1 to n do read(a[i]);

  invers(n);

  readln;readln;

end.

program r9;

uses crt;

var n:longint;

procedure invers(n:longint);

begin

  if n<>0 then begin

                 write(n mod 10,' ');

                 invers(n div 10)

               end

end;

begin

  clrscr;

  write('n=');readln(n);

  write('Cifrele numarului in ordine inversa sunt:');

  invers(n);

  readln;

end.

program r10;

uses crt;

var s:string;

procedure invers(i:integer);

begin

  if i=1 then write(s[1])

         else begin

                write(s[i]);

                invers(i-1)

              end

end;

begin

  clrscr;

  write('sirul de caractere');readln(s);

  invers(length(s));

  readln;

end.

program r11;

uses crt;

var a:array[1..20] of string;

    n,i:integer;

procedure invers(i:integer);

begin

  if i=1 then write(a[1],' ')

         else begin

                write(a[i],' ');

                invers(i-1)

              end

end;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do begin

                     write('cuvantul',i,'=');

                     readln(a[i])

                   end;

  write('Cuvintele inversate sunt ');

  invers(n);

  readln;

end.

program b1;

uses crt;

type stiva=array[1..10] of integer;

var st:stiva;

    n,k:integer;

function solutie:boolean;

begin

  if k=n+1 then solutie:=true

           else solutie:=false

end;

procedure tipar;

var i:integer;

begin

  for i:=1 to n do write(st[i],' ');

  writeln

end;

function valid:boolean;

var ev:boolean;

    i:integer;

begin

  ev:=true;

  for i:=1 to k-1 do if st[i]=st[k] then ev:=false;

  valid:=ev

end;

begin

  clrscr;

  write('n=');readln(n);

  for k:=1 to n do st[k]:=0;

  k:=1;

  while k>0 do begin

                 if solutie then begin

                                   tipar;

                                   k:=k-1

                                 end;

                 if st[k]<n then begin

                                   st[k]:=st[k]+1;

                                   if valid then k:=k+1

                                 end

                            else begin

                                   st[k]:=0;

                                   k:=k-1

                                 end

               end;

  readln;

end.

program b2;

uses crt;

type stiva=array[1..10] of integer;

var st:stiva;

    n,k,p:integer;

function solutie:boolean;

begin

  if k=p+1 then solutie:=true

           else solutie:=false

end;

procedure tipar;

var i:integer;

begin

  for i:=1 to p do write(st[i],' ');

  writeln

end;

function valid:boolean;

var ev:boolean;

    i:integer;

begin

  ev:=true;

  for i:=1 to k-1 do if st[i]=st[k] then ev:=false;

  valid:=ev

end;

begin

  clrscr;

  write('n=');readln(n);

  write('p=');readln(p);

  for k:=1 to p do st[k]:=0;

  k:=1;

  while k>0 do begin

                 if solutie then begin

                                   tipar;

                                   k:=k-1

                                 end;

                 if st[k]<n then begin

                                   st[k]:=st[k]+1;

                                   if valid then k:=k+1

                                 end

                            else begin

                                   st[k]:=0;

                                   k:=k-1

                                 end

               end;

  readln;

end.

program b3;

uses crt;

type stiva=array[1..10] of integer;

var st:stiva;

    a:array[1..10] of integer;

    n,k,i:integer;

function solutie:boolean;

begin

  if k=n+1 then solutie:=true

           else solutie:=false

end;

procedure tipar;

var i:integer;

begin

  for i:=1 to n do write(st[i],' ');

  writeln

end;

function valid:boolean;

begin

  valid:=true

end;

begin

  clrscr;

  write('Nr de multimi');readln(n);

  write('Multimile');

  for i:=1 to n do read(a[i]);

  for k:=1 to n do st[k]:=0;

  k:=1;

  while k>0 do begin

                 if solutie then begin

                                   tipar;

                                   k:=k-1

                                 end;

                 if st[k]<a[k] then begin

                                      st[k]:=st[k]+1;

                                      if valid then k:=k+1

                                    end

                               else begin

                                      st[k]:=0;

                                      k:=k-1

                                    end

               end;

  readln;

end.

program b4;

uses crt;

type stiva=array[1..10] of integer;

var st:stiva;

    n,k:integer;

function solutie:boolean;

begin

  if k=n+1 then solutie:=true

           else solutie:=false

end;

procedure tipar;

var i:integer;

begin

  write('');

  writeln

end;

function valid:boolean;

begin

  valid:=true

end;

begin

  clrscr;

  write('n=');readln(n);

  writeln('Submultimile sunt:');

  for k:=1 to n do st[k]:=-1;

  k:=1;

  while k>0 do begin

                 if solutie then begin

                                   tipar;

                                   k:=k-1

                                 end;

                 if st[k]<1 then begin

                                   st[k]:=st[k]+1;

                                   if valid then k:=k+1

                                 end

                            else begin

                                   st[k]:=-1;

                                   k:=k-1

                                 end

               end;

  readln;

end.

program b5;

uses crt;

type stiva=array[1..10] of integer;

var st:stiva;

    n,k:integer;

function solutie:boolean;

begin

  if k=n+1 then solutie:=true

           else solutie:=false

end;

procedure tipar;

var i,j:integer;

begin

  for i:=1 to n do begin

                     for j:=1 to n do if st[i]=j then write(1,' ')

                                                 else write(0,' ');

                     writeln

                   end;

  writeln;

end;

function valid:boolean;

var ev:boolean;

    i:integer;

begin

  ev:=true;

  for i:=1 to k-1 do

    if (st[i]=st[k]) or (abs(st[i]-st[k])=abs(i-k)) then ev:=false;

  valid:=ev

end;

begin

  clrscr;

  write('n=');readln(n);

  for k:=1 to n do st[k]:=0;

  k:=1;

  while k>0 do begin

                 if solutie then begin

                                   tipar;

                                   k:=k-1

                                 end;

                 if st[k]<n then begin

                                   st[k]:=st[k]+1;

                                   if valid then k:=k+1

                                 end

                            else begin

                                   st[k]:=0;

                                   k:=k-1

                                 end

               end;

  readln;

end.

program b7;

uses crt;

const m=8;n=10;

type matrice=array[1..m,1..n] of byte;

     sir=array[1..4] of integer;

const lab:matrice=((0,0,0,0,0,1,0,0,0,0),

                   (0,0,0,1,0,1,0,0,0,0),

                   (0,0,0,1,1,1,0,0,0,0),

                   (1,1,1,1,0,1,0,0,0,0),

                   (0,0,0,1,0,1,0,0,0,0),

                   (0,1,1,1,1,1,1,1,0,0),

                   (1,1,0,0,1,0,0,0,0,0),

                   (0,0,0,0,1,0,0,0,0,0));

      x:sir=(-1,0,1,0);

      y:sir=(0,1,0,-1);

var t:matrice;

    nr_sol,i,j:byte;

procedure scrie;

var i,j:byte;

begin

  readln;

  nr_sol:=nr_sol+1;

  writeln('Solutia ',nr_sol,':');

  for i:=1 to m do begin

                     for j:=1 to n do write(t[i,j]:3);

                     writeln

                   end

end;

procedure traseu(i,j,pas:byte);

var ii,jj:integer;

    k:byte;

begin

  for k:=1 to 4 do

    begin

      ii:=i+x[k];

      jj:=j+y[k];

      if (ii in [1..m]) and (jj in [1..n]) then

        if (lab[ii,jj]=1) and (t[ii,jj]=0) then

          begin

            t[ii,jj]:=pas;

            if (ii in [1,m]) or (jj in [1,n]) then scrie

                                              else traseu(ii,jj,pas+1);

            t[ii,jj]:=0

          end

    end

end;

begin

  clrscr;

  for i:=1 to m do

  for j:=1 to n do t[i,j]:=0;

  write('Pozitia i,j din interiorul labirintului:');

  readln(i,j);

  nr_sol:=0;

  t[i,j]:=1;

  traseu(i,j,2)

end.

program b8;

uses crt;

type sir=array[1..8] of integer;

const x:sir=(-2,-1,1,2,2,1,-1,-2);

      y:sir=(1,2,2,1,-1,-2,-2,-1);

var t:array[1..10,1..10] of integer;

    nn,n,i,j:byte;

    nr_sol:word;

                       

procedure scrie;

var i,j:byte;

begin

  nr_sol:=nr_sol+1;

  writeln('Solutia ',nr_sol,':');

  for i:=1 to n do begin

                     for j:=1 to n do write(t[i,j]:4);

                     writeln

                   end;

  readln;

end;

procedure mutare(i,j,pas:byte);

var ii,jj:integer;

    k:byte;

begin

  for k:=1 to 8 do

    begin

      ii:=i+x[k];

      jj:=j+y[k];

      if (ii in [1..n]) and (jj in [1..n]) and (t[ii,jj]=0) then

        begin

          t[ii,jj]:=pas;

          if pas=nn then scrie

                    else mutare(ii,jj,pas+1);

          t[ii,jj]:=0

        end

    end

end;

begin

  clrscr;

  write('n=');readln(n);

  for i:=1 to n do

  for j:=1 to n do t[1,j]:=0;

  t[1,1]:=1;

  nn:=n*n;

  nr_sol:=0;

  mutare(1,1,2);

  if nr_sol=0 then writeln('Problema nu are solutie');

  readln;

end.

program l1;

uses crt;

type ref=^inr;

     inr=record inf:integer;

                urm:ref

         end;

var prim:ref;

procedure creare;

var c,d:ref;

    n,i,inf:integer;

begin

  write('Nr de elem el listei=');readln(n);

  write('inf1=');readln(inf);

  new(prim);

  prim^.inf:=inf;

  prim^.urm:=nil;

  d:=prim;

  for i:=2 to n do begin

                     write('inf',i,'=');

                     readln(inf);

                     new(c);

                     c^.inf:=inf;

                     c^.urm:=nil;

                     d^.urm:=c;

                     d:=c

                   end

end;

procedure adaugare;

var c,d:ref;

    inf:integer;

begin

  c:=prim;

  while c^.urm<>nil do c:=c^.urm;

  write('inf care trebuie adaugata');readln(inf);

  new(d);

  d^.inf:=inf;

  d^.urm:=nil;

  c^.urm:=d

end;

procedure listare;

var c:ref;

begin

  c:=prim;

  while c<>nil do begin

                    write(c^.inf,' ');

                    c:=c^.urm

                  end;

  writeln;

end;

procedure cautare;

var c:ref;

    inf,poz:integer;

begin

  write('Informatia cautata');

  readln(inf);

  c:=prim;

  poz:=1;

  while c^.inf<>inf do begin

                         poz:=poz+1;

                         c:=c^.urm

                       end;

  if c<>nil then writeln('Informatia se gaseste pe pozitia ',poz,' a listei')

            else writeln('Informatia nu se gaseste in sir')

end;

procedure eliminare;

var c,d:ref;

    inf:integer;

begin

  write('Informatia care trebuie eliminata');readln(inf);

  c:=prim;

  if prim^.inf=inf then begin

                          prim:=prim^.urm;

                          dispose(c)

                        end

                   else begin

                          while c^.inf<>inf do begin

                                                 d:=c;

                                                 c:=c^.urm

                                               end;

                          d^.urm:=c^.urm;

                          dispose(c)

                        end

end;

begin

  clrscr;

  creare;

  listare;

  adaugare;

  listare;

  eliminare;

  listare;

  readln;

end.

program l2;

uses crt;

type ref=^inr;

     inr=record inf:integer;

                ant,urm:ref

         end;

var prim,ultim:ref;

procedure creare;

var c,d:ref;

    n,i,inf:integer;

begin

  write('Cate elemente contine lista');readln(n);

  write('inf1=');readln(inf);

  new(prim);

  prim^.inf:=inf;

  prim^.ant:=nil;

  prim^.urm:=nil;

  ultim:=prim;

  d:=prim;

  for i:=2 to n do begin

                     write('inf',i,'=');readln(inf);

                     new(c);

                     c^.inf:=inf;

                     c^.ant:=d;

                     c^.urm:=nil;

                     d^.urm:=c;

                     d:=c;

                     ultim:=c

                   end

end;

procedure a_dreapta;

var c:ref;

    inf:integer;

begin

  write('informatia care se adauga la dreapta');readln(inf);

  new(c);

  c^.inf:=inf;

  c^.ant:=ultim;

  c^.urm:=nil;

  ultim^.urm:=c;

  ultim:=c

end;

procedure a_stanga;

var c:ref;

    inf:integer;

begin

  write('informatia care se adauga la stanga');readln(inf);

  new(c);

  c^.inf:=inf;

  c^.ant:=nil;

  c^.urm:=prim;

  prim^.ant:=c;

  prim:=c

end;

procedure a_interior;

var c,d:ref;

    inf:integer;

begin

  write('informatia dupa care se adauga');readln(inf);

  c:=prim;

  while c^.inf<>inf do c:=c^.urm;

  write('informatia care se adauga');readln(inf);

  new(d);

  d^.inf:=inf;

  c^.urm^.ant:=d;

  d^.urm:=c^.urm;

  d^.ant:=c;

  c^.urm:=d

end;

procedure s_ultim;

var c:ref;

begin

  c:=ultim;

  ultim:=ultim^.ant;

  ultim^.urm:=nil;

  dispose(c)

end;

procedure s_prim;

var c:ref;

begin

  c:=prim;

  prim:=prim^.urm;

  prim^.ant:=nil;

  dispose(c)

end;

procedure s_interior;

var c:ref;

    inf:integer;

begin

  write('informatia care se sterge');readln(inf);

  c:=prim;

  while c^.inf<>inf do c:=c^.urm;

  c^.ant^.urm:=c^.urm;

  c^.urm^.ant:=c^.ant;

  dispose(c)

end;

procedure l_stanga_dreapta;

var c:ref;

begin

  c:=prim;

  while c<>nil do begin

                    write(c^.inf,' ');

                    c:=c^.urm

                  end;

  writeln

end;

procedure l_dreapta_stanga;

var c:ref;

begin

  c:=ultim;

  while c<>nil do begin

                    write(c^.inf,' ');

                    c:=c^.ant

                  end

end;

begin

  clrscr;

  writeln('Se creaza lista');

  creare;

  l_stanga_dreapta;

  a_dreapta;

  l_stanga_dreapta;

  a_stanga;

  l_stanga_dreapta;

  a_interior;

  l_stanga_dreapta;

  writeln('Se sterge ultimul element');

  s_ultim;

  l_stanga_dreapta;

  writeln('Se sterge primul element');

  s_prim;

  l_stanga_dreapta;

  s_interior;

  l_stanga_dreapta;

  writeln('Se listeaza de la dreapta la stanga');

  l_dreapta_stanga;

  readln;

end.

program l3;

uses crt;

type ref=^inr;

     inr=record inf:char;

                urm:ref

         end;

var v:ref;

    n,i:integer;

procedure adaug;

var c:ref;

    inf:char;

begin

  write('caracter=');readln(inf);

  new(c);

  c^.inf:=inf;

  c^.urm:=v;

  v:=c

end;

procedure scot;

var c:ref;

begin

  if v=nil then writeln('Lista e vida')

           else begin

                  c:=v;

                  v:=v^.urm;

                  dispose(c)

                end

end;

procedure listare;

var c:ref;

begin

  c:=v;

  while c<>nil do begin

                    write(c^.inf,' ');

                    c:=c^.urm

                  end

end;

begin

  clrscr;

  write('Cate elemente adaugati?');readln(n);

  for i:=1 to n do adaug;

  write('Cate elemente scoateti?');readln(n);

  for i:=1 to n do scot;

  listare;

  readln;

end

program l4;

uses crt;

type ref=^inr;

     inr=record inf:char;

                urm:ref

         end;

var prim,ultim:ref;

    n,i:integer;

procedure adaug;

var c:ref;

    inf:char;

begin

  write('caracter=');readln(inf);

  new(c);

  c^.inf:=inf;

  c^.urm:=nil;

  if ultim=nil then begin

                      prim:=c;

                      ultim:=c

                    end

               else begin

                      ultim^.urm:=c;

                      ultim:=c

                    end

end;

procedure scot;

var c:ref;

begin

  if prim=nil then writeln('Coada este vida')

              else if prim=ultim then begin

                                        c:=prim;

                                        prim:=nil;

                                        ultim:=nil;

                                        dispose(c)

                                      end

                                 else begin

                                        c:=prim;

                                        prim:=prim^.urm;

                                        dispose(c)

                                      end

end;

procedure listare;

var c:ref;

begin

  c:=prim;

  while c<>nil do begin

                    write(c^.inf,' ');

                    c:=c^.urm

                  end

end;

begin

  clrscr;

  write('Cate elemente adaugati in coada? ');readln(n);

  for i:=1 to n do adaug;

  write('Cate elemente scoateti din coada? ');readln(n);

  for i:=1 to n do scot;

  listare;

  readln;

end.

Copyright © Contact | Trimite referat



Ultimele referate adaugate
Mihai Beniuc
   - Mihai beniuc - „poezii"
Mihai Eminescu Mihai Eminescu
   - Mihai eminescu - student la berlin
Mircea Eliade Mircea Eliade
   - Mircea Eliade - Mioara Nazdravana (mioriţa)
Vasile Alecsandri Vasile Alecsandri
   - Chirita in provintie de Vasile Alecsandri -expunerea subiectului
Emil Girlenu Emil Girlenu
   - Dragoste de viata de Jack London
Ion Luca Caragiale Ion Luca Caragiale
   - Triumful talentului… (reproducere) de Ion Luca Caragiale
Mircea Eliade Mircea Eliade
   - Fantasticul in proza lui Mircea Eliade - La tiganci
Mihai Eminescu Mihai Eminescu
   - „Personalitate creatoare” si „figura a spiritului creator” eminescian
George Calinescu George Calinescu
   - Enigma Otiliei de George Calinescu - geneza, subiectul si tema romanului
Liviu Rebreanu Liviu Rebreanu
   - Arta literara in romanul Ion, - Liviu Rebreanu

Cauta referat
Scriitori romani