On-line:гостей 1. Всего: 1 [подробнее..]
АвторСообщение



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


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

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



Спасибо: 0 
ПрофильЦитата Ответить
Ответов -43 ,стр: 1 2 3 All [только новые]


Администратор




Пост N:1294
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:23.01.10 09:50.Заголовок:У меня для этих целе..


У меня для этих целей есть функция 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})})

Для харбора я часть кода переписал на С
Если интересно - могу опубликовать весь свой модуль функций работы с массивами

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник


Пост N:261
Зарегистрирован:27.01.07
ссылка на сообщение  Отправлено:23.01.10 10:27.Заголовок:Некрасивая идея: :s..


Некрасивая идея:


 цитата:

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



Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N:1352
Зарегистрирован:17.05.05
ссылка на сообщение  Отправлено:23.01.10 13:14.Заголовок:PSP пишет: Некрасив..


PSP пишет:

 цитата:
Некрасивая идея


Вполне нормальная идея

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник


Пост N:262
Зарегистрирован:27.01.07
ссылка на сообщение  Отправлено:23.01.10 13:59.Заголовок:Dima пишет: Вполне ..


Dima пишет:

 цитата:
Вполне нормальная идея




Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N:1055
Зарегистрирован:12.09.06
ссылка на сообщение  Отправлено:23.01.10 20:29.Заголовок:PSP пишет: Некрасив..


PSP пишет:

 цитата:
Некрасивая идея:


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

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник


Пост N:265
Зарегистрирован:27.01.07
ссылка на сообщение  Отправлено:23.01.10 20:52.Заголовок:Пожалуйста. Рад, что..


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

Спасибо: 0 
ПрофильЦитата Ответить





Пост N:51
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:23.01.10 23:35.Заголовок:Вопрос конечно интер..


Вопрос конечно интересный, ключевые слова:
Верченко Андрей пишет:
 цитата:
желательно красивую !

.
В моем понимании красота в программировании, это - простота, целесообразность и надежность.
Исходя из этих критериев, самое простое, целесообразное и надежное - функцией 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


Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N:1056
Зарегистрирован:12.09.06
ссылка на сообщение  Отправлено:24.01.10 01:13.Заголовок:Pasha пишет: Если и..


Pasha пишет:

 цитата:
Если интересно - могу опубликовать весь свой модуль функций работы с массивами



Конечно ИНТЕРЕСНО ! Код в студию !!!

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N:1057
Зарегистрирован:12.09.06
ссылка на сообщение  Отправлено:24.01.10 01:16.Заголовок:sergey5703 пишет: И..


sergey5703 пишет:

 цитата:
Исходя из этих критериев, самое простое, целесообразное и надежное - функцией dbcreate создать dbf файл с двумя ....



Нарушается самый главный принцип - БЫСТРОДЕЙСТВИЕ !!!
Самые медленные функции это - дисковые функции, работа с файлами !
Но все равно спасибо !

Спасибо: 0 
ПрофильЦитата Ответить





Пост N:52
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:24.01.10 03:52.Заголовок:Нарушается самый главный принцип - БЫСТРОДЕЙСТВИЕ !!!


Уважаемый Андрей !!! Как раз приведенное мной решение - САМОЕ БЫСТРОДЕЙСТВУЩЕЕ. Вы не застали время компьютеров 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 в квадрате?


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1297
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:24.01.10 10:02.Заголовок:sergey5703 пишет: П..


sergey5703 пишет:

 цитата:
Почему предложенное решение - САМОЕ БЫСТРОДЕЙСТВУЮЩЕЕ? Потому что оно - ЛИНЕЙНО зависимо от числа элементов массива, а решение с использованием ASCAN - экспоненциально зависимо.



