Сортировка методом пузырька

[Raze]

Помогите пожалуйста. Кто знает как сделать так, чтобы метод пузырька не выполнял лишних итераций. Мне сказали, что не хватает флажка реализующего это. Может неправильный алгоритм?

program massiv;
uses crt;
const
n=5;
m=6;
Type
matrix=Array [1..n,1..m] of real;
matrsums=array[1..n]of real;
var
A:matrix;
sums:matrsums;
l,k,i,j:integer;
s:integer;
c,s2:real;
key:char;

begin
repeat
clrscr;
randomize;
writeln('Массив A');
for i:=1 to n do begin writeln;
for j:=1 to m do begin;
A[i,j]:=random(100);
write(' ',a[i,j]:3:2);
end;
end;
for k:=1 to n do begin
sums[k]:=0;
For j:=1 to m do sums[k]:=sums[k]+a[k,j];
writeln;
writeln('Сумма элементов ' ,k, ' строки',' ',sums[k]:6:3);
end;
for i:=1 to n do
for j:=1 to n-i do
if(sums[j]>sums[j+1])then
begin
c:=sums[j];
sums[j]:=sums[j+1];
sums[j+1]:=c;
for k:=1 to m do
begin
c:=a[j,k];
a[j,k]:=a[j+1,k];
a[j+1,k]:=c;
end;
end;
writeln ('Отсортированный массив А');
writeln;
for i:=1 to n do
begin
for j:=1 to m do write(a[i,j]:8:2);
writeln;
end;
Writeln('Начать заново?');
Writeln('Нажмите Esc для выхода или любую другую клавишу для продолжения');
key := readkey;
Until key = #27
End.

[namomelkor]

попробуйте быструю сортировку

Код: Выделить всё

program Quitsort;
 uses
   crt;
 Const
  N=10;
 Type
  Mas=array[1..n] of integer;
var
  a: mas;
  k: integer;
function Part(l, r: integer):integer;
var
  v, i, j, b: integer;
begin
  V:=a[r];
  I:=l-1;
  j:=r;
  repeat
    repeat
      dec(j)
    until (a[j]<=v) or (j=i+1);
    repeat
      inc(i)
    until (a[i]>=v) or (i=j-1);
    b:=a[i];
    a[i]:=a[j];
    a[j]:=b;
  until i>=j;
  a[j]:=a[i];
  a[i]:= a[r];
  a[r]:=b;
  part:=i;
end;
procedure QuickSort(l, t: integer);
var i: integer;
begin
  if l<t then
    begin
      i:=part(l, t);
      QuickSort(l,i-1);
      QuickSort(i+1,t);
    end;
end;
begin
  clrscr;
  randomize;
  for k:=1 to 10 do
    begin
      a[k]:=random(100);
      write(a[k]:3);
    end;
  QuickSort(1,n);
  writeln;
  for k:=1 to n do
    write(a[k]:3);
  readln;
end.

[Игорь Акопян]

народ! юзайте тэг code из расширенного режима

[Oleg_Rus]

а если через for

const nn=100;

type mas=array[1..nn];

var a: mas;
n: integer;

procedure CreateArray;
var i: Integer;
begin
for i:=1 to n do
a:=random(10);
end;

procedure SortArray;
var i, j, buf: Integer;
begin
for i:=1 to n do
for j:=1 to n do
if a<a[j] then
begin
buf:=a;
a:=a[j];
a[j]:=buf;
end;
end;

procedure WriteArray;
begin
for i:=1 to n do write(a:3);
end;

procedure WorkPlace;
begin
Write('Input n:= ');
readln(n);
CreateArray;
SortArray;
WriteArray;
readln;
end;

begin
WorkPlace;
end.

[namomelkor]

procedure SortArray;
var i, j, buf: Integer;
begin
for i:=1 to n do
for j:=1 to n do
if a<a[j] then
begin
buf:=a;
a:=a[j];
a[j]:=buf;
end;
end;

много лишних действий лучше это процедурку переделать так

Код: Выделить всё

procedure SortArray;
var i, j, buf, nom: Integer;
begin
  for i:=1 to n-1 do
  begin
    nom:=i;
    for j:=i+1 to n do
    if a[i]<a[j] then 
      nom:=j;
    buf:=a[i];
    a[i]:=a[nom];
    a[nom]:=buf;
  end;
end;

[Blood_Magic]

народ! юзайте тэг code из расширенного режима

у меня не работает нифига, есть только "Иконки для сообщения" и все!!!

[Колядин Максим]

у меня не работает нифига, есть только "Иконки для сообщения" и все!!!

Если действительно нет, тогда в начале кода с программой пиши в квадратных скобках ([]) ключевое слово CODE, а в конце, тоже в квадратных скобках /CODE

Код: Выделить всё

(code)
                        Вместо закруглённых - квадратные [] 
(/code)    

Код: Выделить всё

[КОД]
begin
var
end.
[/КОД]