Отправлено: 23.01.10 06:23. Заголовок: Подскажите как из одного массива получить второй сокращенный....

Всем привет !
Подскажите идею, желательно красивую !
Имею 2х мерный массив типа
aDim := { {2000,1}, {2009,1}, {2009,1}, {2008,1}, {2000,1}, {2008,1}, {2003,1}, {2009,1} ...... }

Как его сократить, т.е. преобразовать к другому массиву с подсчетом, т.е. чтобы получилось:
aNewDim := { {2000, 2}, {2003,1}, {2008,2}, {2009, 3} }

 Отправлено: 25.01.10 04:35. Заголовок: ГОСПОДА - ПРОТЕСТИРУЙТЕ ВАШИ АЛГОРИТМЫ !!!

// Программа по алгоритму PSP

LOCAL aDim8, aNewSort, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd
aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}}
FOR i := 1 TO 512
FOR j := 1 TO 8
AADD(aDim, aDim8[j])
NEXT
NEXT
? DATE(), TIME(), OS(), VERSION()
? "LEN(aDim) = " + LTRIM(STR(LEN(aDim)))
nTimeStart := SECONDS()
FOR i := 1 TO LEN(aDim)
j := ASCAN(aNewDim, {|x|x[1] == aDim[i, 1]})
IF j == 0
AADD(aNewDim, ACLONE(aDim))
ELSE
aNewDim[j, 2] += aDim[i, 2]
ENDIF
NEXT
aNewSort := ASORT(aNewDim,,, {|x,y|x[1] < y[1]})
nTimeEnd := SECONDS()
? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart))
AEVAL(aNewSort, {|x|QOUT(x[1], STR(x[2]))})
?

// Результат

01/25/10 06:15:15 DOS 5.00 Clipper (R) 5.01
LEN(aDim) = 4096
SECONDS() = 0.06
2000 1024
2003 512
2008 1024
2009 1536

Видим что по данному алгоритму программа на порядок (10 оаз) примерно быстрее, НО "результирующий" массив имеет крохотную размерность (4 элемента) и компьютер отнюдь не 80286. Отсюда ВЫВОД: эффективность сложных алгоритмов обработки данных (таких как индексирование) проявляется начиная с определенных объемов данных. Примерно как для "пузырьковой" и "быстрой" сортировок, то есть при количестве сортируемых элементов меньше 100 эффективнее "пузырьковая" а при больших - "быстрая". Дисковые операции, сами по себе еще не говорят, что программа будет долго работать. Ужасно замедляет программы применение команды LOCATE FOR ... для поиска по большим базам в цикле. По сути, LOCATE - это дисковый аналог ASCAN. А индексы и DBSEEK() - мощнейший инструмент (в умелых руках).

 Отправлено: 25.01.10 10:58. Заголовок: Ребята, обращайте вн..

Ребята, обращайте внимание, когда пишете в посты свои тексты программ!

Если (как в последнем от sergey5703 - но и раньше то и дело встречалось) в тексте программы встречается "открывающая квадратная скобка" + "i" + "закрывающая квадратная скобка" - то этот кусок текста программы не отображается в посте, а все последующее идет курсивом...

Пишите как "[ i ]" - т.е. с пробелами внутри квадратных скобок - и будет вам (и всем остальным) щастье!

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

"Скопипастить-то всякий может - а вот проверить, что скопипастил..." ((с) училка информатики)

 Отправлено: 25.01.10 11:11. Заголовок: Как раз вчера я прод..

Как раз вчера я проделывал это шаманство с [ i ] в своих сырцах :)

 Отправлено: 25.01.10 17:46. Заголовок: sergey5703 пишет: В..

sergey5703 пишет:

цитата:

Видим что по данному алгоритму программа на порядок (10 раз) примерно быстрее,

Вот видите. Несмотря на то, что вы сравнивали "неэффективный" алгоритм с массивами с "эффективным" через total/index, неэффективный побил эффективный на порядок.
Я же предлагал аналогичный вашему алгоритм без ASCAN, такой же эффективный, но без total/index.

цитата:

и компьютер отнюдь не 80286

У нас есть музей ВТ, в котором должны быть двойки. Когда выберу свободную минутку, зайду туда с дискетой, запущу ваш тест, благо это недалеко - на этаже.

 Отправлено: 25.01.10 19:28. Заголовок: Обсуждение в этой те..

Обсуждение в этой теме я считаю полезным (благодаря sergey5703)
У меня, в частности, возникли такие идеи:

1) Переписать на С сортировку двумерного массива - конструкцию ASORT(aNewDim,,, {|x,y|x[1] < y[1]})

2) Сделать на С аналог ASCAN - при неудачном поиске он возвращал бы индекс следующего элемента за искомым, скажем, с отрицательным знаком вместо нуля, чтобы иметь возможность не добавить элемент, а вставить его в нужной позиции, и получить отсортированный результирующий массив

3) Сделать ASCAN в отсортированном двумерном массиве, к примеру с помощью МПД (метода половинного деления)

Все это, естественно, для харбора. Можно сделать и для клиппера, благо api у клиппера и харбора похожи, но зачем ?

 Отправлено: 25.01.10 22:59. Заголовок: Программы по двум ал..

Программы по двум алгоритмам были доработаны в плане генерации исходных данных для проверки быстродействия. Теперь можно получать на выходе "результирующий" массив размерности 4, 528 или 4096 элементов. Вот таблица итоговых результатов:

Зависимость времени выполнения от размерности "результирующего" массива. 
 ------------------------------------------------------------------------ 
 :                            :  Размерность "результирующего" массива  : 
 :          Алгоритм          :-----------------------------------------: 
 :                            :      4      :     528     :    4096     : 
 ------------------------------------------------------------------------ 
 :    INDEX ... TOTAL ...     :  0.49 сек.  :  0.61 сек.  :  1.10 сек.  : 
 ------------------------------------------------------------------------ 
 :    ASCAN ... ASORT ...     :  0.06 сек.  :  5.00 сек.  : 60.20 сек.  : 
 ------------------------------------------------------------------------ 
 

Вывод: "дисковый" алгоритм почти не коррелирует по времени выполнения с размерностью получающегося массива, а время выполнения Ascan и Asort линейно зависит от размерности массива. Рекомендации: осторожнее применять Ascan и Asort в [x]Harbour где размерность массивов не лимитирована как в Clipper.
Доработанные программы:
Скрытый текст

