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

Форум » 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

Pasha: У меня для этих целей есть функция AADDQ. Синтаксис такой: Function AADDQ(aArray, xValue, aD, aI, lSort) // ------------------------------------------------------------- // Аналог AADD - добавляет уникальный элемент в массив // Параметры: // aArray - исходный массив; // xValue - добавляемое значение (допускается массив); // [aD] - описывает добавляемый массив: // <1> - этот элемент используется для сравнения; // <2> - соответствующий элемент суммируется. // <3> - соответствующий элемент добавляется в подмассив; // <4> - подмассив добавляется уникально (рекурсия); // <6> - элементы подмассива суммируются; // <7> - подмассив добавляется уникально AADDQS (рекурсия); // <10> - расчитывается максимальное число; // <11> - элемент переприсваивается. // По умолчанию сравнение производится по 1-му элементу, // все числовые элементы суммируются, все массивы // добавляются. // lSort - исходный массив отсортирован. // Возвращает номер элемента массива. Т.е, с этой функцией результат можно получить так: aNewDim := {} AEval(aDim, {|a| AADDQ(aNewDim, {a[1], a[2]})}) или (без умолчаний) AEval(aDim, {|a| AADDQ(aNewDim, {a[1], a[2]}, {1, 2})}) Для харбора я часть кода переписал на С Если интересно - могу опубликовать весь свой модуль функций работы с массивами

PSP: Некрасивая идея: FUNCTION DimToNewDim( aDim ) LOCAL aNewDim := {} LOCAL i, n FOR i := 1 TO Len( aDim ) IF Empty( aNewDim ) AAdd( aNewDim, aDim[ i ] ) LOOP END // IF n := AScan( aNewDim, { | x | x[ 1 ] == aDim[ i, 1 ] } ) IF n <> 0 aNewDim[ n, 2 ] += aDim[ i, 2 ] ELSE AAdd( aNewDim, aDim[ i ] ) END // IF NEXT RETURN aNewDim

Dima: PSP пишет: Некрасивая идея Вполне нормальная идея

PSP: Dima пишет: Вполне нормальная идея

Andrey: PSP пишет: Некрасивая идея: Классная идея, и самое главное компактно !!! Спасибо большое !!! А то я сделал в лоб, и так крутил и сяк, короче сам себе мозги затуманил....

PSP: Пожалуйста. Рад, что понравилось.

sergey5703: Вопрос конечно интересный, ключевые слова: Верченко Андрей пишет: желательно красивую !. В моем понимании красота в программировании, это - простота, целесообразность и надежность. Исходя из этих критериев, самое простое, целесообразное и надежное - функцией dbcreate создать dbf файл с двумя полями, первое поле тип character(10), второе numeric(10) индексированный по первому полю и записать весь массив в базу преобразовав первый элемент каждого подмассива в строку функцией str, затем вернуться на начало базы и просканировав ее функцией dbeval сформировать результирующий массив. Задача похожа на проверку! // Программа LOCAL aDim, aNewDim := {}, aSubDim aDim := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} DBCREATE("test", {{"key", "C", 10, 0}, {"count", "N", 10, 0}}) USE test INDEX ON key TO test UNIQUE AEVAL(aDim, {|x|IIF(!DBSEEK(STR(x[1])), (DBAPPEND(), FIELD->key := STR(x[1])), NIL), FIELD->count += x[2]}) DBEVAL({||aSubDim := {}, AADD(aSubDim, VAL(key)), AADD(aSubDim, count), AADD(aNewDim, aSubDim)}) CLOSE ERASE ("test.dbf") ERASE ("test.ntx") AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) ? // Результат 2000 2 2003 1 2008 2 2009 3

Andrey: Pasha пишет: Если интересно - могу опубликовать весь свой модуль функций работы с массивами Конечно ИНТЕРЕСНО ! Код в студию !!!

Andrey: sergey5703 пишет: Исходя из этих критериев, самое простое, целесообразное и надежное - функцией dbcreate создать dbf файл с двумя .... Нарушается самый главный принцип - БЫСТРОДЕЙСТВИЕ !!! Самые медленные функции это - дисковые функции, работа с файлами ! Но все равно спасибо !

