Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.soft-sys.math.mathematica > #16373

Re: plotting complex functions in (x,y,t) space

Show all headers | View raw

I recommend a different approach. Plot contours of the magnitude with the
coloring set by the argument.


psin[x_, xi_, y_, yi_, t_, ti_, kx_, ky_] =
  (20 E^(1/2 I kx (-kx (t - ti) + 2 (x - xi)) +
        1/2 I ky (-ky (t - ti) + 2 (y - yi)) -
        ((-kx (t - ti) + (x - xi))^2 +
           (-ky (t - ti) + (y - yi))^2)/
         (1600 + 2 I (t - ti))) Sqrt[2/=F0])/
   (800 + I (t - ti));


f[x_, y_, t_] =
  psin[x, 0, y, 0, t, 0, 2/10, 2/10];


The magnitude of f is given by


absf[x_, y_, t_] = ComplexExpand[Abs[f[x, y, t]],
  TargetFunctions -> {Re, Im}]


(20*E^(-((1600*(-(t/5) + x)^2)/(2560000 + 4*t^2)) -
           (1600*(-(t/5) + y)^2)/(2560000 + 4*t^2))*Sqrt[2/Pi])/
   Sqrt[640000 + t^2]


The minimum magnitude is close to zero.


magMin = With[{
   xmin = -125, ymin = -125, tmin = 0,
   xmax = 200, ymax = 200, tmax = 200},
  Minimize[{absf[x, y, t],
      xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tmax},
     {x, y, t}][[1]] // Simplify]


1/(20*E^50*Sqrt[2*Pi])


The maximum magnitude is


magMax = With[{xmin = -125, ymin = -125, tmin = 0,
   xmax = 200, ymax = 200, tmax = 200},
  Maximize[{absf[x, y, t],
      xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tmax},
     {x, y, t}][[1]] // Simplify]


1/(20*Sqrt[2*Pi])


The argument of f is


argf[x_, y_, t_] = ComplexExpand[Arg[f[x, y, t]],
   TargetFunctions -> {Re, Im}] // Simplify


Rewriting argf


argf2[x_, y_, t_] = Module[
   {z, p, q = (640000 + t^2)},
   z = (256000*(x + y) +
                t*(-51200 + x^2 + y^2))/(2*q);
   p = -(16*(2*t^2 - 10*t*
                    (x + y) + 25*(x^2 + y^2)))/q;
   ArcTan[(E^p*(800*Cos[z] + t*Sin[z]))/q,
      (E^p*((-t)*Cos[z] + 800*Sin[z]))/ q]];


Verifying that the expressions are the same


argf[x, y, t] == argf2[x, y, t]


True


The mnimum is determined numerically to be -Pi


argMin = With[{
   xmin = -125, ymin = -125, tmin = 0,
   xmax = 200, ymax = 200, tmax = 200},
  NMinimize[{argf[x, y, t],
     xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tmax},
    {x, y, t}][[1]]]


-3.14159


And the maximum is Pi


argMax = With[{
   xmin = -125, ymin = -125, tmin = 0,
   xmax = 200, ymax = 200, tmax = 200},
  NMaximize[{argf[x, y, t],
     xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tmax},
    {x, y, t}][[1]]]


3.14159


Use Manipulate to vary the magnitude of the contour. This is quite slow due
to the complexity of the functions involved.


With [{step = (magMax - magMin)/100.},
 Manipulate[
  ControlActive[
   (c - magMin)/(magMax - magMin),
   Module[{
     xmin = -125., ymin = -125., tmin = 0.,
     xmax = 200., ymax = 200., tmax = 200.},
    ContourPlot3D[absf[x, y, t] == c,
     {x, xmin, xmax}, {y, ymin, ymax}, {t, tmin, tmax},
     ColorFunction -> Function[{x, y, t, p},
       Hue[(argMax - argf2[x, y, t])/(argMax - argMin)]],
     ColorFunctionScaling -> False]]],
  {{c, magMin + step, "Abs[f[x,y,t]]"},
   magMin + step, magMax - step, step,
   Appearance -> "Labeled"}]]


Bob Hanlon

On Sat, Dec 21, 2013 at 2:29 PM, Michael B. Heaney <mheaney@alum.mit.edu>wr=
ote:

> Hi Bob,
>
> Thanks again for your help. I have modified your code a little, see below=
.
> It appears that when the plot range is large, the many outer
> semitransparent cuboids are obscuring the inner cuboids of interest. What
> is the best way to fix this? Perhaps an opacity threshold below which the
> cuboids are not plotted?
>
> Best regards,
>
> Michael
>
>
> psin[x_, xi_, y_, yi_, t_, ti_, kx_,
>    ky_] := (20 E^(
>      1/2 I kx (-kx (t - ti) + 2 (x - xi)) +
>       1/2 I ky (-ky (t - ti) +
>          2 (y - yi)) - ((-kx (t - ti) + (x - xi))^2 + (-ky (t - ti) + (y =
-
>            yi))^2)/(1600 + 2 I (t - ti))) Sqrt[2/=F0])/(800 + I (t - ti))=
;
> f[x_, y_, t_] := psin[x, 0, y, 0, t, 0, 0.2, 0.2]
>
> Module[{func, magMin, magMax, argMin, argMax, xmin = -125, ymin = -12=
5,
>   tmin = 0, xmax = 200, ymax = 200, tmax = 200, xstep = 10, yst=
ep = 10,
>   tstep = 10},
>  magMin =
>   Minimize[{Abs[f[x, y, t]], xmin <= x <= xmax, ymin <= y <= ymax=
,
>      tmin <= t <= tmax}, {x, y, t}][[1]];
>  magMax =
>   Maximize[{Abs[f[x, y, t]], xmin <= x <= xmax, ymin <= y <= ymax=
,
>      tmin <= t <= tmax}, {x, y, t}][[1]];
>  Graphics3D[
>   Flatten[
>    Table[{Hue[Arg[func = f[x, y, t]]],
>      Opacity[1 - ((magMax - Abs[func])/(magMax - magMin))^10000],
> EdgeForm[],
>      Cuboid[{x, y, t}, {x + xstep, y + ystep, t + tstep}]}, {x, xmin,
>      xmax - xstep, xstep}, {y, ymin, ymax - ystep, ystep}, {t, tmin,
>      tmax - tstep, tstep}], 1], Axes -> True,
>   AxesLabel -> (Style[#, 18] & /@ {"x", "y", "t"})]]
>
>
>
> On Sun, Oct 27, 2013 at 8:02 PM, Bob Hanlon <hanlonr357@gmail.com> wrote:
>
>> f[x_, y_, t_] = Sqrt[x^2 + y^2 + t^2]*Exp[I*t];
>>
>>
>> Manipulate[
>>  Module[{func,
>>    magMin, magMax, argMin, argMax,
>>
>>    xmin = -1, ymin = -1, tmin = -1,
>>    xmax = 1, ymax = 1, tmax = 1,
>>    xstep = .1, ystep = .1, tstep = .1},
>>   magMin = Minimize[{Abs[f[x, y, t]],
>>       xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tma=
x},
>>      {x, y, t}][[1]];
>>   magMax = Maximize[{Abs[f[x, y, t]],
>>       xmin <= x <= xmax, ymin <= y <= ymax, tmin <= t <= tma=
x},
>>      {x, y, t}][[1]];
>>
>>   Graphics3D[
>>    Flatten[
>>     Table[{
>>       Hue[Arg[func = f[x, y, t]]],
>>       Opacity[((magMax - Abs[func])/(magMax - magMin))^n],
>>
>>       EdgeForm[],
>>       Cuboid[{x, y, t},
>>        {x + xstep, y + ystep, t + tstep}]},
>>      {x, xmin, xmax - xstep, xstep},
>>      {y, ymin, ymax - ystep, ystep},
>>      {t, tmin, tmax - tstep, tstep}], 1],
>>    Axes -> True,
>>    AxesLabel -> (Style[#, 18] & /@ {"x", "y", "t"})]],
>>  {{n, 2, "Opacity"}, Range[1, 2.5, .5]}]
>>
>>
>>
>> Bob Hanlon
>>
>>
>>
>>
>> On Thu, Oct 24, 2013 at 7:09 PM, Michael B. Heaney <mheaney@alum.mit.edu=
>wrote:
>>
>>> Hi Bob,
>>>
>>> Thank you for your suggestion. Is there a way to extend your program so
>>> the cuboids fill all of the space in the 3D plot?
>>>
>>> Thanks again,
>>>
>>> Michael
>>>
>>>
>>> On Sun, Oct 6, 2013 at 9:48 AM, Bob Hanlon <hanlonr357@gmail.com> wrote=
:
>>>
>>>> One approach:
>>>>
>>>>
>>>> f[x_, y_, t_] = Sqrt[x^2 + y^2 + t^2]*Exp[I*t];
>>>>
>>>>
>>>> Module[{func,
>>>>   xmin = -1, ymin = -1, tmin = -1,
>>>>   xmax = 1, ymax = 1, tmax = 1,
>>>>   xstep = .1, ystep = .1, tstep = .1},
>>>>  Graphics3D[
>>>>   Flatten[
>>>>    Table[
>>>>     {Hue[Arg[func = f[x, y, t]]],
>>>>      Opacity[1 - Abs[func]],
>>>>      EdgeForm[],
>>>>      Cuboid[{x, y, t},
>>>>       {x + xstep, y + ystep, t + tstep}]},
>>>>     {x, xmin, xmax - xstep, xstep},
>>>>     {y, ymin, ymax - ystep, ystep},
>>>>     {t, tmin, tmax - tstep, tstep}]],
>>>>   Axes -> True,
>>>>   AxesLabel -> (Style[#, 18] & /@
>>>>      {"x", "y", "t"})]]
>>>>
>>>>
>>>>
>>>> Bob Hanlon
>>>>
>>>>
>>>>
>>>>
>>>> On Sun, Oct 6, 2013 at 3:47 AM, Michael B. Heaney <mheaney@alum.mit.ed=
u
>>>> > wrote:
>>>>
>>>>>
>>>>> Hi,
>>>>>
>>>>> I'd like to plot, on [x,y,t] axes, a complex function F[x,y,t], with
>>>>> the
>>>>> magnitude of F represented by opacity, and the phase of F represented
>>>>> by
>>>>> color. Does anyone have suggestions on how best to do this?
>>>>>
>>>>> Thanks,
>>>>>
>>>>> Michael
>>>>>
>>>>>
>>>>>
>>>>
>>>
>>>
>>> --
>>> ----------------------------------------------------------
>>> Michael B. Heaney
>>> 3182 Stelling Drive
>>> Palo Alto, CA 94303 USA
>>> mheaney@alum.mit.edu
>>> www.linkedin.com/in/michaelbheaney
>>> ----------------------------------------------------------
>>>
>>>
>>
>
>
> --
> ----------------------------------------------------------
> Michael B. Heaney
> 3182 Stelling Drive
> Palo Alto, CA 94303 USA
> mheaney@alum.mit.edu
> www.linkedin.com/in/michaelbheaney
> ----------------------------------------------------------
>
>

Back to comp.soft-sys.math.mathematica | Previous | Next | Find similar | Unroll thread

Thread

Re: plotting complex functions in (x,y,t) space Bob Hanlon <hanlonr357@gmail.com> - 2014-01-03 09:36 +0000

csiph-web