Помощь - Поиск - Пользователи - Календарь
Полная версия: Проверьте плиз правильно ли я считаю сравнения в сортировках
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Neon6868
Там 8 методов сортировок(Пузырёк, Шейкерная, Простая вставка, Бинарные вставки, Прямой выбор, Шейла, Шейла с заданным числом шагов, Хоара).Число сравнений считает y.Где надо писать y:=y+1? Я написал, но скорее всего не там!!!!!!!!!ъ

Вот прога.


Program sortirovka;
  const
    n=15;
  type
    mas=array[-9..n] of integer;
  var
    a:mas;
    i,j:integer;
Procedure puzirkovaya(a:mas);
  var
    y,x,i,j:integer;
  Begin
    y:=0;
    for i:=2 to n do
      for j:=n downto i do begin
        y:=y+1;
          if a[j-1]>a[j] then begin
            x:=a[j-1];
            a[j-1]:=a[j];
            a[j]:=x;
          end;
      end;
    writeln('Puzirkovaya sortirovka');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
  End;
Procedure Sheikernaya(a:mas);
  var
    l,r,k,j,y,x:integer;
  Begin
    l:=2;
    r:=n;
    k:=n;
    repeat
      for j:=r downto l do begin
        y:=y+1;
        if a[j-1]>a[j] then begin
          x:=a[j-1];
          a[j-1]:=a[j];
          a[j]:=x;
          k:=j;
        end;
      end;
        l:=k+1;
          for j:=l to r do begin
            y:=y+1;
              if a[j-1]>a[j] then begin
                x:=a[j-1];
                a[j-1]:=a[j];
                a[j]:=x;
                k:=j;
              end;
          end;
        r:=k-1;
    Until l>r;
    writeln('Sheikernaya sortirovka');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
End;
Procedure sortirovka_vstavkami(a:mas);
  var
    i,x,y,j:integer;
  Begin
    for i:=2 to n do begin
      x:=a[i];
      a[0]:=x;
      j:=i;
      y:=y+1;
        while x<a[j-1] do begin
          y:=y+1;
          a[j]:=a[j-1];
          j:=j-1;
        end;
      a[j]:=x;
    end;
    writeln('Sortirovka vstavkami');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
End;
Procedure binarnie_vstavki(a:mas);
  var
    i,j,y,l,m,r,x:integer;
  Begin
    for i:=2 to n do begin
      y:=y+1;
      x:=a[i];
      l:=1;
      r:=i;
      while l<r do begin
        m:=(l+r) div 2;
          if a[m]<=x then l:=m+1
            else r:=m;
      end;
        for j:=i downto r+1 do a[j]:=a[j-1];
      a[r]:=x;
    end;
    writeln('Sortirovka binarnimi vstavkami');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
End;
Procedure pryamoi_vibor(a:mas);
  var
    i,j,x,y,k:integer;
  Begin
    for i:=1 to n do begin
      k:=i;
      x:=a[i];
      y:=y+1;
        for j:=i+1 to n do
          if a[j]<x then begin
            k:=j;
            x:=a[k];
          end;
      a[k]:=a[i];
      a[i]:=x;
    end;
    writeln('Sortirovka s pomoschiu pryamogo vibora');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
  End;
Procedure Shella(a:mas);
  var
    i,j,m,x,y:integer;
  Begin
    m:=n;
    while m>=1 do begin
      m:=m div 2;
      y:=y+1;
        for i:=m+1 to n do begin
          x:=a[i];
          j:=i-m;
            while (j>=1) and (x<a[j]) do begin
              a[j+m]:=a[j];
              j:=j-m;
            end;
          a[j+m]:=x;
        end;
    end;
    writeln('Sortirovka Shella');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
  End;
Procedure Shella2(a:mas);
  const
    h:array [1..4] of integer=(9,5,3,1);
  var
    i,j,k,s,y,x:integer;
    m:1..4;
  Begin
    for m:=1 to 4 do begin
      k:=h[m];
      s:=-k;
      y:=y+1;
        for i:=k+1 to n do begin
          x:=a[i];
          j:=i-k;
          if s=0 then s:=-k;
          s:=s+1;
          a[s]:=x;
            while x<a[j] do begin
              a[j+k]:=a[j];
              j:=j-k;
            end;
          a[j+k]:=x;
        end;
    end;
    writeln('Sortirovka Shella s zadannoi posledovatelnostui shagov');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
  End;
Procedure Xoara(a:mas);
  const
    m=12;
  var
    i,j,l,r,y:integer;
    x,w:integer;
    s:0..m;
    stack:array [1..m] of record
                      l,r:integer;
                      end;
  Begin
    s:=1;
    stack[s].l:=1;
    stack[s].r:=n;
      repeat
        l:=stack[s].l;
        r:=stack[s].r;
        s:=s-1;
      repeat
        i:=l;
        j:=r;
        x:=a[(l+r) div 2];
      repeat
        while a[i]<x do i:=i+1;
           while x<a[j] do j:=j-1;
            if i<=j then begin
              w:=a[i];
              a[i]:=a[j];
              a[j]:=w;
              i:=i+1;
              j:=j-1;
            end;
      until i>j;
        if i<r then begin
          s:=s+1;
          stack[s].l:=i;
          stack[s].r:=r;
        end;
        r:=j;
      until l>=r;
      until s=0;
      writeln('Sortirovka Xoara');
    for i:=1 to n do write(a[i]:5);
    writeln;
    writeln('Chislo sravnenii:',y);
  End;
Begin
  randomize;
  writeln('Isxodnii massiv:');
  for i:=1 to n do begin
    a[i]:=random(50)-25;
    write(a[i]:5);
  end;
  writeln;
  puzirkovaya(a);
  Sheikernaya(a);
  sortirovka_vstavkami(a);
  binarnie_vstavki(a);
  pryamoi_vibor(a);
  Shella(a);
  Shella2(a);
  Xoara(a);
  readln;
End.


volvo
По поводу Пузырька и Хоара в поиске вот что нашлось:
Счётчик

По поводу других - метод тот же, замена операции сравнения на функцию, а в функции - увеличение счетчика... Это самый оптимальный способ...
Neon6868
Цитата(volvo @ 16.03.2007 19:13) *

По поводу Пузырька и Хоара в поиске вот что нашлось:
Счётчик

По поводу других - метод тот же, замена операции сравнения на функцию, а в функции - увеличение счетчика... Это самый оптимальный способ...



Я понимаю, что надо увеличивать счётчик! А где это в процедурах надо делать???
volvo
Я тебе ссылку привел, будь добр пройти по ней, и прочесть, что там написано! mad.gif Ты что, решил, что специально для тебя я тут буду распинаться второй раз на ту же тему? Ошибаешься...
why cant i import kamagra to can
Apo Amoxil
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.