Время выполнения алгоритма Опции

[sheka]

Упорядочить отдельно каждое сечение трехмерного массива А [p, m, n] насквозь по колонкам по неубыванию.

сортировка (Показать/Скрыть)

  function PCube_SelectExchange2_byTruthIndex(var Cube: PCube; const p, m, n: word): longint;
  var
    B: MyType;
    i,
    ks, js,
    jt, kt: word;
    StartTime, FinishTime: TTime;
  Begin
    with StartTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    for i := 1 to p do
      for ks := 1 to n do
        for js := 1 to m do
        begin
          for jt := js+1 to m do
            if Cube^[i]^[jt]^[ks] <= Cube^[i]^[js]^[ks] then
            begin
              b := Cube^[i]^[jt]^[ks];
              Cube^[i]^[jt]^[ks] := Cube^[i]^[js]^[ks];
              Cube^[i]^[js]^[ks] := b;
            end;
          for kt := ks+1 to n do
            for jt :=1 to m do
              if Cube^[i]^[jt]^[kt] <= Cube^[i]^[js]^[ks] then
              begin
                b := Cube^[i]^[jt]^[kt];
                Cube^[i]^[jt]^[kt] := Cube^[i]^[js]^[ks];
                Cube^[i]^[js]^[ks] := b;
              end;
        end;
    with FinishTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    PCube_SelectExchange2_byTruthIndex := ResTime(StartTime, FinishTime);
  end;

Сортировка выдает удивительные вещи для разных размеров массива, хотя по идее должна выдавать одинаковые(как-бы логично):
Ведь если(допустим массив отсортирован) посчитать количество таких (первых)

выражений (Показать/Скрыть)

if Cube^[i]^[jt]^[ks] <= Cube^[i]^[js]^[ks] then

то получится p*n*(m²+m-2)/2, а таких (вторых)

выражений (Показать/Скрыть)

if Cube^[i]^[jt]^[kt] <= Cube^[i]^[js]^[ks] then

то получится p*m*(n²+n-2)/2*m
Если все это упростить и построить график http://www.wolframalpha.com/input/?i=plot+...10%2C+n%3D1..10 то он окажется почти симметричным относительно m и n, без резких перегибов в какую либо сторону.

Сообщение отредактировано: sheka - 16.04.2011 15:52

[volvo]

Полностью программу прикрепи, а то попытка взять твою функцию и прикрепить к моей программе, ссылку на которую я тебе давал, успехом не увенчалась: при

  cubeWidth  = 127;
  cubeHeight = 127;
  cubeDepth  = 1;

программа просто вылетает на строке

if Cube^[i]^[jt]^[ks] <= Cube^[i]^[js]^[ks] then

, а при

  cubeWidth  = 16129;
  cubeHeight = 1;
  cubeDepth  = 1;

время сортировки = 0 (я не знаю, что у тебя делает ResTime, я сделал так:

    writeln(finishtime.hours - starttime.hours, ':',
            finishtime.minutes - starttime.minutes, ':',
            finishtime.seconds - starttime.seconds, '.',
            finishtime.hseconds - starttime.hseconds);

)...

[sheka]

Хм..Вы все правильно поняли и сделали..
 Kurs.rar ( 4.39 килобайт ) Кол-во скачиваний: 398

Сортировки 3хмерного находятся в UCubSort.pas. Интересует только PCube_SelectExchange2_byTruthIndex. Чтобы включить вывод только их в модуле UMenu сделать то, что написано в комментарии. Главная программа - Маин.

Добавлено через 4 мин.

к моей программе, ссылку на которую я тебе давал

Что-то не помню

[volvo]

Что-то не помню

Тут: Реализация динамических матриц

Что касается первых двух случаев (1, 1, 16129) и (1, 127, 127) - то время их выполнения не различается так, как ты показывал скриншотом. Не в 2 раза. Sorted: 249/235, Random: 486/470, Reverse:640/630, то есть, различия не такие критичные...

Что касается попытки проверить третий случай -

