WOLFRAM

Services & Resources / Wolfram Forums / MathGroup Archive

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: error region in parametric plot

  • To: mathgroup at smc.vnet.net
  • Subject: [mg92756] Re: error region in parametric plot
  • From: m.r at inbox.ru
  • Date: Sun, 12 Oct 2008 04:33:49 -0400 (EDT)
  • References: <gcn4ge$7ad$1@smc.vnet.net>
Cristina Ballantine wrote:
> In plotting parametric regions sometimes I get cracks, i.e., white regions
> that should be colored as part of the region. The code below should
> produce a deformed annulus, but it has two cracks in it. Sometimes I am
> able to force Mathematica to fill part of the cracks by subdividing the
> region with smaller intervals for the angle v. However, this does not work
> for the example below.
>
> Any suggestions are much appreciated.
>
> Cristina
>
>
>
>
> a1 := 1/3*Exp[I*Pi/6]
> a2 := 2/3*Exp[I*3*Pi/4]
> n := 6
>
>
> a1c := Conjugate[a1]
> a2c := Conjugate[a2]
> r1 := Abs[a1]
> r2 := Abs[a2]
> t1 := Arg[a1]
> t2 := Arg[a2]
>
>
>
>
> B[z_] := ((a1c/(r1))*(a1 - z)/(1 - a1c*z))^
>    n*((a2c/(r2))*(a2 - z)/(1 - a2c*z))^n
>
>  a := a1*a2 (a1c + a2c) - (a1 + a2)
>
>  b := (1 - (r1)^2*(r2)^2 - ((1 - (Abs[a1*a2])^2)^2 - (Abs[
>           a])^2)^(1/2))/(a1c*(1 - (r2)^2) + a2c*(1 - (r1)^2))
>  alpha = Arg[N[B[b]]]
>
>
>
> u0[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*0*Pi)/n )]
> u1[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*1*Pi)/n )]
> u2[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*2*Pi)/n )]
> u3[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*3*Pi)/n )]
> u4[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*4*Pi)/n )]
> u5[rho_, v_] := (rho)^(1/n)*Exp[I*((v + 2*5*Pi)/n )]
>
> sol0 :=
>  Solve[(1 - u0[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u0[rho, v] - r2)*Exp[-I*t1] + (r2*u0[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u0[rho, v] == 0, z]
> sol1 := Solve[(1 - u1[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u1[rho, v] - r2)*Exp[-I*t1] + (r2*u1[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u1[rho, v] == 0, z]
> sol2 := Solve[(1 - u2[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u2[rho, v] - r2)*Exp[-I*t1] + (r2*u2[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u2[rho, v] == 0, z]
> sol3 := Solve[(1 - u3[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u3[rho, v] - r2)*Exp[-I*t1] + (r2*u3[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u3[rho, v] == 0, z]
> sol4 := Solve[(1 - u4[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u4[rho, v] - r2)*Exp[-I*t1] + (r2*u4[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u4[rho, v] == 0, z]
> sol5 := Solve[(1 - u5[rho, v]*r1*r2)*Exp[-I (t1 + t2)]*
>      z^2 + ((r1*u5[rho, v] - r2)*Exp[-I*t1] + (r2*u5[rho, v] - r1)*
>         Exp[-I*t2])*z + r1*r2 - u5[rho, v] == 0, z]
>
>
>  plotpi0[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol0], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
> plotpi1[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol1], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
> plotpi2[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol2], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
> plotpi3[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol3], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
> plotpi4[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol4], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
> plotpi5[tmin_, tmax_, c_] :=
>  ParametricPlot[
>   Evaluate[{Re[z], Im[z]} /. sol5], {v, 0, 2*Pi}, {rho, tmin, tmax},
>   ColorFunction -> Function[{x, y, v, rho}, Hue[c, v, rho]],
>   PlotPoints -> 25, PlotRange -> All]
>
>  With[{tmin = .0015, tmax = .01, c = .8},
>  Show[plotpi0[tmin, tmax, c], plotpi1[tmin, tmax, c],
>   plotpi2[tmin, tmax, c], plotpi3[tmin, tmax, c],
>   plotpi4[tmin, tmax, c], plotpi5[tmin, tmax, c], PlotRange -> All]]

When going around the circle, at some point you run into the branch
cut of the square root. Set ExclusionsStyle -> Red to see the
discontinuity. You can choose the branch cut differently for that
portion of the plot:

n = 6; {r1, r2} = {1/3, 2/3}; {t1, t2} = {Pi/6, 3 Pi/4};
u[i_][rho_, v_] := rho^(1/n) Exp[I (v + 2 i Pi)/n]
sol[i_][rho_, v_] := Module[{z}, z /. Solve[
 (1 - u[i][rho, v] r1 r2) Exp[-I (t1 + t2)] z^2 +
  ((r1 u[i][rho, v] - r2) Exp[-I t1] + (r2 u[i][rho, v] -  r1) Exp[-I
t2]) z +
  r1 r2 - u[i][rho, v] == 0, z]]

Manipulate[ParametricPlot[{Re@ #, Im@ #}& /@ sol[#][rho, v] /.
    Sqrt[z_] :> If[1 <= # <= 4, Sqrt[z],
     Sqrt[Abs[z]] E^(I Mod[Arg[z], 2 Pi]/2)] // Evaluate,
   {v, 0, 2 Pi}, {rho, uu, vv},
   ColorFunction -> (Function[{}, Hue[#/6]]), PlotPoints -> {10, 5},
   BoundaryStyle -> None, Mesh -> None, Exclusions -> None]& /@
  Range[0, 5] // Show[#, PlotRange -> All] &,
 {{uu, .0015}, .0001, .002}, {vv, .01, .2}]

Maxim Rytin
m.r at inbox.ru
  • Prev by Date: Re: time based moving average (and other newbie mathematica questions)
  • Next by Date: Re: FindFit
  • Previous by thread: error region in parametric plot
  • Next by thread: Nested If