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

Форум » Clipper » Подскажите как из одного массива получить второй сокращенный.... » Ответить

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

Верченко Андрей: Всем привет ! Подскажите идею, желательно красивую ! Имею 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} }

Ответов - 43, стр: 1 2 3 All

sergey5703: // Программа по алгоритму 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() - мощнейший инструмент (в умелых руках).

gustow: Ребята, обращайте внимание, когда пишете в посты свои тексты программ! Если (как в последнем от sergey5703 - но и раньше то и дело встречалось) в тексте программы встречается "открывающая квадратная скобка" + "i" + "закрывающая квадратная скобка" - то этот кусок текста программы не отображается в посте, а все последующее идет курсивом... Пишите как "[ i ]" - т.е. с пробелами внутри квадратных скобок - и будет вам (и всем остальным) щастье! Перед тем, как тыкнуть в "отправить", неплохо бы глянуть в "Предпросмотр" и убедиться, что высказанная идея действительно "овладеет массами" :) "Скопипастить-то всякий может - а вот проверить, что скопипастил..." ((с) училка информатики)

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

Pasha: sergey5703 пишет: Видим что по данному алгоритму программа на порядок (10 раз) примерно быстрее, Вот видите. Несмотря на то, что вы сравнивали "неэффективный" алгоритм с массивами с "эффективным" через total/index, неэффективный побил эффективный на порядок. Я же предлагал аналогичный вашему алгоритм без ASCAN, такой же эффективный, но без total/index. и компьютер отнюдь не 80286 У нас есть музей ВТ, в котором должны быть двойки. Когда выберу свободную минутку, зайду туда с дискетой, запущу ваш тест, благо это недалеко - на этаже.

Pasha: Обсуждение в этой теме я считаю полезным (благодаря sergey5703) У меня, в частности, возникли такие идеи: 1) Переписать на С сортировку двумерного массива - конструкцию ASORT(aNewDim,,, {|x,y|x[1] < y[1]}) 2) Сделать на С аналог ASCAN - при неудачном поиске он возвращал бы индекс следующего элемента за искомым, скажем, с отрицательным знаком вместо нуля, чтобы иметь возможность не добавить элемент, а вставить его в нужной позиции, и получить отсортированный результирующий массив 3) Сделать ASCAN в отсортированном двумерном массиве, к примеру с помощью МПД (метода половинного деления) Все это, естественно, для харбора. Можно сделать и для клиппера, благо api у клиппера и харбора похожи, но зачем ?

sergey5703: Программы по двум алгоритмам были доработаны в плане генерации исходных данных для проверки быстродействия. Теперь можно получать на выходе "результирующий" массив размерности 4, 528 или 4096 элементов. Вот таблица итоговых результатов: [pre2]Зависимость времени выполнения от размерности "результирующего" массива. ------------------------------------------------------------------------ : : Размерность "результирующего" массива : : Алгоритм :-----------------------------------------: : : 4 : 528 : 4096 : ------------------------------------------------------------------------ : INDEX ... TOTAL ... : 0.49 сек. : 0.61 сек. : 1.10 сек. : ------------------------------------------------------------------------ : ASCAN ... ASORT ... : 0.06 сек. : 5.00 сек. : 60.20 сек. : ------------------------------------------------------------------------ [/pre2]Вывод: "дисковый" алгоритм почти не коррелирует по времени выполнения с размерностью получающегося массива, а время выполнения 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

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

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

Pasha: Вот еще 4-й алгоритм, без использования asort-ascan, вернее, вместо ascan используется поиск в упорядоченном массиве по МПД, при неудаче - вставка элемента в нужную позицию, чтобы выходной массив был отсортирован: [pre]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)[/pre]

sergey5703: Я протестировал Ваш алгоритм - при 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

