Модераторы: Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> [Delphi] Сортировка массивов 
V
    Опции темы
koshkarjov
Дата 19.8.2012, 23:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Здравствуйте! Пишу программу, реализующую различные методы сортировок.
Застрял на методе быстрой сортировки, а именно при добавлении в процедуру подсчета числа сравнений и перестановок. 

Компилятор выводит вот такие ошибки:
Код

[Error] UnitMain.pas(193): Types of actual and formal var parameters must be identical
[Error] UnitMain.pas(194): Types of actual and formal var parameters must be identical
[Error] UnitMain.pas(258): Not enough actual parameters
[Error] UnitMain.pas(298): Types of actual and formal var parameters must be identical
[Fatal Error] T20_P1.dpr(5): Could not compile used unit 'UnitMain.pas'


Код

unit UnitMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
 
type
  TFormMain = class(TForm)
    EditSrc: TEdit;
    btnSort: TButton;
    Label2: TLabel;
    cbSortType: TComboBox;
    btnInitRnd: TButton;
    MemoLog: TMemo;
    btnSortAll: TButton;
    brnPrint: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnInitRndClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure btnSortAllClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure brnPrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //массив
  TArrayOfInteger = array of Integer;
 
const
  //ограничим генерируемые числа
  cMaxInt = 10000;
 
var
  FormMain: TFormMain;
  //массив
  a: TArrayOfInteger;
 
//инициализация
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
//вспомогательная функция копирования
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
//очистка
procedure ArrayClear(a: TArrayOfInteger);
//сортировки
//Метод обмена (Метод пузырька)
procedure BubbleSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод вставок
procedure InsertSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод выбора
procedure ChooseSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод быстрой сортировки
procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean = true);
//Cmp - число сравнений
//Sw - число перестановок
 
implementation
 
{$R *.dfm}
 
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
var
  i: Integer;
begin
  //забиваем массив случайными числами
  ArrayClear(a);
  SetLength(a,N);
  for i:=0 to N-1 do
    a[i]:=Random(cMaxInt);
end;
 
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
var
  i,N: Integer;
begin
  //копируем массив
  N:=Length(a);
  SetLength(Result,N);
  for i:=0 to N-1 do
    Result[i]:=a[i];
end;
 
procedure ArrayClear(a: TArrayOfInteger);
begin
  SetLength(a,0);
end;
 
procedure BubbleSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    for j:=N-1 downto i do
      begin
      Inc(Cmp);
      if a[j-1]>a[j] then
        begin
        Inc(Sw);
        temp:=a[j-1];
        a[j-1]:=a[j];
        a[j]:=temp;
        end;
      end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure InsertSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    begin
    temp:=a[i];
    j:=i-1;
    while (j>=0) and (temp<a[j]) do
      begin
      Inc(Cmp);
      Inc(Sw);
      a[j+1]:=a[j];
      Dec(j);
      end;
    Inc(Cmp);
    a[j+1]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure ChooseSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,k,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=0 to N-2 do
    begin
    k:=i;
    temp:=a[i];
    for j:=i+1 to N-1 do
      begin
      Inc(Cmp);
      if a[j]<temp then
        begin
        k:=j;
        temp:=a[j];
        Inc(Sw);
        end;
      end;
    a[k]:=a[i];
    a[i]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean);
var
  i,j,sred,temp,N:integer;
begin
   Cmp:=0;
   Sw:=0;
   N:=Length(a);
   i:=left; j:=right; //установка начальных границ подмассива
   sred:=a[(left+right) div 2]; //определение серединного элемента
   repeat
      while (a[i]<sred) do i:=i+1; //поиск слева элемента, большего опорного
      while (a[j]>sred) do j:=j-1; //поиск справа элемента, меньшего опорного
      if i<=j then
      begin //обмениваем элементы и изменяем индексы
         temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
         i:=i+1; j:=j-1;
         Inc(Cmp);
      end;
   until i>j;
   if left<j then QuickSort(a, left, j, toShow); //обработка левой половины
   if i<right then QuickSort(a, i, right, toShow); //обработка правой половины
   Inc(Sw);
   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
   if toShow then
      for i:=0 to High(a) do
         FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.btnInitRndClick(Sender: TObject);
