Форум » 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 раздачи).



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