// Программа 1, алгоритм - InTo (INDEX ON ... TOTAL ON ...) #define LEN_NEW_DIM_4096 //#define LEN_NEW_DIM_528 //#define LEN_NEW_DIM_4 LOCAL aDim8, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} #ifdef LEN_NEW_DIM_4096 FOR i := 1 TO 4096 AADD(aDim, {i, 1}) NEXT #else FOR i := 1 TO 512 FOR j := 1 TO 8 #ifdef LEN_NEW_DIM_528 AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) #else AADD(aDim, aDim8[j]) #endif NEXT NEXT #endif ? DATE(), TIME(), OS(), VERSION() ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) nTimeStart := SECONDS() DBCREATE("test", {{"key", "N", 10, 0}, {"count", "N", 10, 0}}) USE test INDEX ON key TO test AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]}) TOTAL ON key FIELDS count TO test2 USE ERASE ("test.dbf") ERASE ("test" + INDEXEXT()) USE test2 DBEVAL({||AADD(aNewDim, {key, count})}) USE ERASE ("test2.dbf") nTimeEnd := SECONDS() ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) ? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim))) #ifdef LEN_NEW_DIM_4 AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) #endif ? // Результат //01/25/10 02:15:23 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 0.49 // 2000 1024 // 2003 512 // 2008 1024 // 2009 1536 //01/25/10 17:54:13 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 0.61 //LEN(aNewDim) = 528 //01/25/10 19:35:43 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 1.10 //LEN(aNewDim) = 4096

Скрытый текст

// Программа 2, алгоритм - AsAs (ASCAN ... ASORT ...) #define LEN_NEW_DIM_4096 //#define LEN_NEW_DIM_528 //#define LEN_NEW_DIM_4 LOCAL aDim8, aNewSort, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} #ifdef LEN_NEW_DIM_4096 FOR i := 1 TO 4096 AADD(aDim, {i, 1}) NEXT #else FOR i := 1 TO 512 FOR j := 1 TO 8 #ifdef LEN_NEW_DIM_528 AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) #else AADD(aDim, aDim8[j]) #endif NEXT NEXT #endif ? DATE(), TIME(), OS(), VERSION() ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) nTimeStart := SECONDS() FOR i := 1 TO LEN(aDim) j := ASCAN(aNewDim, {|x|x[1] == aDim[i, 1]}) IF j == 0 AADD(aNewDim, ACLONE(aDim[ i ])) ELSE aNewDim[j, 2] += aDim[i, 2] ENDIF NEXT aNewSort := ASORT(aNewDim,,, {|x,y|x[1] < y[1]}) nTimeEnd := SECONDS() ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) ? "LEN(aNewSort) = " + LTRIM(STR(LEN(aNewSort))) #ifdef LEN_NEW_DIM_4 AEVAL(aNewSort, {|x|QOUT(x[1], x[2])}) #endif ? // Результат //01/25/10 06:15:15 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 0.06 // 2000 1024 // 2003 512 // 2008 1024 // 2009 1536 //01/25/10 17:58:58 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 5.00 //LEN(aNewSort) = 528 //01/25/10 19:38:10 DOS 5.00 Clipper (R) 5.01 //LEN(aDim) = 4096 //SECONDS() = 60.20 //LEN(aNewSort) = 4096

 Отправлено: 25.01.10 23:28. Заголовок: sergey5703 Ваше упор..

sergey5703
Ваше упорное нежелание замечать алгоритм без ascan смотрится уже забавно :-)
Между тем, я переписал на С ASORT для двумерного массива, что привело к увеличению быстродействия в 10-15 раз

 Отправлено: 26.01.10 00:12. Заголовок: Нельзя объять необъя..

Нельзя объять необъятное, я просто доводил "до ума" проверку двух алгоритмов. Старался обходиться "штатными" средствами Clipper 5.01. Дело то ведь не в языке программирования и не в реализации RTL.
Если полистать монографию Кнута ("Искусство программирования для ЭВМ"), то увидим, что он вообще придумал свою "виртуальную" ЭВМ для проверки алгоритмов. Я уже за годы, что не работаю, стал кое что забывать, а тут такое "упражнение" подвернулось, ну и "завелся". Это, если Вы смотрели фильм с участием Юрия Никулина "Когда деревья были большими", как эпизод фильма, где Никулин обрабатывает деталь напильником и потом говорит "помнят ручки то" (в смысле помнят руки работу). Меня просто поразила приверженность современных программистов к таким неэффективным методам, как последовательный перебор массивов в памяти и мнение о неэффективности index on и dbseek. Я на всем этом не одну "собаку съел".
Простите великодушно ежели чего не так сделал.

 Отправлено: 27.01.10 11:08. Заголовок: Вот еще 4-й алгоритм..

Вот еще 4-й алгоритм, без использования asort-ascan, вернее, вместо ascan используется поиск в упорядоченном массиве по МПД, при неудаче - вставка элемента в нужную позицию, чтобы выходной массив был отсортирован:

Function T4(aDim) 
 LOCAL aNewDim := {}, i, j, ad 
 FOR i := 1 TO LEN(aDim)  
   ad := aDim[ i ] 
   j := a_mpd(aNewDim, ad[1]) 
   if j > 0 
     aNewDim[j, 2] += ad[2] 
   elseif j == 0 .or. -j > Len(aNewDim) 
     AADD(aNewDim, AClone(ad)) 
   else 
     AADD(aNewDim, nil) 
     AINS(aNewDim, -j) 
     aNewDim[-j] = AClone(ad) 
   endif 
 NEXT 
 Return aNewDim 
  
 func icmp(x1, x2) 
 Local n 
 if x1 == x2 
   n := 0 
 elseif x1 < x2 
   n := -1 
 else 
   n := 1 
 endif 
 Return n 
  
 function a_mpd(a, x) 
 Local nLen := Len(a), nLoop, iRes, lFnd := .f., lEnd := .f. 
 Local n1 
 Local n2 
  
 if nLen == 0 
   nLoop := 0 
   lEnd := .t. 
 else 
  
   iRes := icmp(a[1, 1], x) 
   if iRes == 0 
     nLoop := 1 
     lFnd := lEnd := .t. 
   elseif iRes > 0 
     nLoop := 1 
     lEnd := .t. 
   endif 
  
   if ! lEnd 
      if nLen > 1 
 	iRes := icmp(a[nLen, 1], x) 
      endif 
      if iRes == 0 
        nLoop := nLen 
        lFnd := lEnd := .t. 
      elseif iRes < 0 
        nLoop := nLen + 1 
        lEnd := .t. 
      endif 
  
   endif 
  
 endif 
  
  
 if ! lEnd 
  n1 := 1 
  n2 := nLen 
  while .t. 
    if n1 == n2 - 1 
       nLoop := n2 
       exit 
    endif 
    nLoop = Int((n2 + n1) / 2) 
  
    iRes := icmp(a[nLoop, 1], x) 
  
    if iRes == 0  
       lFnd = .t. 
       exit 
    elseif iRes > 0 
       n2 := nLoop 
    else 
       n1 := nLoop 
    endif 
  
  enddo 
 endif 
  
 return if(lFnd, nLoop, -nLoop)

 Отправлено: 28.01.10 05:55. Заголовок: Я протестировал Ваш ..