var
  i,aCount: Integer;
begin
  try
    aCount:=StrToInt(EditSrc.Text);
    ArrayInitRnd(a,aCount);
    MemoLog.Lines.Clear;
    for i:=0 to aCount-1 do
      MemoLog.Lines.Add(IntToStr(a[i]));
  except
    ShowMessage('Введите целое число');
  end;
end;
 
procedure TFormMain.btnSortClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  case cbSortType.ItemIndex of
  0:
    begin
    MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
    BubbleSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  1:
    begin
    MemoLog.Lines.Add('Метод вставок');
    InsertSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  2:
    begin
    MemoLog.Lines.Add('Метод выбора');
    ChooseSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  3:
    begin
    MemoLog.Lines.Add('Метод быстрой сортировки');
    QuickSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  end;
  SetLength(b,0);
end;
 
procedure TFormMain.btnSortAllClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //всякий раз работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  BubbleSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  InsertSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод вставок');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  ChooseSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод выбора');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  QuickSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод быстрой сортировки');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
end;
 
procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.brnPrintClick(Sender: TObject);
var
  i: Integer;
begin
  MemoLog.Lines.Clear;
  for i:=0 to Length(a)-1 do
    MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
end.

Сам проект также прикладываю во вложениях. Заранее благодарен за помощь!

Это сообщение отредактировал(а) koshkarjov - 16.9.2012, 15:41

Присоединённый файл ( Кол-во скачиваний: 6 )
Присоединённый файл  sort.rar 201,64 Kb
PM MAIL   Вверх
koshkarjov
Дата 16.9.2012, 15:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Сам думаю, что запутался в описании переменных Cmp (число сравнений) и Sw (число перестановок). Если их описать, как в предыдущем сообщении, то выходит ошибка. Хотя в других процедурах при таком же описании все работает. Если же описать их в var, вместе с обычными переменными, то они просто не учитываются:
Код

[Hint] UnitMain.pas(196): Value assigned to 'Sw' never used
[Hint] UnitMain.pas(191): Value assigned to 'Cmp' never used
[Hint] UnitMain.pas(181): Value assigned to 'N' never used
[Hint] UnitMain.pas(180): Value assigned to 'Sw' never used
[Hint] UnitMain.pas(179): Value assigned to 'Cmp' never used
PM MAIL   Вверх
Mirkes
Дата 16.9.2012, 18:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 17
Ошибок несколько.
1. Подсчет сравнений и перестановок вообще не ведется!
2. QuickSort вызывается рекурсивно, а параметры ему не передаются. Точнее почему-то передаются не все параметры.
Разбираемся исключительно с QuickSort
Исходный текст.
Код

procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean);
var
  i,j,sred,temp,N:integer;
begin
   Cmp:=0;
   Sw:=0;
   N:=Length(a);
   i:=left; j:=right; //установка начальных границ подмассива
   sred:=a[(left+right) div 2]; //определение серединного элемента
   repeat
      while (a[i]<sred) do i:=i+1; //поиск слева элемента, большего опорного
      while (a[j]>sred) do j:=j-1; //поиск справа элемента, меньшего опорного
      if i<=j then
      begin //обмениваем элементы и изменяем индексы
         temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
         i:=i+1; j:=j-1;
         Inc(Cmp);
      end;
   until i>j;
   if left<j then QuickSort(a, left, j, toShow); //обработка левой половины
   if i<right then QuickSort(a, i, right, toShow); //обработка правой половины
   Inc(Sw);
   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
   if toShow then
      for i:=0 to High(a) do
         FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;

Исправляем вторую ошибку
Код

   if left<j then QuickSort(a, Cmp, Sw, left, j, toShow); //обработка левой половины
   if i<right then QuickSort(a, Cmp, Sw, i, right, toShow); //обработка правой половины

