Locator goes out of the graph region - wolfram-mathematica

When I run the following code
pMin = {-3, -3};
pMax = {3, 3};
range = {pMin, pMax};
Manipulate[
GraphicsGrid[
{
{Graphics[Locator[p], PlotRange -> range]},
{Graphics[Line[{{0, 0}, p}]]}
}, Frame -> All
],
{{p, {1, 1}}, Locator}
]
I expect the Locator control to be within the bounds of the first Graph, but instead it can be moved around the whole GraphicsGrid region. Is there an error in my code?
I also tried
{{p, {1, 1}}, pMin, pMax, Locator}
instead of
{{p, {1, 1}}, Locator}
But it behaves completely wrong.
UPDATE
Thanks to everyone, this is my final solution:
Manipulate[
distr1 = BinormalDistribution[p1, {1, 1}, \[Rho]1];
distr2 = BinormalDistribution[p2, {1, 1}, \[Rho]2];
Grid[
{
{Graphics[{Locator[p1], Locator[p2]},
PlotRange -> {{-5, 5}, {-5, 5}}]},
{Plot3D[{PDF[distr1, {x, y}], PDF[distr2, {x, y}]}, {x, -5, 5}, {y, -5, 5}, PlotRange -> All]}
}],
{{\[Rho]1, 0}, -0.9, 0.9}, {{\[Rho]2, 0}, -0.9, 0.9},
{{p1, {1, 1}}, Locator},
{{p2, {1, 1}}, Locator}
]
UPDATE
Now the problem is that I cannot resize and rotate the lower 3d graph. Does anyone know how to fix that?
I'm back to the solution with two Slider2D objects.

If you examine the InputForm you'll find that GraphicsGrid returns a Graphics object. Thus, the Locator indeed moves throughout the whole image.
GraphicsGrid[{{Graphics[Circle[]]}, {Graphics[Disk[]]}}] // InputForm
If you just change the GraphicsGrid to a Grid, the locator will be restricted to the first part but the result still looks a bit odd. Your PlotRange specification is a bit strange; it doesn't seem to correspond to any format specified in the Documentation center. Perhaps you want something like the following.
Manipulate[
Grid[{
{Graphics[Locator[p], Axes -> True,
PlotRange -> {{-3, 3}, {-3, 3}}]},
{Graphics[Line[{{0, 0}, p}], Axes -> True,
PlotRange -> {{-3, 3}, {-3, 3}}]}},
Frame -> All],
{{p, {1, 1}}, Locator}]

LocatorPane[] does a nice job of confining the locator to a region.
This is a variation on the method used by Mr. Wizard.
Column[{ LocatorPane[Dynamic[pt3],
Framed#Graphics[{}, ImageSize -> 150, PlotRange -> 3]],
Framed#Graphics[{Line[{{-1, 0}, Dynamic#pt3}]}, ImageSize -> {150, 150},
PlotRange -> 3]}]
I would have assumed that you'd want the locator to share the space with the line it controls. In fact, to be "attached" to the line. This turns out to be even easier to implement.
Column[{LocatorPane[Dynamic[pt3],Framed#Graphics[{Line[{{-1, 0}, Dynamic#pt3}]},
ImageSize -> 150, PlotRange -> 3]]}]