Это неверно. Вы сравниваете 2 разных алгоритма. Отсортируйте исходный массив, и затем обрабатывайте его в цикле без ASCAN линейно.
И насчет быстродействия тоже неверно. Какие бы медленные не были бы АТ286, дисковые операции на них так же были очень медленными,
так что неэффективное решение с ASCAN все равно отработает быстрее, чем запись на диск. ASCAN работает достаточно быстро
Я использую работу с большими многомерными массивами с тысячами элементов как раз с тех времен, даже не 286, а 8086, и все работает достаточно быстро. Ниже я даю как раз фунцкции, написанные еще а начале 90-х, когда появился 5.01. Я их конечно многократно дорабатывал, но основа осталась с времен 8086 и "покоренья Крыма"

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1298
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:24.01.10 10:11.Заголовок:модуль _array.prg ..


модуль _array.prg


#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



Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1299
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:24.01.10 10:13.Заголовок:модуль _arrayc.c #..


модуль _arrayc.c

 
#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 );
}



Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1300
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:24.01.10 10:23.Заголовок:Немного модифицирова..


Немного модифицированная функция 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.)})


Спасибо: 0 
ПрофильЦитата Ответить



Не зарегистрирован
Зарегистрирован:01.01.70
ссылка на сообщение  Отправлено:24.01.10 12:04.Заголовок:Я в свое время тоже ..


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

Спасибо: 0 
Цитата Ответить





Пост N:53
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:24.01.10 21:26.Заголовок:Pasha пишет: Это не..


Pasha пишет:

 цитата:
Это неверно. Вы сравниваете 2 разных алгоритма. Отсортируйте исходный массив, и затем обрабатывайте его в цикле без ASCAN линейно.


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


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1303
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:24.01.10 22:03.Заголовок:sergey5703 пишет: Ч..


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 оптимизировалась и вылизывалась многие годы, и кодирование критичного алгоритма на С


Спасибо: 0 
ПрофильЦитата Ответить





Пост N:54
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:24.01.10 22:25.Заголовок:Pasha пишет: Конечн..


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 !!!


Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N:1058
Зарегистрирован:12.09.06
ссылка на сообщение  Отправлено:25.01.10 00:18.Заголовок:Слушайте, хватит спо..


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

А пример не в качестве задания, а тут дурацкие СБЕРБАНКОВСКИЕ файлы подкинули, вот и делал конвертор на МиниГуи...
А алгоритм он и в Африке - алгоритм...
Спасибо большое за подсказку....




Спасибо: 0 
ПрофильЦитата Ответить





Пост N:55
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:25.01.10 00:32.Заголовок:ГОСПОДА - ПРОТЕСТИРУЙТЕ ВАШИ АЛГОРИТМЫ !!!


// Программа

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 раздачи).


Спасибо: 0 
ПрофильЦитата Ответить





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


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

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

// Результат

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

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


Спасибо: 1 
ПрофильЦитата Ответить
постоянный участник




Пост N:138
Зарегистрирован:06.02.07
ссылка на сообщение  Отправлено:25.01.10 10:58.Заголовок:Ребята, обращайте вн..


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

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

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

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

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

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1304
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:25.01.10 11:11.Заголовок:Как раз вчера я прод..


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

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1305
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:25.01.10 17:46.Заголовок:sergey5703 пишет: В..


sergey5703 пишет:

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



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


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



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

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




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


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

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

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

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

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


Спасибо: 0 
ПрофильЦитата Ответить





Пост N:58
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:25.01.10 22:59.Заголовок:Программы по двум ал..


Программы по двум алгоритмам были доработаны в плане генерации исходных данных для проверки быстродействия. Теперь можно получать на выходе "результирующий" массив размерности 4, 528 или 4096 элементов. Вот таблица итоговых результатов:
Зависимость времени выполнения от размерности "результирующего" массива. 
------------------------------------------------------------------------
: : Размерность "результирующего" массива :
: Алгоритм :-----------------------------------------:
: : 4 : 528 : 4096 :
------------------------------------------------------------------------
: INDEX ... TOTAL ... : 0.49 сек. : 0.61 сек. : 1.10 сек. :
------------------------------------------------------------------------
: ASCAN ... ASORT ... : 0.06 сек. : 5.00 сек. : 60.20 сек. :
------------------------------------------------------------------------
Вывод: "дисковый" алгоритм почти не коррелирует по времени выполнения с размерностью получающегося массива, а время выполнения Ascan и Asort линейно зависит от размерности массива. Рекомендации: осторожнее применять Ascan и Asort в [x]Harbour где размерность массивов не лимитирована как в Clipper.
Доработанные программы:
Скрытый текст
Скрытый текст


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1307
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:25.01.10 23:28.Заголовок:sergey5703 Ваше упор..


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


