Re: 'Nother Inverse Function Question
- To: mathgroup at smc.vnet.net
- Subject: [mg126639] Re: 'Nother Inverse Function Question
- From: Ingolf Dahl <ingolf.dahl at telia.com>
- Date: Mon, 28 May 2012 05:09:37 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <201205250854.EAA26865@smc.vnet.net>
Bill, We might first note that it is possible to solve for s and t as functions of x and y In[1]:= Simplify[Solve[ x == s (2 + 1.2 (2 - y)^2) + (1 - s) (-3.2 - 1/3 (y - 1.3)^2), s]] Out[1]= {{s -> (3.76333\[VeryThinSpace]+ 1. x - 0.866667 y + 0.333333 y^2)/( 10.5633\[VeryThinSpace]- 5.66667 y + 1.53333 y^2)}} In[2]:= Simplify[Solve[y == t (-(x/3)^3 + x/2 + 2.5) + (1 - t) ((x/4)^3 + 1), t]] Out[2]= {{t -> (1.\[VeryThinSpace]+ 0.015625 x^3 - 1. y)/(-1.5 - 0.5 x + 0.052662 x^3)}} Now put In[3]:= s[x_, y_] := (3.7633333333333336`\[VeryThinSpace]+ 1.` x - 0.8666666666666667` y + 0.3333333333333333` y^2)/(10.563333333333333`\[VeryThinSpace]- 5.666666666666666` y + 1.5333333333333332` y^2) In[4]:= t[x_, y_] := ( 1.`\[VeryThinSpace]+ 0.015625` x^3 - 1.` y)/(-1.5` - 0.5` x + 0.052662037037037035` x^3) We might now plot s amd t as functions of x and y. Here is one method which give a little jagged edges. In[6]:= ContourPlot[s1 = s[x, y]; t1 = t[x, y]; If[Or[s1 < 0, s1 > 1, t1 < 0, t1 > 1], -0.1, s1], {x, -4, 4}, {y, 0.0, 3.6}, Contours -> Table[i, {i, 0.0, 1.0, 0.1}]] In[7]:= ContourPlot[s1 = s[x, y]; t1 = t[x, y]; If[Or[s1 < 0, s1 > 1, t1 < 0, t1 > 1], -0.1, t1], {x, -4, 4}, {y, 0.0, 3.6}, Contours -> Table[i, {i, 0.0, 1.0, 0.1}]] The transformation seems smooth and invertible in the region. I was a little bit curious to check if we could use reverse interpolation, using my "Obtuse" package (freely downloadable from http://www.familydahl.se/mathematica/index.html). Ignore the warnings when loading the package. In[8]:= Needs["Obtuse`"]; During evaluation of In[8]:= General::compat : "Combinatorica Graph and Permutations \ functionality has been superseded by preloaded functionaliy. The \ package now being loaded may conflict with this. Please see the \ Compatibility Guide for details." Create a table of x and y values as function of s and t values. In[9]:= tabxy3 = Flatten[ Table[{{s[x, y], t[x, y]}, {x, y}}, {x, -4, 3.5, 0.3}, {y, 0.0, 3.6, 0.3}], {1, 2}]; Something fishy happens outside the region of interest, so remove all points outside. An alternative is to allow points slightly outside the region. In[10]:= tabxy3 = tabxy3 /. {{{a_, b_}, {c_, d_}} /; (Or[a < 0, a > 1, b < 0, b > 1]) :> Sequence[]}; RBF interpolation should work very well in this case. Create an interpolation function, which gives x and y as function of s and t. This type of interpolation can be used in 3D also, with 3 parameters. In[11]:= ip = Interpolation[tabxy3, Method -> "RBF"]; Test in one point (where s and t are both 0.5). If a more exact value is needed, this should at least provide a good start value for FindRoot. One could also fiddle with the options of the RBF interpolation or the number of points in the table. ip[{0.5, 0.5}] {-0.529058, 1.61451} Make a parametric plot. We see that we get a quite good, but not perfect, approximation. In[14]:= ParametricPlot[ip[{s, t}], {s, 0., 1.}, {t, 0., 1.}, PlotPoints -> {25, 11}, PlotRange -> {{-4, 3.5}, {0.0, 3.5}}, AspectRatio -> 3.5/7.5] Have fun! Ingolf Dahl Sweden > -----Original Message----- > From: Bill Freed [mailto:billfreed at shaw.ca] > Sent: den 25 maj 2012 10:55 > To: mathgroup at smc.vnet.net > Subject: 'Nother Inverse Function Question > > Thanks for the previous hints on using InverseFunction. Will be helpful for me. > I am working on parameterizing regions bounded by 4 curves in the plane or 6 surfaces in > 3D. > Below is an example for the region bounded by > x=2+1.2(2-y)^2, x=-3.2-1/3(y-1/3)^2 > y=(-x/3)^3+x/2+2.5, y=(x/4)^3+1 > > Table[FindRoot[{x == s (2 + 1.2 (2 - y)^2) + (1 - s) (-3.2 - 1/3 (y - 1.3)^2), y == t (-(x/3)^3 + > x/2 + 2.5) + (1 - t) ((x/4)^3 + 1)}, {x, 0}, {y, 2}], {s, 0, 1, .1}, {t, 0, 1, .1}]; x = > ListInterpolation[x /. %, {{0, 1}, {0, 1}}]; y = ListInterpolation[y /. %%, {{0, 1}, {0, 1}}]; > ParametricPlot3D[{x[s, t], y[s, t], 0}, {s, 0, 1}, {t, 0, 1}, ViewPoint > -> {0, 0, +Infinity}, > Boxed -> False, Axes -> None, PlotPoints -> {25, 11}] > > The problem with this homemade inverter is frequent error messages concerning accuracy > and convergence and also problems in choosing the starting points, here {x,0}, {y,2}. > Is there a way of using InverseFunction or other Mathematica command that is more robust? > > Thanks > Bll Freed
- References:
- 'Nother Inverse Function Question
- From: Bill Freed <billfreed@shaw.ca>
- 'Nother Inverse Function Question