Re: Black box optimization

*To*: mathgroup at smc.vnet.net*Subject*: [mg126303] Re: Black box optimization*From*: Ray Koopman <koopman at sfu.ca>*Date*: Mon, 30 Apr 2012 04:39:34 -0400 (EDT)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com*References*: <jngdfv$pe$1@smc.vnet.net>

(* the problem specification requires the line to pass thru the first point, so shift the origin to that point; then only the slope needs to be solved for *) {u,v} = Transpose@Rest@InData - InData[[1]]; (* get a starting guess: the least-squares slope *) mLS = v.u/u.u 109.504 (* get the least-absolute coefficients; don't use derivatives *) FindMinimum[Tr@Abs[v - m*u],{m, mLS-1, mLS+1}] mLA = m /. %[[2]] bLA = InData[[1]].{-mLA,1} {2.13519, {m -> 110.276}} 110.276 0.345738 (* mLA*x + bLA is the least-absolute error line, subject to the constraint that it pass thru the first point *) On Apr 28, 2:32 am, "McHale, Paul" <Paul.McH... at excelitas.com> wrote: > Is there any black box optimization of user defined non-polynomial functions in Mathematica? I.e. > > I want to minimize fm[x] between 0.010 and 0.060. The goal is to fit the data with mx+b. This requires two points. The first point in the data has to be zero or first element shown below. The other single point must allow a fit with minimum error between the original data points and the new data points generated from an mx+b approximation. > > fm[mPt_]:=Module[{mMinFit,mFit,mError,x,InData}, > InData={{0.`,0.3457378`},{0.005005030108147661`,0.5947282`},{0.010167934319260488`,1.110245`},{0.015746789471210974`,1.753068`},{0.019877754878728275`,2.26061`},{0.025058168807019193`,2.891833`},{0.029851036834650214`,3.470055`},{0.03486106617079409`,4.088596`},{0.04009652061250109`,4.721034`},{0.04501992441075972`,5.31037`},{0.049993105670535644`,5.912859`},{0.054948450286312706`,6.513352`},{0.06007028590992394`,7.144364`}}; > (* Use mMinFit to select Y value for selected point *) > mMinFit=Fit[Select[InData, #[[1]] > 0.01&],{1,x},x]; > (* Generate fit between new fit between first point and new test point *) > mFit=Fit[{First@InData,{mPt,mMinFit /. x->mPt}},{1,x},x]; > (* subtract real data from points generated by new curve *) > mError=Total@Table[Abs@(m[[2]]-mFit /. x ->m[[1]]),{m,InData}] > ] > > Calling fm[0.01] calculates the fit using {{0.`,0.3457378`},{0.01,InterpValue} as the two points mx+b must pass through. It then returns the Abs[] of > the difference between the original points (InData) and the interpolated points based on original x values. This is intended to be the error function. Minimizing fm[x] should give the best possible choice of x to calibrate with. > > I can always fall back to: > > m=Table[{i,fm[i]},{i,0.010,0.060,0.00001}]; > First@Sort[m,#1[[2]] < #2[[2]]&] > > Out:= {0.04474,2.13522} > > Here is a decent graph of the issue: > > ListPlot[Table[fm[i], {i, 0.010, 0.060, 0.001}], Joined -> True] > > I thought I found a better way in Mathematica before... > > Paul McHale | Electrical Engineer, Energetics Systems | Excelitas Technologies Corp. > > Phone: +1 937.865.3004 | Fax: +1 937.865.5170 | Mobile: +1 937.371.2828 > 1100 Vanguard Blvd, Miamisburg, Ohio 45342-0312 USA > Paul.McH... at Excelitas.comwww.excelitas.com > > Please consider the environment before printing this e-mail. > This email message and any attachments are confidential and proprietary to Excelitas Technologies Corp. If you are not the intended recipient of this message, please inform the sender by replying to this email or sending a message to the sender and destroy the message and any attachments. > Thank you