'-- **************************************************************************'
function ARRAverage (Dat!() as single, MinEl as integer, MaxEl as integer) as single
' calculate average value from function Dat1!()
defint p
defsng ARMid!=0
FOR p = MinEl TO MaxEl-1:
ARMid! = ARMid! + Dat!(p):
NEXT p
average! = ARMid! / (MaxEl-MinEl+1)
result=average!
END function
'-- **************************************************************************'
sub ARRAverageSubtract (Dat!() as single)
' calculate and subtract average value from function Dat1!()
defint p, Lmin1, Lmax1
Lmin1 = LBOUND(Dat!):Lmax1 = UBOUND(Dat!)
print "Lmax1=" ,Lmax1
print "Lmin1=" ,Lmin1
defsng ARMid!=0
defsng average!=0
ARMid!=0
FOR p = Lmin1 TO Lmax1:
ARMid! = ARMid! + Dat!(p):
'print "ARMid=" ,ARMid!
NEXT p
average! = ARMid! / (Lmax1-LMin1+1)
print "average=" ,average!
ARMid!=0
FOR p = LMin1 TO Lmax1: Dat!(p) = Dat!(p) - average!: NEXT p
END sub
'-- **************************************************************************'
FUNCTION ARRMax (Dat!() as single, MinEl as integer, MaxEl as integer) as single
'find max element of array
defint p
defsng ARMax!=Dat!(MinEl)
FOR p = MinEl TO MaxEl:
IF Dat!(p) > ARMax! THEN ARMax! = Dat!(p):
NEXT p
result = ARMax!
END FUNCTION
'-- **************************************************************************'
FUNCTION ARRMin (Dat!() as single, MinEl as integer, MaxEl as integer) as single
'find min element of array
defint p
defsng ARMin!=Dat!(MinEl)
FOR p = MinEl TO MaxEl:
IF Dat!(p) < ARMin! THEN ARMin! = Dat!(p):
NEXT p
result = ARMin!
END FUNCTION
'-- **************************************************************************'
FUNCTIONI FindMax (...) AS DOUBLE
DIM Largest AS DOUBLE
DIM I AS BYTE
Largest = ParamVal(1)
FOR I = 1 TO ParamValCount
IF ParamVal(I) > Largest THEN
Largest = ParamVal(I)
END IF
NEXT
FindMax = Largest ' or Result = Largest
END FUNCTIONI
'-- **************************************************************************'
sub ArrExtr (Dat!() as single, byref DatMin!, byref DatMax!) '' as single
defint p
defint MaxEl,MinEl
MinEl=lbound(Dat!)
MaxEl=ubound(Dat!)
defsng ARMax!=Dat!(MinEl)
defsng ARMin!=Dat!(MinEl)
FOR p = MinEl TO MaxEl:
IF Dat!(p) > ARMax! THEN ARMax! = Dat!(p):
IF Dat!(p) < ARMin! THEN ARMin! = Dat!(p):
NEXT p
DatMax!=ARMax!
'print "DatMax=" ,DatMax!
DatMin!=ARMin!
'print "DatMin=" ,DatMin!
END SUB
'**********************************************************************
sub ArrAbsExtr (Dat22!() as single, byref a_AbsDatMax!)
defint p
defint MaxEl,MinEl
MinEl=lbound(Dat22!)
'print "sub MinEl=" ,MinEl
MaxEl=ubound(Dat22!)
'print "sub MaxEl=" ,MaxEl
'defsng ARMax!=abs(Dat!(MinEl))
'defsng ARMin!=abs(Dat!(MinEl))
a_AbsDatMax!=0
a_AbsDatMax!=abs(Dat22!(MinEl))'ARMax!
'print "sub1 _AbsDatMax=" ,a_AbsDatMax!
FOR p = MinEl TO MaxEl-1:
IF abs(Dat22!(p)) > a_AbsDatMax! THEN a_AbsDatMax! = abs(Dat22!(p)) :'print "abs(Dat22(", p, "))=" ,abs(Dat22!(p))
NEXT p
'print "sub2 _AbsDatMax!=" ,a_AbsDatMax!
END SUB
'-- **********************************************************************
Sub ArrRaznost (Dat1!() as single , Dat2!() as single, Raznost!() as single) '' as single'' MinEl??, MaxEl??)
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
'print "ArrRaznost Lmax1=" ,Lmax1
'print "ArrRaznost Lmin1=" ,Lmin1
Lmin2 = LBOUND(Dat2!) : Lmax2 = UBOUND(Dat2!)
'print "ArrRaznost Lmax2=" ,Lmax2
'print "ArrRaznost Lmin2=" ,Lmin2
if Lmin2 <> Lmin1 or Lmax1 <> Lmax2 then showMessage ( "sub ArrRaznost. Arrays size mismatch" ): exit sub
REDIM Raznost!(Lmin1 to Lmax1)
FOR i = Lmin1 TO Lmax1:
Raznost!(i) = Dat1!(i) - Dat2!(i):
'print "Raznost!(",i, ") =" ,Raznost!(i)
NEXT i
END SUB
'-- **********************************************************************
Sub ArrRaznostR (Dat1!() as single , Dat2!() as single) '' as single'' MinEl??, MaxEl??)
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
'print "Lmax1=" ,Lmax1
'print "Lmin1=" ,Lmin1
Lmin2 = LBOUND(Dat2!) : Lmax2 = UBOUND(Dat2!)
'print "Lmax2=" ,Lmax2
'print "Lmin2=" ,Lmin2
if Lmin2 <> Lmin1 or Lmax1 <> Lmax2 then showMessage ( "sub ArrRaznostR. Arrays size mismatch." ): exit sub
FOR i = Lmin1 TO Lmax1:
Dat1!(i) = Dat1!(i) - Dat2!(i):
'print "Raznost!(",i, ") =" ,Raznost!(i)
NEXT i
END SUB
'**********************************************************************
Sub ArrSum (Dat1!() as single , Dat2!() as single, SumA!() as single)
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
Lmin2 = LBOUND(Dat2!) : Lmax2 = UBOUND(Dat2!)
if Lmin2 <> Lmin1 or Lmax1 <> Lmax2 then showMessage ( "Sub ArrSum. Arrays size mismatch" ): exit sub
REDIM SumA!(Lmin1 to Lmax1)
FOR i = Lmin1 TO Lmax1: SumA!(i) = Dat1!(i) + Dat2!(i): NEXT i
END SUB
'**********************************************************************
'**********************************************************************
Sub ArrSumR (Dat1!() as single , Dat2!() as single)
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
Lmin2 = LBOUND(Dat2!) : Lmax2 = UBOUND(Dat2!)
if Lmin2 <> Lmin1 or Lmax1 <> Lmax2 then showMessage ( "Sub ArrSumR. Arrays size mismatch" ): exit sub
FOR i = Lmin1 TO Lmax1: Dat1!(i) = Dat1!(i) + Dat2!(i): NEXT i
END SUB
'**********************************************************************
'-- **********************************************************************
SUB kTArray (Dat1!() as single, kt! as single, Dat2!() as single)
'multiply array to const and save rusult in new array
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
REDIM Dat2!(Lmin1 to Lmax1)
FOR i = Lmin1 to Lmax1: Dat2!(i) = Dat1!(i) * kt!: NEXT i
END SUB
'-- **********************************************************************
SUB kTArrayR (Dat1!() as single, kt! as single)
'multiply array to const
Lmin1 = LBOUND(Dat1!):Lmax1 = UBOUND(Dat1!)
FOR i = Lmin1 to Lmax1: Dat1!(i) = Dat1!(i) * kt!: NEXT i
END SUB
'-- **********************************************************************
SUB Nakopl (F!() as single, Nakop!() as single, period as Word)
'-----------------------------
'Calculate average on moving window (interval) of function
''F() - function array
'Nakop!() - moving average
'period - number of moving window points - (max 65535) must be odd number!
'-----------------------------
Lmin1 = LBOUND(F!): ' for example =0
print "Nakopl Lmin1=" ,Lmin1
Lmax1 = UBOUND(F!) ' for example =56
print "Nakopl Lmax1=" ,Lmax1
REDIM Nakop!(0 to period-1) '!!! from 0 !!!'
defsng Summ!
defword ibeg,iend, NumPnt
'0 0 0 1 2 3 4 5 5 5
'012345678901234567890123456789012345678901234567890123456
'||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -numbers of function points F!()
'||||||| ||||||| - moving window period points
' ^ibeg=3 ^iend=53
'000+++++++++++++++++++++++++++++++++++++++++++++++++++000 - averaged function Nakop!()
'|||^|||
'calculate average on 7 points Nakop!(3)= ( f(0)+f(1)+...f(6) )/7 =f(0)/7+f(1)/7+ ...f(6)/7
' |||^|||
' |||^|||
' |||^|||
'then first point f(0)/7 deleted, next f(7)/7 point added. Nakop!(4)=Nakop!(3)- f(0)/7 + f(7)/7
NumPnt=Lmax1-Lmin1+1 '57 elements in array (0 to 56)
NumInterval=NumPnt-1 '56 intevals
ibeg = (period-1) / 2 'starting point of moving window on F!()
iend = NumInterval - ibeg 'end point point of moving window on F!()
Summ! = 0:
'calculate average in starting point
FOR j = Lmin1 TO Lmin1+(period-1): Summ! = Summ! + F!(j): NEXT j 'cumulative value'
Nakop!(ibeg) = Summ! / period: 'average in starting point
Summ! = 0:
''calculate average in end point
FOR j = Lmin1+NumPnt - period TO Lmin1+NumPnt-1: Summ! = Summ! + F!(j): NEXT j
Nakop!(iend) = Summ! / period: 'вычисление среднего
FOR i = Lmin1+ibeg + 1 TO Lmin1+iend - 1
Nakop!(i) = Nakop!(i-1) + ( F!(i+Lmin1+ibeg) - F!(Lmin1+i-ibeg-1) ) / period
' ^ 4 3 4 3
NEXT i
END SUB
'-- **********************************************************************
sub ARRAddConst (Dat!() as single, const! as single)
defint p, Lmin1, Lmax1
Lmin1 = LBOUND(Dat!):Lmax1 = UBOUND(Dat!)
FOR p = Lmin1 TO Lmax1:
Dat!(p) = const! + Dat!(p):
NEXT p
END SUB
'-- **********************************************************************
SUB ArrReSample (Dat1() AS SINGLE, Dat2() AS SINGLE, npt)
'------------------
'resample data series Dat1() to Dat2!() with new points number npt, using linear interpolation
Lmin1 = LBOUND(Dat1): Lmax1 = UBOUND(Dat1)
print "ArrReSample Lmax1=" ,Lmax1
print "ArrReSample Lmin1=" ,Lmin1
Lmin2 = LBOUND(Dat2): Lmax2 = UBOUND(Dat2)
ipt = Lmax1 - Lmin1+1 '--- 11-0+1=12
kti = npt / ipt '--- 36/12=3
print "ArrReSample kti=" ,kti
j1 = 0 'current new point
j1old = 0 'previous new points
Dat2(Lmin2) = Dat1(Lmin1) '--- в начальных точках значения функций совпадают
FOR i = 1 TO ipt-1 '--- перебираем по оставшимся 11 точкам с 1 ... 11
deltaD1 = (Dat1(i) - Dat1(i - 1)) / kti '--- increment of a function in the new current interval for linear interpolation
ostFunc=Dat1(i-1)-deltaD1*drob-Dat2(j1old)
jz = i * kti '--- =3
j=FIX(jz) '--- absolute new point number'
drob=jz-j '--- fraction
j1 = j - j1old '--- new points number in current interval
FOR k = 1 TO j1
Dat2(j1old + k) = deltaD1 * k +Dat2(j1old) +ostFunc
' print "ArrReSample Dat2(",j1old + k,") =" ,ArrReSample Dat2(j1old + k)
NEXT k
j1old = j1 + j1old
NEXT i
END SUB
'--****************************************************************************************
SUB OgibF (Dat1() AS SINGLE, OgibUp() AS SINGLE, OgibDn() AS SINGLE)
'build envelope - up and down
Lmin1 = LBOUND(Dat1): Lmax1 = UBOUND(Dat1)
print "Lmax1=" ,Lmax1: print "Lmin1=" ,Lmin1
OgibUp(Lmin1)=Dat1(Lmin1)
OgibDn(Lmin1)=Dat1(Lmin1)
ku=Lmin1
kd=Lmin1 '0'
' search max and min
FOR i = Lmin1+1 TO Lmax1 - 1
IF Dat1(i) > Dat1(i - 1) AND Dat1(i) >= Dat1(i + 1) THEN
OgibUp(i)=Dat1(i)
'- intrerpolation'
kti=( OgibUp(i)-OgibUp(ku) )/(i-ku)
for ik=ku+1 to i-1
OgibUp(ik)=kti*(ik-ku)+OgibUp(ku)
next ik
ku=i
ELSEif Dat1(i) < Dat1(i - 1) AND Dat1(i) <= Dat1(i + 1) then
OgibDn(i)=Dat1(i)
'- intrerpolation'
kti=( OgibDn(i)-OgibDn(kd) )/(i-kd)
for ik=kd+1 to i-1
OgibDn(ik)=kti*(ik-kd)+OgibDn(kd)
next ik
kd=i
END IF
NEXT i
END SUB