Programare

Calculează c.m.m.d.c. a două numere naturale n1 şi n2.
program cmmdc;
 uses crt;
 var n1, n2, d: integer;
 begin
 clrscr;
 write (' n1 = '); readln (n1);
 write (' n2 = '); readln (n2);
 if n1 > n2
      then
      begin
      d: = n2;
      while (d <= n2) and  ((n1 mod d <>0) or (n2  mod d <>0)) do
      d: = d - 1
      end
      else
           if
n2 > n1
               then
               begin
              
d: = n1;
               while (d <= n1) and  ((n1 mod d <>0) or (n2 mod d <>0)) do
               d: = d-1
               end
               else
              
d: = n1;
 writeln ('C.m.m.d.c. este ' , d);
 readln;
 end.

 

Descompune un număr natural a în factori primi.
program descomp;
  uses crt;
  var i, j: integer;
  a: longint;
  begin
  write('a = '); readln(a);
  write (a,'=');
  i: = 2;
  repeat
  j: = 2;
  while (j <= i div 2) and (i mod j <> 0) do
  j: = j +1;
  if (j =  i div 2 +1) and (a mod i = 0)
    then
    begin

    write(i, ' * ');
    a: = a div i
    end
    else

    i: = i + 1
  until a = 1;
  gotoxy(wherex-1, wherey) ;
  clreol;
  readln;
  end.

 

Pentru toate numerele prime p cuprinse între două numere naturale date a şi b, cercetaţi  dacă numerele p*p - p + 1 şi
p*p + p + 1 sunt numere prime.

program ADRIANA;
 var a, b, i, j, k, p: integer;
 begin
 
write (' a  = '); readln (a);
 write (' b = '); readln (b);
 for  k: = a  to  b do 
      begin
     
i: = 2;
      while  (i <= k  div 2) and ( k mod i  <> 0 ) do
      i: = i + 1;
      if   i = k  div  2  + 1
      then
      begin
     
p: = k;
      writeln (' p =  ', k ); 
      i: = 2 ;
      while (i <= (p*p - p + 1) div  2) and ((p*p - p + 1) mod  i <> 0) 
      do   
      i: = i + 1;
      if  i =  (p*p - p + 1)  div  2  + 1
      then
     
writeln (' p*p - p + 1 este numar prim. ')
      else
     
writeln ( ' p*p - p + 1 nu este numar prim. ');
      j: = 2; 
      while (j <= (p*p + p + 1) div  2) and  ((p*p + p + 1) mod  j <>0) 
      do   
      j: = j + 1;
      if  j =  (p*p + p + 1)  div  2  + 1
      then
     
writeln (' p*p + p + 1 este numar prim. ')
      else
     
writeln (' p*p + p + 1 nu este numar prim. ');
      end;
      end;
     
readln;
      end.

 

Afişează câtul şi restul împărţirii a două numere întregi a şi b.
program imp;
  var a, b: integer;
  begin 
 
write (' a  = '); readln (a);
  write (' b = '); readln (b);
  if  a > =  0
      then
      begin
     
writeln (' Catul este  ', a div b);
      writeln (' Restul este  ', a - b*(a div b ))
      end
      else
          if 
b > 0
          then
          begin
         
writeln ('Catul este  ', a div b - 1);
          writeln ('Restul este  ', a - b*(a div b - 1))
          end
          else

          if  b < 0
              then
              begin
             
writeln ('Catul este  ', a div b + 1);
              writeln ('Restul este  ', a - b*(a div b + 1))
              end
              else
             
writeln ('Impartirea nu are sens. ');
  readln;
  end.

 

Se citesc pe rând n numere naturale. Fără a calcula produsul lor, găsiţi k maxim astfel încât 7*7*...*7 divide produsul celor n numere.
program ex26p188;
  var i, n, k, nr, kmax: integer; 
  begin
  write('n = '); readln (n);
  kmax: = 0;
  for i: = 1 to n  do
      begin
      k: = 0;
      write ('nr = '); readln (nr);
      while (nr  mod  7 = 0)
      begin
      k: = k + 1;
      nr: = nr  div  7
      end;
      kmax: = kmax + k
      end;
      writeln('k maxim este  ', kmax);
      readln;
  end.

 