sergey5703: Уважаемый Андрей !!! Как раз приведенное мной решение - САМОЕ БЫСТРОДЕЙСТВУЩЕЕ. Вы не застали время компьютеров AT/286 с тактовой частотой CPU 16 МГц. Только чтобы проверить это исходный массив должен быть ОЧЕНЬ БОЛЬШИМ (в идеале максимум - 4096 элементов) и компьютер - очень медленным (AT/286). И тогда Вы убедились бы в том, что программа с файлами работает мгновенно, а с вызовом ASCAN() - ЧАСЫ !!! Еще один вариант решения - САМОЕ КЛИППЕРОВСКОЕ !!! // Программа LOCAL aDim, aNewDim := {} aDim := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}} 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") AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) ? // Результат 2000 2 2003 1 2008 2 2009 3 Почему предложенное решение - САМОЕ БЫСТРОДЕЙСТВУЮЩЕЕ? Потому что оно - ЛИНЕЙНО зависимо от числа элементов массива, а решение с использованием ASCAN - экспоненциально зависимо. То есть в моем решении время выполнения программы рассчитывается по формуле: N * M (где M - меньше 10), а в решении с ASCAN по формуле: N * N (то есть N в квадрате), если N = 4096, то какое число больше N * 10 или N в квадрате?

Pasha: sergey5703 пишет: Почему предложенное решение - САМОЕ БЫСТРОДЕЙСТВУЮЩЕЕ? Потому что оно - ЛИНЕЙНО зависимо от числа элементов массива, а решение с использованием ASCAN - экспоненциально зависимо. Это неверно. Вы сравниваете 2 разных алгоритма. Отсортируйте исходный массив, и затем обрабатывайте его в цикле без ASCAN линейно. И насчет быстродействия тоже неверно. Какие бы медленные не были бы АТ286, дисковые операции на них так же были очень медленными, так что неэффективное решение с ASCAN все равно отработает быстрее, чем запись на диск. ASCAN работает достаточно быстро Я использую работу с большими многомерными массивами с тысячами элементов как раз с тех времен, даже не 286, а 8086, и все работает достаточно быстро. Ниже я даю как раз фунцкции, написанные еще а начале 90-х, когда появился 5.01. Я их конечно многократно дорабатывал, но основа осталась с времен 8086 и "покоренья Крыма"