При рекурсивном вызове надо передавать все параметры!
Теперь разберемся со сравнениями и перестановками.
Сравнение - это любое сравнение элементов массива!
Перестановка - любая перестановка элементов массива
Правим текст:
Код

procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean);
var
  i,j,sred,temp,N:integer;
begin
   Cmp:=0;
   Sw:=0;
   N:=Length(a);
   i:=left; j:=right; //установка начальных границ подмассива
   sred:=a[(left+right) div 2]; //определение серединного элемента
   repeat
      while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
      while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
      if i<=j then
      begin //обмениваем элементы и изменяем индексы
         temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
         i:=i+1; j:=j-1;
         Inc(Sw); //Inc(Cmp); Пишешь обмениваем а увеличиваешь счетчик сравнений!
      end;
   until i>j;
   if left<j then QuickSort(a, left, j, toShow); //обработка левой половины
   if i<right then QuickSort(a, i, right, toShow); //обработка правой половины
//   Inc(Sw); А вот здесь ничего не переставлялось!
   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
   if toShow then
      for i:=0 to High(a) do
         FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;


Советую проверить и другие методы на предмет подсчета НУЖНЫХ величин.


--------------------
Mirkes
PM MAIL   Вверх
koshkarjov
Дата 16.9.2012, 20:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Mirkes, спасибо за помощь!

И еще вопрос: возникают ошибки при вызове функции:
Код

[Hint] UnitMain.pas(180): Value assigned to 'N' never used
[Error] UnitMain.pas(257): Not enough actual parameters
[Error] UnitMain.pas(297): Types of actual and formal var parameters must be identical
[Fatal Error] T20_P1.dpr(5): Could not compile used unit 'UnitMain.pas'

Я так понимаю проблема опять в том, что я не все параметры передаю туда?

Код

unit UnitMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
 
type
  TFormMain = class(TForm)
    EditSrc: TEdit;
    btnSort: TButton;
    Label2: TLabel;
    cbSortType: TComboBox;
    btnInitRnd: TButton;
    MemoLog: TMemo;
    btnSortAll: TButton;
    brnPrint: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnInitRndClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure btnSortAllClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure brnPrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //массив
  TArrayOfInteger = array of Integer;
 
const
  //ограничим генерируемые числа
  cMaxInt = 10000;
 
var
  FormMain: TFormMain;
  //массив
  a: TArrayOfInteger;
 
//инициализация
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
//вспомогательная функция копирования
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
//очистка
procedure ArrayClear(a: TArrayOfInteger);
//сортировки
//Метод обмена (Метод пузырька)
procedure BubbleSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод вставок
procedure InsertSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод выбора
procedure ChooseSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод быстрой сортировки
procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean = true);
//Cmp - число сравнений
//Sw - число перестановок
 
implementation
 
{$R *.dfm}
 
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
var
  i: Integer;
begin
  //забиваем массив случайными числами
  ArrayClear(a);
  SetLength(a,N);
  for i:=0 to N-1 do
    a[i]:=Random(cMaxInt);
end;
 
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
var
  i,N: Integer;
begin
  //копируем массив
  N:=Length(a);
  SetLength(Result,N);
  for i:=0 to N-1 do
    Result[i]:=a[i];
end;
 
procedure ArrayClear(a: TArrayOfInteger);
begin
  SetLength(a,0);
end;
 
procedure BubbleSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    for j:=N-1 downto i do
      begin
      Inc(Cmp);
      if a[j-1]>a[j] then
        begin
        Inc(Sw);
        temp:=a[j-1];
        a[j-1]:=a[j];
        a[j]:=temp;
        end;
      end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure InsertSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    begin
    temp:=a[i];
    j:=i-1;
    while (j>=0) and (temp<a[j]) do
      begin
      Inc(Cmp);
      Inc(Sw);
      a[j+1]:=a[j];
      Dec(j);
      end;
    Inc(Cmp);
    a[j+1]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure ChooseSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,k,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=0 to N-2 do
    begin
    k:=i;
    temp:=a[i];
    for j:=i+1 to N-1 do
      begin
      Inc(Cmp);
      if a[j]<temp then
        begin
        k:=j;
        temp:=a[j];
        Inc(Sw);
        end;
      end;
    a[k]:=a[i];
    a[i]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw, Left, Right: Integer; toShow: Boolean);