Calculează c.m.m.m.c. a două numere naturale n1 şi n2.
program cmmmc;
  uses crt;
  var i, n1, n2: longint;
  begin
 
clrscr;
  write (' n1 = '); readln (n1);
  write (' n2 = '); readln (n2);
  i: = 1;
  while  n1* i mod n2 <> 0 do
           i: = i + 1;
  writeln ('C.m.m.m.c. este  ' , n1* i);
  readln;
  end.

 

Cercetează dacă un punct de coordonate (x,y) este situat în interiorul unui dreptunghi ale cărui colţuri au coordonatele (x1,y1) şi (x2,y2).
program drptg;
  var x1, y1, x2, y2, x, y: real;
  begin
 
write (' x1 = '); readln (x1);
  write (' y1 = '); readln (y1);
  write (' x2 = '); readln (x2);
  write (' y2 = '); readln (y2);
  write (' x = '); readln (x);
  write (' y = '); readln (y);
  if  (x > x1)  and  (x < x2)  and  (y > y1)  and  (y < y2)
      then
     
writeln ('Punctul este situat in interiorul dreptunghiului.')
      else
            if 
(x = x1)  or  (x = x2)  or  (y = y1)  or  (y = y2)
            then 
           
writeln ('Punctul este situat pe o latura a dreptunghiului.')
            else
           
writeln ('Punctul este situat in exteriorul dreptunghiului.');
  readln;
  end.

 

Scrie un număr par a (a >= 4) ca sumă a două numere prime; pot fi mai multe soluţii.
program parprim;
  var a, i, j, k: integer;
  begin
  write(' a = '); readln(a);
  for i: = 2  to a  div  2  do
  begin
  j: = 2;
  while (j <=  i div 2) and (i mod j <> 0) do
  j: = j + 1;
  if  j = i div 2 + 1
      then
      begin
      k: = 2;
      while ( k <= (a - i) div 2) and ((a-i) mod k <> 0 )
      do  
      k: = k + 1;
      if  k = (a - i) div 2 + 1
            then
            writeln (i,' + ', a - i,' = ', a)
      end;
  end
;
  readln;
  end.

 

Încadrează un număr real x între două numere prime p şi q astfel încât diferenţa q - p să fie minimă.
program ex34p189;
  var p, q, i, j: integer;
                x: real;{x >= 2}
  begin
 
write (' x = '); readln (x);
  p: = trunc(x) + 1;
  q: = trunc(x);
  repeat
 
p: = p - 1;
  i: = 2;
  while (i <= p  div  2)  and  (p  mod  i <> 0)  do
  i: = i + 1;
  until (i = p  div  2 + 1)  or  (p = 2);
  repeat
 
q: = q + 1;
  j: = 2;
  while (j <= q  div  2)  and  (q  mod  j <> 0)  do
  j: = j + 1;
  until  j = q  div  2 + 1;
  writeln (p, '   <= ', x : 10 : 2, '  <  ', q);
  readln;
end.

 

Afişează partea întreagă a unui număr real x.
program partintr;
  uses crt;
  var  i, part: integer;
      x: real;
  begin
 
clrscr;
  write (' x = '); readln (x);
  i: = 0;
  if  x >= 0
      then
      begin
      while 
i <= x  do
      i: = i + 1;
      part: = i - 1
      end
      else
      begin
      while 
i >= x  do
      i: = i - 1;
      part: = i + 1
      end;
 
writeln (' part = ' , part);
  readln;
  end.

 