Pasha: модуль _array.prg [pre]#include "common.ch" Function AADDQS(aArray, xValue, aD, aI) // ------------------------------------------------------------- // Аналог AADDQ. // Подразумевается, что входной поток поступает в отсортированном // порядке, т.е. проверяется совпадение только на последний // элемент. // ------------------------------------------------------------- Return AADDQ(aArray, xValue, aD, aI, .t.) Function AADDQ(aArray, xValue, aD, aI, lSort) // ------------------------------------------------------------- // Аналог AADD - добавляет уникальный элемент в массив // Параметры: // aArray - исходный массив; // xValue - добавляемое значение (допускается массив); // [aD] - описывает добавляемый массив: // <1> - этот элемент используется для сравнения; // <2> - соответствующий элемент суммируется (default). // <3> - соответствующий элемент добавляется в подмассив (default); // <4> - подмассив добавляется уникально (рекурсия); // <5> // <6> - элементы подмассива суммируются; // <7> - подмассив добавляется уникально AADDQS (рекурсия); // <10> - расчитывается максимальное число; // <11> - элемент переприсваивается. // По умолчанию сравнение производится по 1-му элементу, // все числовые элементы суммируются, все массивы // добавляются. // lSort - исходный массив отсортирован. // Возвращает номер элемента массива. // ------------------------------------------------------------- Local nPos, nComp, aTemp, aComp, nC := 0, nP, ap, x Local nCount, lad := .t. if IsArray(xValue) if aD == nil /* проверить ! if aI == nil .and. lSort == nil Return HB_AADDQ(aArray, xValue) endif */ lad := .f. nCount := Len(xValue) /* aD = Array(nCount) aD[1] := 1 for nComp := 2 to nCount x := xValue[nComp] if IsNumber(x) aD[nComp] := 2 elseif IsArray(x) aD[nComp] := 3 // xValue[nComp] := AClone(xValue[nComp]) else aD[nComp] := 0 endif next // nC := nP := 1 */ else nCount := Len(aD) endif // if nP == nil if lad aComp := Array(nCount) endif for nComp := 1 to nCount if lad .and. aD[nComp] == nil Loop elseif if(lad, aD[nComp] == 1, nComp == 1) if lad aComp[nComp] = xValue[nComp] endif nP := nComp nC ++ elseif if(lad, aD[nComp] == 3, IsArray(xValue[nComp])) aTemp := AClone(xValue[nComp]) xValue[nComp] = nil xValue[nComp] = aTemp aTemp := nil endif next // endif if aI # nil for nComp = 1 to len(aI) if aI[nComp] # nil aTemp := nil aTemp := AddNtoA(aTemp, xValue[nComp], aI[nComp]) aD[nComp] = 5 xValue[nComp] = nil xValue[nComp] = aTemp endif next endif if nC == 1 if lSort == nil nPos := AScanA(aArray, xValue[nP], nP) else nPos := len(aArray) if nPos # 0 .and. ! (aArray[nPos][nP] = xValue[nP]) nPos := 0 endif endif else nPos := AScanM(aArray, aComp) endif else if lSort == nil nPos := ASCAN(aArray, xValue) else nPos := len(aArray) if nPos # 0 .and. ! (aArray[nPos] = xValue) nPos := 0 endif endif endif if nPos == 0 AADD(aArray, xValue) nPos := Len(aArray) elseif aD # nil .or. ! lad ap := aArray[nPos] for nComp := 1 to nCount #ifndef __HARBOUR__ if ! lad if nComp # 1 x := xValue[nComp] if IsNumber(x) ap[nComp] += x elseif IsArray(x) AEval(x, {|a| AADD(ap[nComp], a)}) endif endif elseif aD[nComp] == nil Loop elseif aD[nComp] == 2 ap[nComp] += xValue[nComp] elseif aD[nComp] == 3 if ! Empty(xValue[nComp]) AEval(xValue[nComp], {|a| AADD(ap[nComp], a)}) endif elseif aD[nComp] == 4 if ! Empty(xValue[nComp]) AEval(xValue[nComp], {|a| AADDQ(ap[nComp], a)}) endif elseif aD[nComp] == 5 AddNtoA(ap[nComp], xValue[nComp] [aI[nComp]], aI[nComp]) elseif aD[nComp] == 6 AddAr(ap[nComp], xValue[nComp]) elseif aD[nComp] == 7 AADDQS(ap[nComp], xValue[nComp][1]) elseif aD[nComp] == 10 ap[nComp] = MAX(ap[nComp], xValue[nComp]) elseif aD[nComp] == 11 ap[nComp] := xValue[nComp] endif #else if ! lad if nComp # 1 x := xValue[nComp] if IsNumber(x) ap[nComp] += x elseif IsArray(x) AMERGE(ap[nComp], x) endif endif elseif HB_ISNUMERIC(nP := aD[nComp]) .and. nP > 1 x := xValue[nComp] switch nP // aD[nComp] case 2 ap[nComp] += x exit case 3 if ! Empty(x) AMERGE(ap[nComp], x) endif exit case 4 if ! Empty(x) // AEval(x, {|a| AADDQ(ap[nComp], a)}) // AEval(x, {|a| if(IsArray(a), HB_AADDQ(ap[nComp], a), AADDQ(ap[nComp], a))}) AADDQX(ap[nComp], x) endif exit case 5 AddNtoA(ap[nComp], x [aI[nComp]], aI[nComp]) exit case 6 AddAr(ap[nComp], x) exit case 7 AADDQS(ap[nComp], x[1]) exit case 10 ap[nComp] = MAX(ap[nComp], x) exit case 11 ap[nComp] := x exit end endif #endif next endif Return nPos Function AddNtoA(a, n, nInd) // ------------------------------------------------------------- // Суммирует параметр n к элементу nInd массива a // При необходимости создает, изменяет размерность // и иницализирует массив a // Возвращает: массив a // ------------------------------------------------------------- if nInd > 0 if a == nil a = Array(nInd) AFill(a, 0) a[nInd] = n elseif Len(a) < nInd ASize(a, nInd) a[nInd] := n else if a[nInd] == nil a[nInd] := n else a[nInd] += n endif endif elseif a == nil a = {} endif Return a Function AddAr(a1, a2) // ------------------------------------------------------------- // Поэлементно прибавляет массив a2 к массиву a1 // При необходимости изменяет размерность и иницализирует массив a // ------------------------------------------------------------- Local i, nLen := len(a2) if len(a1) < nLen ASize(a1, nLen) endif for i = 1 to nLen if IsNumber(a2[ i ]) if a1[ i ] == nil a1[ i ] := a2[ i ] else a1[ i ] += a2[ i ] endif endif next Return nil Function ASUM(aArray) // ------------------------------------------------------------- // Суммирует массив числового или символьного типа // ------------------------------------------------------------- Local xValue if ! Empty(aArray) xValue = aArray[1] AEVAL(aArray, {|xE| xValue += xE}, 2) else xValue = 0 endif Return xValue Function AASUM(aArray, ax) // ------------------------------------------------------------- // Поэлементно суммирует массив числового или символьного типа // ------------------------------------------------------------- Local ser for ser = 1 to len(ax) if ax[ser] # nil aArray[ser] += ax[ser] endif next Return nil Function AADDA(a1, a2) // ------------------------------------------------------------- // Добавляет все элементы массива a2 к массиву a1 // Возвращает ссылку на массив a1. // ------------------------------------------------------------- if a1 == nil a1 := {} endif #ifndef __HARBOUR__ AEVAL(a2, {|a| AADD(a1, a)}) #else AMERGE(a1, a2) #endif Return a1 Function ADELM(a, n) // ------------------------------------------------------------- // Удаляет элемент n массива a и корректирует его размер // ------------------------------------------------------------- #ifndef __HARBOUR__ ADEL(a, n) ASize(a, len(a) - 1) Return a #else #ifdef __XHARBOUR__ Return ADEL(a, n, .t.) #else Return HB_ADEL(a, n, .t.) #endif #endif Function ASortA(a, n, n2) // ------------------------------------------------------------- // Сортирует двухмерный массив по индексу n // Если задан n2 - сортировка по двум индексам // ------------------------------------------------------------- Return ASort(a,,, if(n2 == nil,; {|x1, x2| x1[n] < x2[n]},; {|x1, x2| if(x1[n]=x2[n], x1[n2]<x2[n2], x1[n]<x2[n])} )) Function AInsM(a, n, x) // ------------------------------------------------------------- // Вставляет в массив a значение x в позицию n // ------------------------------------------------------------- #ifndef __HARBOUR__ AADD(a, nil) AINS(a, n) a[n] = x Return a #else #ifdef __XHARBOUR__ Return AINS(a, n, x, .t.) #else Return HB_AINS(a, n, x, .t.) #endif #endif Function AEvalF(aRr, block, bFilter) // ------------------------------------------------------------- // Выполняет блок кода block для каждого элемента массива aRr, // удовлетворяющего фильтру bFilter // ------------------------------------------------------------- Local ser, a #ifndef __HARBOUR__ for a :=1 to len(aRr) #else for each a in aRr #endif if Eval(bFilter, a) Eval(block, a) endif next Return aRr Function AFillA(a, x) // ------------------------------------------------------------- // Аналог aFill для подмассивов // ------------------------------------------------------------- Local ser for ser = 1 to len(a) if IsArray(a[ser]) AFillA(a[ser], x) elseif a[ser] == nil a[ser] := x endif next Return nil // Добавлено 24.6.99 - лажа в макросах Function ArrayGet(a, ni1, ni2, ni3) Local x if ni3 # nil x := a[ni1][ni2][ni3] elseif ni2 # nil x := a[ni1][ni2] else x := a[ni1] endif Return x Function ArrayPut(a, x, ni1, ni2, ni3) if ni3 # nil a[ni1][ni2][ni3] := x elseif ni2 # nil a[ni1][ni2] := x else a[ni1] := x endif Return nil Function ArrayInc(a, x, ni1, ni2, ni3) if ni3 # nil a[ni1][ni2][ni3] += x elseif ni2 # nil a[ni1][ni2] += x else a[ni1] += x endif Return nil #ifndef __HARBOUR__ Function AScanA(a, x, n, lEqu) // ------------------------------------------------------------- // Поиск в двухмерном массиве a значения x по индексу n // lEqu - точный поиск строки // ------------------------------------------------------------- Return AScan(a, if(lEqu==nil, {|ax| ax[n] = x}, {|ax| ax[n] == x})) Function AScanB(a, x, n, lEqu) // ------------------------------------------------------------- // Тоже самое, возвращает найденный массив // ------------------------------------------------------------- Local nPos := AScanA(a, x, n, lEqu), aRet if nPos # 0 aRet := a[nPos] endif Return aRet Function AScanM(a, af) // ------------------------------------------------------------- // Поиск в двухмерном массиве a по массиву af // Сравниваются непустые элементы массива af. // ------------------------------------------------------------- Local ax, ser, i, l := .f. Local as := {}, ay if ! Empty(a) for i := 1 to len(af) if i <= len(a[1]) .and. af[ i ] # nil AADD(as, {i, af[ i ]}) endif next endif //Return ASCAN(a, {|ax| doAScanM(ax, as)}) #ifndef __HARBOUR__ for ser := 1 to len(a) ax := a[ser] #else for each ax in a #endif l := .t. // for i = 1 to len(af) // if len(ax) >= i .and. af[ i ] # nil .and. ! (ax[ i ] == af[ i ]) // l := .f. // Exit // endif // next for each ay in as index i if ! (ax[ay[1]] == ay[2]) l := .f. exit endif next if l #ifdef __HARBOUR__ ser := hb_EnumIndex() #endif Exit endif next Return if(l, ser, 0) /* Static func doAScanM(ax, as) Local l := .t., ay for each ay in as index i if ! (ax[ay[1]] == ay[2]) l := .f. exit endif next Return l */ Function ASUMA(aArray, nPos) // ------------------------------------------------------------- // Суммирует элементы двумерного массива числового типа по 2-й размерности nPos // Возвращает: сумму // ------------------------------------------------------------- Local nSum := 0 AEval(aArray, {|a| nSum += a[nPos]}) Return nSum #endif[/pre]