Insert p: 1
Insert m: 16129
Insert n: 1
No heap dump by heaptrc unit
Exitcode = 201
Runtime error 201 at $0040F2F2
  $0040F2F2  PCUBE_CREATE,  line 58 of UCubServ.pas
  $0040CFBE  CREATE,  line 73 of UMenu.pas
  $0040D259  MENU,  line 179 of UMenu.pas
  $00401567  main,  line 7 of /kurs/main.pas
  $00408BD1

Облом-с...

[sheka]

Да, действительно, 16129 как-то многовато элементов. Разрешается 8191 по каждому индексу. Но почему тогда в первый раз отработало? Там же тоже идет переполнение массива.

Почему вы написали TDynArray = array[1 .. maxint div sizeof(TType)] of TType;вот здесь maxint? там же можно "maxword" или как-то так.

то есть, различия не такие критичные...

Хм..такое замудрое число как 16129 я поставил специально (не ожидая вылета, ведь почему-то у меня не стоял какой-то, не помню какой, флажек Checking), потому что вот при таких значениях выдает ту же калабурду:





Добавлено через 1 мин.
т.е. во второй и третьей таблице byTruthIndex почти одинаковые и отличаются от первой таблицы.

[volvo]

Так... Давай для начал разберемся, что ты делаешь, и имеешь ли ты право вот так запросто сравнивать результаты. Чуть-чуть изменяем

  function PCube_SelectExchange2_byTruthIndex(var Cube: PCube; const p, m, n: word): longint;
  var
    B: MyType;
    i,
    ks, js,
    jt, kt: word;
    StartTime, FinishTime: TTime;
    cnt : longint; // <--- 1
  Begin
    cnt := 0;
    with StartTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    for i := 1 to p do
      for ks := 1 to n do
        for js := 1 to m do
        begin
          for jt := js+1 to m do
          begin
             inc(cnt); // <--- 2
            if Cube^[i]^[jt]^[ks] <= Cube^[i]^[js]^[ks] then
            begin
              b := Cube^[i]^[jt]^[ks];
              Cube^[i]^[jt]^[ks] := Cube^[i]^[js]^[ks];
              Cube^[i]^[js]^[ks] := b;
            end;
          end;
          for kt := ks+1 to n do
          begin
            inc(cnt); // <--- 3
            for jt :=1 to m do
              if Cube^[i]^[jt]^[kt] <= Cube^[i]^[js]^[ks] then
              begin
                b := Cube^[i]^[jt]^[kt];
                Cube^[i]^[jt]^[kt] := Cube^[i]^[js]^[ks];
                Cube^[i]^[js]^[ks] := b;
              end;
          end;
        end;
    with FinishTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    writeln ('count = ', cnt); // <--- 4
    PCube_SelectExchange2_byTruthIndex := ResTime(StartTime, FinishTime);
  end;

, то есть, проверяем количество сравнений (от него же зависит общее время работы с матрицей). Что имеем? Правильно: у матриц (100*4*400) и (100*400*4) счетчик одинаков и = 32160000. А вот у матрицы (100*40*40) - 6240000, то бишь в 5 с лишним раз меньше. Откуда возникают вопросы. Первый из них - ты вообще тестировал свой алгоритм? Скажем, на матрицах 5*6*2 и 5*3*4? Визуально проверял, работает ли он? Сортируется одинаково? А то выполняешь вслепую какие-то действия, потом сравниваешь результаты, а их, возможно, вообще нельзя сравнивать...

[sheka]

Алгоритм сочинял исходя из задания:
Выполнить сортировку, совершая обход непосредственно по элементам заданного двумерного массива, не используя дополнительных массивов и преобразований индексов.
Проверял, работает замечательно (самый последний).
Были и другие проверки для разных размеров.

Вот это - действительно маразм (видно что-то упустил, когда считал):

Ведь если(допустим массив отсортирован) посчитать количество таких (первых)
выражений (Показать/Скрыть)
то получится p*n*(m2+m-2)/2, а таких (вторых)
выражений (Показать/Скрыть)
то получится p*m*(n2+n-2)/2*m
Если все это упростить и построить график http://www.wolframalpha.com/input/?i=plot+...10%2C+n%3D1..10 то он окажется почти симметричным относительно m и n, без резких перегибов в какую либо сторону.