Спасибо: 0 
ПрофильЦитата Ответить





Пост N:59
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:26.01.10 00:12.Заголовок:Нельзя объять необъя..


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


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1309
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:27.01.10 11:08.Заголовок:Вот еще 4-й алгоритм..


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

Function T4(aDim) 
LOCAL aNewDim := {}, i, j, ad
FOR i := 1 TO LEN(aDim)
ad := aDim[ i ]
j := a_mpd(aNewDim, ad[1])
if j > 0
aNewDim[j, 2] += ad[2]
elseif j == 0 .or. -j > Len(aNewDim)
AADD(aNewDim, AClone(ad))
else
AADD(aNewDim, nil)
AINS(aNewDim, -j)
aNewDim[-j] = AClone(ad)
endif
NEXT
Return aNewDim

func icmp(x1, x2)
Local n
if x1 == x2
n := 0
elseif x1 < x2
n := -1
else
n := 1
endif
Return n

function a_mpd(a, x)
Local nLen := Len(a), nLoop, iRes, lFnd := .f., lEnd := .f.
Local n1
Local n2

if nLen == 0
nLoop := 0
lEnd := .t.
else

iRes := icmp(a[1, 1], x)
if iRes == 0
nLoop := 1
lFnd := lEnd := .t.
elseif iRes > 0
nLoop := 1
lEnd := .t.
endif

if ! lEnd
if nLen > 1
iRes := icmp(a[nLen, 1], x)
endif
if iRes == 0
nLoop := nLen
lFnd := lEnd := .t.
elseif iRes < 0
nLoop := nLen + 1
lEnd := .t.
endif

endif

endif


if ! lEnd
n1 := 1
n2 := nLen
while .t.
if n1 == n2 - 1
nLoop := n2
exit
endif
nLoop = Int((n2 + n1) / 2)

iRes := icmp(a[nLoop, 1], x)

if iRes == 0
lFnd = .t.
exit
elseif iRes > 0
n2 := nLoop
else
n1 := nLoop
endif

enddo
endif

return if(lFnd, nLoop, -nLoop)



Спасибо: 0 
ПрофильЦитата Ответить





Пост N:60
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:28.01.10 05:55.Заголовок:Я протестировал Ваш ..


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

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

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



Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1314
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:28.01.10 17:38.Заголовок:1000000 элементов, з..


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

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

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


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




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


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

Function T4(aDim) 
LOCAL aNewDim := {}, i, j, ad
Local nSec := Seconds()

FOR each ad in aDim
j := ASCANAS(aNewDim, ad[1], 1)
if j > 0
aNewDim[j, 2] += ad[2]
elseif j == 0 .or. -j > Len(aNewDim)
AADD(aNewDim, {ad[1], ad[2]})
else
AINS(aNewDim, -j, {ad[1], ad[2]}, .t.)
endif
NEXT
Return Seconds() - nSec

#pragma BEGINDUMP

#include "hbapi.h"
#include "hbapiitm.h"

