VPF::Сортировка методом линейного выбора и "быстрая" со

Truegirl

Дата 27.9.2009, 22:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 72
Регистрация: 20.11.2008

Репутация: нет
Всего: нет

Уважаемые программисты, помогите пожалуйста доделать задание, никак не получается. надо отсортировать массив двумя способами: по нажатию 3 методом линейного выбора, а по нажатию 4 - ки методом быстрой сортировки с первым разделяющим элементом, собственно 1е я сделала, а 2е никак придкмать не могу. Помогите пожалуйста!!!!

Код


program Project_Sort;

const
max=10000;
type
TMassivInt=array [1..max] of integer;
var
massiv: TMassivInt;

key: byte;
x:integer;



Procedure Show(var massiv: TMassivInt; n:integer);
var
i: integer;
begin
write ('Prosmotr massiva: ');
for i := 1 to n do Write (massiv[i],' ');{вывод на экран}
writeln;
writeln;
end;


Procedure Create(var massiv: TMassivInt; n:integer);
var
i: integer;
begin
writeln ('Sozdat massiv');
write ('Zadat chislo elementov v massive: ');
readln (n);
Randomize;
for i := 1 to n do massiv[i]:=random (100);
Show(massiv, n);
end;


procedure Sort(var massiv: TMassivInt; n:integer );
var
i, j, temp, min:integer;
begin
writeln ('Sortirovka massiva');
writeln('VVesti chislo elementov massiva');
readln(n);
for i:=1 to n-1 do
begin
min := i;
for j:=i+1 to n do
if massiv[j]<massiv[min] then
min := j;
temp := massiv[min];
massiv[min] :=massiv[i];
massiv[i] := temp;
Show(massiv, n);
end;
end;

BEGIN

Writeln ('1: Sozdat massiv');
Writeln ('2: Prosmotr massiva');
Writeln ('3: Sortirovka massiva');
Writeln ('0: Exit');

Repeat

Write('Vibrat kommandu: ');
Readln (key);
case key of
1: Create (massiv, x);
2: begin
writeln ('Prosmotr massiva');
write ('Vvesti chislo elementov v massive: ');
readln (x);
Show (massiv, x);
end;
3: Sort (massiv, x);
end;
until key=0;
end.

evorios

Дата 7.10.2009, 20:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 17.9.2009

Репутация: 1
Всего: 1

Код


program Project_Sort;

{$APPTYPE CONSOLE}

const
  max=10000;
type
  TMassivInt=array [1..max] of integer;
var
  massiv, massiv_orig: TMassivInt;
  init: boolean = false;
  key: byte;
  temp, bool_count, swap_count, n: integer;

procedure CopyArray;
var
  i: integer;
begin
  for i:=1 to n do massiv[i]:=massiv_orig[i];
end;

Procedure Show(cr: boolean = true);
var
  i: integer;
begin
  if cr then write(#13);
  for i := 1 to n do
    if massiv[i]>9 then Write(massiv[i], ' ')
    else Write('0', massiv[i], ' ');{вывод на экран}
end;

procedure ShowLn;
begin
  write('Prosmotr massiva: ');
  Show(false);
  writeln;
end;

Procedure Create;
var
  i: integer;
begin
  writeln ('Sozdat massiv');
  write ('Zadat chislo elementov v massive: ');
  readln (n);
  Randomize;
  for i := 1 to n do massiv_orig[i]:=random(100);
  CopyArray;
  ShowLn;
  init := true;
end;

procedure swap(var i, j: integer);
begin
  temp := massiv[i];
  massiv[i] := massiv[j];
  massiv[j] := temp;
  Show;
  inc(swap_count);
end;

function bool(var i, j: integer): integer;
begin
  inc(bool_count);
  result := i-j; 
end;

procedure Sort;
var
  i, j, min: integer;
begin
  CopyArray;
  bool_count := 0;
  swap_count := 0;
  writeln ('Sortirovka massiva');
  for i:=1 to n-1 do
  begin
    min := i;
    for j:=i+1 to n do
      if bool(massiv[j], massiv[min])<0 then
        min := j;
    swap(min, i);
  end;
  writeln;
  writeln ('Koli4estvo sravnenii: ', bool_count);
  writeln ('Koli4estvo peremeshenii: ', swap_count);
end;

procedure BistrSort;
var
  t: integer;

procedure qsort(var i, j: integer);
var
  m, l, r: integer;
begin
  m:=massiv[i];
  l:=i;
  r:=j;
  while l<r do begin
    while (l<r) and (bool(massiv[l], m)<0) do inc(l);
    while (l<r) and (bool(massiv[r], m)>=0) do dec(r);
    if l<r then swap(l, r);
  end;
  if j-i>1 then begin
    if bool(massiv[l], m)>=0 then dec(l);
    if (bool(massiv[r], m)<0) or (r=i) then inc(r);
    if i<l then qsort(i, l);
    if r<j then qsort(r, j);
  end;
end;

begin
  CopyArray;
  t := 1;
  bool_count := 0;
  swap_count := 0;
  writeln ('Sortirovka massiva');
  qsort(t, n);
  writeln;
  writeln ('Koli4estvo sravnenii: ', bool_count);
  writeln ('Koli4estvo peremeshenii: ', swap_count);
end;

BEGIN

  Writeln ('1: Sozdat massiv');
  Writeln ('2: Prosmotr massiva');
  Writeln ('3: Sortirovka massiva');
  Writeln ('4: Bistraya sortirovka massiva');
  Writeln ('0: Exit');

  Repeat
    Write('Vibrat kommandu: ');
    Readln (key);
    case key of
      0: ;
      1: Create;
      2: if init then begin
        CopyArray;
        ShowLn;
      end
      else writeln ('Massiv ne sozdan.');
      3: if init then Sort
      else writeln ('Massiv ne sozdan.');
      4: if init then BistrSort
      else writeln ('Massiv ne sozdan.');
      else writeln ('Neizvestnaya komanda.');
    end;
  until key=0;
end.

PS можно было ещё немного уменьшить количество сравнений и перемещений, но я не стал заморачиваться

Это сообщение отредактировал(а) evorios - 7.10.2009, 20:48

Truegirl

Дата 16.10.2009, 18:17 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 72
Регистрация: 20.11.2008

Репутация: нет
Всего: нет

спасибо огромное

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »