p.specht
 | Das Verfahren von Nelder & Mead ist eine relativ einfache, daher robuste Suche nach Minima bzw. Maxima auf einer zwei- oder mehrdimensionalen Fehler-, Kosten- oder Gewinnfunktion (Im Gegensatz zu anderen Verfahren kommt es ohne partielle Ableitungen aus!).
Wie alle solche Verfahren besteht auch hier die Gefahr, in bloß lokalen Optimalpunkten hängenzubleiben. Daher sollte man stets mehrere Duchläufe mit geänderten Anfangs-Eckpunkten des "wandernden Dreiecks" (2D) bzw. wandernden Tetraeders (3D) bzw. Simplexes (>3D) durchspielen.
Der Algorithmus selbst stammt aus dem Jahre 1965 und wurde aus HP-BASIC nach XProfan 11 transkribiert. Daher noch die alte "Spagetti-Programmierung" mit vielen "GOTO". Versuche verliefen bei mir ohne große Fehler. Hier meine Umsetzung nach XProfan 11 - aber wie immer ohne jede Gewähr:
WindowTitle "Nelder-Mead Downhillsimplex zur Optimierung auf n-dimensional-nichtlinearen Funktionen"
' (Tr) 2012-07 übersetzt aus HP-Basic nach XProfan 11.2a by P. Specht, Wien
' Umsetzung ohne jegliche Gewähr!
REM Rechtsvermerke der 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!,Norm!,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!
'====================================
'Weitere Testfunktionen:
' Rosenbrock-„Bananenfunktion“
'f(x,y)=(1-x)^2+100*(y-x^2)^2
'min bei 1,1 mit f(x,y)=0
' Himmelblau-Funktion
'f(x,y)=(x^2+y-11)^2+(x+y^2-7)^2
'max bei x=-0.270845, y=-0.923039 mit f(x,y)=181.617
'4*min: 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 Form 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
|
|
(948)
Deutsch
English
Français
Español
Italia