Я протестировал Ваш алгоритм - при 4096 элементах в Клиппер 5.01 внутренняя ошибка 332. Перешел на Харбор - результаты примерно одинаковые с моим алгоритмом (INDEX ON ... TOTAL ON ...), конкретно в комментах в конце программ. Решил увеличить число элементов до 1000000 и мой алгоритм отработал, хоть и в 160 раз медленнее, а вот Ваш алгоритм я не смог проверить на 1000000 элементов даже в Харборе - после часа ожидания у меня стало заканчиваться время ночного интернета и я снял программу. Может быть Вы на миллионе элементов сможете проверить наши программы на более мощном компьютере?
Файл MAKExHrb.BAT
Скрытый текст

@echo off rem компиляция %1.PRG xHarbour rem http://www.xharbour.org SET PATH=c:\BCC55\BIN;c:\XHARBOUR\BIN SET INCLUDE=c:\BCC55\INCLUDE;c:\XHARBOUR\INCLUDE SET LIB=c:\BCC55\LIB;c:\BCC55\LIB\PSDK;c:\XHARBOUR\LIB set HB_BIN_INSTALL=c:\xharbour\bin set HB_LIB_INSTALL=c:\xharbour\lib\ set HB_INC_INSTALL=c:\xharbour\include\ %HB_BIN_INSTALL%\harbour.exe %1.prg -gc0 -i%HB_INC_INSTALL% if exist %1.exe del %1.exe if exist %1.tds del %1.tds bcc32.exe -O2 -d -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% %1.c vm.lib rtl.lib gtwin.lib lang.lib rdd.lib dbffpt.lib hsx.lib hbsix.lib macro.lib pp.lib dbfntx.lib dbfcdx.lib pcrepos.lib common.lib debug.lib codepage.lib ct.lib if exist %1.c del %1.c if exist %1.obj del %1.obj if exist %1.tds del %1.tds

Файл test8.prg (INDEX ON ... TOTAL ON ...)
Скрытый текст

// Программа 1, алгоритм - InTo (INDEX ON ... TOTAL ON ...) #define LEN_NEW_DIM_1000000 //#define LEN_NEW_DIM_4096 //#define LEN_NEW_DIM_528 //#define LEN_NEW_DIM_4 #ifdef __HARBOUR__ REQUEST HB_CODEPAGE_RU866 REQUEST HB_LANG_RU866 REQUEST DBFNTX #endif LOCAL aDim8, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd #ifdef __HARBOUR__ HB_SETCODEPAGE("RU866") HB_LANGSELECT("RU866") RDDSETDEFAULT("DBFNTX") #endif aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} #ifdef LEN_NEW_DIM_1000000 FOR i := 1000000 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_4096 FOR i := 4096 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_528 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) NEXT NEXT #endif #ifdef LEN_NEW_DIM_4 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, aDim8[j]) NEXT NEXT #endif ? DATE(), TIME(), OS(), VERSION() ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) nTimeStart := SECONDS() DBCREATE("test", {{"key", "N", 10, 0}, {"count", "N", 10, 0}}) USE test INDEX ON key TO test AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]}) TOTAL ON key FIELDS count TO test2 USE ERASE ("test.dbf") ERASE ("test" + INDEXEXT()) USE test2 DBEVAL({||AADD(aNewDim, {key, count})}) USE ERASE ("test2.dbf") nTimeEnd := SECONDS() ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) ? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim))) #ifdef LEN_NEW_DIM_4 AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) //#else //SET ALTERNATE TO test8.out //SET ALTERNATE ON //SET CONSOLE OFF //AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) //? //SET CONSOLE ON //SET ALTERNATE OFF //SET ALTERNATE TO #endif ? // Результат //01/28/10 05:20:36 Windows XP Professional 5.01.2600 Service Pack 2 xHarbour bui //ld 1.2.1 Intl. (SimpLex) (Rev. 6658) //LEN(aDim) = 4096 //SECONDS() = 1.01 //LEN(aNewDim) = 4096 //01/28/10 06:42:13 Windows XP Professional 5.01.2600 Service Pack 2 xHarbour bui //ld 1.2.1 Intl. (SimpLex) (Rev. 6658) //LEN(aDim) = 1000000 //SECONDS() = 161.96 //LEN(aNewDim) = 1000000

Файл test11.prg (T4 from Pasha)
Скрытый текст

// Программа 3, алгоритм - T4 from Pasha #define LEN_NEW_DIM_1000000 //#define LEN_NEW_DIM_4096 //#define LEN_NEW_DIM_528 //#define LEN_NEW_DIM_4 #ifdef __HARBOUR__ REQUEST HB_CODEPAGE_RU866 REQUEST HB_LANG_RU866 REQUEST DBFNTX #endif LOCAL aDim8, aNewDim := {}, aDim := {}, ad, i, j, nTimeStart, nTimeEnd #ifdef __HARBOUR__ HB_SETCODEPAGE("RU866") HB_LANGSELECT("RU866") RDDSETDEFAULT("DBFNTX") #endif aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} #ifdef LEN_NEW_DIM_1000000 FOR i := 1000000 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_4096 FOR i := 4096 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_528 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) NEXT NEXT #endif #ifdef LEN_NEW_DIM_4 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, aDim8[j]) NEXT NEXT #endif ? DATE(), TIME(), OS(), VERSION() ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) nTimeStart := SECONDS() //FOR i := 1 TO LEN(aDim) // j := ASCAN(aNewDim, {|x|x[1] == aDim[i, 1]}) // IF j == 0 // AADD(aNewDim, ACLONE(aDim[ i ])) // ELSE // aNewDim[j, 2] += aDim[i, 2] // ENDIF //NEXT //aNewSort := ASORT(aNewDim,,, {|x,y|x[1] < y[1]}) FOR i := 1 TO LEN(aDim) ad := aDim[ i ] j := a_mpd(aNewDim, ad[1]) if j > 0 aNewDim[j, 2] += ad[2] elseif j == 0 .or. -j > Len(aNewDim) AADD(aNewDim, AClone(ad)) else AADD(aNewDim, nil) AINS(aNewDim, -j) aNewDim[-j] = AClone(ad) endif NEXT nTimeEnd := SECONDS() ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) ? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim))) #ifdef LEN_NEW_DIM_4 AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) //#else //SET ALTERNATE TO test11.out //SET ALTERNATE ON //SET CONSOLE OFF //AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) //? //SET CONSOLE ON //SET ALTERNATE OFF //SET ALTERNATE TO #endif ? function a_mpd(a, x) Local nLen := Len(a), nLoop, iRes, lFnd := .f., lEnd := .f. Local n1, n2 if nLen == 0 nLoop := 0 lEnd := .t. else iRes := icmp(a[1, 1], x) if iRes == 0 nLoop := 1 lFnd := lEnd := .t. elseif iRes > 0 nLoop := 1 lEnd := .t. endif if !lEnd if nLen > 1 iRes := icmp(a[nLen, 1], x) endif if iRes == 0 nLoop := nLen lFnd := lEnd := .t. elseif iRes < 0 nLoop := nLen + 1 lEnd := .t. endif endif endif if !lEnd n1 := 1 n2 := nLen while .t. if n1 == n2 - 1 nLoop := n2 exit endif nLoop := Int((n2 + n1) / 2) iRes := icmp(a[nLoop, 1], x) if iRes == 0 lFnd := .t. exit elseif iRes > 0 n2 := nLoop else n1 := nLoop endif enddo endif return if(lFnd, nLoop, -nLoop) func icmp(x1, x2) Local n if x1 == x2 n := 0 elseif x1 < x2 n := -1 else n := 1 endif Return n // Результат //01/28/10 05:16:23 Windows XP Professional 5.01.2600 Service Pack 2 xHarbour bui //ld 1.2.1 Intl. (SimpLex) (Rev. 6658) //LEN(aDim) = 4096 //SECONDS() = 1.02 //LEN(aNewDim) = 4096

 Отправлено: 28.01.10 17:38. Заголовок: 1000000 элементов, з..

