p.specht
 | the take action of Nelder & Mead is a relatively simple, therefore robuste Search to Minima or. Maxima on of/ one two- or mehrdimensionalen Error-, cost- or Gewinnfunktion (in the Contrast To others take action comes it without partial Ableitungen from!).
How any such take action exists here The menace, in mere local Optimalpunkten hängenzubleiben. therefore ought to one always several Duchläufe with modified initially-Eckpunkten the "wandernden Dreiecks" (2D) or. wandernden Tetraeders (3D) or. Simplexes (>3D) run through.
The Algorithmus self stammt from the years 1965 and was from HP-BASIC to XProfan 11 transkribiert. therefore yet The old "Spagetti-Programmierung" with many "GOTO". try verliefen by me without large Error. here my Umsetzung to XProfan 11 - but How always without each Gewähr:
Window Title "Nelder-Mead Downhillsimplex to optimization on n-dimensional-nichtlinearen Funktionen"
' (Tr) 2012-07 Translated from HP-Basic to XProfan 11.2a by P. woodpecker, Wien
' Umsetzung without jegliche Gewähr!
REM Rechtsvermerke the Originalvorlage:
REM copyright 1987
REM John H. Mathews
REM Dept. of Mathematics
REM California State University, Fullerton
REM Nelder-Mead Method for n-Dimensions
Window 0,0 - %maxx,%maxy-44
CLS:Font 2
Declare N&,K&,J&,FUN$,L$,R$,A$,ANS$
Declare Epsilon!,x!,y!,z!,u!,v!,w!,F!,s!,rule!,YR!,YE!,YC!
Declare LO&,HO&,HI&,LI&,Max&,Min&,Count&
Goto "L100"
Proc s10' FUNCTION
X! = P![1] : Y! = P![2] : Z! = P![3]
u! = P![4] : V! = P![5] : W!=P![6]
'====================================
F! = X!*X! - 4*X! + Y!*Y! - Y! - X!*Y!
'====================================
'further Testfunktionen:
' Rosenbrock-„Bananenfunktion“
'f(x,y)=(1-x)^2+100*(y-x^2)^2
'mins with 1,1 with f(x,y)=0
' azure-function
'f(x,y)=(x^2+y-11)^2+(x+y^2-7)^2
'max with x=-0.270845, y=-0.923039 with f(x,y)=181.617
'4*mins: f(3.0,2.0)=0.0 f(-2.8051118,3.131312)=0.0
'f(-3.779310,-3.283186)=0.0 f(3.584428, -1.848126)=0.0
'====================================
ENDPROC
' Proc PRINT
Proc s20
N&=2
FUN$ ="X*X - 4*X + Y*Y - Y - X*Y"
C$[1] = "[X' : C$[2] = ",Y" : C$[3] = ",Z"
C$[4] = ",U" : C$[5] = ",V" : C$[6] = ",W,"
L$ =" F" : R$ ="] = "
Print L$;C$[1];
WhileLoop 2,N&: K&=&Loop
Print C$[K&];
EndWhile
Print R$;FUN$
Return
ENDPROC
'{ Hauptteil PROGRAM NELDER MEAD
L100:
Epsilon! = +1*10^-5
Declare C$[6],C![6],E![6],M![6],P![6],R![6],V![6,6],Y![6],Z![6]
L120:
REM SUBROUTINE INPUTS
s1000
REM SUBROUTINE NELDER MEAD
Gosub "S200"
REM SUBROUTINE OUTPUT
s2000
Print "\n WANT TO TRY NEW STARTING VERTICES ? ";
Input ANS$
Case (ANS$ = "Y") Or (ANS$ = "y") : Goto "L120"
Goto "L9999"
'}
s200:
REM SUBROUTINE NELDER MEAD
MIN&=10
MAX&=200
COUNT&=0
REM order the vertices.
LO&=0 : HI& =0
WhileLoop N& : J&=&Loop
case Y![J&] < Y![LO&] : LO&=J&
case Y![J&] > Y![HI&] : HI&=J&
EndWhile
LI&=HI& : HO&=LO&
WhileLoop 0,n&:J&=&Loop
case (J& <> LO&) AND (Y![J&] < Y![LI&]) : LI&=J&
case (J& <> HI&) AND (Y![J&] > Y![HO&]): HO&=J&
EndWhile
' =======================================================================
While (Y![HI&] > (Y![LO&] + EPSILON!)) And ( (COUNT&<MAX&) Or (COUNT&<MIN&) )
REM The main loop
REM shape new vertices M and R
WhileLoop N&:K&=&Loop
s!=0
WhileLoop 0,N& : J& = &Loop
s!=s!+V![J&,K&]
EndWhile
M![K&]=(s!-V![HI&,K&]) / N&
EndWhile
WhileLoop N&: K&=&Loop
R![K&]=2*M![K&]-V![HI&,K&]
P![K&]=R![K&]
EndWhile
REM SUBROUTINE FUNCTION
s10
YR!=F!
REM Improve the simplex.
If YR! < Y![HO&] : Goto "L375" : Else : Goto "L525" : EndIf
L375:
IF Y![LI&] < YR! : Goto "L380" : Else : Goto "L410" : EndIf
L380:
REM Replace a vertex
WhileLoop N&:K&=&Loop
V![HI&,K&]=R![K&]
EndWhile
Y![HI&]=YR!
Goto "L515"
L410:
REM Construct vertex E.
WhileLoop N&: K&=&Loop
E![K&]=2*R![K&]-M![K&]
P![K&]=E![K&]
EndWhile
REM DO SUBROUTINE FUNCTION
s10
YE!=F!
IF YE! < Y![LI&] : GOTO "L455" : ELSE : GOTO "L480" : ENDIF
L455:
WhileLoop N&: K&=&Loop
V![HI&,K&]=E![K&]
EndWhile
Y![HI&]=YE!
Goto "L510"
REM ELSE
L480:
REM Replace a vertex.
WhileLoop N&: K&=&Loop
V![HI&,K&]=R![K&]
EndWhile
Y![HI&]=YR!
L510:
REM ENDIF
L515:
REM ENDIF
Goto "L700"
L525:
If YR! < Y![HI&] : Goto "L535" : Else : Goto "L560" : EndIf
L535:
REM Replace a vertex
WhileLoop N& : K&=&Loop
V![HI&,K&]=R![K&]
EndWhile
Y![HI&]=YR!
L560:
REM CONTINUE
REM Construct vertex C
WhileLoop N& : K& = &Loop
C![K&]=(V![HI&,K&]+M![K&])/2
P![K&]=C![K&]
EndWhile
s10
' REM SUBROUTINE FUNCTION
YC!=F!
If YC! < Y![HI&] : Goto "L605" : Else : Goto "L630" : EndIf
L605:
WhileLoop N&: K&=&Loop
V![HI&,K&]=C![K&]
EndWhile
Y![HI&]=YC!
Goto "L695"
L630:
REM ELSE
REM Shrink the simplex
WhileLoop 0,N& : J&=&Loop
If J& <> LO& : Goto "L650" : Else : Goto "L685" : EndIf
L650:
WhileLoop N& : K& = &Loop
V![J&,K&]=(V![J&,K&]+V![LO&,K&])/2
Z![K&]=V![J&,K&]
P![K&] = Z![K&]
EndWhile
s10
' REM SUBROUTINE FUNCTION
Y![J&]=F!
L685:
REM CONTINUE
EndWhile
L695:
REM ENDIF
L700:
REM ENDIF
COUNT&=COUNT&+1
REM order the vertices.
LO&=0
HI&=0
WhileLoop N& : J&=&Loop
case Y![J&] < Y![LO&] : LO&=J&
case Y![J&] > Y![HI&] : HI& =J&
EndWhile
LI&=HI&
HO&=LO&
WhileLoop 0,N&:J&=&Loop
case (J& <> LO&) AND (Y![J&] < Y![LI&]) : LI&=J&
case (J& <> HI&) AND (Y![J&] > Y![HO&]): HO&=J&
EndWhile
WEND
' =======================================================================
REM Determine the size of the simplex
NORM!=0
WhileLoop 0,N&:J&=&Loop
s!=0
WhileLoop N&: K&=&Loop
s!=s! + ( V![LO&,K&] - V![J&,K&] ) * ( V![LO&,K&] - V![J&,K&] )
EndWhile
case s! > NORM! : NORM!=s!
EndWhile
NORM!=SQRT(NORM!)
Return
REM SUBROUTINE INPUTS
Proc s1000
CLS
Print " THE NELDER-MEAD SIMPLEX METHOD OR 'POLYTOPE METHOD' IS"
Print "\n USED FOR FINDING THE MINIMUM OF THE FUNCTION F(V)"
Print "\n FOR CONVENIENCE, THE FUNCTION F(V) CAN BE EXPRESSED USING"
Print "\n THE VARIABLES X = v , Y = v , Z = v , u = v , V = v , W = v ."
Print " 1 2 3 4 5 6 "
Print
' REM DO SUBROUTINE PRINT FUNCTION
s20
Print "\n YOU MUST SUPPLY",int(N&+1)," LINEARLY INDEPENDENT"
Print
If N& = 2 : Goto "L1160" : Else : Goto "L1190" : EndIf
L1160:
Print " STARTING POINTS V = ( v , v ) FOR J=0,1,3"
Print " J J,1 J,2"
Goto "L1280"
L1190:
REM ELSE
If N& = 3 : Goto "L1210" : Else : Goto "L1240" : EndIf
L1210:
Print " STARTING POINTS V = (v,v,v) FOR J=0,1,3,4"
Print " J J,1 J,2 J,3"
Goto "L1280"
L1240:
REM ELSE
PRINT " STARTING POINTS V = (v,v,...,v) FOR J=0,1,...,N"
PRINT " J J,1 J,2 J,N"
PRINT " WHERE n =",N&
L1280:
REM ENDIF
WhileLoop 0,N& : J&=&Loop
PRINT
PRINT " GIVE COORDINATES OF POINT V"
PRINT " ",J&
WhileLoop N& : K&=&Loop
PRINT " V(";J&;",";K&;") = ";
INPUT A$
V![J&,K&]=val(A $)
Z![K&]=V![J&,K&]
EndWhile
WhileLoop N& : K&=&Loop
P![K&] = Z![K&]
EndWhile
' REM DO SUBROUTINE FUNCTION
s10
Y![J&]=F!
EndWhile' NEXT J&
Return
ENDPROC
' SUBROUTINE OUTPUT
Proc s2000
CLS
Print
Print " THE NELDER-MEAD METHOD WAS USED TO FIND THE MINIMUM OF THE FUNCTION"
Print
' REM DO SUBROUTINE PRINT FUNCTION
s20
Print
Print " IT TOOK ";COUNT&;" ITERATIONS TO FIND AN APPROXIMATION FOR"
Print
IF N& = 2 : Goto "L2100" : Else : Goto "L2130" : EndIf
L2100:
Print " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p )"
Print " 1 2"
Goto "L2220"
L2130:
REM ELSE
If N& = 3 : Goto "L2150" : Else : Goto "L2180" : EndIf
L2150:
Print " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p ,p )"
Print " 1 2 3"
Goto "L2220"
L2180:
REM ELSE
Print " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p ,...,p )"
Print " 1 2 N"
Print " WHERE n = ";N&
L2220:
REM ENDIF
WhileLoop N& : K&=&Loop
Print "P(";K&;") = ";V![LO&,K&]
EndWhile
Print "\n THE MAXIMUM DISTANCE TO THE OTHER VERTICES OF THE SIMPLEX IS"
Print "\n DP = ";Norm!
Print "\n THE FUNCTION VALUE AT THE MINIMUM POINT IS"
Print "\n F(P) = ";Y![LO&]
Print "\n DF = ";Y![HI&]-Y![LO&];" IS AN ESTIMATE FOR THE ACCURACY."
Return
ENDPROC
L9999:
End
|
|
(774)
Deutsch
English
Français
Español
Italia