'-- **************************************************************************' 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