1000000 элементов, зачем же такой фанатизм :)
Для каждой задачи надо использовать свой инструмент, для данных обьемом миллион строк массивы однозначно не годятся, и их надо сбрасывать в таблицу на диске и затем обрабатывать, т.е. использовать Ваш алгоритм с total/index.
Возможно, на харборе до обработки массива дело и не дошло, система не смогла и создать массив такой размерности, забив память. Двумерный массив с миллионной размерностью - это сотни мегабайт.
А при размерности до десятков тысяч элементов надо использовать массивы. Точную границу можно определить эксперементально.

На клиппере я тест с 4096 элементов прогнал, правда на 5.2, и он дал результаты:
с total: 0.77 сек
с массивами: 0.44 сек
5.01 не сработал наверное из-за проблем с большим обьемом данных, 5.2 все-таки стабильнее.

На харборе прогоню тест позже, сейчас нет времени.
К тому же, для корректного сравнения алгоритм МПД надо переписать на С (что я уже сделал у себя), так как index/seek ведь реализован на С.

 Отправлено: 28.01.10 20:40. Заголовок: Привожу тестовые про..

Привожу тестовые программки:

Function T4(aDim) 
 LOCAL aNewDim := {}, i, j, ad 
 Local nSec := Seconds() 
  
 FOR each ad in aDim 
   j := ASCANAS(aNewDim, ad[1], 1) 
   if j > 0 
     aNewDim[j, 2] += ad[2] 
   elseif j == 0 .or. -j > Len(aNewDim) 
     AADD(aNewDim, {ad[1], ad[2]}) 
   else 
     AINS(aNewDim, -j, {ad[1], ad[2]}, .t.) 
   endif 
 NEXT 
 Return Seconds() - nSec 
  
 #pragma BEGINDUMP 
  
 #include "hbapi.h" 
 #include "hbapiitm.h" 
  
 int itmCompare( PHB_ITEM pValue, PHB_ITEM pItem, BOOL bExact ) 
 { 
    int iRet = 1; 
  
    if( HB_IS_STRING( pValue ) && HB_IS_STRING( pItem ) ) 
    { 
       iRet = hb_itemStrCmp( pValue, pItem, bExact ); 
    } 
    else if( HB_IS_DATE( pValue ) && HB_IS_DATE( pItem ) ) 
    { 
 #ifdef __XHARBOUR__ 
       if( pItem->item.asDate.value == pValue->item.asDate.value && 
           pItem->item.asDate.time == pValue->item.asDate.time ) 
 #else 
       if( hb_itemGetTD( pItem ) == hb_itemGetTD( pValue ) ) 
 #endif 
       { 
          iRet = 0; 
       } 
 #ifdef __XHARBOUR__ 
       else if( pValue->item.asDate.value < pItem->item.asDate.value ) 
 #else 
       else if( hb_itemGetTD( pValue ) < hb_itemGetTD( pItem ) ) 
 #endif 
       { 
          iRet = -1; 
       } 
    } 
    else if( HB_IS_NUMINT( pValue ) && HB_IS_NUMINT( pItem ) ) 
    { 
       HB_LONG l1 = hb_itemGetNInt( pValue ); 
       HB_LONG l2 = hb_itemGetNInt( pItem ); 
       if( l1 == l2 ) 
       { 
          iRet = 0; 
       } 
       else if( l1 < l2 ) 
       { 
          iRet = -1; 
       } 
    } 
    else if( HB_IS_NUMBER( pValue ) && HB_IS_NUMBER( pItem ) ) 
    { 
       double d1 = hb_itemGetND( pValue ); 
       double d2 = hb_itemGetND( pItem ); 
       if( d1 == d2 ) 
       { 
          iRet = 0; 
       } 
       else if( d1 < d2 ) 
       { 
          iRet = -1; 
       } 
    } 
    else if( HB_IS_LOGICAL( pValue ) && HB_IS_LOGICAL( pItem ) ) 
    { 
       BOOL b1 = hb_itemGetL( pValue ); 
       BOOL b2 = hb_itemGetL( pItem ); 
       if( b1 == b2 ) 
       { 
          iRet = 0; 
       } 
       else if(! b1 ) 
       { 
          iRet = -1; 
       } 
    } 
  
    return iRet; 
 } 
  
 static LONG hb_ascanas(PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulIndex, BOOL bExact) 
 { 
    ULONG ulLoop = 0; 
    BOOL bFound = FALSE; 
  
    if( pArray && HB_IS_ARRAY( pArray ) && pValue && ulIndex ) 
    { 
       ULONG ulLen = hb_arrayLen( pArray ); 
       BOOL bEnd = FALSE; 
       PHB_ITEM pSubArray, pItem; 
       int iResult; 
  
       if( ulLen == 0) 
       { 
          ulLoop = 0; 
          bEnd = TRUE; 
       } 
       else 
       { 
  
          pSubArray = hb_arrayGetItemPtr( pArray, 1 ) ; 
          pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ; 
          if( pItem ) 
          { 
             iResult = itmCompare( pItem, pValue, bExact ); 
          } 
          else 
          { 
             bEnd = TRUE; 
          } 
  
          if( ! bEnd ) 
          { 
             if( iResult == 0 ) 
             { 
                ulLoop = 1; 
                bFound = bEnd = TRUE; 
             } 
             else if( iResult > 0 ) 
             { 
                ulLoop = 1; 
                bEnd = TRUE; 
             } 
          } 
  
          if( ! bEnd ) 
          { 
             if( ulLen > 1 ) 
             { 
                pSubArray = hb_arrayGetItemPtr( pArray, ulLen ) ; 
                pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ; 
                if( pItem ) 
                { 
                   iResult = itmCompare( pItem, pValue, bExact ); 
                } 
                else 
                { 
                   bEnd = TRUE; 
                } 
             } 
             if( ! bEnd ) 
             { 
                if( iResult == 0 ) 
                { 
                   ulLoop = ulLen; 
                   bFound = bEnd = TRUE; 
                } 
                else if( iResult < 0 ) 
                { 
                   ulLoop = ulLen + 1; 
                   bEnd = TRUE; 
                } 
             } 
          } 
  
       } 
  
       if( ! bEnd ) 
       { 
          ULONG ul1 = 1, ul2 = ulLen; 
  
          while( TRUE ) 
          { 
             if( ul1 == ul2 - 1 ) 
             { 
                ulLoop = ul2; 
                break; 
             } 
             ulLoop = (ul2 + ul1) / 2; 
  
             pSubArray = hb_arrayGetItemPtr( pArray, ulLoop ) ; 
             pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ; 
  
             if( pItem ) 
             { 
                iResult = itmCompare( pItem, pValue, bExact ); 
             } 
             else 
             { 
                ulLoop = 0; 
                break; 
             } 
  
             if( iResult == 0 ) 
             { 
                bFound = TRUE; 
                break; 
             } 
             else if( iResult > 0 ) 
             { 
                ul2 = ulLoop; 
             } 
             else 
             { 
                ul1 = ulLoop; 
             } 
          } 
       } 
  
    } 
  
    return ( bFound ? ulLoop : - (LONG) ulLoop ); 
 } 
  
 HB_FUNC( ASCANAS ) 
 { 
    hb_retnl( hb_ascanas(hb_param( 1, HB_IT_ARRAY ), 
              hb_param( 2, HB_IT_ANY ), 
              hb_parnl( 3 ), 
              ( ISLOG(4) ? hb_parl(4) : FALSE ) ) ); 
 } 
  
 #pragma ENDDUMP

