Prev: FindRoot + Compile = incompatible (?)
Next: A Question About Directive [off-topic]
From: maria giovanna dainotti on 26 Jul 2010 07:09
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

From: Daniel Lichtblau on 27 Jul 2010 04:18
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

From: J. Batista on 1 Aug 2010 04:57
Dean Maria, here is a possible solution to your question. The white contour
areas can be removed by approaching the output of ContourPlot as an image,
treating the task as one of image processing (as suggested previously by
Daniel Lichtblau). First, equate the original ContourPlot output with a
variable name, for example originalPlot == Out[1] (where Out[1] is the
ContourPlot output cell). Alternatively, you can simply select the
ContourPlot, copy and then paste into the first line of the code sequence
below in place of the variable originalPlot. I will now display the four
lines of the code sequence and then explain them afterwards.

originalColorData == ImageData[originalPlot];

targetPixels == Position[originalColorData, originalColorData[[180, 180]]];

newColorData == ReplacePart[originalColorData, targetPixels -> {1., 1., 1.}];

Image[newColorData]


The first code line accomplishes the task of collecting and reading the
ContourPlot into computer memory as image data, in this case a vector of RGB
color values. Note that I place a semicolon at the end of this and other
lines of code in order to suppress the visual output of the code sequence's
result. This is because the vector is lengthy and will clog the notebook
unnecessarily.
The second code line establishes the pattern by which the portions of the
plot that you wish to alter are identified as a subset of the entire
original data set. The pattern is established by entering the pixel
coordinate of a representative target pixel that you wish to alter, in this
case [[180, 180]] being one of the pixels in the white contour areas. You
can determine an appropriate pixel coordinate by right-clicking in the
original ContourPlot output, selecting Get Indices, and then guiding your
cursor to a desired location within the plot.
The third code line replaces the pixel locations flagged by the previous
pattern search with new pixel data, in this case new RGB color values that
you select. I have used the example of {1., 1., 1.} to illustrate changing
from the semi-white color of the original plot to a true white that matches
the plot background. Be sure to use decimal points as above when expressing
color values for your pixels, as something like {1, 1, 1} will not
be understood correctly for this purpose. If you want to change the
semi-white color of your original plot to black, use {0., 0., 0.}.
The fourth and final line re-establishes the newly altered set of pixel data
as an image object, and displays the altered image.

Hope this helps.
Best Regards,
J. Batista

On Mon, Jul 26, 2010 at 6:37 AM, maria giovanna dainotti <
mariagiovannadainotti(a)yahoo.it> 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
>
>
From: J. Batista on 2 Aug 2010 07:01
Maria/All, I just learned from a colleague that all equations on my message
have double equal signs. Please note that is probably due to a transmission
error. All equations should only have a single equal sign. I'm
retransmitting my original message.
Regards,
J. Batista
On Sun, Aug 1, 2010 at 3:10 AM, J. Batista <jbatista800(a)gmail.com> wrote:

> Dean Maria, here is a possible solution to your question. The white
> contour areas can be removed by approaching the output of ContourPlot as an
> image, treating the task as one of image processing (as suggested previously
> by Daniel Lichtblau). First, equate the original ContourPlot output with a
> variable name, for example originalPlot == Out[1] (where Out[1] is the
> ContourPlot output cell). Alternatively, you can simply select the
> ContourPlot, copy and then paste into the first line of the code sequence
> below in place of the variable originalPlot. I will now display the four
> lines of the code sequence and then explain them afterwards.
>
> originalColorData == ImageData[originalPlot];
>
> targetPixels == Position[originalColorData, originalColorData[[180, 180]]];
>
> newColorData == ReplacePart[originalColorData, targetPixels -> {1., 1.,
> 1.}];
>
> Image[newColorData]
>
>
> The first code line accomplishes the task of collecting and reading the
> ContourPlot into computer memory as image data, in this case a vector of RGB
> color values. Note that I place a semicolon at the end of this and other
> lines of code in order to suppress the visual output of the code sequence's
> result. This is because the vector is lengthy and will clog the notebook
> unnecessarily.
> The second code line establishes the pattern by which the portions of the
> plot that you wish to alter are identified as a subset of the entire
> original data set. The pattern is established by entering the pixel
> coordinate of a representative target pixel that you wish to alter, in this
> case [[180, 180]] being one of the pixels in the white contour areas. You
> can determine an appropriate pixel coordinate by right-clicking in the
> original ContourPlot output, selecting Get Indices, and then guiding your
> cursor to a desired location within the plot.
> The third code line replaces the pixel locations flagged by the previous
> pattern search with new pixel data, in this case new RGB color values that
> you select. I have used the example of {1., 1., 1.} to illustrate changing
> from the semi-white color of the original plot to a true white that matches
> the plot background. Be sure to use decimal points as above when expressing
> color values for your pixels, as something like {1, 1, 1} will not
> be understood correctly for this purpose. If you want to change the
> semi-white color of your original plot to black, use {0., 0., 0.}.
> The fourth and final line re-establishes the newly altered set of pixel
> data as an image object, and displays the altered image.
>
> Hope this helps.
> Best Regards,
> J. Batista
>
> On Mon, Jul 26, 2010 at 6:37 AM, maria giovanna dainotti <
> mariagiovannadainotti(a)yahoo.it> 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]-spherefa=
r[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 bi=
t
>> 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
>>
>>
>


From: Bill Rowe on 3 Aug 2010 06:40
On 8/2/10 at 7:02 AM, jbatista800(a)gmail.com (J. Batista) wrote:

>Maria/All, I just learned from a colleague that all equations on my
>message have double equal signs. Please note that is probably due
>to a transmission error. All equations should only have a single
>equal sign. I'm retransmitting my original message.

In Mathematica, equations are written with a double equal sign.
Expressions with a single equal sign are assignments in
Mathematica, not equations.

<snip>

>>originalColorData == ImageData[originalPlot];

The expression above *is* an equation in Mathematica which would
evaluate to true if the variable originalColorData had already
been assigned the value returned by ImageData.

What was probably desired was an assignment (not an equation) to
set the value of originalColorData to the value returned by ImageData.

In some respects, calling attention to the difference between
*equations* (using ==) and *assignments* (using =) in
Mathematica is being a bit pedantic. But I believe it is
important to be clear about this difference since many posts
here regarding issues are due to the confusion caused by
thinking of a something written with a single = character in
Mathematica as an "equation".


 | 
Pages: 1
Prev: FindRoot + Compile = incompatible (?)
Next: A Question About Directive [off-topic]