int itmCompare( PHB_ITEM pValue, PHB_ITEM pItem, BOOL bExact )
{
int iRet = 1;

if( HB_IS_STRING( pValue ) && HB_IS_STRING( pItem ) )
{
iRet = hb_itemStrCmp( pValue, pItem, bExact );
}
else if( HB_IS_DATE( pValue ) && HB_IS_DATE( pItem ) )
{
#ifdef __XHARBOUR__
if( pItem->item.asDate.value == pValue->item.asDate.value &&
pItem->item.asDate.time == pValue->item.asDate.time )
#else
if( hb_itemGetTD( pItem ) == hb_itemGetTD( pValue ) )
#endif
{
iRet = 0;
}
#ifdef __XHARBOUR__
else if( pValue->item.asDate.value < pItem->item.asDate.value )
#else
else if( hb_itemGetTD( pValue ) < hb_itemGetTD( pItem ) )
#endif
{
iRet = -1;
}
}
else if( HB_IS_NUMINT( pValue ) && HB_IS_NUMINT( pItem ) )
{
HB_LONG l1 = hb_itemGetNInt( pValue );
HB_LONG l2 = hb_itemGetNInt( pItem );
if( l1 == l2 )
{
iRet = 0;
}
else if( l1 < l2 )
{
iRet = -1;
}
}
else if( HB_IS_NUMBER( pValue ) && HB_IS_NUMBER( pItem ) )
{
double d1 = hb_itemGetND( pValue );
double d2 = hb_itemGetND( pItem );
if( d1 == d2 )
{
iRet = 0;
}
else if( d1 < d2 )
{
iRet = -1;
}
}
else if( HB_IS_LOGICAL( pValue ) && HB_IS_LOGICAL( pItem ) )
{
BOOL b1 = hb_itemGetL( pValue );
BOOL b2 = hb_itemGetL( pItem );
if( b1 == b2 )
{
iRet = 0;
}
else if(! b1 )
{
iRet = -1;
}
}

return iRet;
}

static LONG hb_ascanas(PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulIndex, BOOL bExact)
{
ULONG ulLoop = 0;
BOOL bFound = FALSE;

if( pArray && HB_IS_ARRAY( pArray ) && pValue && ulIndex )
{
ULONG ulLen = hb_arrayLen( pArray );
BOOL bEnd = FALSE;
PHB_ITEM pSubArray, pItem;
int iResult;

if( ulLen == 0)
{
ulLoop = 0;
bEnd = TRUE;
}
else
{

pSubArray = hb_arrayGetItemPtr( pArray, 1 ) ;
pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ;
if( pItem )
{
iResult = itmCompare( pItem, pValue, bExact );
}
else
{
bEnd = TRUE;
}

if( ! bEnd )
{
if( iResult == 0 )
{
ulLoop = 1;
bFound = bEnd = TRUE;
}
else if( iResult > 0 )
{
ulLoop = 1;
bEnd = TRUE;
}
}

if( ! bEnd )
{
if( ulLen > 1 )
{
pSubArray = hb_arrayGetItemPtr( pArray, ulLen ) ;
pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ;
if( pItem )
{
iResult = itmCompare( pItem, pValue, bExact );
}
else
{
bEnd = TRUE;
}
}
if( ! bEnd )
{
if( iResult == 0 )
{
ulLoop = ulLen;
bFound = bEnd = TRUE;
}
else if( iResult < 0 )
{
ulLoop = ulLen + 1;
bEnd = TRUE;
}
}
}

}

if( ! bEnd )
{
ULONG ul1 = 1, ul2 = ulLen;

while( TRUE )
{
if( ul1 == ul2 - 1 )
{
ulLoop = ul2;
break;
}
ulLoop = (ul2 + ul1) / 2;

pSubArray = hb_arrayGetItemPtr( pArray, ulLoop ) ;
pItem = hb_arrayGetItemPtr( pSubArray, ulIndex ) ;

if( pItem )
{
iResult = itmCompare( pItem, pValue, bExact );
}
else
{
ulLoop = 0;
break;
}

if( iResult == 0 )
{
bFound = TRUE;
break;
}
else if( iResult > 0 )
{
ul2 = ulLoop;
}
else
{
ul1 = ulLoop;
}
}
}

}

return ( bFound ? ulLoop : - (LONG) ulLoop );
}

HB_FUNC( ASCANAS )
{
hb_retnl( hb_ascanas(hb_param( 1, HB_IT_ARRAY ),
hb_param( 2, HB_IT_ANY ),
hb_parnl( 3 ),
( ISLOG(4) ? hb_parl(4) : FALSE ) ) );
}

#pragma ENDDUMP


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

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

Static func TestA(n1, n2) 
? T1(MakeA(n1, n2))
? T4(MakeA(n1, n2))
Return nil

Static func MakeA(n1, n2)
Local i, aDim := {}

