Related
I'm trying to draw lines to the intersection of two functions in Mathematica that can be manipulated with a couple variables each in the following equation:
Manipulate[
Show[
Plot[
Tooltip[QSupply + q^PriceElasticity, "Supply"], {q, 0, 150},
AxesOrigin -> {0, 0},
PlotStyle -> {Thick, Red},
AxesLabel -> {"quantity", "price"},
PlotRange -> {{0, 200}, {0, 200}},
PlotLabel -> Macroeconomy, Ticks -> {{{45, "Qe"}}, {{54.3, "Pe"}}},
BaseStyle -> {FontWeight -> "Bold", FontSize -> 12}
],
Plot[
Tooltip[(DemandElasticity/q) + QDemand, "Aggregate Demand"], {q,
0, 180},
AxesOrigin -> {0, 0},
PlotStyle -> {Thick, Blue}
],
Graphics[{Dashed, Line[{{45, 0}, {45, 54.3}}]}],
Graphics[{Dashed, Line[{{0, 54.3}, {45, 54.3}}]}]
],
{PriceElasticity, 0.6, 10},
{QSupply, -17, 55, 2},
{DemandElasticity, 500, 10000, 100},
{QDemand, 0, 150, 10}
]
I tried using the FindRoot function, but the output doesn't give a raw value (eg. {q->40.0123}. Is there a way to extract the value from the FindRoot output? Or is there a better way to go about this?
I also looked into using Mesh but it looks like that would only help draw a dot at the point of intersection.
Thanks for your help!
daList={{0.059, 0.298, 0.726, 0.735, 1.461, 2.311, 3.315},
{0.05, 0.404,0.664, 0.782, 1.376, 2.328, 3.432},
{0.087, 0.628, 0.986, 1.187,1.914, 3.481, 4.993},
{0.073, 0.594, 0.975, 1.147, 2.019, 3.417,5.037},
{0.143, 0.821, 1.442, 1.595, 2.983, 4.98, 7.604},
{0.107,0.871, 1.431, 1.684, 2.964, 5.015, 7.394}}
ListPlot[daList,
Joined -> True,
PlotRange -> {{1, 7}, {0, 7}},
PlotStyle -> {{Thick, Lighter[Red, .5]},
{Dashed, Black},
{Thick,Lighter[Red, .3]},
{Dashed, Black},
{Thick,Lighter[Red, .1]},
{Dashed, Black}},
Prolog ->{GrayLevel[0.5], EdgeForm[Thickness[.005]],
Rectangle[{1.01, 0.01}, {6.99, 6.99}]}]
As you can see, I need to assign different directive to each line.
I would like the Dashed Black Line to be Points (Joined->False).
I can`t grasp the methods to group directive for sublist yet.
Thank You for your attention.
If you want every other plot to be joined, you could just set Joined->{True, False}, e.g.
ListPlot[daList, Joined -> {True, False},
PlotRange -> {{1, 7}, {0, 7}},
PlotStyle -> {{Thick, Lighter[Red, .5]}, {Dashed, Black}, {Thick,
Lighter[Red, .3]}, {Dashed, Black}, {Thick,
Lighter[Red, .1]}, {Dashed, Black}},
Prolog -> {GrayLevel[0.5], EdgeForm[Thickness[.005]],
Rectangle[{1.01, 0.01}, {6.99, 6.99}]}]
which produces
Edit
Concerning your comment, I guess you could always plot the even and odd sets of points separately and combine them with show. So for your example:
joinedStyle = {Thick, Lighter[Red, #]} & /# {.5, .3, .1};
pointStyle = Black;
plot1 = ListPlot[daList[[1 ;; ;; 2]], Joined -> True, PlotStyle -> joinedStyle,
PlotRange -> {{1,7},{0,7}}];
plot2 = ListPlot[daList[[2 ;; ;; 2]], Joined -> False, PlotStyle -> pointStyle];
Show[plot1, plot2, PlotRange -> {{1, 7}, {0, 7}},
Prolog -> {GrayLevel[0.5], EdgeForm[Thickness[.005]],
Rectangle[{1.01, 0.01}, {6.99, 6.99}]}]
You may consider constructing your plots separately, and layering them with Show. Here is an example that hopefully is not too far from the mark.
{d1, d2} = Partition[daList, 2]\[Transpose];
lambda = {541, 550, 560, 570, 580, 590, 600};
colors = {Thick, Red~Lighter~#} & /# {0.5, 0.3, 0.1};
g1 = ListPlot[d1, Joined -> True, PlotStyle -> colors];
g2 = ListPlot[d2, PlotStyle -> {{Black, AbsolutePointSize[5]}}];
Show[{g1, g2}, PlotRange -> {{1, 7}, {0, 7}},
AspectRatio -> 1/GoldenRatio, Frame -> True, FrameStyle -> 20,
FrameTicks -> {{Automatic,
None}, {MapIndexed[{#2[[1]], #} &, lambda], Automatic}},
Prolog -> {GrayLevel[0.5], EdgeForm[Thickness[.005]],
Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]}, ImageSize -> 600]
I think I am almost copying Heike here, but it is not intentional. Hopefully both answers add something.
There is a more complete example of the use of Scaled and ImageScaled for this very application in: https://stackoverflow.com/questions/6303500/mathematica-matlab-like-figure-plot
As an alternative to ListPlot, you could consider Graphics
tdata = MapIndexed[{#2[[1]], #1} &, #] & /# daList;
and
Graphics[
{ GrayLevel[0.7], EdgeForm[AbsoluteThickness[2]],
Rectangle[{1.02, 0.05}, {7.2, 7.75}],
(*lines*)
AbsoluteThickness[2],
Transpose[{Lighter[Red, #] & /# {0.5, 0.3, 0.1},
Line#tdata[[#]] & /# {1, 3, 5}}],
(*points*)
Black, PointSize[0.016],
Point#tdata[[#]] & /# {2, 4, 6}
}, Axes -> True, PlotRange -> {{1, 7.2}, {0, 7.8}},
AspectRatio -> 1/GoldenRatio]
gives
or, to give each data set a different symbol,as in the following plot:
Code:
Graphics[
{ GrayLevel[.7], EdgeForm[AbsoluteThickness[2]],
Rectangle[{1.02, 0.05}, {7.2, 7.75}],
(*lines*)
AbsoluteThickness[2],
Transpose[{Lighter[Red, #] & /# {0.5, 0.3, 0.1},
Line#tdata[[#]] & /# {1, 3, 5}}],
(*points*)
Inset[Graphics[{EdgeForm[Black], White, Rectangle[]},
ImageSize -> 8], #] & /# tdata[[2]],
Inset[Graphics[{EdgeForm[Black], White,
Polygon[{{1, 0}, {0, Sqrt[3]}, {-1, 0}}]},
ImageSize -> 10], #] & /# tdata[[4]],
Inset[Graphics[{ EdgeForm[Black], White, Disk[]},
ImageSize -> 9], #] & /# tdata[[6]]
}, Axes -> True, PlotRange -> {{1, 7.2}, {0, 7.8}},
AspectRatio -> 1/GoldenRatio]
Please Consider :
Manipulate[Rasterize[Graphics[{
Black, Rectangle[{0, 0}, {6, 10}],
Red, Rectangle[{0, 0}, {2, L}],
Green, Rectangle[{2, 0}, {4, M}],
Blue, Rectangle[{4, 0}, {6, S}]},
ImageSize -> {200, 270},
ImageSize -> 50]],
Control#{{L, 1, Style["L", Red, Bold, 24]}, Range[10],
ControlType -> Slider, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled", ImageSize -> 200},
Control#{{M, 1, Style["M", Green, Bold, 24]}, Range[10],
ControlType -> Slider, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled", ImageSize -> 200},
Control#{{S, 1, Style["S", Blue, Bold, 24]}, Range[10],
ControlType -> Slider, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled", ImageSize -> 200}]
Can I change the Background Color : Black instead of White for example.
Why is there so much empty space on the right. I have never been able to match the slider size with the width of the Manipulate being just enveloping the graphics contained?
If you set Paneled -> False in Manipulate, it shrinks the white space around the Graphics. The remaining white can be easily set to have a different background by setting it appropriately in the Graphics[...] command. You can also style the outer panel by setting the background in the BaseStyle for Manipulate. Here's a slight modification of your code:
Manipulate[
Graphics[{Black, Rectangle[{0, 0}, {6, 10}], Red,
Rectangle[{0, 0}, {2, L}], Green, Rectangle[{2, 0}, {4, M}], Blue,
Rectangle[{4, 0}, {6, S}]}, ImageSize -> {200, 300},
Background -> LightOrange],
Control#{{L, 1, Style["L", Red, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"},
Control#{{M, 1, Style["M", Green, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"},
Control#{{S, 1, Style["S", Blue, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"}, BaseStyle -> {Background -> LightPurple},
Paneled -> False, ImageMargins -> 10]
I hadn't noticed in my previous example that the labels had moved slightly upwards. In any case, belisarius' suggestion of using ImageSize -> Small is simpler, so I've adopted it.
I think you overused the ImageSize option:
Manipulate[
Graphics[{Black, Rectangle[{0, 0}, {6, 10}], Red,
Rectangle[{0, 0}, {2, L}], Green, Rectangle[{2, 0}, {4, M}], Blue,
Rectangle[{4, 0}, {6, S}]}, ImageSize -> {200, 300}],
Control#{{L, 1, Style["L", Red, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"},
Control#{{M, 1, Style["M", Green, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"},
Control#{{S, 1, Style["S", Blue, Bold, 24]}, Range[10],
ControlType -> Slider, ImageSize -> Small, ControlPlacement -> Top,
DefaultBaseStyle -> {Bold, 16, FontFamily -> "Helvetica"},
Appearance -> "Labeled"}]
Is it possible to adjust the size/font of the TogglerBar, so that they are all equally large in case of different name size.
The example below is the solution proposed by Belisarius for : "Can TogglerBar be used as multiple CheckBox in Mathematica ?"
I would like each Button to be equally sized.
Manipulate[Graphics[
{
{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
If[MemberQ[whatToDisplay, "I am a Circle"],
{Red, Circle[{5, 5}, r]}],
If[MemberQ[whatToDisplay, "and I am a very nice Square"], {Blue,
Rectangle[{5, 5}, {r, r}]}],
If[MemberQ[whatToDisplay, "Other"], {Black,
Line[Tuples[{3, 4}, 2]]}]
},
PlotRange -> {{0, 20}, {0, 10}}
],
{{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1,
ControlType -> Slider,
ControlPlacement -> Top},
Control#{{whatToDisplay, True,
Style["What", Black, Bold, 12]}, {"I am a Circle",
"and I am a very nice Square", "Other"},
ControlType -> TogglerBar,
Appearance -> "Horizontal",
ControlPlacement -> Top}]
EDIT : It is trully ugly in the code (if we can still call that a code) but looks good on display.
Mathematica 8 introduced Overlay which allows multiple expressions to be easily overlaid atop each other. Coupled with Invisible (from v6), we have all the necessary ingredients to easily synchronize all of the button sizes without resorting to counting spaces or pixels. The following code illustrates their use, with the relevant parts emphasized:
DynamicModule[{options, allLabels, size, pad}
, options =
{ "I am a Circle" -> {Red, Circle[{5, 5}, size]}
, "and I am a very nice Square" -> {Blue, Rectangle[{5, 5}, {size, size}]}
, "Other" -> {Black, Line[Tuples[{3, 4}, 2]]}
}
; allLabels = options[[All, 1]]
; pad[label_] :=
Overlay[Append[Invisible /# allLabels, label], Alignment -> Center]
; Manipulate[
Graphics[what /. options /. size -> r, PlotRange -> {{0, 20}, {0, 10}}]
, {{r, 1, "Radius"}, 1, 5, 1}
, {{what, {}, "What"}, # -> pad[#] & /# allLabels, TogglerBar}
]
]
The definition:
pad[label_] :=
Overlay[Append[Invisible /# allLabels, label], Alignment -> Center]
defines a function that stacks all of the labels invisibly atop one another, and then puts the desired label visibly on top of that. The result is the desired label with enough whitespace on either side to accommodate any of the other labels.
The Manipulate statement uses pad to create the labels for the TogglerBar:
{{what, {}, "What"}, # -> pad[#] & /# allLabels, TogglerBar}
Note that the labels are specified in the form value -> label to allow the values to retain their original form without the Overlay and Invisible specifiers added by pad.
This is a way, although not completely satisfactory because the Panel length is not automatically calculated. Let's call it a first approach ...
Manipulate[
Graphics[{{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
If[MemberQ[whatToDisplay, "I am a Circle"], {Red, Circle[{5, 5}, r]}],
If[MemberQ[whatToDisplay, "and I am a very nice Square"],
{Blue, Rectangle[{5, 5}, {r, r}]}],
If[MemberQ[whatToDisplay, "Other"], {Black, Line[Tuples[{3, 4}, 2]]}]},
PlotRange -> {{0, 20}, {0, 10}}],
{{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1, ControlType -> Slider,
ControlPlacement -> Top},
Control#{{whatToDisplay, True, Style["What", Black, Bold, 12]},
(# -> Panel[#, ImageSize -> 150, FrameMargins -> 0,
Background -> White,
Alignment -> Center]) & /#
{"I am a Circle", "and I am a very nice Square", "Other"},
ControlType -> TogglerBar,
Appearance -> "Horizontal",
ControlPlacement -> Top}]
Edit
here you have a better approach, with automatic size calculation:
(* get the Image Size first*)
ley = {"I am a Circle", "and I am Square", "Other"};
sZ = Max[Dimensions[ImageData[Rasterize[#][[1]]]][[2]] & /# ley];
Manipulate[
Graphics[
{{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
If[MemberQ[whatToDisplay, "I am a Circle"],
{Red, Circle[{5, 5}, r]}],
If[MemberQ[whatToDisplay, "and I am a very nice Square"],
{Blue, Rectangle[{5, 5}, {r, r}]}],
If[MemberQ[whatToDisplay, "Other"],
{Black, Line[Tuples[{3, 4}, 2]]}]},
PlotRange -> {{0, 20}, {0, 10}}],
(*Controls Follow *)
{{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1,
ControlType -> Slider,
ControlPlacement -> Top },
Control#{{whatToDisplay, True, Style["What", Black, Bold, 12]},
(# -> Panel[#, ImageSize -> sZ,
FrameMargins -> 0,
Background -> White,
Alignment -> Center]) & /# ley,
ControlType -> TogglerBar,
Appearance -> "Horizontal",
ControlPlacement -> Top}]
Mathematica may have an option somewhere to do this, but I don't know it. So, here is a proposed solution:
First, this pads a string left and right so that it is of length n:
Clear[strpad];
strpad[str_String, n_] := Module[
{strlength, exc, excr},
strlength = StringLength#str;
exc = Floor[(n - strlength)/2];
excr = n - strlength - exc;
StringJoin[
Table[" ", {i, exc}],
str,
StringJoin[Table[" ", {i, excr}]]]]
Then, modify your program so that either you use these padded strings or add a Rule[#, strpad[#, 30]] & /# immediately before {"I am a Circle", "and I am a very nice Square", "Other"}, so that your code becomes
Manipulate[
Graphics[{{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
If[MemberQ[whatToDisplay, "I am a Circle"], {Red,
Circle[{5, 5}, r]}],
If[MemberQ[whatToDisplay, "and I am a very nice Square"], {Blue,
Rectangle[{5, 5}, {r, r}]}],
If[MemberQ[whatToDisplay, "Other"], {Black,
Line[Tuples[{3, 4}, 2]]}]},
PlotRange -> {{0, 20}, {0, 10}}], {{r, 1,
Style["Radius", Black, Bold, 12]}, 1, 5, 1, ControlType -> Slider,
ControlPlacement -> Top},
Control#{{whatToDisplay, True, Style["What", Black, Bold, 12]},
Rule[#, strpad[#, 30]] & /# {"I am a Circle", "and I am a very nice Square", "Other"},ControlType -> TogglerBar, Appearance -> "Horizontal",
ControlPlacement -> Top}]
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]