т.к. посчитал как вы сказали с помощью переменной - оказалось везде одинаковое число. Что еще больше удивляет, ведь перепад в 4*400 очень велик.

Вот здесь счетчик надо было поставить чуть не туда: после второго цикла

for kt := ks+1 to n do
          begin
            inc(cnt); // <--- 3
            for jt :=1 to m do
            //сюда

Сообщение отредактировано: sheka - 17.04.2011 19:34

[volvo]

И все равно нельзя сравнивать время обработки матриц. Количество сравнений - одинаковое (что-то я проморгал, не туда воткнул счетчик, согласен). Но...

Сравним количество перемещений: (Показать/Скрыть)

  function PCube_SelectExchange2_byTruthIndex(var Cube: PCube; const p, m, n: word): longint;
  var
    B: MyType;
    i,
    ks, js,
    jt, kt: word;
    StartTime, FinishTime: TTime;
    cnt : longint;
  Begin
    cnt := 0;
    with StartTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    for i := 1 to p do
      for ks := 1 to n do
        for js := 1 to m do
        begin
          for jt := js+1 to m do
          begin
            if Cube^[i]^[jt]^[ks] <= Cube^[i]^[js]^[ks] then
            begin
              inc(cnt);
              b := Cube^[i]^[jt]^[ks];
              Cube^[i]^[jt]^[ks] := Cube^[i]^[js]^[ks];
              Cube^[i]^[js]^[ks] := b;
            end;
          end;
          for kt := ks+1 to n do
          begin
            for jt :=1 to m do
              if Cube^[i]^[jt]^[kt] <= Cube^[i]^[js]^[ks] then
              begin
                inc(cnt);
                b := Cube^[i]^[jt]^[kt];
                Cube^[i]^[jt]^[kt] := Cube^[i]^[js]^[ks];
                Cube^[i]^[js]^[ks] := b;
              end;
          end;
        end;
    with FinishTime do GetTime(Hours,Minutes,Seconds,HSeconds);
    writeln ('count = ', cnt);
    PCube_SelectExchange2_byTruthIndex := ResTime(StartTime, FinishTime);
  end;

(я надеюсь, теперь я не ошибся с местом? )

Для чистоты эксперимента я решил прогнать этот тест на абсолютно одинаковых данных:

  // -- 60 randoms for test --
  const RSize = 5 * 6 * 2;
  var R : array[1 .. RSize] of MyType;

   procedure PCube_Init(var Cube: PCube; const p, m, n: word);
   var
     i, j, k: word;
     curr : Word;
   begin
     curr := 1;
     for i := 1 to p do
       for j := 1 to m do
         for k := 1 to n do
         begin
           Cube^[i]^[j]^[k] := R[curr];
           Inc(Curr);
         end;
   end;
   procedure PCube_Print(var Cube: PCube; const p, m, n: word);
   var
     i, j, k: word;
   begin
     for i := 1 to p do
     begin
       writeln;
       writeln('Layer:', i);
       for j := 1 to m do
       begin
         for k := 1 to n do
         begin
           write(Cube^[i]^[j]^[k]:5);
         end;
         writeln;
       end;
     end;
   end;

При входе в Menu, еще до Repeat, выполняется
    for i := 1 to RSize do
    begin
      R[i] := Random(100);
    end;