I am not sure what you are trying to achieve. There are a number of problems I see, but I don't know what to address. Perhaps you just want a simple Slider2D construction?
DynamicModule[{p = {1, 1}},
Column#{Slider2D[Dynamic[p], {{-3, -3}, {3, 3}},
ImageSize -> {200, 200}],
Graphics[Line[{{0, 0}, Dynamic[p]}],
PlotRange -> {{-3, 3}, {-3, 3}}, ImageSize -> {200, 200}]}]
This is a reply to the updated question about 3D graphic rotation.
I believe that LocatorPane as suggested by David is a good way to approach this. I just put in a generic function since your example would not run on Mathematica 7.
DynamicModule[{pt = {{-1, 3}, {1, 1}}},
Column[{
LocatorPane[Dynamic[pt],
Framed#Graphics[{}, PlotRange -> {{-5, 5}, {-5, 5}}]],
Dynamic#
Plot3D[{x^2 pt[[1, 1]] + y^2 pt[[1, 2]],
-x^2 pt[[2, 1]] - y^2 pt[[2, 1]]},
{x, -5, 5}, {y, -5, 5}]
}]
]

Related

Manipulate an image mathematica

I'm having trouble making an image move left to right in mathematica.
I have the manipulate for a point,
(*Rook Movement*)
Manipulate[
Graphics[Translate[Point[{0, 0}], {t, t2}], Axes -> True,
PlotRange -> {{0, 8}, {0, 8}}], {t, 0, 8}, {t2, 0, 8}]
I also have an image defined as "rook".
How do I replace the Point with my image of a rook?
Thanks!
img = ExampleData[{"TestImage", "F16"}];
Manipulate[
Graphics[Inset[img, {t, t2}], Axes -> True,
PlotRange -> {{0, 8}, {0, 8}}], {t, 0, 8}, {t2, 0, 8}]

How to output custom polygon coordinates in Mathematica?

I am trying to make either a nested manipulate or just a manipulate with two windows: I need one window which functions as:
Manipulate[Graphics[Polygon[pt],
PlotRange -> 2], {{pt, {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1, -1}}},
Locator, LocatorAutoCreate -> True}]
but outputs its coordinates to another window which uses these coordinates to plot a specified graph. I am not sure if Manipulate is even the best option for this, but essentially I am trying to make a visual interface where a user can specify a polygon and then the program uses the information of those coordinates to plot a specified 3D plot.
I think I could figure out how to do this if I knew how to output the coordinates from the manipulate or how to make something that does.
For Example:
GraphicsRow[{
Manipulate[
Graphics[Polygon[rs = pt], PlotRange -> 2],
{{pt, {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1, -1}}},
Locator, LocatorAutoCreate -> True}],
Dynamic#
ParametricPlot3D[Through[(Interpolation /#
First#(Transpose /# {Append[#, 0] & /# rs}))[t]], {t, 1, Length#rs},
PlotRange -> 2]}]

Plot, plane, point, line, sphere in same 3D plot. Multiple figures in same plot in Mathematica

How do I plot for example a plane and a line in same 3D plot?
Show and Plot3D can handle it. There are probably many other ways.
l = Line[{{-2, -2, 41}, {6, 4, -10}}];
Show[{Plot3D[{2 x + 7 y}, {x, -2, 5}, {y, -2, 5}, AxesLabel -> {x, y, z}],
Graphics3D[{Thick, l}]}]
I couldn't resist either...
GraphicsGrid[
{
{ContourPlot3D[x + 2 y + 3 z , {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
Contours -> {0}, Axes -> None, ColorFunction -> (White &),
Lighting -> "Neutral"],
Style["One plane", FontFamily -> "Comic Sans MS", 36, Bold]},
{ContourPlot3D[x + 2 y + 3 z , {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
Contours -> {0, 5}, Axes -> None, ColorFunction -> (Green &),
Lighting -> "Neutral"],
Style["Two plane", FontFamily -> "Comic Sans MS", 36, Bold]},
{ContourPlot3D[x + 2 y + 3 z , {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
Contours -> {0}, Axes -> None, ColorFunction -> (Red &),
Lighting -> "Neutral"],
Style["Red plane", FontFamily -> "Comic Sans MS", 36, Bold]},
{Show[
ContourPlot3D[x + 2 y + 3 z , {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
Contours -> {0}, Axes -> None, ColorFunction -> (Blue &),
Lighting -> "Neutral"],
Graphics3D[{Orange, Thickness[0.01],
Line[{{-2, -2, -2}, {2, 2, 2}}]}]
], Style["Blue plane", FontFamily -> "Comic Sans MS", 36, Bold]}
}
]
Just showing off:
Manipulate[
Show[
{Plot3D[ {1}, {x, -1, 1}, {y, -1, 1}, PlotRange -> {-1, 1}, Mesh -> False],
Plot3D[{-1}, {x, -1, 1}, {y, -1, 1}, Mesh -> False],
ParametricPlot3D[{{Sin#t, Cos#t, 1}, {Sin#t, Cos#t, -1}}, {t, 0, 2 Pi}],
Graphics3D[
{Table[{Hue[n/10], Thick, Line[{{Re[#], Im[#], 1}, {-z Re[#], -z Im[#], z}}&#
Exp[n 2 I Pi/10]]}, {n, 10}],
Sphere[{0, 0, 0}, .3]}]}],
{z, 1, -1}]

Is there a way to draw a set of lines in mathematica all with the same origin point?

I have a set of points given by this list:
list1 = {{3, 1}, {1, 3}, {-1, 2}, {-1, -1}, {1, -2}};
I would like Mathematica to draw a line from the origin to all the points above. In other words draw vectors from the origin (0,0) to all the individual points in the above set. Is there a way to do this? So far I've tried the Filling option, PlotPoints and VectorPlot but they don't seem to be able to do what I want.
Starting easy, and then increasing difficulty:
Graphics[{Arrow[{{0, 0}, #}] & /# list1}]
Graphics[{Arrow[{{0, 0}, #}] & /# list1}, Axes -> True]
Needs["PlotLegends`"];
list1 = {{3, 1}, {1, 3}, {-1, 2}, {-1, -1}, {1, -2}};
k = ColorData[22, "ColorList"][[;; Length#list1]];
GraphicsRow[{
Graphics[Riffle[k, Arrow[{{0, 0}, #}] & /# #], Axes -> True],
Graphics#Legend[Table[{k[[i]], #[[i]]}, {i, Length##}]]}] &#list1
Needs["PlotLegends`"];
list1 = {{3, 1}, {1, 3}, {-1, 2}, {-1, -1}, {1, -2}};
k = ColorData[22, "ColorList"][[;; Length#list1]];
ls = Sequence[Thick, Line[{{0, 0}, {1, 0}}]];
GraphicsRow[{
Graphics[Riffle[k, Arrow[{{0, 0}, #}] & /# #], Axes -> True],
Graphics#Legend[MapThread[{Graphics[{#1, ls}], #2} &, {k, #}]]}] &#list1
Needs["PlotLegends`"];
list1 = {{3, 1}, {1, 3}, {-1, 2}, {-1, -1}, {1, -2}};
pr = {Min##, Max##} & /# Transpose#list1;
k = ColorData[22, "ColorList"][[;; Length#list1]];
GraphicsRow[{
Graphics[r = Riffle[k, {Thick,Arrow[{{0, 0}, #}]} & /# #], Axes -> True],
Graphics#
Legend[MapThread[
{Graphics[#1, Axes -> True, Ticks -> None, PlotRange -> pr],
Text#Style[#2, 20]} &,
{Partition[r, 2], #}]]}] &#list1
You could also tweak ListVectorPlot, although I don't see why you should do it, as it is not intended to use like this:
list1 = {{3, 1}, {1, 3}, {-1, 2}, {-1, -1}, {1, -2}};
data = Table[{i/2, -i/Norm[i]}, {i, list1}];
ListVectorPlot[data, VectorPoints -> All,
VectorScale -> {1, 1, Norm[{#1, #2}] &},
VectorStyle -> {Arrowheads[{-.05, 0}]}]
Graphics[
{
Line[{{0, 0}, #}] & /# list1
}
]
where /# is the shorthand infix notation for the function Map.
I wonder why you tried Filling, Plotpoints and VectorPlot. I must assume you haven't read the documentation at all, because even a superficial reading would tell you that those commands and options have nothing to do with the functionality you're looking for.

How to make a grid of plots with a single pair of FrameLabels?

What is the simplest way to create a row/column/grid of plots, with the whole grid having a single FrameLabel?
I need something similar to this:
p := ListPlot[RandomInteger[10, 5], Joined -> True, Axes -> False,
Frame -> True, PlotRange -> {0, 11},
FrameLabel -> {"horizontal", None}, AspectRatio -> 1]
GraphicsRow[{Show[p, FrameLabel -> {"horizontal", "vertical"}], p, p}]
For a row format, it could have one or multiple horizontal labels, but only one vertical one.
Issues to consider:
Vertical scale must match for all plots, and must not be ruined by e.g. a too long label or automatic PlotRangePadding.
Good (and resize-tolerant!) control of inter-plot spacing is needed (after all, this is one of the motivations behind removing the redundant labels)
General space-efficiency of the arrangement. Maximum content, minimum (unnecessary) whitespace.
EDIT
I'm trying to be able to robustly create print ready figures, which involves a lot of resizing. (Because the exported PDFs will usually not have the same proportions as what I see in the notebook, and must have readable but not oversized fonts)
You can use LevelScheme to achieve what you want. Here's an example:
<< "LevelScheme`"
Figure[{
Multipanel[{{0, 1}, {0, 1}}, {1, 3},
XFrameLabels -> textit["x"], BufferB -> 3,
YFrameLabels -> textit["Sinc(x)"], BufferL -> 3,
TickFontSize -> 9,
XGapSizes -> {0.1, 0.1},
PanelLetterCorner -> {1, 1}
],
FigurePanel[{1, 1}, PlotRange -> {{-1.6, -0.6}, {-0.5, 1}}],
RawGraphics[Plot[Sinc[20 x], {x, -1.6, -0.6}]],
FigurePanel[{1, 2}, PlotRange -> {{-0.5, 0.5}, {-0.5, 1}}],
RawGraphics[Plot[Sinc[20 x], {x, -0.5, 0.5}]],
FigurePanel[{1, 3}, PlotRange -> {{0.6, 1.6}, {-0.5, 1}}],
RawGraphics[Plot[Sinc[20 x], {x, 0.6, 1.6}]]
},
PlotRange -> {{-0.1, 1.02}, {-0.12, 1.095}}]
LevelScheme offers you tremendous flexibility in the arrangement of your plot.
Instead of naming giving the plot common labels, you can move the definition inside the FigurePanel[] and control the labels for each one individually.
You can set inter-plot spacings both in the X and Y directions and also change the sizes of each panel, for e.g., the left one can take up 2/3 of the space and the next two just 1/6 of the space each.
You can set individual plot ranges, change the frame tick labels for each, control which side of the panel (top/bottom/l/r) the labels should be marked, change panel numberings, etc.
The only drawback is that you might have to wrestle with it in some cases, but in general, I've found it a pleasure to use.
EDIT
Here's one similar to your example:
Figure[{
Multipanel[{{0, 1}, {0, 1}}, {1, 3},
YFrameLabels -> textit["Vertical"], BufferL -> 3,
TickFontSize -> 9,
XGapSizes -> {0.1, 0.1},
PanelLetterCorner -> {1, 1}
],
FigurePanel[{1, 1}, PlotRange -> {{1, 10}, {0, 10}}],
RawGraphics[ListLinePlot[RandomInteger[10, 10]]],
FigurePanel[{1, 2}, PlotRange -> {{1, 10}, {0, 10}},
LabB -> textit["Horizontal"], BufferB -> 3],
RawGraphics[ListLinePlot[RandomInteger[10, 10]]],
FigurePanel[{1, 3}, PlotRange -> {{1, 10}, {0, 10}}],
RawGraphics[ListLinePlot[RandomInteger[10, 10]]]
},
PlotRange -> {{-0.1, 1.02}, {-0.2, 1.095}}]
EDIT 2
To answer Mr. Wizard's comment, here's a blank template for a 2x3 grid
Figure[{Multipanel[{{0, 1}, {0, 1}}, {2, 3},
XFrameTicks -> None,
YFrameTicks -> None,
XGapSizes -> {0.1, 0.1},
YGapSizes -> {0.1}],
FigurePanel[{1, 1}],
FigurePanel[{1, 2}],
FigurePanel[{1, 3}],
FigurePanel[{2, 1}],
FigurePanel[{2, 2}],
FigurePanel[{2, 3}]
}, PlotRange -> {{-0.01, 1.01}, {-0.01, 1.01}}]
And here's one with extended panels
Figure[{Multipanel[{{0, 1}, {0, 1}}, {2, 3},
XFrameTicks -> None,
YFrameTicks -> None,
XGapSizes -> {0.1, 0.1},
YGapSizes -> {0.1}],
FigurePanel[{1, 1}, PanelAdjustments -> {{0, 0}, {1.1, 0}}],
FigurePanel[{1, 2}],
FigurePanel[{1, 3}],
FigurePanel[{2, 2}, PanelAdjustments -> {{0, 1.1}, {0, 0}}]
}, PlotRange -> {{-0.01, 1.01}, {-0.01, 1.01}}]
You already know how to handle multiple horizontal labels through ListPlot.
You can get single labels by using Panel. For example...
p := ListPlot[RandomInteger[10, 5], Joined -> True, Axes -> False,
Frame -> True, PlotRange -> {0, 11}, AspectRatio -> 1]
Panel[GraphicsRow[{p, p, p}], {"horizontal",Rotate["vertical", Pi/2]},
{Bottom, Left}, Background -> White]
You can optionally include labels on Top and Right edges too.
Here is one option I just put together. Its advantage is that it is simple.
I like the look of yoda's LevelScheme plots better, assuming those can be done for a grid as well.
p := ListPlot[RandomInteger[10, 5], Joined -> True, Axes -> False,
Frame -> True, PlotRange -> {0, 11}, AspectRatio -> 1]
gg = GraphicsGrid[{{p, p, p}, {p, p, p}, Graphics /# Text /# {"Left", "Center", "Right"}},
Spacings -> 5, ItemAspectRatio -> {{1, 1, 0.15}}];
Labeled[gg, Rotate["vertical", Pi/2], Left]

Resources