Pasha: 1000000 элементов, зачем же такой фанатизм :) Для каждой задачи надо использовать свой инструмент, для данных обьемом миллион строк массивы однозначно не годятся, и их надо сбрасывать в таблицу на диске и затем обрабатывать, т.е. использовать Ваш алгоритм с total/index. Возможно, на харборе до обработки массива дело и не дошло, система не смогла и создать массив такой размерности, забив память. Двумерный массив с миллионной размерностью - это сотни мегабайт. А при размерности до десятков тысяч элементов надо использовать массивы. Точную границу можно определить эксперементально. На клиппере я тест с 4096 элементов прогнал, правда на 5.2, и он дал результаты: с total: 0.77 сек с массивами: 0.44 сек 5.01 не сработал наверное из-за проблем с большим обьемом данных, 5.2 все-таки стабильнее. На харборе прогоню тест позже, сейчас нет времени. К тому же, для корректного сравнения алгоритм МПД надо переписать на С (что я уже сделал у себя), так как index/seek ведь реализован на С.

Pasha: Привожу тестовые программки: [pre]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[/pre] Входными параметрами для теста будут размеры исходного и выходного массива. Если оба параметра равны, то алгоритм теряет смысл, поэтому будем тестировать, скажем на параметрах: 10000/1000, 20000/5000 и т.д. Процедура заполнения тестового массива и тест: [pre]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[/pre] Алгоритм с index/total: [pre]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[/pre] Компьютер: 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 - при переписывании на С исчезнет такая зависимость от размера выходного массива. Результаты ожидаемые.

Pasha: И до кучи дам уже функцию сортировки двумерного массиво по одному/двум индексам (ц) Viktor Szakats, Jose Lalin и мой Функция itmCompare см. в предыдущем посте [pre]#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(); }[/pre]

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

Pasha: sergey5703 пишет: название алгоритма МПД расшифруйте банальный метод половинного деления :-) чем же "не оптимизирована" функция dbTotal ее надо реализовать на С И замечание по алгоритмам - на самом деле все эти секунды времени выполнения - фигня Разница в производительности в 10 раз - это фигня ? Тем более мы рассматриваем простейший алгоритм. Как, к примеру, можно обработать с помощью total массивы вида: {{ключ, значение, {{ключ, значение}, ...} }, ...} где нужна рекурсия ? по сравнению с такими критериями как простота, совместимость с ЛЮБОЙ xBase-совместимой системой программирования, надежность, "прозрачность", нечувствительность к размерности данных и относительно стабильная приемлемая скорость выполнения не зависящая от мощности процессора и размера оперативной памяти. Для задач разного класса не может быть универсального алгоритма. Использовать total для обработки массива данных 10/100 элементов это маразм И кстати о памяти - работа с массивами в памяти в принципе чревата фрагментацией оперативной памяти и огромными проблемами при работе больших программных систем. Я имею в виду массивы БОЛЬШИХ размерностей. Никто кроме вас не говорит об использовании БОЛЬШИХ массивов. Вы воюете сами с собой Поэтому для меня просто удивительно, что "на эти грабли" на которые мы наступали в начале 90-х снова наступает "племя молодое незнакомое". Это вы мне говорите ?

sergey5703: Оптимизированная программа (без TOTAL ON ...). [pre2]Зависимость времени выполнения от размерности "результирующего" массива. ------------------------------------------------------------------------ : : Размерность "результирующего" массива : : Алгоритм :-----------------------------------------: : : 4-528 :4096-10000: 100000 : 1000000 : ------------------------------------------------------------------------ :оптимизир.(без TOTAL ON ...):0.20 сек.:0.40 сек. :3.00 сек.:32.58 сек.: ------------------------------------------------------------------------ [/pre2] Файл 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

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

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

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

sergey5703: Обнаружил пример работы в Harbour 2.0 с dbf и индексными файлами В ОПЕРАТИВНОЙ ПАМЯТИ (файл C:\hb20\contrib\hbmemio\tests\test.prg) и переделал последнюю (оптимизированную - без TOTAL ON) версию программы. Ускорение работы - почти в два раза! Файл Hb20make.BAT [pre]@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 [/pre] Файл test9.prg [pre]// Программа - оптимизированная (без 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 [/pre]

полная версия страницы