for i := 1 to n1
AADD(aDim, {n2 - i%n2, n1-i})
next

Return aDim


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

Static func T1(aDim) 
LOCAL aNewDim := {}, i, j
Local nSec := Seconds()
Field Key, Count

DBCREATE("test", {{"key", "N", 10, 0}, {"count", "N", 10, 0}})
USE test EXCLUSIVE
INDEX ON key TO test
AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]})
TOTAL ON key FIELDS count TO test2
USE
ERASE ("test.dbf")
ERASE ("test" + INDEXEXT())
USE test2
DBEVAL({||AADD(aNewDim, {key, count})})
USE
ERASE ("test2.dbf")

Return Seconds() - nSec


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

P1/P2 T1 T4

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

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

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

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


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1316
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:28.01.10 21:10.Заголовок:И до кучи дам уже фу..


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


#include "hbapiitm.h" 

int itmCompare( PHB_ITEM pValue, PHB_ITEM pItem, BOOL bExact );

static BOOL hb_itemIsLessA( PHB_ITEM pItem1, PHB_ITEM pItem2, ULONG ul1, ULONG ul2 )
{
int iResult = 0;

if( HB_IS_ARRAY( pItem1 ) && HB_IS_ARRAY( pItem2 ) )
{
ULONG ulLen1 = hb_arrayLen( pItem1 );
ULONG ulLen2 = hb_arrayLen( pItem2 );

if( ul1 <= ulLen1 && ul1 <= ulLen2 )
{

iResult = itmCompare( hb_arrayGetItemPtr( pItem1, ul1 ), hb_arrayGetItemPtr( pItem2, ul1 ), FALSE );

if( ! iResult && ul2 && ul2 <= ulLen1 && ul2 <= ulLen2 )
{
iResult = itmCompare( hb_arrayGetItemPtr( pItem1, ul2 ), hb_arrayGetItemPtr( pItem2, ul2 ), FALSE );
}
}

}

return iResult < 0;

}

/* partition array pItems[lb..ub] */

static LONG hb_arraySortQuickPartitionA( PHB_ITEM pItems, ULONG ul1, ULONG ul2, LONG lb, LONG ub )
{
LONG i, j, p;

/* select pivot and exchange with 1st element */
p = lb + ( ( ub - lb ) >> 1 );
if( p != lb )
{
hb_itemSwap( pItems + lb, pItems + p );
}

/* sort lb+1..ub based on pivot */
i = lb + 1;
j = ub;

while( TRUE )
{
while( i < j && hb_itemIsLessA( pItems + i, pItems + lb, ul1, ul2 ) )
{
i++;
}

while( j >= i && hb_itemIsLessA( pItems + lb, pItems + j, ul1, ul2 ) )
{
j--;
}

if( i >= j )
{
break;
}

/* Swap the items */
hb_itemSwap( pItems + i, pItems + j );
j--;
i++;
}

/* pivot belongs in pItems[j] */
if( j > lb )
{
hb_itemSwap( pItems + lb, pItems + j );
}

return j;
}

/* sort array pItems[lb..ub] */

static void hb_arraySortQuickA( PHB_ITEM pItems, ULONG ul1, ULONG ul2, LONG lb, LONG ub )
{
while( lb < ub )
{
/* partition into two segments */
LONG m = hb_arraySortQuickPartitionA( pItems, ul1, ul2, lb, ub );

/* sort the smallest partition to minimize stack requirements */
if( m - lb <= ub - m )
{
hb_arraySortQuickA( pItems, ul1, ul2, lb, m - 1 );
lb = m + 1;
}
else
{
hb_arraySortQuickA( pItems, ul1, ul2, m + 1, ub );
ub = m - 1;
}
}
}

