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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 06.04.2012, 19:36   #1
Npwas
Форумчанин
 
Аватар для Npwas
 
Регистрация: 26.09.2011
Сообщений: 158
Вопрос Помигете найти ошибку, сортировки+файлы!(Delphi)

Задача у меня тут на сортировки, чтоб считало скок проведено сравнени и перестановок, данно 9 массивов, 3-и по 10эл., по 100 и по 2000; есть отсортированный, неотсортиров. и в обратном порядке!!! Ошибка происходи сразу после закрытия приложения(после того как до этого была нажата кнопка) вот она:
Exception EAccessViolation in module Project1.exe at 00004590. Access violation adress 00404590 in module 'Project1.exe' Read of address 000002A8.
Кроме того 2-ая ошибка то что подсчитывает перестановки и сравнения не правильно!!! И 3-я не до конца записывает кол-во эл-тов в файл!!!

Вот мой код:
Код:
unit ProbnikoSortikusus;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;
TYPE
    TForm1 = class(TForm)
    SG: TStringGrid;
       Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    public
    private
    end;
    mas=array of integer;
VAR
  Form1: TForm1;
  A:mas;
  N,Temp,i,j,rt,sravn,perestanov: integer;
  F:TextFile;
  E,Z,S1,S2:string;

implementation

{$R *.dfm}


{ГЕНЕРАЦИЯ ЭЛ-ТОВ, ИСКЛЮЧЕНА ВОЗМОЖНОСТЬ ПОВТОРА ЭЛ-ТОВ}
PROCEDURE  Randomus_Generator;
Var
  ololo:boolean;
  ch:integer;
 BEGIN
  ch:=0;
  Temp:=random(N+1);
  IF Temp=0 THEN//для того, чтоб осчет шел от 1
         Temp:=1;
  A[1]:=Temp;//первой значение для последующих сравнений
  {Начало генерации массива А}
  FOR i:=2 to N do
    Begin
      ololo:=true;
      {Алгоритм подборки след. знач., искл. повтор одинаковых эл-тов}
      WHILE ololo DO
        Begin
         ch:=0;//индикатор проверки: есть ли уже нова сгенерированный элемент
         Temp:=random(N+1);
         IF Temp=0 THEN//
                Temp:=1;
         FOR j:=1 to i do
             IF Temp=A[j] THEN //проверка: есть ли уже такой элемент
                      inc(ch);
         IF ch=0 THEN//если данного эл-та небыло то он записывается
           Begin
            A[i]:=Temp;
            ololo:=false;//условие выхода для комбинации последующего эл-та
           End;
        End;
    End;
 END;
{ПРОЦЕДУРА СОХРАНЕНИЯ ЗНАЧЕНИЙ МАССИВА В ФАЙЛ}
PROCEDURE Mass_Save_to_File(S:string);
 BEGIN
  AssignFile(F,S);
  Rewrite(F);//открытие. и созд. файл
  For i:=1 to N do
   Begin
    Writeln(F,A[i]);//запись массива А в файл
   End;
  CloseFile(F);
 END;

{ПРОЦЕДУРА ВОССТАНОВЛЕНИЯ МАССИВА}
PROCEDURE Restart_Massiv(S:string);
 BEGIN
  AssignFile(F, S);
  Reset(F);//открытие данного файла
  For i:=1 to N do
   begin
     Readln(F, A[i]);//чтение значений из файла в массив А
   end;
  CloseFile(F);
 END;

{ПРОЦЕДУРА ОБНУЛЕНИЯ СЧЕТЧИКОВ}
PROCEDURE obnul;
 BEGIN
    sravn:=0;
    perestanov:=0;
 END;
//ПРОЦЕДУРЫ СОРТИРОВОК

{СОРТИРОВКА ПУЗЫРЬКОМ}
PROCEDURE BubbleSort;
 BEGIN
  For i:=1 to N do
   For j:=1 to N-i do
     Begin
      inc(sravn);
      If A[j]>A[j+1] Then
       Begin
         Temp:=A[j];
         A[j]:=A[j+1];
         A[j+1]:=Temp;
         inc(perestanov);
       End;
     End;
 END;

{СОРТИРОВКА ПРЯМЫМ ВЫБОРОМ}
PROCEDURE PrjamVibor;
Var
   min:integer;
 BEGIN
   For i :=1 to N-1 do
    Begin
      min:=i;
      For j :=i+1 to N do
       Begin
        inc(sravn);
        If a[j] < a[min] then
                    min := j;
       End;
      Temp := a[i];
      a[i] := a[min];
      a[min] := Temp;
      inc(perestanov);
    End;
 END;