var
  i,j,sred,temp,N:integer;
begin
   Cmp:=0;
   Sw:=0;
   N:=Length(a);
   i:=left; j:=right; //установка начальных границ подмассива
   sred:=a[(left+right) div 2]; //определение серединного элемента
   repeat
      while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
      while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
      if i<=j then
      begin //обмениваем элементы и изменяем индексы
         temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
         i:=i+1; j:=j-1;
         Inc(Sw);
      end;
   until i>j;
   if left<j then QuickSort(a, Cmp, Sw, left, j, toShow); //обработка левой половины
   if i<right then QuickSort(a, Cmp, Sw, i, right, toShow); //обработка правой половины
   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
   if toShow then
      for i:=0 to High(a) do
         FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.btnInitRndClick(Sender: TObject);
var
  i,aCount: Integer;
begin
  try
    aCount:=StrToInt(EditSrc.Text);
    ArrayInitRnd(a,aCount);
    MemoLog.Lines.Clear;
    for i:=0 to aCount-1 do
      MemoLog.Lines.Add(IntToStr(a[i]));
  except
    ShowMessage('Введите целое число');
  end;
end;
 
procedure TFormMain.btnSortClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  case cbSortType.ItemIndex of
  0:
    begin
    MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
    BubbleSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  1:
    begin
    MemoLog.Lines.Add('Метод вставок');
    InsertSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  2:
    begin
    MemoLog.Lines.Add('Метод выбора');
    ChooseSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  3:
    begin
    MemoLog.Lines.Add('Метод быстрой сортировки');
    QuickSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  end;
  SetLength(b,0);
end;
 
procedure TFormMain.btnSortAllClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //всякий раз работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  BubbleSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  InsertSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод вставок');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  ChooseSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод выбора');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  QuickSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод быстрой сортировки');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
end;
 
procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.brnPrintClick(Sender: TObject);
var
  i: Integer;
begin
  MemoLog.Lines.Clear;
  for i:=0 to Length(a)-1 do
    MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
end.
PM MAIL   Вверх
Mirkes
Дата 17.9.2012, 06:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 17
Вообще то это свинство. Как я длжен найти строки, если номеров нет? Хоть бы в искомых строках поставил признак "Ошибка здесь. Строка №180"
Цитата(koshkarjov @  16.9.2012,  20:58 Найти цитируемый пост)
И еще вопрос: возникают ошибки при вызове функции:
Код

[Hint] UnitMain.pas(180): Value assigned to 'N' never used
[Error] UnitMain.pas(257): Not enough actual parameters
[Error] UnitMain.pas(297): Types of actual and formal var parameters must be identical
[Fatal Error] T20_P1.dpr(5): Could not compile used unit 'UnitMain.pas
;
Я так понимаю проблема опять в том, что я не все параметры передаю туда?


Ответы по порядку.
в 180 строке выплняется ненужное действие. Эту строку можно удалить вместе с описанием переменной N
строка 257 - правильно понимаете.
В процедуре QuickSort вы определили набор параметров
Код

procedure QuickSort (a: TArrayOfInteger;            // сортируемый массив
                              var Cmp,              // число сравнений
                                  Sw,               // число перестановок
                                  Left,             // левый элемент сортируемого фрагмента
                                  Right: Integer;   // правый элемент сортируемого фрагмента
                                  toShow: Boolean); // признак вывода на печать


Некорректное замечание: какого черта параметры left и right передаются по ссылке? Их нужно менять в процедуре и возвращать значения? Если нет - НИКОГДА не передавайте параметры по ссылке, если они не ДОЛЖНЫ меняться в процедуре, причем их изменение ДОЛЖНО быть видно снаружи!
Но в данном случае это не привело к ошибке.
Вызов вы осуществили в форме
Цитата