Входными параметрами для теста будут размеры исходного и выходного массива.
Если оба параметра равны, то алгоритм теряет смысл, поэтому будем тестировать,
скажем на параметрах: 10000/1000, 20000/5000 и т.д.

Процедура заполнения тестового массива и тест:

Static func TestA(n1, n2) 
 ? T1(MakeA(n1, n2)) 
 ? T4(MakeA(n1, n2)) 
 Return nil 
  
 Static func MakeA(n1, n2) 
 Local i, aDim := {} 
  
 for i := 1 to n1 
    AADD(aDim, {n2 - i%n2, n1-i}) 
 next 
  
 Return aDim

Алгоритм с index/total:

Static func T1(aDim) 
 LOCAL aNewDim := {}, i, j 
 Local nSec := Seconds() 
 Field Key, Count 
  
 DBCREATE("test", {{"key", "N", 10, 0}, {"count", "N", 10, 0}})  
 USE test EXCLUSIVE 
 INDEX ON key TO test  
 AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]})  
 TOTAL ON key FIELDS count TO test2  
 USE  
 ERASE ("test.dbf")  
 ERASE ("test" + INDEXEXT())  
 USE test2  
 DBEVAL({||AADD(aNewDim, {key, count})})  
 USE  
 ERASE ("test2.dbf")  
  
 Return Seconds() - nSec

Компьютер: Celeron E4500 2.2Hz 2G RAM WinXP SP2
Результаты теста: при параметрах, разумных для массива, тест T4 бьет тест T1 на порядок

P1/P2 T1 T4

4000/400 0.36 0.02
4000/1000 0.41 0.03
10000/2000 0.94 0.11

При больших параметрах: 50000/20000 и т.д. тест Т1 немного превосходит тест Т4, но не всегда

50000/20000 5.33 7.27
500000/50000 41.05 46.98
1000000/30000 78.83 19.86 (результат неожиданный, но второй запуск показал тоже самое: Т4 побил Т1)

Тест T4 особенно критичен к размеры выходного массива.
Недостаток тестов: У Т1 - неоптимизорованный total в харборе, у Т4 - при переписывании на С исчезнет такая зависимость от размера выходного массива.
Результаты ожидаемые.

 Отправлено: 28.01.10 21:10. Заголовок: И до кучи дам уже фу..

И до кучи дам уже функцию сортировки двумерного массиво по одному/двум индексам
(ц) Viktor Szakats, Jose Lalin и мой
Функция itmCompare см. в предыдущем посте

