Divide et Impera: Interclasare vs Farey

PROGRAM Sortare_prin_Interclasare;
TYPE vector=array[1..100] of integer;
Var a:vector;
    n,i:integer;

Procedure sort(p,q:integer;var a:vector);
var aux:integer;
Begin
if(a[p]>a[q]) then
                  begin
                   aux:=a[p];
                   a[p]:=a[q];
                   a[q]:=aux;
                  end;
End;

Procedure interclasare(p,q,m:integer;var a:vector);
var c: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
                     c[k]:=a[i];
                     i:=i+1;
                     k:=k+1;
                    end
 else
  begin
   c[k]:=a[j];
   j:=j+1;
   k:=k+1;
  end;

if(i<=m) then
 for j:=i to m do
  begin
   c[k]:=a[j];
   k:=k+1;
  end
else
 for i:=j to q do
  begin
   c[k]:=a[i];
   k:=k+1;
  end;

k:=1;
for i:=p to q do
 begin
  a[i]:=c[k];
  k:=k+1;
 end;
End;

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;

   writeln(p,' ',m,' ',q);
   {if(m-p>1) then}
    DivImp(p,m,a);
   {if(m+1-q>1) then}
    DivImp(m+1,q,a);
   interclasare(p,q,m,a);
  end;
End;

BEGIN
Readln(n);
 for i:=1 to n do readln(a[i]);
DivImp(1,n,a);

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

readln;

END.

PROGRAM Sortare_prin_Interclasare;
TYPE vector=array[1..10] of longint;
Var a:vector;
    n,i:longint;
    v_N,v_D:vector;

Procedure sort(p,q:integer;var a:vector);
var aux:integer;
Begin
if(a[p]>a[q]) then
                  begin
                   aux:=a[p];
                   a[p]:=a[q];
                   a[q]:=aux;
                  end;
End;

Procedure interclasare(p,q,m:integer;var a:vector);
var c: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
                     c[k]:=a[i];
                     i:=i+1;
                     k:=k+1;
                    end
 else
  begin
   c[k]:=a[j];
   j:=j+1;
   k:=k+1;
  end;

if(i<=m) then
 for j:=i to m do
  begin
   c[k]:=a[j];
   k:=k+1;
  end
else
 for i:=j to q do
  begin
   c[k]:=a[i];
   k:=k+1;
  end;

k:=1;
for i:=p to q do
 begin
  a[i]:=c[k];
  k:=k+1;
 end;
End;

Procedure DivImp(p,q:integer;var a:vector;v_N:vector;v_D:vector);
var m,a1,a2,a3,a4:integer;
Begin
 if
    {(((v_N[3] div v_D[3])-(v_N[1] div v_D[1]))<=1)or}
    (q-p<=1) then sort(p,q,a)
else
  begin
   p:=v_N[1] div v_D[1];
   q:=v_N[3] div v_D[3];

   v_N[2]:=v_N[1]+v_N[3];
   v_D[2]:=v_D[1]+v_D[3];
   m:=v_N[2] div v_D[2];

   writeln(p,' ',m,' ',q);

   {m:=(p+q) div 2;}
   {b:=m;}


   a1:=v_N[3];
   a2:=v_D[3];
   v_N[3]:=v_N[2];
   v_D[3]:=v_D[2];
   {q:=v_N[3] div v_D[3];}
   if(m-p>1) then
    DivImp(p,m,a,v_N,v_D);
   v_N[3]:=a1;
   v_D[3]:=a2;

   {a:=m+1;}

   a3:=v_N[1];
   a4:=v_D[1];
   v_N[1]:=v_N[2]+1;
   v_D[1]:=v_D[2];
   {p:=v_N[1] div v_D[1]+1;}
   if(m+1-q>1) then
    DivImp(m+1,q,a,v_N,v_D);
   v_N[1]:=a3;
   v_D[1]:=a4;


   interclasare(p,q,m,a);
  end;
End;

BEGIN
Readln(n);
 for i:=1 to n do readln(a[i]);

v_N[1]:=1;
v_D[1]:=1;
v_N[3]:=n;
v_D[3]:=1;
v_N[2]:=v_N[1]+v_N[3];
v_D[2]:=v_D[1]+v_D[3];


