home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / derive / download / Setup.exe / %MAINDIR% / Users / Simplex.mth < prev    next >
Encoding:
Text File  |  2002-05-15  |  3.2 KB  |  59 lines
  1. "The Simplex Method"
  2.  
  3. "Author:  Valeriu Anisiu,    anisiu@math.ubbcluj.ro"
  4. "address: Faculty of Mathematics and Computer Science"
  5. "         Babes-Bolyai University"
  6. "         Kogalniceanu 1 Street"
  7. "         3400 Cluj-Napoca, Romania"
  8.  
  9. eps_:=0
  10.  
  11. simplextables:=
  12.  
  13. PIVOTSIMPLEX(aa,mf,r,s,v,w,p,i,j):=PROG(p:=aa SUB r SUB s,i:=mf,LOOP(IF(i=r,i~
  14. :-1),IF(i=0,exit),j:=DIM(aa`),LOOP(IF(j=s,j:-1),IF(j=0,exit),aa SUB i SUB j:=~
  15. aa SUB i SUB j-aa SUB i SUB s*aa SUB r SUB j/p,IF(ABS(aa SUB i SUB j)<=eps_,aa~
  16.  SUB i SUB j:=0),j:-1),i:-1),aa SUB r:=1/p*aa SUB r,MAP(aa SUB i_ SUB s:=0,i_~
  17. ,1,DIM(aa)),aa SUB r SUB s:=1,v SUB r:=s,w SUB s:=r,IF(VECTOR?(simplextables)~
  18. ,simplextables:=APPEND(simplextables,[[r,s,aa]])))
  19.  
  20. SIMPLEX1(aa,mf,n,nb,nc,r,s,v,w,i):=LOOP(s:=0,q_:=-eps_,IF(mf=DIM(aa),MAP(IF(aa~
  21.  SUB mf SUB j_<q_,PROG(s:=j_,q_:=aa SUB mf SUB j_)),j_,1,nb),MAP(IF(aa SUB mf~
  22.  SUB j_<q_ AND (w SUB j_<=n OR aa SUB (mf+1) SUB j_<=eps_),PROG(s:=j_,q_:=aa S~
  23. UB mf SUB j_)),j_,1,nb)),IF(s=0,RETURN(-aa SUB mf SUB nc)),q_:=inf,i:=DIM(aa)~
  24. -2,LOOP(IF(i=0,exit),IF(aa SUB i SUB s>eps_,IF(aa SUB i SUB nc/aa SUB i SUB s<~
  25. q_,PROG(r:=i,q_:=aa SUB i SUB nc/aa SUB i SUB s))),i:-1),IF(q_=inf,RETURN(-q_~
  26. )),PIVOTSIMPLEX(aa,mf,r,s,v,w))
  27.  
  28. SIMPLEX(aa,n,m,nb,nc,mf,v,w,rez,ii,jj,x):=PROG(v:=VECTOR(n+i,i,1,m),w:=VECTOR~
  29. (i,i,1,nb),x:=VECTOR(0,i,1,n+m),mf:=DIM(aa),rez:=SIMPLEX1(aa,mf,n,nb,nc,r,s,v~
  30. ,w),IF(ABS(rez)>eps_,RETURN([inf,[],[]])),ii:=1,LOOP(IF(ii>m,exit),IF(v SUB ii~
  31. >nb,PROG(IF(aa SUB ii SUB nc>eps_,RETURN([inf,[?],[]])),jj:=0,MAP(IF(ABS(aa SU~
  32. B ii SUB j_)>eps_,jj:=j_),j_,1,nb),IF(jj>0,PIVOTSIMPLEX(aa,mf,ii,jj,v,w)))),ii~
  33. :+1),mf:=DIM(aa)-1,IF(VECTOR?(simplextables),simplextables:=APPEND(simplextab~
  34. les,["phase2:"])),rez:=SIMPLEX1(aa,mf,n,nb,nc,r,s,v,w),MAP(PROG(ii:=v SUB i_,~
  35. x SUB ii:=aa SUB i_ SUB nc),i_,1,m),~
  36. IF(ABS(rez)=inf,[rez,[],[]],[rez,x SUB [1,...,n],x SUB [n+1,...,n+m]]))
  37.  
  38. SIMPLEXCALL(a,l,g,e,b,c,m,n,nb,nc,aa):=PROG(m:=DIM(a),n:=DIM(a`),nb:=n+l+g,nc~
  39. :=nb+e+1,IF(DIM(c)<=n,c:=APPEND(c,VECTOR(0,j,DIM(c)+1,n+1))),c:=APPEND(c SUB ~
  40. [1,...,n],VECTOR(0,j,1,l+g+e),[c SUB (n+1)]),aa:=APPEND(a`,IDENTITY_MATRIX(l+~
  41. g+e),[b])`,MAP(aa SUB (l+i_) SUB (n+l+i_):=-1,i_,1,g),aa:=APPEND(aa,[c],-[SUM~
  42. (aa)]),MAP(aa SUB (m+2) SUB j_:=0,j_,nb+1,nc-1),IF(VECTOR?(simplextables),sim~
  43. plextables:=[[aa]]),SIMPLEX(aa,n,m,nb,nc))
  44.  
  45. MINIMIZE(c,a,b,ag,ae,al,u,vars,zero):=PROG(vars:=VARIABLES([a,c]),IF(NOT(VECT~
  46. OR?(a)) OR a=[] OR vars=[],RETURN("Use args:    (expr,[cond1,cond2,...])")),z~
  47. ero:=0*vars,IF([GRAD(GRAD(c,vars),vars),GRAD(GRAD(LHS(a)-RHS(a),vars),vars)],~
  48. "ok",RETURN("Nonlinear function or constraint"),RETURN("Nonlinear function or~
  49.  constraint")),c:=APPEND(GRAD(c,vars),[-SUBST(c,vars,zero)]),ag:=[],ae:=[],al~
  50. :=[],LOOP(IF(a=[],exit),u:=FIRST(a),a:=REST(a),u:=u-RHS(u),IF(SUBST(LHS(u),va~
  51. rs,zero)>0,u:=-u),IF(SUBST(u,LHS(u),0),ae:=APPEND(ae,[u])),IF(SUBST(u,LHS(u),~
  52. 1),ag:=APPEND(ag,[u])),IF(SUBST(u,LHS(u),-1),al:=APPEND(al,[u]))),a:=APPEND(a~
  53. l,ag,ae),b:=-SUBST(LHS(a),vars,zero),a:=GRAD(LHS(a)`,vars)`,u:=SIMPLEXCALL(a,~
  54. DIM(al),DIM(ag),DIM(ae),b,c),[u SUB 1,vars=u SUB 2,u SUB 3])
  55.  
  56. MAXIMIZE(c,a,rez):=PROG(rez:=MINIMIZE(-c,a),IF(STRING?(rez),rez,[-rez SUB 1,r~
  57. ez SUB 2,rez SUB 3]))
  58.  
  59.