#include "hbapiitm.h" 
  
 int itmCompare( PHB_ITEM pValue, PHB_ITEM pItem, BOOL bExact ); 
  
 static BOOL hb_itemIsLessA( PHB_ITEM pItem1, PHB_ITEM pItem2, ULONG ul1, ULONG ul2 ) 
 { 
    int iResult = 0; 
  
    if( HB_IS_ARRAY( pItem1 ) && HB_IS_ARRAY( pItem2 ) ) 
    { 
       ULONG ulLen1 = hb_arrayLen( pItem1 ); 
       ULONG ulLen2 = hb_arrayLen( pItem2 ); 
  
       if( ul1 <= ulLen1 && ul1 <= ulLen2 ) 
       { 
  
          iResult = itmCompare( hb_arrayGetItemPtr( pItem1, ul1 ), hb_arrayGetItemPtr( pItem2, ul1 ), FALSE ); 
  
          if( ! iResult && ul2 && ul2 <= ulLen1 && ul2 <= ulLen2 ) 
          { 
             iResult = itmCompare( hb_arrayGetItemPtr( pItem1, ul2 ), hb_arrayGetItemPtr( pItem2, ul2 ), FALSE ); 
          } 
       } 
  
    } 
  
    return iResult < 0; 
  
 } 
  
 /* partition array pItems[lb..ub] */ 
  
 static LONG hb_arraySortQuickPartitionA( PHB_ITEM pItems, ULONG ul1, ULONG ul2, LONG lb, LONG ub ) 
 { 
    LONG i, j, p; 
  
    /* select pivot and exchange with 1st element */ 
    p = lb + ( ( ub - lb ) >> 1 ); 
    if( p != lb ) 
    { 
       hb_itemSwap( pItems + lb, pItems + p ); 
    } 
  
    /* sort lb+1..ub based on pivot */ 
    i = lb + 1; 
    j = ub; 
  
    while( TRUE ) 
    { 
       while( i < j && hb_itemIsLessA( pItems + i, pItems + lb, ul1, ul2 ) ) 
       { 
          i++; 
       } 
  
       while( j >= i && hb_itemIsLessA( pItems + lb, pItems + j, ul1, ul2 ) ) 
       { 
          j--; 
       } 
  
       if( i >= j ) 
       { 
          break; 
       } 
  
       /* Swap the items */ 
       hb_itemSwap( pItems + i, pItems + j ); 
       j--; 
       i++; 
    } 
  
    /* pivot belongs in pItems[j] */ 
    if( j > lb ) 
    { 
       hb_itemSwap( pItems + lb, pItems + j ); 
    } 
  
    return j; 
 } 
  
 /* sort array pItems[lb..ub] */ 
  
 static void hb_arraySortQuickA( PHB_ITEM pItems, ULONG ul1, ULONG ul2, LONG lb, LONG ub ) 
 { 
    while( lb < ub ) 
    { 
       /* partition into two segments */ 
       LONG m = hb_arraySortQuickPartitionA( pItems, ul1, ul2, lb, ub ); 
  
       /* sort the smallest partition to minimize stack requirements */ 
       if( m - lb <= ub - m ) 
       { 
          hb_arraySortQuickA( pItems, ul1, ul2, lb, m - 1 ); 
          lb = m + 1; 
       } 
       else 
       { 
          hb_arraySortQuickA( pItems, ul1, ul2, m + 1, ub ); 
          ub = m - 1; 
       } 
    } 
 } 
  
 BOOL hb_arraySortA( PHB_ITEM pArray, ULONG ul1, ULONG ul2, ULONG * pulStart, ULONG * pulCount ) 
 { 
  
    if( HB_IS_ARRAY( pArray ) ) 
    { 
       PHB_BASEARRAY pBaseArray = pArray->item.asArray.value; 
       ULONG ulLen = pBaseArray->ulLen; 
       ULONG ulStart; 
       ULONG ulCount; 
       ULONG ulEnd; 
  
       if( pulStart && ( *pulStart >= 1 ) ) 
       { 
          ulStart = *pulStart; 
       } 
       else 
       { 
          ulStart = 1; 
       } 
  
       if( ulStart <= ulLen ) 
       { 
          if( pulCount && *pulCount >= 1 && ( *pulCount <= ulLen - ulStart ) ) 
          { 
             ulCount = *pulCount; 
          } 
          else 
          { 
             ulCount = ulLen - ulStart + 1; 
          } 
  
          if( ulStart + ulCount > ulLen )             /* check range */ 
          { 
             ulCount = ulLen - ulStart + 1; 
          } 
  
          ulEnd = ulCount + ulStart - 2; 
  
          /* Optimize when only one or no element is to be sorted */ 
          if( ulCount > 1 ) 
          { 
             hb_arraySortQuickA( pBaseArray->pItems, ul1, ul2, ulStart - 1, ulEnd ); 
          } 
       } 
  
       return TRUE; 
    } 
    else 
    { 
       return FALSE; 
    } 
 } 
  
 HB_FUNC( ASORTA2 ) 
 { 
    PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); 
    ULONG ul1 = hb_parnl( 2 ); 
    ULONG ul2 = hb_parnl( 3 ); 
  
    if( pArray && ! hb_arrayIsObject( pArray ) && ul1 ) 
    { 
 //      ULONG ulStart = hb_parnl( 2 ); 
 //      ULONG ulCount = hb_parnl( 3 ); 
  
       hb_arraySortA( pArray, ul1, ul2, NULL, NULL ); 
  
    } 
    hb_ret(); 
 }

 Отправлено: 28.01.10 21:34. Заголовок: Мне хотелось бы проя..

Мне хотелось бы прояснить некоторые моменты: название алгоритма МПД расшифруйте если можно и если у Вас есть "алгоритмические" link-и (URL) и если не жалко - можете поделиться, еще очень интересует как Вы в своих постах делаете текст в ScrollBox-ах. Непонятно также чем же "не оптимизирована" функция dbTotal (команда TOTAL ON ...), на мой взгляд - так это просто образец грамотного программирования. И замечание по алгоритмам - на самом деле все эти секунды времени выполнения - фигня, по сравнению с такими критериями как простота, совместимость с ЛЮБОЙ xBase-совместимой системой программирования, надежность, "прозрачность", нечувствительность к размерности данных и относительно стабильная приемлемая скорость выполнения не зависящая от мощности процессора и размера оперативной памяти. И кстати о памяти - работа с массивами в памяти в принципе чревата фрагментацией оперативной памяти и огромными проблемами при работе больших программных систем. Я имею в виду массивы БОЛЬШИХ размерностей. Поэтому для меня просто удивительно, что "на эти грабли" на которые мы наступали в начале 90-х снова наступает "племя молодое незнакомое".

 Отправлено: 28.01.10 22:53. Заголовок: sergey5703 пишет: н..

sergey5703 пишет:

цитата:

название алгоритма МПД расшифруйте

банальный метод половинного деления :-)

цитата:

чем же "не оптимизирована" функция dbTotal

ее надо реализовать на С

цитата:

И замечание по алгоритмам - на самом деле все эти секунды времени выполнения - фигня

Разница в производительности в 10 раз - это фигня ? Тем более мы рассматриваем простейший алгоритм.
Как, к примеру, можно обработать с помощью total массивы вида:

{{ключ, значение, {{ключ, значение}, ...} }, ...}

где нужна рекурсия ?

цитата:

по сравнению с такими критериями как простота, совместимость с ЛЮБОЙ xBase-совместимой системой программирования, надежность, "прозрачность", нечувствительность к размерности данных и относительно стабильная приемлемая скорость выполнения не зависящая от мощности процессора и размера оперативной памяти.

Для задач разного класса не может быть универсального алгоритма. Использовать total для обработки массива данных 10/100 элементов это маразм

цитата:

И кстати о памяти - работа с массивами в памяти в принципе чревата фрагментацией оперативной памяти и огромными проблемами при работе больших программных систем. Я имею в виду массивы БОЛЬШИХ размерностей.

Никто кроме вас не говорит об использовании БОЛЬШИХ массивов. Вы воюете сами с собой

цитата:

Поэтому для меня просто удивительно, что "на эти грабли" на которые мы наступали в начале 90-х снова наступает "племя молодое незнакомое".

