Multiple nichtlineare Regression ======================= Multiple means, that in the subesquent Program up to 9 Einflußgrössen X1...X9 on a Ergebnisvariable Y wirken can. Weiters becomes therefore in the jeweiligen size a parable designed Grades (apiece Einflußgröße differently) to the Gauss-Kriterium the kleinsten quadratischen Abweichungssumme adjusted. the works though only, if The Einflußgrößen X voneinander independent are, what z.B. into Sozialwissenschaften only very heavy To to judge is. in the engineering find itself often good Argumente, Why one influence z.B. solid into Result eingeht: volume goes naturally with the 3. Potenz the Längenabmessungen etc.
Funktionsweise: After input the jeweiligen Ergebniswertes go The pertinent Einflußgrößen association (thereby should sufficient data under unterschiedlichsten terms exist, about from Laborversuchen). the Program errechnet The (up to 9-)dimensionale Vandermonde-Matrix and fit iterativ-zyklich any parables such a long time on, To The Gesamtvarianz not further correct go can.
Result is then the vector the Koeffizienten the Einflußgrößen-Kombinationen.
not in detail examined - private demonstration without each Gewähr!
Example for a Vandermonde-Matrix for 2 Einflußgrößen x1 and x2, The here up to quadratic into Result come in can: 1 ______ X2______ x2^2 x1 ____ x1*x2___ x1*x2^2 X1^2__ x1^2*x2_ x1^2*x2^2
Anzumerken is yet, that with the Program objectively only parables adjusted go can. with Wachstumsvorgängen etc. are but often Exponentialfunktionen, Logarithmusfunktionen, Sinusschwingungen u.v.a.m. in the game. For this there then too others modes and Herangehensweisen!
Window Title "Mehrdimensionale nichtlineare Regression"
'Q: https://jean-pierre.moreau.pagesperso-orange.fr/Basic/regiter_bas.txt
'XProfan-11.2a-demonstration (D) transponiert 2017-02 by P.woodpecker, Vienna/Austria
Window Style 24:window 0,0-%maxx,%maxy:font 2:CLS:set("decimals",17)
'*******************************************************
'* Program to demonstrate multidimensional operation *
'* of the multi-nonlinear regression subroutine with *
'* iterative error reduction *
'* --------------------------------------------------- *
'* Ref.: BASIC Scientific Subroutines Vol. II, By *
'* F.R. Ruckdeschel, byte/McGRAW-HILL, 1981 *
'* --------------------------------------------------- *
'* SAMPLE RUN: *
'* MULTI-DIMENSIONAL AND MULTI-NONLINEAR REGRESSION *
'* *
'* How many data points ? 10 *
'* *
'* How many dimensions ? 2 *
'* *
'* What is the fit for size 1 ? 2 *
'* What is the fit for size 2 ? 1 *
'* *
'* Input the data as prompted: *
'* *
'* Y( 1) = ? 7 *
'* X( 1, 1) = ? 1 *
'* X( 1, 2) = ? 6 *
'* *
'* Y( 2) = ? 7 *
'* X( 2, 1) = ? 6 *
'* X( 2, 2) = ? 1 *
'* *
'* Y( 3) = ? 6 *
'* X( 3, 1) = ? 3 *
'* X( 3, 2) = ? 3 *
'* *
'* Y( 4) = ? 8 *
'* X( 4, 1) = ? 2 *
'* X( 4, 2) = ? 6 *
'* *
'* Y( 5) = ? 9 *
'* X( 5, 1) = ? 1 *
'* X( 5, 2) = ? 8 *
'* *
'* Y( 6) = ? 9 *
'* X( 6, 1) = ? 7 *
'* X( 6, 2) = ? 2 *
'* *
'* Y( 7) = ? 6 *
'* X( 7, 1) = ? 3 *
'* X( 7, 2) = ? 3 *
'* *
'* Y( 8) = ? 7 *
'* X( 8, 1) = ? 3 *
'* X( 8, 2) = ? 4 *
'* *
'* Y( 9) = ? 7 *
'* X( 9, 1) = ? 4 *
'* X( 9, 2) = ? 3 *
'* *
'* Y( 10) = ? 2 *
'* X( 10, 1) = ? 0 *
'* X( 10, 2) = ? 2 *
'* *
'* The calculated coefficients are: *
'* *
'* 1 0 *
'* 2 .999999 *
'* 3 0 *
'* 4 .999999 *
'* 5 0 *
'* 6 0 *
'* *
'* standard deviation: 0 *
'* *
'* Number of iterations: 4 *
'* *
'*******************************************************
'DEFINT I-n
'DEFDBL A-H, O-Z
declare i&,j&,k&,L&,M&,n&,n1&,n2&,n3&,n4&
declare i1&,i2&,i3&,i4&,i5&,i6&,i7&,i8&,i9&
declare m&[9],m1&,m2&,m3&,m4&,L1&,sw&
declare b!,c!,d!,d1!,y!
Print "\n question: Programmed example calculate [levelly or 0 = No]? Beispl.Nr.= ";
input sw&
case sw&<>0:sw&=1' 0:Own input. 1:Obiges example calculate
print
PRINT " MULTIDIMENSIONAL NONLINEAR REGRESSION"
PRINT
print " How many data points ? ";
case sw&=1:m&=10
case sw&=0:INPUT m&
PRINT
print " How many dimensions ? ";
case sw&=1:L&=2
case sw&=0:Input L&
PRINT
if sw&=0
whileloop l&:i&=&Loop'=FOR i& = 1 TO l&
PRINT " What is the grade of the fit for size Nbr."; i&;": x^";
INPUT m&[i&]
endwhile'=NEXT i
elseif sw&=1
m&[1]=2
m&[2]=1
else
Print "\n\n example not yet association!":sound 200,10:waitinput:end
endif
n& = 1
Whileloop l&:i&=&Loop'=FOR i = 1 TO l
n&=n&*(m&[i&]+1)
endwhile'=NEXT i
case m&<n&:m&=n&'=IF m < n THEN m = n
Declare x![m&,l&],y![m&],z![m&,n&],d![n&],A![m&,m&],B![m&,2*m&],C![m&,m&],d1![n&],y1![m&]
'=DIM x(m, l), y(m), z(m, n), d(n), A(m, m), b(m, 2 * m), c(m, m), d1(n), y1(m)
PRINT
if sw&=0
PRINT " Input the data as prompted:"
PRINT
Whileloop m&:i&=&Loop'=FOR i = 1 TO m
PRINT " Y("; i&; ") = "; : INPUT y![i&]
whileloop l&:j&=&Loop'=FOR j = 1 TO l
PRINT " X("; i&; ","; j&; ") = "; : INPUT x![i&, j&]
endwhile'=NEXT j
PRINT
endwhile'=NEXT i
else
y![1]=7:x![1,1]=1:x![1,2]=6
y![2]=7:x![2,1]=6:x![2,2]=1
y![3]=6:x![3,1]=3:x![3,2]=3
y![4]=8:x![4,1]=2:x![4,2]=6
y![5]=9:x![5,1]=1:x![5,2]=8
y![6]=9:x![6,1]=7:x![6,2]=2
y![7]=6:x![7,1]=3:x![7,2]=3
y![8]=7:x![8,1]=3:x![8,2]=4
y![9]=7:x![9,1]=4:x![9,2]=3
y![10]=2:x![10,1]=0:x![10,2]=2
endif
'Call iteration supervisor
GOSUB "S2000"
PRINT
PRINT " The calculated coefficients are:"
PRINT
Whileloop n&:i&=&Loop'= FOR i = 1 TO n
PRINT " "; i&; " "; INT(1000000 * d![i&]) / 1000000
endwhile'=NEXT i
PRINT
PRINT " standard deviation: "; INT(1000000 * d!) / 1000000
PRINT
PRINT " Number of iterations: "; l1&
PRINT
print "============================================================="
sound 2000,200
waitinput
beep:cls:Print "\n\n\n\n\n BYE!"
waitinput 1000
END
'*************************************************************
'* Coefficient matrix generation subroutine *
'* for multiple non-linear regression. *
'* --------------------------------------------------------- *
'* means calculates the standard deviation d, even though *
'* there is some redundant computing. *
'* The maximum number of dimensions is 9. *
'* The input data set consists of m data sets of the shape: *
'* Y(i),X(i,1),X(i,2) ... X(i,l) *
'* The number of dimensions is l. *
'* The order of the fit to each size is M(j). *
'* The result is on (m1+1)(m2+1)...(ml+1)+1 column by m row *
'* matrix, Z. Diese matrix is arranged as follows *
'* (Ex.:l=2,M(1)=2,M(2)=2): *
'* 1 X1 X1*X1 X2 X2*X1 X2*X1*X1 X2*X2 X2*X2*X1 X2*X2*X1*X1 *
'* Diese matrix should be dimensioned in the calling program *
'* as should means the X(i,j) matrix of data values. *
'*************************************************************
'Calculate the utterly number of dimensions
s1000:
n& = 1
Whileloop l&:i&=&Loop'= FOR i = 1 TO l
n& = n& * (m&[i&]+1)
endwhile'= NEXT
d! = 0
Whileloop m&:i&=&Loop'= FOR i = 1 TO m
'Branch according to size l (return if l > 9)
case l&>0:GOTO "G10"
l& = 0: RETURN
G10:
case l&<=9 : GOTO "G15"
l& = 0: RETURN
G15:
j& = 0
case l& = 1:GOSUB "S40"
case l& = 2:GOSUB "S50"
case l& = 3:GOSUB "S60"
case l& = 4:GOSUB "S70"
case l& = 5:GOSUB "S80"
case l& = 6:GOSUB "S90"
case l& = 7:GOSUB "S100"
case l& = 8:GOSUB "S110"
case l& = 9:GOSUB "S120"
y! = 0
Whileloop n&:k&=&Loop'= FOR k& = 1 TO n
y! = y! + d![k&] * z![i&, k&]
endwhile'= NEXT k
d! = d! + (y![i&] - y!) * (y![i&] - y!)
endwhile'= NEXT i
'Calculate standard deviation (if m > n)
G30:
case (m&-n&)>0:GOTO "G35"
d! = 0: RETURN
G35:
d!=d!/(m&-n&)
d!=SQRT(d!)'Quickbasic: sqr
RETURN
'Subroutines used by subroutine 1000
s40:
b! = 1
s41:
c! = b!
Whileloop 0,m&[1]:i1&=&Loop'= FOR i1& = 0 TO m&[1]
j&=j&+1: z![i&,j&] = b!: b! = b! * x![i&,1]
endwhile'=NEXT i1
b! = c!
RETURN
s50:
b!= 1
s51:
c!= b!
Whileloop 0,m&[2]:i2&=&Loop'= FOR i2 = 0 TO m(2)
GOSUB "S41"
b!=b!*x![i&,2]
endwhile'= NEXT i2
b!= c!
RETURN
s60:
b!= 1
s61:
c!= b!
Whileloop 0,m&[3]:i3&=&Loop'= FOR i3 = 0 TO m(3)
GOSUB "S51"
b!= b!* x![i&,3]
endwhile'= NEXT i3
b! = c!
RETURN
s70:
b!= 1
s71:
c!= b!
Whileloop 0,m&[4]:i4&=&Loop'= FOR i4 = 0 TO m(4)
GOSUB "S61"
b!= b!*x![i&,4]
endwhile'=NEXT i4
b!= c!
RETURN
s80:
b!= 1
s81:
c! = b!
whileloop 0,m&[5]:i5&=&Loop'=FOR i5 = 0 TO m(5)
GOSUB "S71"
b!= b!*x![i&,5]
endwhile'=NEXT i5
b!= c!
RETURN
s90:
b!= 1
s91:
c!= b!
Whileloop 0,m&[6]:i6&=&Loop'= FOR i6 = 0 TO m(6)
GOSUB "S81"
b! = b!* x![i&,6]
endwhile'=NEXT i6
b!= c!
RETURN
s100:
b!= 1
s101:
c!= b!
whileloop 0,m&[7]'= FOR i7 = 0 TO m(7)
GOSUB "S91"
b!= b!* x![i&, 7]
endwhile'= NEXT i7
b!=c!
RETURN
s110:
b!= 1
s111:
c!= b!
whileloop 0,m&[8]:i8&=&Loop'= FOR i8 = 0 TO m(8)
GOSUB "S101"
b! = b! * x![i&,8]
endhwile'= NEXT i8
b!= c!
RETURN
s120:
b!= 1
s121:
c!= b!
whileloop 0,m&[9]'= FOR i9 = 0 TO m(9)
GOSUB "S111"
b! = b! * x![i&,9]
endwhile'= NEXT i9
b!= c!
RETURN
'**********************************************************
'* Least squares fitting subroutine, general purpose *
'* subroutine for multidimensional, nonlinear regression *
'* ------------------------------------------------------ *
'* The equation fitted has the shape: *
'* Y = D(1)X1 + D(2)X2 + ... + D(n)Xn *
'* The coefficients are returned by the program in D(i). *
'* The X(i) can be simple powers of x, or functions. *
'* note that the X(i) are assumed to be independent. *
'* The measured responses are Y(i), there are m of them. *
'* Y is a m row column vector, Z(i,j) is a m by n matrix. *
'* m must be >= n+2. The subroutine inputs are m, n, Y(i) *
'* and Z(i,j) previously calculated. The subroutine calls *
'* several other matrix routines during the calculation. *
'**********************************************************
s1200:
m4& = m&
n4& = n&
whileloop m&:i&=&Loop'= FOR i = 1 TO m
Whileloop n&:j&=&Loop'= FOR j = 1 TO n
A![i&,j&] = z![i&, j&]
endwhile'= NEXT j
endwhile'= NEXT i
GOSUB "S5100"'b=Transpose(a)
n1&= m&: n2& = n&: GOSUB "S5400"'move A to C
n1&= n&: n2& = m&: GOSUB "S5200"'move B to A
n1&= m&: n2& = n&: GOSUB "S5300"'move C to B
m1&= n&: n1& = m&: n2& = n&: GOSUB "S5000"'multiply A and B
n1&= n&: GOSUB "S5500"'move C to A
GOSUB "S6000"'b=Inverse(a)
m& = m4&'restore m
GOSUB "S5200"'move B to A
Whileloop m&:i&=&Loop'= FOR i = 1 TO m
Whileloop n&:j&=&Loop'= FOR j = 1 TO n
b![j&,i&] = z![i&,j&]
endwhile'=NEXT j
endwhile'= NEXT i
m2& = n&: n2& = m&: GOSUB "S5000"'multiply A and B
n1& = n&: n2& = m&: GOSUB "S5500"'move C to A
whileloop m&:i&=&Loop'=FOR i = 1 TO m
b![i&,1] = y![i&]
endwhile'=NEXT
m1& = n&: n2& = 1: n1& = m&: GOSUB "S5000"'multiply A and B
'Product C is n by 1 - Regression coefficients are in C(I,1)
whileloop n&:i&=&Loop'= FOR i = 1 TO n
d![i&] = c![i&,1]
endwhile'= NEXT
RETURN
s5000:
'Matrix multiplication
whileloop m1&:i&=&Loop'= FOR i = 1 TO m1
whileloop n2&:j&=&Loop'= FOR j = 1 TO n2
c![i&,j&] = 0
whileloop n1&:k&=&Loop'= FOR k = 1 TO n1
c![i&,j&] = c![i&,j&] + A![i&,k&] * B![k&,j&]
endwhile'= NEXT k
endwhile'= NEXT j
endwhile'= NEXT i
RETURN
s5100:
'Matrix transpose
whileloop n&:i&=&Loop'= FOR i = 1 TO n
whileloop m&:j&=&Loop'= FOR j = 1 TO m
b![i&,j&] = A![j&,i&]
endwhile'= NEXT j
endwhile'= NEXT i
RETURN
s5200:
'Matrix save (B in A)
case (n1&*n2&)=0:RETURN
Whileloop n1&:i1&=&Loop'= FOR i1 = 1 TO n1
whileloop n2&:i2&=&Loop'= FOR i2 = 1 TO n2
A![i1&,i2&] = b![i1&,i2&]
endwhile'= NEXT i2
endwhile'= NEXT i1
RETURN
s5300:
'Matrix save (C in B)
case (n1& * n2&)=0:RETURN
Whileloop n1&:i1&=&Loop'= FOR i1 = 1 TO n1
whileloop n2&:i2&=&Loop'= FOR i2 = 1 TO n2
b![i1&, i2&] = c![i1&, i2&]
endwhile'= NEXT i2
endwhile'= NEXT i1
RETURN
s5400:
'Matrix save (A in C)
case (n1& * n2&)=0:RETURN
whileloop n1&:i1&=&Loop'= FOR i1 = 1 TO n1
whileloop n2&:i2&=&Loop'= FOR i2 = 1 TO n2
c![i1&,i2&] = A![i1&,i2&]
endwhile'NEXT i2
endwhile'NEXT i1
RETURN
s5500:
'Matrix save (C in A)
case (n1&*n2&)=0:RETURN
whileloop n1&:i1&=&Loop'= FOR i1 = 1 TO n1
whileloop n2&:i2&=&Loop'= FOR i2 = 1 TO n2
A![i1&,i2&] = c![i1&,i2&]
endwhile'=NEXT i2
endwhile'=NEXT i1
RETURN
s6000:
'Matrix inversion
Whileloop n&:i&=&Loop'= FOR i = 1 TO n
whileloop n&:j&=&Loop'= FOR j = 1 TO n
b![i&, j& + n&] = 0
b![i&, j&] = A![i&, j&]
endwhile'= NEXT j
b![i&, i& + n&] = 1
endwhile'= NEXT i
whileloop n&:k&=&Loop'= FOR k = 1 TO n
case k& = n&:GOTO "G6010"
m& = k&
whileloop k&+1,n&:i&=&Loop'= FOR i = k + 1 TO n
case ABS(b![i&, k&]) > ABS(b![m&, k&]):m& = i&
endwhile'= NEXT i
case m& = k&:GOTO "G6010"
whileloop k&,2*n&:j&=&Loop'= FOR j = k TO 2 * n
b! = b![k&, j&]
b![k&, j&] = b![m&, j&]
b![m&, j&] = b!
endwhile'= NEXT j
G6010:
whileloop k&+1,2*n&:j&=&Loop'= FOR j = k + 1 TO 2 * n
b![k&, j&] = b![k&, j&] / b![k&, k&]
endwhile'= NEXT j
case k& = 1:GOTO "G6020"
whileloop k&-1:i&=&Loop'= FOR i = 1 TO k - 1
whileloop k&+1,2*n&:j&=&Loop'= FOR j = k + 1 TO 2 * n
b![i&,j&] = b![i&,j&] - b![i&,k&] * b![k&,j&]
endwhile'= NEXT j
endwhile'= NEXT i
Case k& = n&:GOTO "G6030"
G6020:
whileloop k&+1,n&:i&=&Loop'= FOR i = k + 1 TO n
whileloop k&+1,2*n&:j&=&Loop'= FOR j = k + 1 TO 2 * n
b![i&,j&] = b![i&,j&] - b![i&,k&] * b![k&,j&]
endwhile'= NEXT j
endwhile'=NEXT i
endwhile'= NEXT k
G6030:
Whileloop n&:i&=&Loop'= FOR i = 1 TO n
whileloop n&:j&=&Loop'= FOR j = 1 TO n
b![i&,j&] = b![i&,j&+n&]
endwhile'= NEXT j
endwhile'= NEXT i
RETURN
'********************************************************************
'* Multi-dimensional polynomial regression iteration subroutine *
'* ---------------------------------------------------------------- *
'* Diese routine supervises the calling of several other subroutines *
'* in order to iteratively fit least squares polynomials in more *
'* than one size. *
'* The routine repeatedly calculates improved coefficients until *
'* the standard deviation is no longer reduced. The inputs to the *
'* subroutine are the number of dimensions l&, the degree of fit *
'* for each size m(i), and the input data, x(i) and y(i). *
'* The coefficients are returned in d(i), with the standard devia- *
'* tion in d. means returned is the number of iterations tried, l1&. *
'* y1(i), d1(i) and d1 are used respectively to save the original *
'* values of y(i) and the current values of d(i) and d. *
'********************************************************************
s2000:
l1& = 0
'Save the y![i&]
whileloop m&:i&=&Loop'= FOR i = 1 TO m
y1![i&] = y![i&]
endwhile'= NEXT
'Zero d1(i)
whileloop n&:i&=&Loop'= FOR i = 1 TO n
d1![i&] = 0
endwhile'= NEXT
'Set the initial standard deviation high
d1! = 10000000
'Call coefficients subroutine
G2050:
GOSUB "S1000"
'Call regression subroutine
GOSUB "S1200"
'Get standard deviation
GOSUB "S1000"
'If standard deviation is decreasing, continue
case d1! > d!:GOTO "G2100"
'Terminate iteration
whileloop n&:i&=&Loop'= FOR i = 1 TO n
d![i&] = d1![i&]
endwhile'= NEXT
' Restore y![i&]
Whileloop m&:i&=&Loop'=FOR i = 1 TO m
y![i&] = y1![i&]
endwhile'= NEXT
'Get the final standard deviation
GOSUB "S1000"
RETURN
'Save the standard deviation
G2100:
d1! = d!: l1& = l1& + 1
'Augment coefficient matrix
whileloop n&:i&=&Loop'= FOR i = 1 TO n
d![i&] = d1![i&] + d![i&]
d1![i&] = d![i&]
endwhile'=NEXT
'Restore y![i&]
whileloop m&:i&=&Loop'=FOR i = 1 TO m
y![i&] = y1![i&]
endwhile'= NEXT
'Reduce y![i&] according to the d(i)
GOSUB "S2150"
'We now have a set of error values
GOTO "G2050"
'End subroutine 2000
'Subroutine 2150
s2150:
whileloop m&:i&=&Loop'= FOR i = 1 TO m
j& = 0
Case l& = 1:GOSUB "S2160"
Case l& = 2:GOSUB "S2170"
Case l& = 3:GOSUB "S2180"
Case l& = 4:GOSUB "S2190"
Case l& = 5:GOSUB "S2200"
Case l& = 6:GOSUB "S2210"
Case l& = 8:GOSUB "S2230"
Case l& = 9:GOSUB "S2240"
'aray generated for row i
y! = 0
whileloop n&:k&=&Loop'= FOR k = 1 TO n
y! = y! + d![k&] * z![i&,k&]
endwhile'= NEXT k
y![i&] = y![i&] - y!
endwhile'= NEXT i
RETURN
'End subroutine s2150
s2160:
b!=1
s2161:
c!=b!
whileloop 0,m&[1]:i1&=&Loop'FOR i1 = 0 TO m(1)
j&= j& + 1
z![i&,j&] = b!: b! = b! * x![i&,1]
endwhile'NEXT i1
b! = c!
RETURN
s2170:
b!= 1
s2171:
c!= b!
whileloop 0,m&[2]:i2&=&Loop'= FOR i2 = 0 TO m(2)
GOSUB "S2161"
b!= b!* x![i&,2]
endwhile'NEXT i2
b!=c!
RETURN
s2180:
b! = 1
s2181:
c! = b!
whileloop 0,m&[3]:i3&=&Loop'= FOR i3 = 0 TO m(3)
GOSUB "S2171"
b = b * x(i, 3)
endwhile'= NEXT i3
b!= c!
RETURN
s2190:
b!= 1
s2191:
c!= b!
whileloop 0,m&[4]:i4&=&Loop'= FOR i4 = 0 TO m(4)
GOSUB "S2181"
b!= b!* x![i&,4]
endwhile'NEXT i4
b! = c!
RETURN
s2200:
b! = 1
s2201:
c!= b!
whileloop 0,m&[5]:i5&=&Loop'= FOR i5 = 0 TO m(5)
GOSUB "S2191"
b! = b! * x![i&,5]
endwhile'NEXT i5
b! = c!
RETURN
s2210:
b! = 1
s2211:
c! = b!
whileloop 0,m&[6]:i6&=&Loop'= FOR i6 = 0 TO m(6)
GOSUB "S2201"
b! = b! * x![i&,6]
endwhile'NEXT i6
b! = c!
RETURN
s2220:
b! = 1
s2221:
c! = b!
whileloop 0,m&[7]:i7&=&Loop'= FOR i7 = 0 TO m(7)
GOSUB "S2211"
b!= b!* x![i&,7]
endwhile'= NEXT i7
b! = c!
RETURN
s2230:
b! = 1
s2231:
c! = b!
whileloop 0,m&[8]:i8&=&Loop'= FOR i8 = 0 TO m(7)
GOSUB "S2221"
b! = b! * x![i,8]' was 7 ! Error?
endwhile'NEXT i8
b! = c!
RETURN
s2240:
b! = 1
whileloop 0,m&[9]:i9&=&Loop'= FOR i9 = 0 TO m(9)
GOSUB "S2231"
b! = b! * x!(i&,9)
endwhile'NEXT i9
RETURN
'End Pgm regiter.prf
|