Pasha: модуль _arrayc.c [pre] #include "hbapi.h" #include "hbapiitm.h" /* itmCompare(p1, p2) return: 0 if p1 == p2 -1 if p1 < p2 1 if p1 > p2 */ 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_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 ULONG hb_ascana(PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulIndex, BOOL bExact) { ULONG ulLoop, ulLen; PHB_ITEM pSubArray, pItem; BOOL bFound = FALSE; if( pArray && HB_IS_ARRAY( pArray ) && pValue && ulIndex ) { ulLen = hb_arrayLen( pArray ); for( ulLoop = 0; ulLoop < ulLen; ulLoop++ ) { pSubArray = hb_arrayGetItemPtr( pArray, ulLoop + 1 ) ; pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ; if( pItem && ( itmCompare( pItem, pValue, bExact ) == 0) ) { bFound = TRUE; break; } } } return ( bFound ? ulLoop + 1 : 0 ); } HB_FUNC( ASCANA ) { hb_retnl( hb_ascana(hb_param( 1, HB_IT_ARRAY ), hb_param( 2, HB_IT_ANY ), hb_parnl( 3 ), ( ISLOG(4) ? hb_parl(4) : FALSE ) ) ); } HB_FUNC( ASCANB ) { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); ULONG ulPos = hb_ascana( pArray, hb_param( 2, HB_IT_ANY ), hb_parnl( 3 ), ( ISLOG(4) ? hb_parl(4) : FALSE ) ); if( ulPos ) hb_itemReturn( hb_arrayGetItemPtr( pArray, ulPos ) ); else hb_ret(); } static ULONG hb_aaddq(PHB_ITEM pArray, PHB_ITEM pValue ) { ULONG ulPos = hb_ascana( pArray, hb_arrayGetItemPtr( pValue, 1 ), 1, FALSE ); PHB_ITEM pSubArray, pItem, pResult; ULONG ulIndex, ulLen; if( ulPos ) { pSubArray = hb_arrayGetItemPtr( pArray, ulPos ); ulLen = hb_arrayLen( pValue ); ulIndex = hb_arrayLen( pSubArray ); if( ulIndex < ulLen) ulLen = ulIndex; for( ulIndex = 2; ulIndex <= ulLen; ulIndex ++ ) { pItem = hb_arrayGetItemPtr( pValue, ulIndex ); if( HB_IS_NUMBER( pItem ) ) { pResult = hb_arrayGetItemPtr( pSubArray, ulIndex ); if( HB_IS_NUMERIC( pResult ) ) { if( HB_IS_NUMINT( pResult ) && HB_IS_NUMINT( pItem ) ) { HB_LONG lNumber1 = hb_itemGetNL( pResult ); HB_LONG lNumber2 = hb_itemGetNL( pItem ); HB_LONG lSum = lNumber1 + lNumber2; if( ! (lNumber2 >= 0 ? lSum >= lNumber1 : lSum < lNumber1 ) ) { hb_itemPutNDDec( pResult, ( double ) lNumber1 + ( double ) lNumber2, 0); } else { hb_itemPutNL( pResult, lSum ); } } else { double dNumber1; double dNumber2; int iDec1 = 0; int iDec2 = 0; dNumber1 = hb_itemGetNDDec( pResult, &iDec1 ); dNumber2 = hb_itemGetNDDec( pItem, &iDec2 ); hb_itemPutNDDec( pResult, dNumber1 + dNumber2, HB_MAX( iDec1, iDec2 ) ); } } } else if( HB_IS_ARRAY( pItem ) ) { pResult = hb_arrayGetItemPtr( pSubArray, ulIndex ); if( HB_IS_ARRAY( pResult ) ) { ULONG ulStart = hb_arrayLen( pResult ); ULONG ulAdd = hb_arrayLen( pItem ); ULONG ulInd; hb_arraySize( pResult, ulStart + ulAdd ); for( ulInd = 1; ulInd <= ulAdd; ulInd++ ) { hb_itemCopy( hb_arrayGetItemPtr( pResult, ulStart + ulInd ), hb_arrayGetItemPtr( pItem, ulInd ) ); } } } } } else { hb_arrayAdd( pArray, pValue ); ulPos = hb_arrayLen( pArray ); } return ulPos; } HB_FUNC( HB_AADDQ ) { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); PHB_ITEM pValue = hb_param( 2, HB_IT_ARRAY ); if( pArray && pValue ) hb_retnl( hb_aaddq( pArray, pValue ) ); else hb_retnl( 0 ); } // AEval(x, {|a| if(IsArray(a), HB_AADDQ(ap[nComp], a), AADDQ(ap[nComp], a))}) HB_FUNC( AADDQX ) { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); PHB_ITEM pValue = hb_param( 2, HB_IT_ARRAY ); if( pArray && pValue ) { ULONG ulIndex; ULONG ulLen = hb_arrayLen( pValue ); PHB_ITEM pItem; for( ulIndex = 1; ulIndex <= ulLen; ulIndex ++ ) { pItem = hb_arrayGetItemPtr( pValue, ulIndex ); if( HB_IS_ARRAY( pItem ) ) { hb_aaddq( pArray, pItem ); } else { if( ! hb_arrayScan( pArray, pItem, NULL, NULL, FALSE, FALSE ) ) hb_arrayAdd( pArray, pItem ); } } } hb_ret(); } HB_FUNC( ASCANM ) { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); PHB_ITEM pValue = hb_param( 2, HB_IT_ARRAY ); ULONG ulLen, ulCount; ULONG ulLoop, ulIndex; BOOL bFound = FALSE, bCompare; PHB_ITEM pSubArray, pItem, pItem2; if( pArray && pValue && (ulLen = hb_arrayLen( pArray )) ) { ulCount = hb_arrayLen( pValue ); pSubArray = hb_arrayGetItemPtr( pArray, 1 ); if( ulCount > hb_arrayLen( pSubArray ) ) ulCount = hb_arrayLen( pSubArray ); for( ulLoop = 0; ulLoop < ulLen; ulLoop++ ) { bCompare = TRUE; pSubArray = hb_arrayGetItemPtr( pArray, ulLoop + 1 ) ; for( ulIndex = 0; ulIndex < ulCount; ulIndex++ ) { pItem = hb_arrayGetItemPtr( pValue, ulIndex + 1 ) ; if( pItem && ! HB_IS_NIL( pItem ) ) { pItem2 = hb_arrayGetItemPtr( pSubArray, ulIndex+1 ); if( pItem2 && ( itmCompare(pItem, pItem2, TRUE ) != 0 ) ) { bCompare = FALSE; break; } } } if( bCompare ) { bFound = TRUE; break; } } } hb_retnl( bFound ? ulLoop + 1 : 0 ); } HB_FUNC( ASUMA ) { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ), pSubArray, pItem; ULONG ulPos = hb_parnl( 2 ), ulIndex, ulLen; double dSum = 0.0; HB_LONG lSum = 0, lNumber1, lNumber2; BOOL bLong = TRUE; if( pArray && ulPos ) { ulLen = hb_arrayLen( pArray ); for( ulIndex = 0; ulIndex < ulLen; ulIndex++ ) { pSubArray = hb_arrayGetItemPtr( pArray, ulIndex + 1 ) ; pItem = hb_arrayGetItemPtr( pSubArray, ulPos ); if( pItem ) { if( bLong && HB_IS_NUMINT( pItem ) ) { lNumber1 = lSum; lNumber2 = hb_itemGetNL( pItem ); lSum += lNumber2; if( ! (lNumber2 >= 0 ? lSum >= lNumber1 : lSum < lNumber1 ) ) { bLong = FALSE; dSum = ( double ) lNumber1 + ( double ) lNumber2; } } else { if( bLong ) { if( lSum ) dSum = (double) lSum; bLong = FALSE; } dSum += hb_itemGetND( pItem ); } } } } if( bLong ) hb_retnl( lSum ); else hb_retnd( dSum ); }[/pre]