Код

    QuickSort(b,Cmp,Sw);


Внимание вопрос: Как процедура сортировки должна догадаться откуда, докуда сортировать и печатать ли массив?
правильная форма вызова очевидно такая:
Код

    QuickSort(b,Cmp,Sw,0,High(b),false); // или true если хочется видеть печать.

И что самое печальное - delphi опять будет ругаться. Следует еще изменить описание метода:
Код

procedure QuickSort (a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean); 

или присвоить 0 и High(b) в специально созданные переменные. А все из-за неправильного описания. Я бы рекомендовал изменить описание.

срока 297 - та же песня. Исправьте параметры

Последняя ошибка следствие предыдущих.


--------------------
Mirkes
PM MAIL   Вверх
koshkarjov
Дата 17.9.2012, 19:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Выкладываю готовую программу, вдруг кому нужно будет.
Код

unit UnitMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
 
type
  TFormMain = class(TForm)
    EditSrc: TEdit;
    btnSort: TButton;
    Label2: TLabel;
    cbSortType: TComboBox;
    btnInitRnd: TButton;
    MemoLog: TMemo;
    btnSortAll: TButton;
    brnPrint: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnInitRndClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure btnSortAllClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure brnPrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //массив
  TArrayOfInteger = array of Integer;
 
const
  //ограничим генерируемые числа
  cMaxInt = 10000;
 
var
  FormMain: TFormMain;
  //массив
  a: TArrayOfInteger;
 
//инициализация
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
//вспомогательная функция копирования
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
//очистка
procedure ArrayClear(a: TArrayOfInteger);
//сортировки
//Метод обмена (Метод пузырька)
procedure BubbleSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод вставок
procedure InsertSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод выбора
procedure ChooseSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод быстрой сортировки
procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean = true);
//Cmp - число сравнений
//Sw - число перестановок
 
implementation
 
{$R *.dfm}

procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
var
  i: Integer;
begin
  //забиваем массив случайными числами
  ArrayClear(a);
  SetLength(a,N);
  for i:=0 to N-1 do
    a[i]:=Random(cMaxInt);
end;
 
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
var
  i,N: Integer;
begin
  //копируем массив
  N:=Length(a);
  SetLength(Result,N);
  for i:=0 to N-1 do
    Result[i]:=a[i];
end;
 
procedure ArrayClear(a: TArrayOfInteger);
begin
  SetLength(a,0);
end;
 
procedure BubbleSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    for j:=N-1 downto i do
      begin
      Inc(Cmp);
      if a[j-1]>a[j] then
        begin
        Inc(Sw);
        temp:=a[j-1];
        a[j-1]:=a[j];
        a[j]:=temp;
        end;
      end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure InsertSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=1 to N-1 do
    begin
    temp:=a[i];
    j:=i-1;
    while (j>=0) and (temp<a[j]) do
      begin
      Inc(Cmp);
      Inc(Sw);
      a[j+1]:=a[j];
      Dec(j);
      end;
    Inc(Cmp);
    a[j+1]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure ChooseSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
  i,j,k,N,temp: Integer;
begin
  Cmp:=0;
  Sw:=0;
  N:=Length(a);
  for i:=0 to N-2 do
    begin
    k:=i;
    temp:=a[i];
    for j:=i+1 to N-1 do
      begin
      Inc(Cmp);
      if a[j]<temp then
        begin
        k:=j;
        temp:=a[j];
        Inc(Sw);
        end;
      end;
    a[k]:=a[i];
    a[i]:=temp;
    end;
  //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  if toShow then
    for i:=0 to N-1 do
      FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean);
var
  i,j,sred,temp:integer;
begin
   i:=left; j:=right; //установка начальных границ подмассива
   sred:=a[(left+right) div 2]; //определение серединного элемента
   repeat
      while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
      while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
      if i<=j then
      begin //обмениваем элементы и изменяем индексы
         temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
         i:=i+1; j:=j-1;
         Inc(Sw);
      end;
   until i>j;
   if left<j then QuickSort(a, Cmp, Sw, left, j, false); //обработка левой половины
   if i<right then QuickSort(a, Cmp, Sw, i, right, false); //обработка правой половины
   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
   if toShow then
      for i:=0 to High(a) do
         FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.btnInitRndClick(Sender: TObject);
