 p.specht
 | cela procéder de Nelder & Mead ist une relativ simple, daher robuste cherche pour Minima bzw. Maxima sur einer deux- ou bien mehrdimensionalen faute-, coûter- ou bien Gewinnfunktion (Im opposition trop anderen procéder venez es sans partielle Ableitungen aus!).
comment alle solche procéder besteht aussi ici qui péril, dans bloß lokalen Optimalpunkten hängenzubleiben. Daher sollte on stets plusieurs Duchläufe avec modifié Anfangs-Eckpunkten des "wandernden Dreiecks" (2D) bzw. wandernden Tetraeders (3D) bzw. Simplexes (>3D) durchspielen.
qui Algorithmus selbst stammt aus dem Jahre 1965 et wurde aus HP-BASIC pour XProfan 11 transkribiert. Daher encore qui vieille "Spagetti-Programmierung" avec vielen "GOTO". Versuche verliefen chez mir sans grand faute. ici mon Umsetzung pour XProfan 11 - mais comment toujours sans chacun Gewähr:
Titre de la fenêtre "Nelder-Mead Downhillsimplex zur Optimierung sur n-dimensional-nichtlinearen Funktionen"
' (Tr) 2012-07 traduit aus HP-Basic pour XProfan 11.2a by P. Specht, vienne
' Umsetzung sans jegliche Gewähr!
REM Rechtsvermerke qui Originalvorlage:
REM Copyright 1987
REM John H. Mathews
REM Dept. of Mathematics
REM California State University, Fullerton
REM Nelder-Mead Method for N-Dimensions
Fenêtre 0,0 - %maxx,%maxy-44
CLS:Font 2
Déclarer N&,K&,J&,FUN$,L$,R$,A$,ANS$
Déclarer Epsilon!,x!,y!,z!,u!,v!,w!,F!,S!,Norm!,YR!,YE!,YC!
Déclarer 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 chez 1,1 avec f(x,y)=0
' Himmelblau-Funktion
'f(x,y)=(x^2+y-11)^2+(x+y^2-7)^2
'max chez x=-0.270845, y=-0.923039 avec 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$ ="] = "
Imprimer L$;C$[1];
WhileLoop 2,N&: K&=&Boucle
Imprimer C$[K&];
Endwhile
Imprimer R$;FUN$
Retour
ENDPROC
'{ Hauptteil PROGRAM NELDER MEAD
L100:
Epsilon! = +1*10^-5
Déclarer 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
Imprimer "\n WANT TO TRY NEW STARTING VERTICES ? ";
Contribution ANS$
Cas (ANS$ = "Y") Or (ANS$ = "y") : Goto "L120"
Goto "L9999"
'}
S200:
REM SUBROUTINE NELDER MEAD
MIN&=10
MAX&=200
COUNT&=0
REM l'ordre le vertices.
LO&=0 : HI& =0
WhileLoop N& : J&=&Boucle
cas Y![J&] < Y![LO&] : LO&=J&
cas Y![J&] > Y![HI&] : HI&=J&
Endwhile
LI&=HI& : HO&=LO&
WhileLoop 0,n&:J&=&Boucle
cas (J& <> LO&) AND (Y![J&] < Y![LI&]) : LI&=J&
cas (J& <> HI&) AND (Y![J&] > Y![HO&]): HO&=J&
Endwhile
' =======================================================================
Tandis que (Y![HI&] > (Y![LO&] + EPSILON!)) And ( (COUNT&<MAX&) Or (COUNT&<MIN&) )
REM The main loop
REM forme new vertices M and R
WhileLoop N&:K&=&Boucle
S!=0
WhileLoop 0,N& : J& = &Boucle
S!=S!+V![J&,K&]
Endwhile
M![K&]=(S!-V![HI&,K&]) / N&
Endwhile
WhileLoop N&: K&=&Boucle
R![K&]=2*M![K&]-V![HI&,K&]
P![K&]=R![K&]
Endwhile
REM SUBROUTINE FUNCTION
S10
YR!=F!
REM Improve le simplex.
Si YR! < Y![HO&] : Goto "L375" : D'autre : Goto "L525" : EndIf
L375:
IF Y![LI&] < YR! : Goto "L380" : D'autre : Goto "L410" : EndIf
L380:
REM Replace a vertex
WhileLoop N&:K&=&Boucle
V![HI&,K&]=R![K&]
Endwhile
Y![HI&]=YR!
Goto "L515"
L410:
REM Construct vertex E.
WhileLoop N&: K&=&Boucle
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&=&Boucle
V![HI&,K&]=E![K&]
Endwhile
Y![HI&]=YE!
Goto "L510"
REM ELSE
L480:
REM Replace a vertex.
WhileLoop N&: K&=&Boucle
V![HI&,K&]=R![K&]
Endwhile
Y![HI&]=YR!
L510:
REM ENDIF
L515:
REM ENDIF
Goto "L700"
L525:
Si YR! < Y![HI&] : Goto "L535" : D'autre : Goto "L560" : EndIf
L535:
REM Replace a vertex
WhileLoop N& : K&=&Boucle
V![HI&,K&]=R![K&]
Endwhile
Y![HI&]=YR!
L560:
REM CONTINUE
REM Construct vertex C
WhileLoop N& : K& = &Boucle
C![K&]=(V![HI&,K&]+M![K&])/2
P![K&]=C![K&]
Endwhile
S10
' REM SUBROUTINE FUNCTION
YC!=F!
Si YC! < Y![HI&] : Goto "L605" : D'autre : Goto "L630" : EndIf
L605:
WhileLoop N&: K&=&Boucle
V![HI&,K&]=C![K&]
Endwhile
Y![HI&]=YC!
Goto "L695"
L630:
REM ELSE
REM Shrink le simplex
WhileLoop 0,N& : J&=&Boucle
Si J& <> LO& : Goto "L650" : D'autre : Goto "L685" : EndIf
L650:
WhileLoop N& : K& = &Boucle
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 l'ordre le vertices.
LO&=0
HI&=0
WhileLoop N& : J&=&Boucle
cas Y![J&] < Y![LO&] : LO&=J&
cas Y![J&] > Y![HI&] : HI& =J&
Endwhile
LI&=HI&
HO&=LO&
WhileLoop 0,N&:J&=&Boucle
cas (J& <> LO&) AND (Y![J&] < Y![LI&]) : LI&=J&
cas (J& <> HI&) AND (Y![J&] > Y![HO&]): HO&=J&
Endwhile
WEND
' =======================================================================
REM Determine le size of le simplex
NORM!=0
WhileLoop 0,N&:J&=&Boucle
S!=0
WhileLoop N&: K&=&Boucle
S!=S! + ( V![LO&,K&] - V![J&,K&] ) * ( V![LO&,K&] - V![J&,K&] )
Endwhile
cas S! > NORM! : NORM!=S!
Endwhile
NORM!=SQRT(NORM!)
Retour
REM SUBROUTINE INPUTS
Proc S1000
CLS
Imprimer " THE NELDER-MEAD SIMPLEX METHOD OU 'POLYTOPE METHOD' IS"
Imprimer "\n USED FOR FINDING THE MINIMUM OF THE FUNCTION F(V)"
Imprimer "\n FOR CONVENIENCE, THE FUNCTION F(V) CAN BE EXPRESSED USING"
Imprimer "\n THE VARIABLES X = v , Y = v , Z = v , U = v , V = v , W = v ."
Imprimer " 1 2 3 4 5 6 "
Imprimer
' REM DO SUBROUTINE PRINT FUNCTION
S20
Imprimer "\n YOU MUST SUPPLY",int(N&+1)," LINEARLY INDEPENDENT"
Imprimer
Si N& = 2 : Goto "L1160" : D'autre : Goto "L1190" : EndIf
L1160:
Imprimer " STARTING POINTS V = ( v , v ) FOR J=0,1,3"
Imprimer " J J,1 J,2"
Goto "L1280"
L1190:
REM ELSE
Si N& = 3 : Goto "L1210" : D'autre : Goto "L1240" : EndIf
L1210:
Imprimer " STARTING POINTS V = (v,v,v) FOR J=0,1,3,4"
Imprimer " 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&=&Boucle
PRINT
PRINT " GIVE COORDINATES OF POINT V"
PRINT " ",J&
WhileLoop N& : K&=&Boucle
PRINT " V(";J&;»;K&;") = ";
INPUT A$
V![J&,K&]=val(A$)
Z![K&]=V![J&,K&]
Endwhile
WhileLoop N& : K&=&Boucle
P![K&] = Z![K&]
Endwhile
' REM DO SUBROUTINE FUNCTION
S10
Y![J&]=F!
Endwhile' NEXT J&
Retour
ENDPROC
' SUBROUTINE OUTPUT
Proc S2000
CLS
Imprimer
Imprimer " THE NELDER-MEAD METHOD WAS USED TO FIND THE MINIMUM OF THE FUNCTION"
Imprimer
' REM DO SUBROUTINE PRINT FUNCTION
S20
Imprimer
Imprimer " IT TOOK ";COUNT&;" ITERATIONS TO FIND AN APPROXIMATION FOR"
Imprimer
IF N& = 2 : Goto "L2100" : D'autre : Goto "L2130" : EndIf
L2100:
Imprimer " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p )"
Imprimer " 1 2"
Goto "L2220"
L2130:
REM ELSE
Si N& = 3 : Goto "L2150" : D'autre : Goto "L2180" : EndIf
L2150:
Imprimer " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p ,p )"
Imprimer " 1 2 3"
Goto "L2220"
L2180:
REM ELSE
Imprimer " THE COORDINATES OF THE LOCAL MINIMUM P = (p ,p ,...,p )"
Imprimer " 1 2 N"
Imprimer " WHERE N = ";N&
L2220:
REM ENDIF
WhileLoop N& : K&=&Boucle
Imprimer "P(";K&;") = ";V![LO&,K&]
Endwhile
Imprimer "\n THE MAXIMUM DISTANCE TO THE OTHER VERTICES OF THE SIMPLEX IS"
Imprimer "\n DP = ";Norm!
Imprimer "\n THE FUNCTION VALUE AT THE MINIMUM POINT IS"
Imprimer "\n F(P) = ";Y![LO&]
Imprimer "\n DF = ";Y![HI&]-Y![LO&];" IS AN ESTIMATE FOR THE ACCURACY."
Retour
ENDPROC
L9999:
Fin
|
|