Divide et impera – Subprograme minim, maxim, suma elemente si interclasare vector

>

{Programul rezolva cu ajutorul subprogramelor minimul unui vector, 
maximul sau, prcum si pe cele doua simultan, suma vectorului, si il
sorteaza prin interclasare.}

program divide_et_impera;
uses crt;
type vector=array[1..10] of integer;
var     v:vector;
        i,n:integer;
        min,max,p,q,mij:integer;
        m:char;
procedure citire;
begin
    writeln;
    writeln('Introduceti elementele vectorului : ');
for i:=1 to n do
   readln(v[i]);
end;
function maxim(p,q:byte):integer;
var max1,max2:integer;
begin
    if p=q then maxim:=v[p]
    else
    begin
    max1:=maxim(p,(p+q)div 2);
    max2:=maxim((p+q)div 2 +1,q);
    if max1>max2 then
    maxim:=max1
    else maxim:=max2;
    end;
    end;
function suma(p,q:byte):integer;
var s,suma1,suma2,mij:integer;
begin
     s:=0;
     if p=q then suma:=s+v[p]
     else
     begin
     mij:=(p+q)div 2;
     suma1:=suma(p,mij);
     suma2:=suma(mij + 1, q);
     suma:=suma1+suma2;
     end;
     end;
function minim(p,q:byte):integer;
var min1,min2:integer;
begin
    if p=q then minim:=v[p]
    else
    begin
    min1:=minim(p,(p+q)div 2);
    min2:=minim((p+q)div 2 +1,q);
    if min1>min2 then
    minim:=min2
    else minim:=min1;
    end;
    end;
procedure min_max(p,q,min,max:integer);
var min1,max1,mij:integer;
begin
     if p=q then
        begin
        min:=v[p];
        max:=v[p];
     end
     else
     if (q=p+1) then
        if (v[p]<v[q]) then
        begin
     min:=v[p];
     max:=v[q];
     end
     else
      begin
       min:=v[q];
       max:=v[p];
         end
         else
         begin
           mij:=(p+q)div 2;
           min_max(p,mij,min1,max1);
           min_max(mij+1,q,min,max);
      if min>min1 then min:=min1;
      if max>max1 then max:=max1;
      end;
      end;

 procedure sort(p,q:integer;var a:vector);
 var m:integer;
 begin
 if a[p]>a[q]  then
                     begin
                     m:=a[p];
                     a[p]:=a[q];
                     a[q]:=m
                     end;
 end;
 procedure interc(p,q,m:integer;var a:vector);
 var b:vector;
        i,j,k:integer;
 begin
 i:=p;
 j:=m+1;
 k:=1;
 while (i<=m) and (j<=q) do
 if a[i]<=a[j] then
                     begin
                     b[k]:=a[i];
                      i:=i+1;
                      k:=k+1
                      end
                      else begin
                             b[k]:=a[j];j:=j+1;k:=k+1
                             end;
 if i<=m then
 for j:=i to m do begin
                          b[k]:=a[j];
                          k:=k+1;
                          end
              else
for i:=j to q do begin
                        b[k]:=a[j];
                         k:=k+1;
                         end;
k:=1;
for i:=p to q do begin
                          a[i]:=b[k];
                          k:=k+1;
                          end
end;
{prcedura catre uneste procedurile de sortare si de interclasare pentru a face posibila sortarea prin interclasare}
procedure divimp(p,q:integer; var a:vector);  
var m:integer;
begin
if (q-p)<=1 then sort(p,q,a)
                   else begin
                           m:=(p+q) div 2;
                           divimp(p,m,a);
                           divimp(m+1,q,a);
                           interc(p,q,m,a);
                           end;
end;
procedure citire2;   {citirea numarului de elemente}
begin
clrscr;
  writeln;
  write('Dati numarul de elemente al vectorului : ');readln(n);
end;
procedure iesire;
begin
end;
  begin
  clrscr;
   
   writeln('********************************************');
   writeln('PROGRAM DE CALCUL CU METODA DIVIDE ET IMPERA');
   writeln('********************************************');
   writeln('');
   writeln('');
   writeln('Apasati tasta corespunzatoare programului dorit : ');
   writeln('');
   writeln('');
   writeln('1. Minimul vectorului ');
   writeln('2. Maximul vectorului ');
   writeln('3. Minimul si maximul ');
   writeln('4. Suma vectorului ');
   writeln('5. Sortarea vectorului prin interclasare ');
   writeln('6. Iesire ');
{prin aceasta metoda se face psibila rularea fiecarui subprogram in parte prin apasarea tastei corspunzatoare}
   m:=readkey;  
    case m of
         '1' : begin
              citire2;
              citire;
              writeln;
         writeln('Minimul este ',minim(1,n));
         readln;
         end;
         '2' : begin
              citire2;
              citire;
              writeln;
         writeln('Maximul este ',maxim(1,n));
        readln;
         end;
         '3' : begin
              citire2;
              citire;
              writeln;
         writeln('Minimul este ',minim(1,n),' si maximul este ', maxim(1,n));
        readln;
         end;
         '4' : begin
              citire2;
              citire;
              writeln;
         writeln('Suma  este  ',suma(1,n));
          readln;
          end;
         '5' : begin
              citire2;
              citire;
              divimp(1,n,v);
              writeln;
              writeln;
              writeln('Elementele vectorului asezate in ordine crescatoare sunt');
              writeln;
              writeln;
 for i:=1 to n do
 writeln (v[i]);
        readln;
           end;
         '6'  : iesire
         end;
end.

{Alexandru Sirbu, oxxy_2005@yahoo.com, pascalzone.evonet.ro}