Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2015, 12:35   #1
DjSmerty
 
Регистрация: 25.12.2015
Сообщений: 4
По умолчанию Очень сильно нужна помощь!!!!

Код:
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 = 100000;
 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;

Последний раз редактировалось Вадим Мошев; 25.12.2015 в 12:41.
DjSmerty вне форума Ответить с цитированием
Старый 25.12.2015, 12:36   #2
DjSmerty
 
Регистрация: 25.12.2015
Сообщений: 4
По умолчанию

Код:
//если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  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;

Последний раз редактировалось Вадим Мошев; 25.12.2015 в 12:41.
DjSmerty вне форума Ответить с цитированием
Старый 25.12.2015, 12:37   #3
DjSmerty
 
Регистрация: 25.12.2015
Сообщений: 4
По умолчанию

Код:
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.

Помогите описать полностью программу)))

Последний раз редактировалось Вадим Мошев; 25.12.2015 в 12:40.
DjSmerty вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ПРИВЕТ ВСЕМ! Очень сильно нужна ваша потдержка(экзамен в понедельник ), огромная просьба отписаться..Буду премного благодарен..) SwAAAte83 Паскаль, Turbo Pascal, PascalABC.NET 1 20.01.2012 09:41
Очень нужна помощь c матрицами, макросами в Excel. Заранее благодарен(поверьте, очень-очень нужна помощь) Farridjan Помощь студентам 1 03.07.2009 12:24
Очень нужна помощь! Нужно найти ошибку в очень простой программе. Lex55555777 Помощь студентам 3 07.12.2008 20:32