Pasha: Немного модифицированная функция PSP будет выглядеть так: FUNCTION DimToNewDim( aDim ) LOCAL aNewDim := {} LOCAL i, n, x ASORTA(aDim, 1) // сортировка по 1-му элементу, исходник ASORTA в модуле _array.c FOR i := 1 TO Len( aDim ) IF Empty( aNewDim ) .or. x # aDim[i, 1] x := aDim[i, 1] AAdd( aNewDim, AClone(aDim[ i ]) ) // AClone обязательно ! иначе будет меняться исходный массив ELSE ATAIL(aNewDim)[2] += aDim[i, 2] END // IF NEXT RETURN aNewDim или тоже самое: ASORTA(aDim, 1) AEval(aDim, {|a| AADDQ(aNewDim, {a[1], a[2]},,, .t.)})

wad1: Я в свое время тоже работал с большими массивами, причем размер в 4096 преодолевал с помощью вложенных подмассивов (в Harbour слава богу это ограничение пропало). Так вот во времена "покорения Крыма" тормоза начинались, когда массив переставал помещаться в памяти и свопился на диск.

sergey5703: Pasha пишет: Это неверно. Вы сравниваете 2 разных алгоритма. Отсортируйте исходный массив, и затем обрабатывайте его в цикле без ASCAN линейно. Что то я не пойму - Вы предлагаете при каждом добавлении в новый массив его сортировать, каким позвольте полюбопытствовать методом - методом "пузырька"? Тогда Ваша программа будет выполняться не часы, а ДНИ! И вообще спор бесполезный - в современных супер компьютерных системах с виртуальной памятью и кэшированием дисковых операций - сказать НАВЕРНЯКА что и когда будет записано на диск, то ли dbf файл, то ли страница виртуальной памяти с массивом НЕВОЗМОЖНО. Просто ПОВЕРЬТЕ на слово - команды INDEX ON и TOTAL ON - это САМЫЙ МОЩНЫЙ ИНСТРУМЕНТ xBase систем (и самый эффективный). И если, как я предполагаю, это было учебное задание Андрея, то можно узнать у него - что ему поставили преподаватели и за какой вариант (вроде третейского суда :-)

