DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »sorttxt«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »sorttxt« 

TextFile

(sort=algol list.no xref.no
)
begin
  comment program til intern sortering;
  integer m,n,kk;
  write(out,<:angiv antal elementer::>);
  setposition(out,0,0);
  read(in,m,n);
  begin
    integer procedure lige(f,s);
    integer f,s;
    begin
      integer ll,jj;
      ll:=0;
      jj:=1;
      repeat
    write(out,jj,f,s);
      ll:=if A(jj,f)<A(jj,s) then -1 else if A(jj,f)>A(jj,s) then 1 else 0;
      jj:=jj+1;
      until jj=m+1 or ll<>0;
    end lige;

    procedure ombyt(f,s);
    integer f,s;
    begin
      integer jj,x;
      for jj:=1 step 1 until m do
      begin
        x:=A(jj,f);  A(jj,f):=A(jj,s);  A(jj,s):=x;
      end;
    end;

    integer array A(1:m,0:n),grænse(1:2,1:ln(n)/ln(2)+1);
    real r,r1,r2,r3;
    integer i,j,k,p,første,sidste;
    for j:=1 step 1 until m do
    for i:=1 step 1 until n do A(j,i):=10000*random(kk);
    for j:=1 step 1 until m do A(j,0):=-1;
    comment start sortering;
    r:=systime(1,r1,r2);
    p:=1;
    første:=1;  sidste:=n;
næstestreng:
    i:=første;   j:=sidste;
    k:=i+(j-i)//2;   comment k udpeger midterelementet;
    if lige(i,k)=1 then ombyt(i,k);
    if lige(k,j)=1 then ombyt(k,j);
    if lige(i,k)=1 then ombyt(i,k);
    comment nu er A(i) <= A(k) <=A(j) ;
C1: i:=i+1;
    if lige(i,k)=-1 then goto C1;
    comment nu er A(i) >= A(k);
C2: j:=j-1;
    if lige(j,k)=1 then goto C2;
    comment nu er A(k) >= A(j);
    if i <= j then ombyt(i,j) else goto nystreng;
    if j=k then k:=i else if i=k then k:=j;
    goto C1;
nystreng:
    if sidste - i < j - første then
    begin comment øverste streng vælges;
      grænse(1,p):=i;  grænse(2,p):=sidste;
      sidste:=j;
    end else
    begin comment nederste streng vælges;
      grænse(1,p):=første;  grænse(2,p):=j;
      første:=i;
    end;
    p:=p+1;
nytest:
    if sidste-første>1 then goto næstestreng;
    if sidste-første=1 and lige(første,sidste)=1 then ombyt(første,sidste);
    p:=p-1;
    if p<1 then goto stop;
    første:=grænse(1,p);
    sidste:=grænse(2,p);
    goto nytest;
stop:
    write(out,<:<10>tid: :>,systime(1,r1,r2)-r);
    for i:=1 step 1 until n do if lige(i-1,i)=1 then write(out,<:<10>:>,i);
  end;
end
▶EOF◀