BOOL hb_arraySortA( PHB_ITEM pArray, ULONG ul1, ULONG ul2, ULONG * pulStart, ULONG * pulCount )
{

if( HB_IS_ARRAY( pArray ) )
{
PHB_BASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ulLen = pBaseArray->ulLen;
ULONG ulStart;
ULONG ulCount;
ULONG ulEnd;

if( pulStart && ( *pulStart >= 1 ) )
{
ulStart = *pulStart;
}
else
{
ulStart = 1;
}

if( ulStart <= ulLen )
{
if( pulCount && *pulCount >= 1 && ( *pulCount <= ulLen - ulStart ) )
{
ulCount = *pulCount;
}
else
{
ulCount = ulLen - ulStart + 1;
}

if( ulStart + ulCount > ulLen ) /* check range */
{
ulCount = ulLen - ulStart + 1;
}

ulEnd = ulCount + ulStart - 2;

/* Optimize when only one or no element is to be sorted */
if( ulCount > 1 )
{
hb_arraySortQuickA( pBaseArray->pItems, ul1, ul2, ulStart - 1, ulEnd );
}
}

return TRUE;
}
else
{
return FALSE;
}
}

HB_FUNC( ASORTA2 )
{
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
ULONG ul1 = hb_parnl( 2 );
ULONG ul2 = hb_parnl( 3 );

if( pArray && ! hb_arrayIsObject( pArray ) && ul1 )
{
// ULONG ulStart = hb_parnl( 2 );
// ULONG ulCount = hb_parnl( 3 );

hb_arraySortA( pArray, ul1, ul2, NULL, NULL );

}
hb_ret();
}



Спасибо: 0 
ПрофильЦитата Ответить





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


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

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1317
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:28.01.10 22:53.Заголовок:sergey5703 пишет: н..


sergey5703 пишет:

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



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


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



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


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



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

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

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


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



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


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



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


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



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

Спасибо: 0 
ПрофильЦитата Ответить





Пост N:62
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:29.01.10 21:06.Заголовок:Оптимизированная про..


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

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



Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1320
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:29.01.10 22:00.Заголовок:sergey5703 пишет: е..


sergey5703 пишет:

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



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


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



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

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

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


Спасибо: 1 
ПрофильЦитата Ответить





Пост N:63
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:30.01.10 01:40.Заголовок:Pasha пишет: Смотри..


Pasha пишет:

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


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


Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1321
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:30.01.10 09:19.Заголовок:sergey5703 пишет: А..


sergey5703 пишет:

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



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

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

Спасибо: 1 
ПрофильЦитата Ответить





Пост N:65
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:02.02.10 21:38.Заголовок:Обнаружил пример раб..


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

Файл Hb20make.BAT
@echo off 

rem compilation %1.PRG Harbour 2.0.0
rem http://www.harbour-project.org

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

Файл test9.prg
// Программа - оптимизированная (без TOTAL ON ...) - В ПАМЯТИ !!! 

#define LEN_NEW_DIM_1000000
//#define LEN_NEW_DIM_100000
//#define LEN_NEW_DIM_10000
//#define LEN_NEW_DIM_4096
//#define LEN_NEW_DIM_528
//#define LEN_NEW_DIM_4
#ifdef __HARBOUR__
REQUEST HB_CODEPAGE_RU866
REQUEST HB_LANG_RU866
//REQUEST DBFNTX
REQUEST HB_MEMIO
#endif

