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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 26.12.2007, 15:20   #1
Рената
Пользователь
 
Регистрация: 09.02.2007
Сообщений: 18
По умолчанию Помогите найти ошибку

Цель задачи оценить время работы сортировки алгоритмов. Ошибка с подсчетом времени Time:= Meml[$0:$046c]; Помогите найти ошибку.Cпасибо.

Код:
program SORT_ARRAY;
  uses Crt;
  const
    { Размер массива }
    max = 16000;
    { Диапазон случайных чисел }
    randmax : Longint = 16000000;
    theword : Longint = 65536;
  type
    { Тип элемента сортируемого массива }
    itp = Longint;
    { Тип массива }
    mas = array [0..max] of itp;
    { Тип процедуры для сортировки}
    Func = procedure ( var A : mas );
    { Массивы для цифровой сортировки}
    C8T = array [0..256] of Integer;
    C12T = array [0..4096] of Integer;

{ директива для использования переменных типа процедуры }
{$F+}
{ Заполнение массива числами по возрастанию }
  procedure FillInc( var A : mas );
    var
      i : Integer;
    begin
      for i := 1 to max do
        A[i] := i;
    end;
  { Сортировка вставками }
  procedure InsertSort( var A : mas );
    var
      i, k : Integer;
      x : itp;
    begin
      { Вставляем в уже отсортированную часть элементы со 2 по max }
      for i := 2 to max do
        begin
          k := i;
          x := A[i];
          { Передвигаем на 1 позицию направо элементы,
            большие вставляемого элемента (он записан в x) }
          { Условие k > 1 гарантирует, что мы не выйдем за
            границу массива, если вставляется элемент,
            меньший всех предыдущих}
  
          while (k > 1) and (A[k - 1] > x) do
            begin
              A[k] := A[k - 1];
              k := k - 1;
            end;
          { Вставляем элемент в нужную позицию }
          A[k] := x;
        end;
    end;

  { Сортировка выбором }
  procedure SelectSort2(var A : mas);
    var
      i, j, m : Integer;
      x : itp;
    begin
      { Ищем элементы для позиций с 1 по max - 1 }
      for i := 1 to max - 1 do
        begin
          m := i;
          x := A[i];
          { Просматриваем все еще не выбранные элементы }
          for j := i + 1 to max do
            { Если встречается элемент, меньший того, что сейчас
              стоит на позиции m, запоминаем в m его позицию,
              а в x - его значение }
            if x > A[j] then
              begin
                m := j;
                x := A[j];
              end;
            { Меняем местами i-ый элемент, и минимальный из оставшихся m-ый элемент, сохраненный в x }
            A[m] := A[i];
            A[i] := x;
        end;
    end;

  { Сортировка "пузырьком" }
  procedure BubbleSort( var A : mas );
    var
      i, j : Integer;
      x : itp;
    begin
      for i := max downto 2 do
        for j := 2 to i do
          if A[j] < A[j - 1] then
            begin
              x := A[j];
              A[j] := A[j - 1];
              A[j - 1] := x;
            end;
    end;
{$F-}

  { Проверка того, что массив отсортирован }
  function CheckArray( var A : mas ) : Boolean;
    var
      i : Integer;
    begin
      CheckArray := TRUE;
      for i := 1 to max - 1 do
        if A[i] > A[i + 1] then
          CheckArray := FALSE;
    end;

  { Вывод элементов массива на экран }
  procedure PrintArray( var A : mas );
    var
      i : Integer;
    begin
      WriteLn;
      for i := 1 to max do
        Write(A[i] : 16);
      WriteLn;
    end;

  var
    A : mas;
    Fill  : array [1..4] of Func;
    FillS : array [1..4] of string[24];
    Sort  : array [1..20] of Func;
    SortS : array [1..20] of string[24];
    i, j : Integer;
    Time: Longint;
  begin
    FillS[1] := 'Increasing';
    Fill[1] := 'FillInc';
    SortS[1] := 'Insertion';
    SortS[2] := 'Insertion with Bound';
    SortS[3] := 'Bubble';
    Sort[1] := 'InsertSort';
    Sort[2] := 'InsertSort2';
    Sort[3] := 'BubbleSort';
    Write('' : 24);
    for i := 1 to 4 do
      Write(FillS[i] : 12);
    WriteLn;
    for i := 1 to 20 do
      begin
        Write(SortS[i] : 24);
        for j := 1 to 4 do
          begin
            Fill[j](A);
            Time:= Meml[$0:$046c];
            Sort[i](A);
            Time := Meml[$0:$046c] - Time;
            if CheckArray(A) then             
         Write(Time : 12)
            else
              begin
                Write('Failed' : 12);
{                PrintArray(A);}
              end;
          end;
        WriteLn;
      end;
  end.

Последний раз редактировалось Alex21; 26.12.2007 в 15:42.
Рената вне форума Ответить с цитированием
Старый 04.01.2008, 23:46   #2
VladOS107
Новичок
Джуниор
 
Регистрация: 04.01.2008
Сообщений: 1
По умолчанию

В паскале максимально переменных не более 65кб а у тебя получается 73кб
VladOS107 вне форума Ответить с цитированием
Старый 05.01.2008, 04:29   #3
Jeni
Форумчанин
 
Регистрация: 31.05.2007
Сообщений: 486
По умолчанию

Я пока не могу сказать насчет ошибки с подсчетом времени, но есть странные строки кода. Идет объявление двух массивов типа "функция".
Код:
  var
    Fill  : array [1..4] of Func;
    Sort  : array [1..20] of Func; // Неясно, почему 20, ведь функций сортировки всего 3 ?
А дальше в коде идет странное присвоение для элементов этих массивов:
Код:
  Fill[1] := 'FillInc';
  Sort[1] := 'InsertSort';
  Sort[2] := 'InsertSort2'; // Кстати, ошибка. Наверное предполагалось SelectSort2 ?
  Sort[3] := 'BubbleSort';
Т.е. элементам массивов типа функция присваиваются строки! И что, неужели компилятор это пропускает? Если да, то уж точно непонятно что вызывается в строке Sort[i](A);
Jeni вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите найти ошибку Максим_Леонидович БД в Delphi 4 20.08.2008 23:23
Помогите найти ошибку ( с++ ) JOFRIF Помощь студентам 10 23.05.2008 14:34
Помогите найти ошибку KnDmPetr Паскаль, Turbo Pascal, PascalABC.NET 1 11.04.2008 15:48
Помогите найти ошибку NeiL Общие вопросы Delphi 7 04.03.2008 07:14
help!!! Помогите найти ошибку!!! linker13 Общие вопросы Delphi 2 07.07.2007 23:15