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

Re: Problem with Min Max between two functions

• To: mathgroup at smc.vnet.net
• Subject: [mg111318] Re: Problem with Min Max between two functions
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Tue, 27 Jul 2010 04:18:31 -0400 (EDT)

maria giovanna dainotti wrote:
> Dear Mathgroup,
> I have the following function 
> R1=1.029
> R2=3.892
> R3=8
> e1=250
> e2=11.8
> e3=80.5
> i=pi/12
> spherenear[x_,y_]:=((R3^2-x^2-y^2)^(1/2))
> spherefar[x_,y_]:=-((R3^2-x^2-y^2)^(1/2))
> emptynear[x_,y_]:=Min[Re[spherenear[x,y]],Re[(R2^2-x^2)^(1/2)+y*Tan[i]]]
> emptyfar[x_,y_]:=Max[Re[spherefar[x,y]],Re[-(R2^2-x^2)^(1/2)]+y*Tan[i]]
> jetnear[x_,y_]:=Min[Re[spherenear[x,y]],Re[(R1^2-x^2)^(1/2)+y*Tan[i]]]
> jetfar[x_,y_]:=Max[Re[spherefar[x,y]],Re[-(R1^2-x^2)^(1/2)]+y*Tan[i]]
> f[x_,y_]:=((jetnear[x,y]-jetfar[x,y])*e1+e3*(spherenear[x,y]-emptynear[x,y]+emptyfar[x,y]-spherefar[x,y])+e2*(emptynear[x,y]-jetnear[x,y]+jetfar[x,y]-emptyfar[x,y]))*Boole[-R1=EF=82=A3x=EF=82=A3R1]+((emptynear[x,y]-emptyfar[x,y])*e2+e3*(spherenear[x,y]-emptynear[x,y]+emptyfar[x,y]-spherefar[x,y]))*(Boole[-R2<x<-R1]+Boole[R2>x>R1])+(spherenear[x,y]-spherefar[x,y])*e3*(Boole[x<-R2]+Boole[x>R2])
> 
> ContourPlot[f[x,y],{x,-8,8},{y,-8,8},Contours=EF=82=AE{0,100,200,300,400,500,600,700,800,900}]
> 
>>From the picture you can see there is a white contours that results a bit odd, I 
> think th at it comes out from the introduction of the Min and Max.
> I would like to remove this white contour. Could you help me?
> Thanks a lot for your attention
> Cheers
> Maria      
> 

Would help if the code above had Mathematica InputForm for Pi, ->, and < 
(or maybe it is meant to be <=, but inside a numerical Boole that 
distinction hardly matters). Anyway, you have discontinuous derivatives 
and possibly even discontinuous functions, I'm not sure. You can get rid 
of the white curves by blurring ever so slightly. One way to do this is 
as below.

eps = 10^(-4);
g[x_, y_] =
   f[x, y]/2 + (f[x + eps, y] + f[x - eps, y] + f[x, y + eps] +
       f[x, y - eps])/8;

ContourPlot[g[x, y], {x, -8, 8}, {y, -8, 8},
  Contours -> {0, 100, 200, 300, 400, 500, 600, 700, 800, 900}]

There might also be approaches using image processing functionality.

Daniel Lichtblau
Wolfram Research