{БЫСТРАЯ СОРТИРОВКА}
PROCEDURE QuitSort(p,q :integer); {p,q — индексы начала и конца сортируемой части массива}
Var
  r : integer;
 BEGIN
  If p<q Then {массив из одного элемента тривиально упорядочен}
   Begin
    r:=A[p];
    i:=p-1;
    j:=q+1;
    While i<j Do
     Begin
       Repeat
         i:=i+1;
         inc(sravn);
       Until A[i]>=r;
       Repeat
         j:=j-1;
         inc(sravn);
       Until A[j]<=r;
       inc(sravn);
       If i<j Then
         Begin
          Temp:=A[i];
          A[i]:=A[j];
          A[j]:=Temp;
          inc(perestanov);
         End;
     End;
    QuitSort(p,j);
    QuitSort(j+1,q);
   End;
 END;
<----Весы Там.
Npwas вне форума Ответить с цитированием
Старый 06.04.2012, 19:37   #2
Npwas
Форумчанин
 
Аватар для Npwas
 
Регистрация: 26.09.2011
Сообщений: 158
По умолчанию

Вот еще часть кода:

Код:
//ДОП. ПРОЦЕДУРЫ
{ПРОЦЕДУРА ЗАПИСЫВАЮЩАЯ ОСТСОРТИРОВАННЫЙ МАССИВ НАОБОРОТ}
PROCEDURE naoborot;
 BEGIN
  BubbleSort;
  j:=N;
  Mass_Save_to_File(S2);
  AssignFile(F,S2);
  Reset(F);//окртытие файла S2
  For i:=1 to N do
    Begin
      Readln(F, A[j]);//чтение значений из файла в массив А
      j:=j-1;
    End;
  CloseFile(F);
  inc(rt);
  S2:='DopFile'+IntToStr(rt)+'.txt'
 END;
{ПРОЦЕДУРА ДЕЛАЮЩАЯ ОСТСОРТИРОВАННЫЙ МАССИВ}
PROCEDURE otsort_mas;
 BEGIN
   BubbleSort;
 END;
{ЗАПУСК ВЫВОДА В ТАБЛИЦУ}
PROCEDURE TForm1.Button1Click(Sender: TObject);
Var
  h1,h2:integer;
 BEGIN
   S2:='DopFile.txt' ;
   h1:=1;
   h2:=3;
   For i:=1 to 3 do
   Begin
     Case i of
       1:E:='10';
       2:E:='100';
       3:E:='2000';
     End;
     For j:=h1 to h2 do
      Begin
        Case j of
           1,4,7:Z:=' эл. неотсорт.';
           2,5,8:Z:=' эл. отсорт.';
           3,6,9:Z:=' эл. обр.пор.';
        End;
        SG.Cells[0,j]:=E+Z;
      End;
     h1:=h2+1;
     h2:=h2+3;
   End;
   For i:=1 to 6 do
     If not(i mod 2=0) then
     SG.Cells[i,0]:='Число сравн.';
   For i:=1 to 6 do
     If i mod 2=0 then
     SG.Cells[i,0]:='Число перестанов.';
   For h2:=1 to 9 do
    Begin
      Case h2 of //созд. новый файл под массив
            1:Begin
                S1:='MassFile.txt';
                N:=10;
                SetLength(A,N);
                Randomus_Generator;
                Mass_Save_to_File(S1);
                obnul;
              end;
            4:Begin
                S1:='MassFile2.txt';
                N:=100;
                SetLength(A,N);
                Randomus_Generator;
                Mass_Save_to_File(S1);
                obnul;
              End;
            7:Begin
                S1:='MassFile3.txt';
                N:=2000;
                SetLength(A,N);
                Randomus_Generator;
                Mass_Save_to_File(S1);
                obnul;
              End;
      End;
      Case h2 of //выбор массива: рандомный, отсосртированный или неостсортиров.
               1,4,7: Begin
                       obnul;
                       Restart_Massiv(S1);
                      End;
               2,5,8: Begin
                       otsort_mas;
                       obnul;
                      End;
               3,6,9: Begin
                       naoborot;
                       obnul;
                      End;
      End;
     For h1:=1 to 6 do
      Begin
       If not(h1 mod 2=0) then
         Case h1 of
           1: Begin
               obnul;
               BubbleSort;
               SG.Cells[h1,h2]:=IntToStr(sravn);
               SG.Cells[h1+1,h2]:=IntToStr(perestanov);
               obnul;
              End;
           3:Begin
              obnul;
              PrjamVibor;
              SG.Cells[h1,h2]:=IntToStr(sravn);
              SG.Cells[h1+1,h2]:=IntToStr(perestanov);
              obnul;
             End;
           5:Begin
              obnul;
              QuitSort(1,N);
              SG.Cells[h1,h2]:=IntToStr(sravn);
              SG.Cells[h1+1,h2]:=IntToStr(perestanov);
              obnul;
             End;
         End;
      End;
    End;
 END;
END.//THE END.
<----Весы Там.
Npwas вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
найти ошибку в проге на Delphi Serjik-ahaha Помощь студентам 15 03.07.2011 13:11
Delphi не могу найти ошибку..... world12_tk Помощь студентам 2 10.10.2009 15:19
Delphi. Не могу найти ошибку. Армана Помощь студентам 4 23.02.2009 23:34
Помогите найти ошибку (Delphi) Rigard Помощь студентам 4 23.07.2008 03:06