DivImp(1,n,a,v_N,v_D);

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

readln;

END.

PROGRAM Sortare_prin_Interclasare;
TYPE vector=array[1..100] of longint;
Var a:vector;
    n,i:longint;
    v_N,v_D:vector;

Procedure sort(p,q:integer;var a:vector);
var aux:integer;
Begin
if(a[p]>a[q]) then
                  begin
                   aux:=a[p];
                   a[p]:=a[q];
                   a[q]:=aux;
                  end;
End;

Procedure interclasare(p,q,m:integer;var a:vector);
var c: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
                     c[k]:=a[i];
                     i:=i+1;
                     k:=k+1;
                    end
 else
  begin
   c[k]:=a[j];
   j:=j+1;
   k:=k+1;
  end;

if(i<=m) then
 for j:=i to m do
  begin
   c[k]:=a[j];
   k:=k+1;
  end
else
 for i:=j to q do
  begin
   c[k]:=a[i];
   k:=k+1;
  end;

k:=1;
for i:=p to q do
 begin
  a[i]:=c[k];
  k:=k+1;
 end;
End;

Procedure DivImp(p,q:integer;var a:vector;v_N:vector;v_D:vector);
var m,a1,a2,a3,a4:integer;
Begin
 if
    {(((v_N[3] div v_D[3])-(v_N[1] div v_D[1]))<=1)or}
    (q-p<=1) then sort(p,q,a)
else
  begin
   p:=v_N[1] div v_D[1];
   q:=v_N[3] div v_D[3];

   v_N[2]:=v_N[1]+v_N[3];
   v_D[2]:=v_D[1]+v_D[3];
   m:=v_N[2] div v_D[2];

   writeln(p,' ',m,' ',q);

   {m:=(p+q) div 2;}
   {b:=m;}


   a1:=v_N[3];
   a2:=v_D[3];
   v_N[3]:=v_N[2];
   v_D[3]:=v_D[2];
   {q:=v_N[3] div v_D[3];}
   if(m-p>1) then
    DivImp(p,m,a,v_N,v_D);
   v_N[3]:=a1;
   v_D[3]:=a2;

   {a:=m+1;}

   a3:=v_N[1];
   a4:=v_D[1];
   v_N[1]:=v_N[2]+1;
   v_D[1]:=v_D[2];
   {p:=v_N[1] div v_D[1]+1;}
   if(m+1-q>1) then
    DivImp(m+1,q,a,v_N,v_D);
   v_N[1]:=a3;
   v_D[1]:=a4;


   interclasare(p,q,m,a);
  end;
End;

BEGIN
Readln(n);
 for i:=1 to n do readln(a[i]);

v_N[1]:=1;
v_D[1]:=1;
v_N[3]:=n;
v_D[3]:=1;
v_N[2]:=v_N[1]+v_N[3];
v_D[2]:=v_D[1]+v_D[3];


DivImp(1,n,a,v_N,v_D);

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

readln;

END.

PROGRAM Sortare_prin_Interclasare;
TYPE vector=array[1..100] of longint;
Var a:vector;
    n,i:longint;
    v_N,v_D:vector;

Procedure sort(p,q:integer;var a:vector);
var aux:integer;
Begin
if(a[p]>a[q]) then
                  begin
                   aux:=a[p];
                   a[p]:=a[q];
                   a[q]:=aux;
                  end;
End;

Procedure interclasare(p,q,m:integer;var a:vector);
var c: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
                     c[k]:=a[i];
                     i:=i+1;
                     k:=k+1;
                    end
 else
  begin
   c[k]:=a[j];
   j:=j+1;
   k:=k+1;
  end;

if(i<=m) then
 for j:=i to m do
  begin
   c[k]:=a[j];
   k:=k+1;
  end
else
 for i:=j to q do
  begin
   c[k]:=a[i];
   k:=k+1;
  end;

k:=1;
for i:=p to q do
 begin
  a[i]:=c[k];
  k:=k+1;
 end;
End;

Procedure DivImp(p,q:integer;var a:vector;v_N:vector;v_D:vector);
var m,a1,a2,a3,a4,b1,b2,b3,b4,c1,c2,c3,c4:integer;
Begin
 if(abs(q-p)<1) then sort(p,q,a)