Calculează c.m.m.d.c. şi c.m.m.m.c. a două numere naturale a şi b.
program ex29p189;          
  m: longint;
  begin
  write ('a = '); readln (a);
  write ('b = '); readln (b);
      if a < b
      then
      begin
      d: = a; m: = b; i: = 2;
      while (d > 0) and ((a  mod d <> 0 ) or (b  mod d <> 0)) do
      d: = d - 1;
      while (m mod a <> 0) or (m mod b <> 0) do
      begin
      m: = m*i;
      i: = i + 1
      end
      end
      else
      begin
      d: = b; m: = a; i: = 2;
      while (d > 0 ) and (( a mod d <> 0) or ( b mod d <>0 )) do
      d: = d - 1;
      while ( m mod a <> 0) or ( m mod b <> 0) do
      begin
      m: = m*i;
      i: = i + 1
      end
      end;
  writeln ('C.m.m.d.c. este  ', d);
  writeln ('C.m.m.m.c. este  ', m);
  readln;
  end.

 

Desenează cercurile olimpice.
program cercuri;
  uses graph;
  var gdriver, gmode: integer;
  begin
  gdriver: = detect;
  initgraph(gdriver, gmode,'c:\tp\bgi');
  if graphresult<>0
      then
      begin
      writeln('tentativa esuata');
      halt
      end;
  setcolor(red);
  circle(150,150,80);
  setcolor(yellow);
  circle(270,150,80);
  setcolor(magenta);
  circle(390,150,80);
  setcolor(green);
  circle(210,230,80);
  setcolor(cyan);
  circle(330,230,80);
  settextstyle(triplexfont,0,4);
  outtextxy(150,330,'CERCURILE OLIMPICE');
  readln;
  closegraph
  end.

 

Plimbă un cerc pe ecran până la apăsarea unei taste.
program ex37p190;
  uses graph, crt;
  var gdriver, gmode, d, x, y: integer;
  begin
  gdriver: = detect;
  initgraph(gdriver,gmode,'c:\tp\bgi');
  ifgraphresult <> 0
      then
      begin
      writeln(' tentativa esuata ');
      halt
      end;
  clrscr;
  randomize;
  x: = 20+random(getmaxx-2*20);
  y: = 20+random(getmaxy-2*20);
  circle(x, y, 20);
  repeat
  d: = random(8);
  case d of
  0 : if y>20 then y: = y - 1;
  1 : if (x<getmaxx-20) and (y>20)
      then
      begin
      x: = x + 1;
      y: = y - 1
      end;
  2 : if x<getmaxx-20 then x: = x+1;
  3 : if(x<getmaxx-20) and (y<getmaxy-20) 
      then
      begin
      x: = x + 1;
      y: = y + 1
      end;
  4 : if y<getmaxy-20 then y: = y + 1;
  5 : if (x>20) and (y<getmaxy-20) 
      then
      begin
      x: = x - 1;
      y: = y + 1
      end;
  6 : if x>20 then x: = x - 1;
  7 : if (x>20) and (y>20) 
      then
      begin
      x: = x - 1;
      y: = y - 1
      end
  end;
  setcolor(red);
  circle(x, y, 20);
  delay(100);
  setcolor(black);
  circle(x, y,20);
  until keypressed;
  readln;
  closegraph
  end.

 

Tipăreşte răsturnatul unui număr natural a.
program ex28p189;
  var a, rast: longint;
  begin
  write('a = '); readln (a);
  rast: = 0;
  while a<>0 do
  begin
  rast: = rast*10 + a  mod  10;
  a: = a  div  10
  end;
  writeln('Rasturnatul este ',rast);
  readln;
  end.

 

Verifică dacă 3 numere naturale a, b, c sunt numere pitagorice.
program pitgr;
  uses crt;
  var a, b, c, x, y, z: real;
  begin
 
clrscr;
  write('a = '); readln(a);
  write('b = '); readln(b);
  write('c = '); readln(c);
  x: = sqrt(b*b + c*c);
  y: = sqrt(a*a + c*c);
  z: = sqrt(a*a + b*b);
  if (a = x) or (b = y) or (c = z)
      then
      writeln('Numerele sunt pitagorice.')
      else
      writeln('Numerele nu sunt pitagorice.');
  readln;
  end.