, т.о., генерируются случайные данные, которые потом будут использованы для инициализации матрицы. И проверим, сколько перемещений делается в матрице (5*6*2), и сколько - в матрице (5*3*4). Как? Вот так:

      2: // Выбрана сортировка Cube в меню
      begin
      (*
        Create(Cube,p,m,n);
        CubeFill[FillType](Cube,p,m,n);
        Time := CubeSort[SortType](Cube,p,m,n);
        writeln('Time = ',Time);
        Destroy(Cube,p,m,n);
      *)
        writeln('first');
        p := 5; m := 6; n := 2;
        PCube_Create(Cube,p,m,n);
        PCube_Init(Cube,p,m,n);
        PCube_Print(Cube,p,m,n);
        readln;

        Time := CubeSort[3](Cube,p,m,n);
        PCube_Print(Cube,p,m,n);
        writeln('Time = ',Time);
        Destroy(Cube,p,m,n);

        readln;

        writeln('second');
        p := 5; m := 3; n := 4;
        PCube_Create(Cube,p,m,n);
        PCube_Init(Cube,p,m,n);
        PCube_Print(Cube,p,m,n);
        readln;

        Time := CubeSort[3](Cube,p,m,n);
        PCube_Print(Cube,p,m,n);
        writeln('Time = ',Time);
        Destroy(Cube,p,m,n);
      end;

, дальше все без изменений.

Запускаем, выполняем, и получаем: (Показать/Скрыть)

1. Vector Sort
2. Cube Sort
3. Complex
4. Exit
2
first

Layer:1
   54   59
   71   84
   60   85
   54   84
   42   62
   64   38

Layer:2
   43   29
   89    5
   96   27
   38   47
   79   81
   52   47

Layer:3
   56   39
   92   83
    7   33
    8   64
    2   36
   83   95

Layer:4
   77   14
   87   87
   97   47
   79   80
   46   52
   78   67

Layer:5
   11   72
   63   58
   14   53
   94   75
   52   10
   41   47

count = 170

Layer:1
   38   62
   42   64
   54   71
   54   84
   59   84
   60   85

Layer:2
    5   47
   27   52
   29   79
   38   81
   43   89
   47   96

Layer:3
    2   56
    7   64
    8   83
   33   83
   36   92
   39   95

Layer:4
   14   78
   46   79
   47   80
   52   87
   67   87
   77   97

Layer:5
   10   53
   11   58
   14   63
   41   72
   47   75
   52   94
Time = 0

second

Layer:1
   54   59   71   84
   60   85   54   84
   42   62   64   38

Layer:2
   43   29   89    5
   96   27   38   47
   79   81   52   47

Layer:3
   56   39   92   83
    7   33    8   64
    2   36   83   95

Layer:4
   77   14   87   87
   97   47   79   80
   46   52   78   67

Layer:5
   11   72   63   58
   14   53   94   75
   52   10   41   47

count = 135

Layer:1
   38   54   62   84
   42   59   64   84
   54   60   71   85

Layer:2
    5   38   47   81
   27   43   52   89
   29   47   79   96

Layer:3
    2   33   56   83
    7   36   64   92
    8   39   83   95

Layer:4
   14   52   78   87
   46   67   79   87
   47   77   80   97

Layer:5
   10   41   53   72
   11   47   58   75
   14   52   63   94
Time = 0

Чувствуешь разницу? На первой матрице count = 170, на второй - 135. Как думаешь, какая из них будет обрабатываться дольше? Здесь по значению Time этого не видно, очень маленькие размеры. Но у второй матрицы (в данном случае) явно есть преимущества в скорости. В эту сторону тоже посмотри...

[sheka]

Допустим. Что-то не верится, но сейчас обязательно посмотрю.

Меня интересует вот какой вопрос: почему там, где массив отсортирован, где этих обменов вообще нет, а только проверка условия, значения 40*40 и 400*4 совпадают, и очень отличаются от 4*400 ???
И почему вот здесь вектор(1600элементов) сортируется медленнее такой аналогичной сортировки матрицы, где сначала вектор заполняется из матрицы, а потом возвращается.


Вот сделал с "тиками" http://volvo71.narod.ru/time_count.htm#time_rdtsc_32.

Нижняя таблица - относительно максимального (в промилле).
Что-то не очень уж точно, есть заскоки, но такого заскока, как я выше описал не наблюдается.

Не могли бы вы попробовать это запустить под DOSoм, может нормально получится:
с GetTime:  forWin.rar ( 4.39 килобайт ) Кол-во скачиваний: 393

с "Тиками":  forWin_tics.rar ( 4.72 килобайт ) Кол-во скачиваний: 439