var
  i,aCount: Integer;
begin
  try
    aCount:=StrToInt(EditSrc.Text);
    ArrayInitRnd(a,aCount);
    MemoLog.Lines.Clear;
    for i:=0 to aCount-1 do
      MemoLog.Lines.Add(IntToStr(a[i]));
  except
    ShowMessage('Введите целое число');
  end;
end;
 
procedure TFormMain.btnSortClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  case cbSortType.ItemIndex of
  0:
    begin
    MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
    BubbleSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  1:
    begin
    MemoLog.Lines.Add('Метод вставок');
    InsertSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  2:
    begin
    MemoLog.Lines.Add('Метод выбора');
    ChooseSort(b,Cmp,Sw);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  3:
    begin
    MemoLog.Lines.Add('Метод быстрой сортировки');
    QuickSort(b,Cmp,Sw,0,High(b),true);
    MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
    MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
    MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
    end;
  end;
  SetLength(b,0);
end;
 
procedure TFormMain.btnSortAllClick(Sender: TObject);
var
  Cmp,Sw: Integer;
  b: TArrayOfInteger;
begin
  MemoLog.Lines.Clear;
  //всякий раз работаем с копией массива, чтобы его не потерять
  b:=ArrayCopy(a);
  BubbleSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  InsertSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод вставок');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  ChooseSort(b,Cmp,Sw,false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод выбора');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
  b:=ArrayCopy(a);
  QuickSort(b,Cmp,Sw,0,High(b),false);
  MemoLog.Lines.Add('');
  MemoLog.Lines.Add('Метод быстрой сортировки');
  MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  SetLength(b,0);
end;
 
procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ArrayClear(a);
end;
 
procedure TFormMain.brnPrintClick(Sender: TObject);
var
  i: Integer;
begin
  MemoLog.Lines.Clear;
  for i:=0 to Length(a)-1 do
    MemoLog.Lines.Add(IntToStr(a[i]));
end;
 
end.

И сам проект также прикладываю во вложении ниже.

Это сообщение отредактировал(а) koshkarjov - 19.9.2012, 00:49

Присоединённый файл ( Кол-во скачиваний: 20 )
Присоединённый файл  sort.rar 240,49 Kb
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Центр помощи"

ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Несоблюдение правил может повлечь за собой самые строгие меры от закрытия/удаления темы до бана пользователя!


  • Название темы должно отражать её суть! (Не следует добавлять туда слова "помогите", "срочно" и т.п.)
  • При создании темы, первым делом в квадратных скобках укажите область, из которой исходит вопрос (язык, дисциплина, диплом). Пример: [C++].
  • В названии темы не нужно указывать происхождение задачи (например "школьная задача", "задача из учебника" и т.п.), не нужно указывать ее сложность ("простая задача", "легкий вопрос" и т.п.). Все это можно писать в тексте самой задачи.
  • Если Вы ошиблись при вводе названия темы, отправьте письмо любому из модераторов раздела (через личные сообщения или report).
  • Для подсветки кода пользуйтесь тегами [code][/code] (выделяйте код и нажимаете на кнопку "Код"). Не забывайте выбирать при этом соответствующий язык.
  • Помните: один топик - один вопрос!
  • В данном разделе запрещено поднимать темы, т.е. при отсутствии ответов на Ваш вопрос добавлять новые ответы к теме, тем самым поднимая тему на верх списка.
  • Если вы хотите, чтобы вашу проблему решили при помощи определенного алгоритма, то не забудьте описать его!
  • Если вопрос решён, то воспользуйтесь ссылкой "Пометить как решённый", которая находится под кнопками создания темы или специальным флажком при ответе.

Более подробно с правилами данного раздела Вы можете ознакомится в этой теме.

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Poseidon, Rodman
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Центр помощи | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0962 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.