Pasha: sergey5703 пишет: Что то я не пойму - Вы предлагаете при каждом добавлении в новый массив его сортировать, каким позвольте полюбопытствовать методом - методом "пузырька"? Тогда Ваша программа будет выполняться не часы, а ДНИ! Конечно нет. Сначала формируется исходный массив (AADD), затем он сортируется (ASORT, один вызов), и затем формируется выходной массив И вообще спор бесполезный - в современных супер компьютерных системах с виртуальной памятью и кэшированием дисковых операций - сказать НАВЕРНЯКА что и когда будет записано на диск, то ли dbf файл, то ли страница виртуальной памяти с массивом НЕВОЗМОЖНО. Просто ПОВЕРЬТЕ на слово - команды INDEX ON и TOTAL ON - это САМЫЙ МОЩНЫЙ ИНСТРУМЕНТ xBase систем (и самый эффективный). И если, как я предполагаю, это было учебное задание Андрея, то можно узнать у него - что ему поставили преподаватели и за какой вариант (вроде третейского суда :-) На слово не поверю :) То, что используется виртуальная память и кеширование файловых операций не означает, что хранение данных в памяти и в файле на диске равнозначны. К тому же, в нашем случае, еще будет задействована подсистема rdd. dbTotal (команда TOTAL) рудимент клиппера. Гляньте, как она реализована в харборе. Вы удивитесь :) через те же массивы. С тех пор, как она реализована (уже 10 лет как!) никому не пришло в голову ее переписать на С. Так что запись файла dbf - просто лишнее промежуточное действие. Даже есть использовать memarea, слой rdd будет выполнять операции медленне, чем обращение к элементам массива А использование индексации предполагает вызов dbSeek, а это поиск в индексном файле с его сложной страничной структурой И зачем это все, когда действия с массивами - это практически мгновенные операции со структурой item Любая операция с массивом даже не на порядок быстрее соответсвующего вызова rdd: AADD - dbAppend, Ascan - dbSeek Из своего опыта. Посмотрите мою функцию ASCANM: реализацию в prg и на С Как-то я обнаружил, что эта функция очень тормозит при поиске в большом массиве. Оптимизировать ее на уровне prg уже некуда, и я переписал ее на С, и скорость ее работы увеличилась примерно в 100 раз, задержка просто исчезла. То есть, для оптимизации огромный эффект дает отказ от пи-кода и использования vm, несмотря на то, что vm оптимизировалась и вылизывалась многие годы, и кодирование критичного алгоритма на С

