Related
Suppose I have a function like this.
u = (1 / 4 Sin[t] (1 - r^2)) ;
Plot[u,{r,0,1}]
The above command will plot "U" on Y-axis and "r" on X-axis, But I want it in the reverse direction. "U" on X-axis and "r" on Y-axis.
How to do this, I'm new to Mathematica.
Many thanks for considering my request.
You can tabulate the results using Table and reverse each data point
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
ru = ListLinePlot[table = Table[{r, u[r]}, {r, 0, 1, 0.01}],
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
ur = ListLinePlot[Reverse /# table,
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{ru, ur}]
Or you can generate an inverse function to use in Plot
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
plotru = Plot[u[r], {r, 0, 1},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
Clear[t, u]
v = Quiet[InverseFunction[(1/4 Sin[t] (1 - #^2)) &]];
t = 1.57;
plotur = Plot[-v[x], {x, 0, 0.25},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{plotru, plotur}]
I found the answer to this Question using the ParametricPlot command
ParametricPlot[{(1 - r^2) /. r -> Abs[r], r}, {r, -Pi, Pi}]
The only thing that is given is that the red circle has a radius of 2 and intersects the center of the black circles.
To start you off...
x = Sqrt[2^2 + 2^2]/2;
Show[
ParametricPlot[{
{x Cos[t], x Sin[t] + 2},
{x Cos[t] + 2, x Sin[t]},
{x Cos[t], x Sin[t] - 2},
{x Cos[t] - 2, x Sin[t]}}, {t, 0, 2 Pi}],
Graphics[Line[{{2, 0}, {0, 2}}]]]
I can plot the curve corresponding to an implicit equation:
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
But I cannot find a way to color the contour line depending on the location of the point. More precisely, I want to color the curve in 2 colors, depending on whether x² + y² < k or not.
I looked into ColorFunction but this is only for coloring the region between the contour lines.
And I was not able to get ContourStyle to accept a location-dependent expression.
you could use RegionFunction to split the plot in two:
Show[{
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 < .5],
ContourStyle -> Red],
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 >= .5],
ContourStyle -> Green]
}]
Maybe something like this
pl = ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
points = pl[[1, 1]];
colorf[{x_, y_}] := ColorData["Rainbow"][Rescale[x, {-1, 1}]]
pl /. {Line[a_] :> {Line[a, VertexColors -> colorf /# points[[a]]]}}
which produces
This does not provide a direct solution to your question but I believe it is of interest.
It is possible to color a line progressively from within ContourPlot using what I think is an undocumented format, namely a Function that surrounds the Line object. Internally this is similar to what Heike did, but her solution uses the vertex numbers to then find the matching coordinates allowing styling by spacial position, rather than position along the line.
ContourPlot[
x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
BaseStyle -> {12, Thickness[0.01]},
ContourStyle ->
(Line[#, VertexColors -> ColorData["DeepSeaColors"] /# Rescale##] & ## # &)
]
For some of the less adept, less information is more. Time was wasted browsing for a way to set the color of contour lines until I chanced onto Roelig's edited answer. I just needed ContourStyle[].
Show[{ContourPlot[
x^2 + 2 x y Tan[2 # ] - y^2 == 1, {x, -3, 3}, {y, -3.2, 3.2},
ContourStyle -> Green] & /# Range[-Pi/4, Pi/4, .1]},
Background -> Black]
I have a dataset with labels which I would like to plot with points colored according to their label. Is there a simple way how to get current line numer inside plot, so that I can determine which category does the point belong to?
I understood that x,y,z are the coordinates of plotted data, but it doesn't help for the external labels.
This is quite ugly and it works just on sorted dataset with regular distribution.
data = Import["http://ftp.ics.uci.edu/pub/machine-learning-databases/iris/iris.data"];
data = Drop[data, -1]; (*there one extra line at the end*)
inData = data[[All, 1 ;; 4]];
labels = data[[All, 5]];
ListPlot3D[inData,
ColorFunction ->
Function[{x, y, z},
If[y < 0.33, RGBColor[1, 1, 0.],
If[y < 0.66, RGBColor[1, 0, 0.], RGBColor[1, 0, 1]]
]
]
]
Expected result:
Suppose that points is the lists of coordinates and labels a list of the corresponding labels so for example
points = Flatten[Table[{i, j, Sin[i j]},
{i, 0, Pi, Pi/20}, {j, 0, Pi, Pi/10}], 1];
labels = RandomChoice[{"label a", "label b", "label c"}, Length[points]];
Each label corresponds to a colour which I'm writing as a list of rules, e.g.
rules = {"label a" -> RGBColor[1, 1, 0],
"label b" -> RGBColor[1, 0, 0], "label c" -> RGBColor[1, 0, 1]};
Then the points can be plotted in the colour corresponding to their label as follows
ListPointPlot3D[Pick[points, labels, #] & /# Union[labels],
PlotStyle -> Union[labels] /. rules]
Edit
To colour individual points in a ListPlot3D you can use VertexColors, for example
ListPlot3D[points, VertexColors -> labels /. rules, Mesh -> False]
For Example:
(* Build the labeled structure and take a random permutation*)
f[x_, y_] = Sqrt[100 - x x - y y];
l = RandomSample#Flatten[{Table[{{"Lower", {x, y, f[x, y] - 5}},
{"Upper", {x, y, 5 - f[x, y]}}},
{x, -5, 5, .1}, {y, -5, 5, .1}]}, 3];
(*Plot*)
Graphics3D[
Riffle[l[[All, 1]] /. {"Lower" -> Red, "Upper" -> Green},
Point /# l[[All, 2]]], Axes -> True]
"Foveated imaging is a digital image processing technique in which the image resolution, or amount of detail, varies across the image according to one or more "fixation points." A fixation point indicates the highest resolution region of the image and corresponds to the center of the eye's retina, the fovea."
I want to use such image to illustrate humans visual acuity, The bellow diagram shows the relative acuity of the left human eye (horizontal section) in degrees from the fovea (Wikipedia) :
Is there a way to create a foveated image in Mathematica using its image processing capabilities ?
Something along the following lines may work for you. The filtering details should be adjusted to your tastes.
lena = ExampleData[{"TestImage", "Lena"}]
ImageDimensions[lena]
==> {512, 512}
mask = DensityPlot[-Exp[-(x^2 + y^2)/5], {x, -4, 4}, {y, -4, 4},
Axes -> None, Frame -> None, Method -> {"ShrinkWrap" -> True},
ColorFunction -> GrayLevel, ImageSize -> 512]
Show[ImageFilter[Mean[Flatten[#]] &, lena, 20, Masking -> mask], ImageSize -> 512]
Following on Sjoerd's answer, you can Fold[] a radius-dependent blur as follows.
A model for the acuity (very rough model):
Clear[acuity];
acuity[distance_, x_, y_, blindspotradius_] :=
With[{\[Theta] = ArcTan[distance, Sqrt[x^2 + y^2]]},
Clip[(Chop#Exp[-Abs[\[Theta]]/(15. Degree)] - .05)/.95,
{0,1}] (1. - Boole[(x + 100.)^2 + y^2 <= blindspotradius^2])]
Plot3D[acuity[250., x, y, 25], {x, -256, 256}, {y, -256, 256},
PlotRange -> All, PlotPoints -> 40, ExclusionsStyle -> Automatic]
The example image:
size = 100;
lena = ImageResize[ExampleData[{"TestImage", "Lena"}], size];
Manipulate[
ImageResize[
Fold[Function[{ima, r},
ImageFilter[(Mean[Flatten[#]] &), ima,
7*(1 - acuity[size*5, r, 0, 0]),
Masking -> Graphics[Disk[p/2, r],
PlotRange -> {{0, size}, {0, size}}]
]],
lena, Range[10, size, 5]],
200],
{{p, {size, size}}, Locator}]
Some examples:
WaveletMapIndexed can give a spatially-varying blur, as shown in the Mathematica documentation (WaveletMapIndexed->Examples->Applications->Image Processing). Here is an implementation of a foveatedBlur, using a compiled version of the acuity function from the other answer:
Clear[foveatedBlur];
foveatedBlur[image_, d_, cx_, cy_, blindspotradius_] :=
Module[{sx, sy},
{sy, sx} = ImageDimensions#image;
InverseWaveletTransform#WaveletMapIndexed[ImageMultiply[#,
Image[acuityC[d, sx, sy, -cy + sy/2, cx - sx/2, blindspotradius]]] &,
StationaryWaveletTransform[image, Automatic, 6], {___, 1 | 2 | 3 | 4 | 5 | 6}]]
where the compiled acuity is
Clear[acuityC];
acuityC = Compile[{{distance, _Real}, {sx, _Integer}, {sy, _Integer}, {x0, _Real},
{y0, _Real}, {blindspotradius, _Real}},
Table[With[{\[Theta] = ArcTan[distance, Sqrt[(x - x0)^2 + (y - y0)^2]]},
(Exp[-Abs[\[Theta]]/(15 Degree)] - .05)/.95
*(1. - Boole[(x - x0)^2 + (y - y0 + 0.25 sy)^2 <= blindspotradius^2])],
{x, Floor[-sx/2], Floor[sx/2 - 1]}, {y, Floor[-sy/2], Floor[sy/2 - 1]}]];
The distance parameter sets the rate of falloff of the acuity. Focusing point {cx,cy}, and blind-spot radius are self-explanatory. Here is an example using Manipulate, looking right at Lena's right eye:
size = 256;
lena = ImageResize[ExampleData[{"TestImage", "Lena"}], size];
Manipulate[foveatedBlur[lena, d, p[[1]], p[[2]], 20], {{d, 250}, 50,
500}, {{p, ImageDimensions#lena/2}, Locator, Appearance -> None}]
See the blind spot?