LOCAL aDim8, aNewDim := {}, aDim := {}, i, j, nTimeStart, nTimeEnd
LOCAL nCurKey, nCurCount
SET DATE FORMAT TO "DD/MM/YYYY"
#ifdef __HARBOUR__
HB_SETCODEPAGE("RU866")
HB_LANGSELECT("RU866")
//RDDSETDEFAULT("DBFNTX")
#endif
aDim8 := {{2000, 1}, {2009, 1}, {2009, 1}, {2008, 1}, {2000, 1}, {2008, 1}, {2003, 1}, {2009, 1}}
#ifdef LEN_NEW_DIM_1000000
FOR i := 1000000 TO 1 STEP -1
AADD(aDim, {i, 1})
NEXT
#endif
#ifdef LEN_NEW_DIM_100000
FOR i := 100000 TO 1 STEP -1
AADD(aDim, {i, 1})
NEXT
#endif
#ifdef LEN_NEW_DIM_10000
FOR i := 10000 TO 1 STEP -1
AADD(aDim, {i, 1})
NEXT
#endif
#ifdef LEN_NEW_DIM_4096
FOR i := 4096 TO 1 STEP -1
AADD(aDim, {i, 1})
NEXT
#endif
#ifdef LEN_NEW_DIM_528
FOR i := 1 TO 512
FOR j := 1 TO 8
AADD(aDim, {aDim8[j, 1] + (i - 1) + (j - 1), aDim8[j, 2]})
NEXT
NEXT
#endif
#ifdef LEN_NEW_DIM_4
FOR i := 1 TO 512
FOR j := 1 TO 8
AADD(aDim, aDim8[j])
NEXT
NEXT
#endif
? DATE(), TIME(), OS()
? DBSETDRIVER(), VERSION()
? "LEN(aDim) = " + LTRIM(STR(LEN(aDim)))
nTimeStart := SECONDS()
//--------------------------------------------------------------------
DBCREATE("mem:test", {{"KEY", "N", 10, 0},;
{"COUNT", "N", 10, 0}},, .T., "memarea")
//USE test
INDEX ON KEY TAG key
AEVAL(aDim, {|x|DBAPPEND(), FIELD->key := x[1], FIELD->count := x[2]})
GO TOP
DO WHILE !EOF()
nCurKey := FIELD->key; nCurCount := 0
DO WHILE !EOF() .AND. (nCurKey == FIELD->key)
nCurCount += FIELD->count
SKIP
ENDDO
AADD(aNewDim, {nCurKey, nCurCount})
ENDDO
//--------------------------------------------------------------------
nTimeEnd := SECONDS()
DBCLOSEAREA()
DBDROP("mem:test") // Free memory resource
? "SECONDS() = " + LTRIM(STR(nTimeEnd - nTimeStart))
? "LEN(aNewDim) = " + LTRIM(STR(LEN(aNewDim)))
#ifdef LEN_NEW_DIM_4
AEVAL(aNewDim, {|x|QOUT(x[1], x[2])})
//#else
//SET ALTERNATE TO test9.out
//SET ALTERNATE ON
//SET CONSOLE OFF
//AEVAL(aNewDim, {|x|QOUT(x[1], x[2])})
//?
//SET CONSOLE ON
//SET ALTERNATE OFF
//SET ALTERNATE TO
#endif
?

// Результаты

//02/02/2010 21:17:39 Windows XP 5.1.2600 Service Pack 2
//DBFNTX Harbour 2.0.0 (Rev. 13372)
//LEN(aDim) = 1000000
//SECONDS() = 16.76
//LEN(aNewDim) = 1000000



Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник


Пост N:818
Зарегистрирован:09.10.06
ссылка на сообщение  Отправлено:02.02.10 22:10.Заголовок:У меня время получил..


У меня время получилось 8 сек.

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


Спасибо: 1 
ПрофильЦитата Ответить





Пост N:66
Зарегистрирован:01.01.10
ссылка на сообщение  Отправлено:03.02.10 21:05.Заголовок:Ну у меня компьютер ..


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

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N:1516
Зарегистрирован:23.05.05
ссылка на сообщение  Отправлено:17.06.10 09:47.Заголовок:На comp.lang.xharbou..

Спасибо: 0 
ПрофильЦитата Ответить
Ответов -43 ,стр: 1 2 3 All [только новые]
Ответ:
1 2 3 4 5 6 7 8 9
большой шрифт малый шрифт надстрочный подстрочный заголовок большой заголовок видео с youtube.com картинка из интернета картинка с компьютера ссылка файл с компьютера русская клавиатура транслитератор  цитата  кавычки моноширинный шрифт моноширинный шрифт горизонтальная линия отступ точка LI бегущая строка оффтопик свернутый текст

показывать это сообщение только модераторам
не делать ссылки активными
Имя, пароль:      зарегистрироваться    
Тему читают:
-участник сейчас на форуме
-участник вне форума
Все даты в формате GMT  3 час. Хитов сегодня: 207
Права: смайлыда,картинкида,шрифтыда,голосованиянет
аватарыда,автозамена ссылоквкл,премодерацияоткл,правканет