Это вы мне говорите ?

 Отправлено: 29.01.10 21:06. Заголовок: Оптимизированная про..

Оптимизированная программа (без TOTAL ON ...).

Зависимость времени выполнения от размерности "результирующего" массива. 
 ------------------------------------------------------------------------ 
 :                            :  Размерность "результирующего" массива  : 
 :          Алгоритм          :-----------------------------------------: 
 :                            :  4-528  :4096-10000:  100000 :  1000000 : 
 ------------------------------------------------------------------------ 
 :оптимизир.(без TOTAL ON ...):0.20 сек.:0.40 сек. :3.00 сек.:32.58 сек.: 
 ------------------------------------------------------------------------ 
 

Файл test8.prg
Скрытый текст

// Программа - оптимизированная (без TOTAL ON ...) #define LEN_NEW_DIM_1000000 //#define LEN_NEW_DIM_100000 //#define LEN_NEW_DIM_10000 //#define LEN_NEW_DIM_4096 //#define LEN_NEW_DIM_528 //#define LEN_NEW_DIM_4 #ifdef __HARBOUR__ REQUEST HB_CODEPAGE_RU866 REQUEST HB_LANG_RU866 REQUEST DBFNTX #endif LOCAL aDim8, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd LOCAL nCurKey, nCurCount SET DATE FORMAT TO "DD/MM/YYYY" #ifdef __HARBOUR__ HB_SETCODEPAGE("RU866") HB_LANGSELECT("RU866") RDDSETDEFAULT("DBFNTX") #endif aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} #ifdef LEN_NEW_DIM_1000000 FOR i := 1000000 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_100000 FOR i := 100000 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_10000 FOR i := 10000 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_4096 FOR i := 4096 TO 1 STEP -1 AADD(aDim, {i, 1}) NEXT #endif #ifdef LEN_NEW_DIM_528 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) NEXT NEXT #endif #ifdef LEN_NEW_DIM_4 FOR i := 1 TO 512 FOR j := 1 TO 8 AADD(aDim, aDim8[j]) NEXT NEXT #endif ? DATE(), TIME(), OS() ? DBSETDRIVER(), VERSION() ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) nTimeStart := SECONDS() //-------------------------------------------------------------------- DBCREATE("test", {{"key", "N", 10, 0}, {"count", "N", 10, 0}}) USE test INDEX ON key TO test AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]}) GO TOP DO WHILE !EOF() nCurKey := FIELD->key; nCurCount := 0 DO WHILE !EOF() .AND. (nCurKey == FIELD->key) nCurCount += FIELD->count SKIP ENDDO AADD(aNewDim, {nCurKey, nCurCount}) ENDDO //-------------------------------------------------------------------- nTimeEnd := SECONDS() ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) ? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim))) #ifdef LEN_NEW_DIM_4 AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) #endif ? // Результаты //29/01/2010 11:32:41 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 4096 //SECONDS() = 0.19 //LEN(aNewDim) = 4 // 2000 1024 // 2003 512 // 2008 1024 // 2009 1536 //29/01/2010 11:30:50 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 4096 //SECONDS() = 0.20 //LEN(aNewDim) = 528 //29/01/2010 11:29:18 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 4096 //SECONDS() = 0.40 //LEN(aNewDim) = 4096 //29/01/2010 17:27:36 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 10000 //SECONDS() = 0.36 //LEN(aNewDim) = 10000 //29/01/2010 17:29:34 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 100000 //SECONDS() = 3.00 //LEN(aNewDim) = 100000 //29/01/2010 10:45:30 Windows XP 5.1.2600 Service Pack 2 //DBFNTX Harbour 2.0.0 (Rev. 13372) //LEN(aDim) = 1000000 //SECONDS() = 32.58 //LEN(aNewDim) = 1000000

 Отправлено: 29.01.10 22:00. Заголовок: sergey5703 пишет: е..

sergey5703 пишет:

цитата:

еще очень интересует как Вы в своих постах делаете текст в ScrollBox-ах.

надо выделить фрагмент, и нажать на кнопку моноширинный шрифт (2-ю, их две)

цитата:

Оптимизированная программа (без TOTAL ON ...).

Вы правильно сделали, что убрали лишнее звено - команду total
С total алгоритм выглядел так: исходный массив сбрасывается в проиндексированную таблицу на диске
Затем (это делает total): в цикле по этой таблице формируется еще одна таблица на диске, в которую группируются данные из первой таблицы.
Поскольку первая таблица проиндексирована, поиск в ней выполнять не надо.
Затем в цикле по второй таблице данные выбираются в результирующий массив

Теперь (без total) данные в цикле по первой таблице сразу попадают в результирующий массив, что совершенно логично.
Осталось сделать еще один логичный шаг: отказаться и от первой таблицы.

Смотрите. Исходный массив (будем считать его достаточно большим) возникает не сам по себе, а в результате запроса из БД (его заполнение в результате расчета не рассматриваем).
Затем он сбрасывается в первую таблицу, и дальше по алгоритму без total
Т.е: выборка из БД (чтение) - Сброс во временную таблицу на диске (запись) - цикл по этой таблице (опять чтение)
Самое оптимальное - это вообще отказаться от заполнения исходного массива, а в процессе выборки из БД сразу формировать результирующий массив.
И формировать результирующий массив сразу упорядоченным, чтобы оптимизировать поиск в нем.

 Отправлено: 30.01.10 01:40. Заголовок: Pasha пишет: Смотри..

Pasha пишет:

цитата:

Смотрите. Исходный массив (будем считать его достаточно большим) возникает не сам по себе, а в результате запроса из БД

А зачем результаты запроса помещать в массив? Сейчас так модно программировать? Тогда меня совершенно не удивляют вопросы из некоторых постов: "почему после некоторого времени программа сильно замедляется?". В результате МАССОВОГО использования массивов в программе образуется огромное количество маленьких фрагментов свободной памяти, но недостаточное для инициации процедуры "сборки мусора" (потому что объемы физической памяти сейчас на компьютерах обычно огромны) и вот поступает запрос на выделение памяти и система выделения памяти Харбора начинает ЛИНЕЙНОЕ перелопачивание списка свободных фрагментов, ну и далее имеем - то что имеем, чудовищное замедление работы программы - несмотря (или благодаря) использованию вместо "медленных" операций с диском, "быстрых" операций с массивами. Вообще ПРОФАЙЛЕР для Харбора планируется? Вы не в курсе? Вы по аглицки могете - тогда озадачте Лунареса с Закатосом!

 Отправлено: 30.01.10 09:19. Заголовок: sergey5703 пишет: А..

sergey5703 пишет:

цитата:

А зачем результаты запроса помещать в массив? Сейчас так модно программировать?