sergey5703: Pasha пишет: Конечно нет. Сначала формируется исходный массив (AADD), затем он сортируется (ASORT, один вызов), и затем формируется выходной массив Если Вы предлагаете сразу же первой операцией сортировку исходного массива, то в принципе это ничем не отличается от индексирования и здесь можно до посинения приводить кучу аргументов как за так и против ЛЮБОГО решения. Если уж Си-код настолько эффективней пи-кода, тогда не проще ли вообще программировать на Си? Для систем с виртуальной памятью - это самое правильное - примитивнейшие алгоритмы и супер оптимизированный машинный Си-код. Но мы то в разделе CLIPPER!!! И отличия конкретной реализации в [x]Harbour RTL мне кажется здесь ни при чем. Pasha пишет: dbTotal (команда TOTAL) рудимент клиппера. Гляньте, как она реализована в харборе. Вы удивитесь :) через те же массивы. С тех пор, как она реализована (уже 10 лет как!) никому не пришло в голову ее переписать на С. Глянул! Она (функция dbTotal) реализована и в Clipper-e и в [x]Harbour-e ОДИНАКОВО и массивы в ней используются для имен полей (массив из 1-го элемента) и сумм этих полей (массив тоже из 1-го элемента в нашем примере). Я ПОДЧЕРКИВАЮ - мое решение (с TOTAL ON) будет ЭФФЕКТИВНЕЙ в Clipper 5.01 на CPU 80286 16 МГц с 640 Кб RAM !!!