Сообщение отредактировано: sheka - 17.04.2011 22:42

[sheka]

Тоже одинаковое!
По заданию матрицы упорядочены насквозь по столбцам.

procedure PCube_Init(var Cube: PCube; const p, m, n: word);
   var
     i, j, k: word;
     curr : Word;
   begin
     curr := 1;
     for i := 1 to p do
       for k := 1 to n do     //эта   
          for j := 1 to m do //и эта строки у Вас были наоборот. 
         
         begin
           Cube^[i]^[j]^[k] := R[curr];
           Inc(Curr);
         end;
   end;

Меня интересует вот какой вопрос: почему там, где массив отсортирован, где этих обменов вообще нет, а только проверка условия, значения 40*40 и 400*4 совпадают, и очень отличаются от 4*400 ?

По ходу у меня комп глючный. Проверил еще на 3х - нормально. Сейчас еще в DOSboxe перепроверю - и завтра сдавать

[volvo]

По заданию матрицы упорядочены насквозь по столбцам.

В программе присутствует выбор: упорядоченная/случайная/обратно упорядоченная? Присутствует. Зачем, спрашивается, если по заданию "матрицы упорядочены насквозь по столбцам." (С)?

//эта   
//и эта строки у Вас были наоборот. 

Не понял. Ничего, что мне нужно было заполнение именно в том виде, в котором я показал? Или, пардон, для того, чтоб делать тесты, мне надо получить указание, КАК их делать? Тогда кому нужны такие тесты? Я захотел, чтобы матрица инициализировалась ровно в том же порядке, в котором и создается: массив

   54   59   71   84   60   85   54   84   42   62   64   38   43   29   89    5
   96   27   38   47   79   81   52   47   56   39   92   83    7   33    8   64
    2   36   83   95   77   14   87   87   97   47   79   80   46   52   78   67
   11   72   63   58   14   53   94   75   52   10   41   47

привел к инициализации матрицы:

Layer:1
   54   59
   71   84
   60   85
   54   84
   42   62
   64   38

Layer:2
   43   29
   89    5
   96   27
   38   47
   79   81
   52   47

Layer:3
   56   39
   92   83
    7   33
    8   64
    2   36
   83   95

Layer:4
   77   14
   87   87
   97   47
   79   80
   46   52
   78   67

Layer:5
   11   72
   63   58
   14   53
   94   75
   52   10
   41   47

, т.е., построчно. Что в этом неправильного? Я создаю не упорядоченную матрицу, а случайную, как хочу, так и инициализирую. Кстати, заметь:

procedure PCube_FillRandom(var Cube: PCube; const p, m, n: word);
var
  i, j, k: word;
begin
  for i := 1 to p do
    for j := 1 to m do
      for k := 1 to n do
        Cube^[i]^[j]^[k] := random(p*m*n)+1
end;

, значит, правильно, а у меня - "наоборот"? Очень интересно. С чего бы это так? В своем глазу чего-то не замечаем? Продолжай в том же духе... Далеко пойдешь... У меня к твоей задаче интерес улетучился.


Кстати. Особое внимание я бы рекомендовал уделить проверке освобождения памяти. Ибо при запуске программы без моих исправлений после теста на 3-4 матрицах большого размера (порядка 100-400) в момент выхода из программы heaptrc печатает лог, где содержатся утечки (ну, это ты должен помнить, я где-то уже рассказывал, как ловить утечки памяти). Так вот печать этого лога занимает порядка двух минут. Там ДИКАЯ утечка. Не отрабатывают процедуры Destroy так, как они должны отрабатывать, не вся память чистится. К тому же выход из программы по Halt-у это плохой стиль.

[sheka]

Я Вас ни коим образом не хотел обидеть. Просто для данной задачи такое заполнение массива действительно является случайным, а не одинаковым.

Не отрабатывают процедуры Destroy

Если не ошибаюсь там стоял Сreate, вместо Destroy, поэтому шло переполнение, верно? (просто сейчас уже вообще удалил Destroyи)

К тому же выход из программы по Halt-у это плохой стиль.

Спасибо, исправил.