А разве кто-то весь запрос из БД помещает в массив ? Андрей дал в качестве задачи пример с маленькими массивами,
вы заговорили об огромных массивах, и понеслось...
Насчет проблем с фрагментацией памати и сборкой мусора - мне кажется вы преувеличиваете, ничего подобного не произойдет.
Впрочем, можно провести тест: выделять/освобождать многомерные массивы шестизначного размера, и смотреть за состоянием программы

Насчет профайлера - не знаю

 Отправлено: 02.02.10 21:38. Заголовок: Обнаружил пример раб..

Обнаружил пример работы в Harbour 2.0 с dbf и индексными файлами В ОПЕРАТИВНОЙ ПАМЯТИ (файл C:\hb20\contrib\hbmemio\tests\test.prg) и переделал последнюю (оптимизированную - без TOTAL ON) версию программы.
Ускорение работы - почти в два раза!

Файл Hb20make.BAT

@echo off 
  
 rem compilation %1.PRG Harbour 2.0.0 
 rem http://www.harbour-project.org 
  
 SET PATH=c:\BCC55\BIN;c:\hb20\BIN 
 SET INCLUDE=c:\BCC55\INCLUDE;c:\hb20\INCLUDE 
 SET LIB=c:\BCC55\LIB;c:\BCC55\LIB\PSDK;c:\hb20\lib\win\bcc 
 set HB_BIN_INSTALL=c:\hb20\bin 
 set HB_LIB_INSTALL=c:\hb20\lib\win\bcc 
 set HB_INC_INSTALL=c:\hb20\include\ 
 %HB_BIN_INSTALL%\harbour.exe %1.prg %2 -gc0 -i%HB_INC_INSTALL% 
 if exist %1.exe del %1.exe 
 if exist %1.tds del %1.tds 
 bcc32.exe -o%1.obj -c -d -O2 -I%HB_INC_INSTALL% %1.c 
 ilink32.exe -Gn -s -L%HB_LIB_INSTALL% -Lc:\bcc55\lib -Lc:\bcc55\lib\psdk c0x32.obj %1.obj, %1.exe, , hbvm.lib hbrtl.lib hbmacro.lib hbpp.lib hbcommon.lib hblang.lib gtwin.lib hbrdd.lib rddntx.lib rddnsx.lib rddcdx.lib rddfpt.lib hbdebug.lib hbpcre.lib hbhsx.lib hbsix.lib hbwin.lib hbct.lib hbzlib.lib hbcpage.lib xhb.lib hbmemio.lib cw32.lib import32.lib odbc32.lib, ,  
 if exist %1.tds del *.tds 
 if exist %1.map del *.map 
 if exist %1.obj del *.obj 
 if exist %1.c   del *.c 
 

Файл test9.prg

// Программа - оптимизированная (без TOTAL ON ...) - В ПАМЯТИ !!! 
  
 #define LEN_NEW_DIM_1000000 
 //#define LEN_NEW_DIM_100000 
 //#define LEN_NEW_DIM_10000 
 //#define LEN_NEW_DIM_4096 
 //#define LEN_NEW_DIM_528 
 //#define LEN_NEW_DIM_4 
 #ifdef __HARBOUR__ 
 REQUEST HB_CODEPAGE_RU866 
 REQUEST HB_LANG_RU866 
 //REQUEST DBFNTX 
 REQUEST HB_MEMIO 
 #endif 
  
 LOCAL aDim8, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd 
 LOCAL nCurKey, nCurCount 
 SET DATE FORMAT TO "DD/MM/YYYY" 
 #ifdef __HARBOUR__ 
 HB_SETCODEPAGE("RU866") 
 HB_LANGSELECT("RU866") 
 //RDDSETDEFAULT("DBFNTX") 
 #endif 
 aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} 
 #ifdef LEN_NEW_DIM_1000000 
 FOR i := 1000000 TO 1 STEP -1 
   AADD(aDim, {i, 1}) 
 NEXT 
 #endif 
 #ifdef LEN_NEW_DIM_100000 
 FOR i := 100000 TO 1 STEP -1 
   AADD(aDim, {i, 1}) 
 NEXT 
 #endif 
 #ifdef LEN_NEW_DIM_10000 
 FOR i := 10000 TO 1 STEP -1 
   AADD(aDim, {i, 1}) 
 NEXT 
 #endif 
 #ifdef LEN_NEW_DIM_4096 
 FOR i := 4096 TO 1 STEP -1 
   AADD(aDim, {i, 1}) 
 NEXT 
 #endif 
 #ifdef LEN_NEW_DIM_528 
 FOR i := 1 TO 512 
   FOR j := 1 TO 8 
     AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]}) 
   NEXT 
 NEXT 
 #endif 
 #ifdef LEN_NEW_DIM_4 
 FOR i := 1 TO 512 
   FOR j := 1 TO 8 
     AADD(aDim, aDim8[j]) 
   NEXT 
 NEXT 
 #endif 
 ? DATE(), TIME(), OS() 
 ? DBSETDRIVER(), VERSION() 
 ? "LEN(aDim) = " + LTRIM(STR(LEN(aDim))) 
 nTimeStart := SECONDS() 
 //-------------------------------------------------------------------- 
 DBCREATE("mem:test", {{"KEY", "N", 10, 0},; 
                       {"COUNT", "N", 10, 0}},, .T., "memarea") 
 //USE test 
 INDEX ON KEY TAG key 
 AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]}) 
 GO TOP 
 DO WHILE !EOF() 
   nCurKey := FIELD->key; nCurCount := 0 
   DO WHILE !EOF() .AND. (nCurKey == FIELD->key) 
     nCurCount += FIELD->count 
     SKIP 
   ENDDO 
   AADD(aNewDim, {nCurKey, nCurCount}) 
 ENDDO 
 //-------------------------------------------------------------------- 
 nTimeEnd := SECONDS() 
 DBCLOSEAREA() 
 DBDROP("mem:test")  // Free memory resource 
 ? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart)) 
 ? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim))) 
 #ifdef LEN_NEW_DIM_4 
 AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) 
 //#else 
 //SET ALTERNATE TO test9.out 
 //SET ALTERNATE ON 
 //SET CONSOLE   OFF 
 //AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) 
 //? 
 //SET CONSOLE   ON 
 //SET ALTERNATE OFF 
 //SET ALTERNATE TO 
 #endif 
 ? 
  
 // Результаты 
  
 //02/02/2010 21:17:39 Windows XP 5.1.2600 Service Pack 2 
 //DBFNTX Harbour 2.0.0 (Rev. 13372) 
 //LEN(aDim) = 1000000 
 //SECONDS() = 16.76 
 //LEN(aNewDim) = 1000000