Andrey: Слушайте, хватит спорить... Если кто-то хочет доказать свою правоту, то он берет и делает ТЕСТы того (массив) и другого (файл) примера ! Я не силен в доказательствах по научному, я просто практик. И я ответственно заявляю дисковые операции - ТОРМОЗА на всех процессорах от 8086 до сегодняшних. Я задачу еще делал в 2000 году на Клипере 5.3b, начисление абонентской платы по базе в 100 000 абонентов. Сделал самое простое в лоб - считывание прихода 1-БД, запись в файл DBF - врем.файл, расчет, запись расчета в 1-БД. Задача считалась по 12 часов !!! Это на 2-ом Pentium'е . Достало через год, переписал через массив - стал считать за 3 часа ! Сейчас на хХарборе за 1 час где-то, но по большому счету запись расчета в Базу - сильно тормозит расчеты. А пример не в качестве задания, а тут дурацкие СБЕРБАНКОВСКИЕ файлы подкинули, вот и делал конвертор на МиниГуи... А алгоритм он и в Африке - алгоритм... Спасибо большое за подсказку....

sergey5703: // Программа 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}} 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() 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)) AEVAL(aNewDim, {|x|QOUT(x[1], x[2])}) ? // Результат 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 Ну вот, а говорили дисковые операции медленные. Компьютер Во время выполнения теста параллельно выполнялся еще BitComet 0.89 (4 раздачи).

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]

Петр: У меня время получилось 8 сек. Но у меня к вам вопрос несколько иной. Вот зачем для Hb 2.0 скрипты писать? Неужели hbmk2 test9 -lhbmemio труднее набрать..

sergey5703: Ну у меня компьютер просто слабый, поэтому подольше. А пакетные файлы? Не знаю, привычка, однако ... :-)

Pasha: На comp.lang.xharbour обсуждается тоже самое: http://groups.google.com/group/comp.lang.xharbour/browse_thread/thread/6f48caacd85c3409# Там и druzus подключился, советует использовать хэш

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