else
  begin
   p:=trunc((v_N[1]/v_D[1])*n);
   q:=trunc((v_N[3]/v_D[3])*n);

   v_N[2]:=v_N[1]+v_N[3];
   v_D[2]:=v_D[1]+v_D[3];
   m:=trunc((v_N[2]/v_D[2])*n);

   writeln(p,' ',m,' ',q);

   {m:=(p+q) div 2;}
   {b:=m;}


   a1:=v_N[3];
   a2:=v_D[3];
   b1:=v_N[1];
   b2:=v_D[1];
   c1:=v_N[2];
   c2:=v_D[2];

   v_N[3]:=v_N[2];
   v_D[3]:=v_D[2];
   {q:=v_N[3] div v_D[3];}
   if(m-p>=1) then
    DivImp(p,m,a,v_N,v_D);
   v_N[3]:=a1;
   v_D[3]:=a2;
   v_N[1]:=b1;
   v_D[1]:=b2;
   v_N[2]:=c1;
   v_D[2]:=c2;
   p:=trunc((v_N[1]/v_D[1])*n);
   q:=trunc((v_N[3]/v_D[3])*n);

   v_N[2]:=v_N[1]+v_N[3];
   v_D[2]:=v_D[1]+v_D[3];
   m:=trunc((v_N[2]/v_D[2])*n);


   {a:=m+1;}

   a3:=v_N[1];
   a4:=v_D[1];
   b3:=v_N[2];
   b4:=v_D[2];
   c1:=v_N[3];
   c2:=v_D[3];


   v_N[1]:=v_N[2]+1;
   v_D[1]:=v_D[2];
   {p:=v_N[1] div v_D[1]+1;}
   if(m-q>=1) then
    DivImp(m+1,q,a,v_N,v_D);
   v_N[1]:=a3;
   v_D[1]:=a4;
   v_N[2]:=b3;
   v_D[2]:=b4;
   v_N[3]:=c1;
   v_D[3]:=c2;
   p:=trunc((v_N[1]/v_D[1])*n);
   q:=trunc((v_N[3]/v_D[3])*n);

   v_N[2]:=v_N[1]+v_N[3];
   v_D[2]:=v_D[1]+v_D[3];
   m:=trunc((v_N[2]/v_D[2])*n);


   interclasare(p,q,m,a);
  end;
End;

BEGIN
Readln(n);
 for i:=1 to n do readln(a[i]);

v_N[1]:=0;
v_D[1]:=1;
v_N[3]:=1;
v_D[3]:=1;
v_N[2]:=v_N[1]+v_N[3];
v_D[2]:=v_D[1]+v_D[3];


DivImp(1,n,a,v_N,v_D);

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

readln;

END.

Comentarii

Trimiteți un comentariu

Postări populare de pe acest blog

Descompunere numar in suma de numere

UNIT Des; INTERFACE Uses Graph,Crt; Type Vd=array[0..500] of word; Var sol,sl2:Vd; i,dist,nr,v_intr:Word; gd,gm,vdd,xd,clk:integer; p,c,cont,val_i,opt:word; Procedure Desen(sl:Vd;p:word); Procedure InitGR; Procedure Concluzii_GR; Procedure Meniu; IMPLEMENTATION Procedure Meniu; Begin {clrscr;} Writeln(' ~ MENIU ~'); Writeln(' 1. Text'); Writeln(' 2. Grafic'); Writeln(' Alegeti o optiune : '); Readln(opt); if not (opt in [1..2]) then Begin TextColor(LightRed); Writeln('Eroare la intr opt '); sound(350); Delay(3500); nosound; TextColor(15); Halt; End; clrscr; End; Procedure InitGR; Begin gd:=0; dist:=0; Write('Intr val pt DELAY -> recomandari : min (nr*p)^2 , pt nr mici :'); Readln(v_intr); Initgraph(gd,gm,'c:\bp\bgi'); setviewport(0,10,getmaxx-10,500,true); End; Procedure DesHis3D(v:word); Begin Bar3d(xd,vdd-v*10,10+xd,vdd,10,true); dist:=dist+15; End; Procedure Desen(sl:Vd;p:word); Begin dist...
Citiți mai multe