Related
I would like to have the vertical arrangement of colors in stacked bars match the arrangement of colors in the chart legend. But no matter what I try, they don't match. Here's the situation
BarChart[{{5, 37, 56}, {22, 49, 28}, {31, 60, 10}},
ChartLayout -> "Percentile",
ChartLegends -> Placed[{"1-Volume", "2-Area", "3-Length"}, Right],
ChartLabels -> {{"Before", "During", "After"}, None}]
In the real-world example the legend has quite a few more entries (6), so it would be nice if the order of the legend colors matched the order in the bars. I realize that I could set the ChartLegends to display at Bottom, but doesn't look good given the many legend entries.
Also, reversing the Legends list does not work as desired. The text of the legends was re-ordered, but the colors were not reordered (see below), so the legend captions no longer match the data in the chart.
Changing the order of the data (or the data and the legend items) does not work either.
Any suggestions?
BarChart[{{5, 37, 56}, {22, 49, 28}, {31, 60, 10}},
ChartLayout -> "Percentile",
ChartLegends -> {"1-Volume", "2-Area", "3-Length"},
ChartLabels -> {{"Before", "During", "After"}, None}] /.
Column[List[a : Grid[List[___]] ..]] :> Column[Reverse#List#a]
Edit
Remember to use FullForm when you want to mess up with Graphics/Chart/Plot internals
Building on the nice answer given by Belisarius, an alternative method using Part
bc[[2,1,1,1]]= Reverse#bc[[2,1,1,1]];bc
This may be inferred from FullForm and
Position[bc, #, Infinity]& /# {Framed[___],
Column[___],List[___,"1-Volume",___]}
or from any one of these, perhaps, and trial-and-error.
Although not part of the question, Simon's trick (see here) may be used to further manipulate the legend.
bc/.Labeled[g_,Framed[leg_],pos_]:>
Labeled[g,Framed[leg,FrameStyle->Orange,RoundingRadius->10,
Background->LightYellow],pos]
for example, gives the following:
Part may also be used to remove the frame around the legend (see this question)
but Simon's method is much more versatile.
bc[[2]]=bc[[2,1]];bc
You can use LegendContainer for this.
SetOptions[Legending`GridLegend,
Legending`LegendContainer -> (Framed#MapAt[Reverse, #, {1, 1}] &)];
BarChart[{{5, 37, 56}, {22, 49, 28}, {31, 60, 10}},
ChartLayout -> "Percentile",
ChartLegends -> {"1-Volume", "2-Area", "3-Length"},
ChartLabels -> {{"Before", "During", "After"}, None}]
I'm in the process of creating a notebook that contains a style to write documents. I would like Mathematica to behave similar to LaTeX in the sense that when I write a "Definition" cell then it will write "Definition [Chapter#].[Definition#]".
To see what I mean do the following. In an empty notebook create a cell and modify the style to "Chapter". You can do this by selecting the cell and the going to Format->Style->Other, enter "Chapter".
Now go to Format->Edit StyleSheet.... Enter Chapter in the input box. This will generate a cell labeled Chapter. Select that cell, and click on Cell->Show Expression. At this point select all that text that you see there and replace it with the following:
Cell[StyleData["Chapter"],
CellFrame->{{0, 0}, {0, 0}},
ShowCellBracket->Automatic,
CellMargins->{{42, 27}, {10, 30}},
CounterIncrements->"Chapter",
CounterAssignments->{{"Section", 0}, {"Definition", 0}},
FontFamily->"Verdana",
FontSize->24,
FontWeight->"Bold",
CellFrameLabels->{{
Cell[
TextData[{
"Chapter ",
CounterBox["Chapter"]
}], "ChapterLabel", CellBaseline -> Baseline], Inherited}, {
Inherited, Inherited}},
FontColor->RGBColor[0.641154, 0.223011, 0.0623026]]
This will change the style of how a chapter cell is displayed. I changed the color and font. The most important thing to me is the CellFrameLabels. Noticed that I have made it so that every time you create a chapter cell it will display: Chapter [Chapter Number].
In the picture above I have created several chapter cells and I have added the text: ": Title of Chapter #".
This is simple enough, we can create any cell, apply a definition and take advantange of counters to label the cells.
I have noticed how some books have definitions enclosed in box. So in this case I would like to create a box that contains Definition. Here is my lame attempt with the definition of the cell "Definition".
Cell[StyleData["Definition"],
CellFrame->{{0, 0}, {0, 2}},
ShowCellBracket->Automatic,
CellMargins->{{27, 27}, {0, 8}},
PageBreakWithin->False,
CellFrameMargins->16,
CellFrameColor->RGBColor[0.641154, 0.223011, 0.0623026],
Background->RGBColor[0.963821, 0.927581, 0.844465],
FontFamily->"Verdana",
CounterIncrements->"Definition",
FontSize->12,
CellFrameLabels->{{
Cell[
TextData[{
"Definition ",
CounterBox["Chapter"], ".",
CounterBox["Definition"]
}], "DefinitionLabel", CellBaseline -> Baseline], Inherited}, {
Inherited, Inherited}},
]
Here is how it looks in the notebook:
Here is the question: Is there a way to make the CellFrameLabels part of the cell? I want the label to have the same background and to be inline with the other text. Here is a screen shot of how I want it to look:
I have made the "label" bold font and blue. This is something that the user should not be able to modify.
I don't think that it's possible to do in the way you want. CellLabels can only be text, while both CellDingbat and CellFrameLabels can be arbitrary cell expressions.
Both CellDingbat -> ... and CellFrameLabels -> {{...,None},{None,None}} work if the cell is only a single line long. But do not automatically resize for multiple line cells (at least as far as I could tell). For example:
Cell["Abcdefg", "Text",
CellFrame->{{0, 1}, {0, 2}},
CellMargins->{{30, 24}, {6, 6}},
CellFrameMargins->0,
CellFrameColor->RGBColor[0, 0, 1],
CellFrameLabels->{{Cell[" Definition 1.1 ", "Text",
CellFrame -> {{2, 0}, {0, 2}}, CellFrameMargins -> 0], None}, {None, None}},
CellFrameLabelMargins->0,
Background->RGBColor[0, 1, 1]]
Putting a CellFrameLabel on the top does not have this problem, but I don't know how to align it to the left...
Cell["Abcde", "Text",
CellFrame->{{1, 1}, {0, 2}},
CellMargins->{{30, 24}, {6, 6}},
CellFrameMargins->0,
CellFrameColor->RGBColor[0, 0, 1],
CellFrameLabels->{{None, None}, {None,
Cell[" Definition 1.1 ", "Text",
CellFrame -> {{2, 2}, {0, 2}}, CellFrameMargins -> 0]}},
CellFrameLabelMargins->0,
Background->RGBColor[0, 1, 1]]
I think that maybe the best looking solution would be to include the "Definition ch.def:" in the cell contents.
Cell[TextData[{
Cell["Definition 1.1: ", Editable->False, Selectable->False, Deletable->False],
"Abcdefg"}], "Text",
CellFrame->{{1, 1}, {0, 2}},
CellMargins->{{30, 24}, {6, 6}},
CellFrameColor->RGBColor[0, 0, 1],
Background->RGBColor[0, 1, 1]]
Make it so that it's not deletable by the average user and it is probably almost as good as a cell(frame)label. It can include counters so that it automatically shows the correct numbering. The only problem is that it does not appear automatically, but if you just copy a pre-existing cell, then that's not too much of a problem.
Edit: Adding an input alias that creates the non-deletable counter
First we get the current input aliases,
oldAliases = InputAliases /. Options[EvaluationNotebook[], InputAliases];
then replace any existing alias EscdefEsc with our new one:
newAliases =
Append[DeleteCases[oldAliases, "def" -> _],
"def" -> Cell[TextData[
RowBox[StyleBox[#, FontWeight->"Bold", FontColor->Blue]&/#{"Definition ",
CounterBox["Chapter"], ".", CounterBox["Definition"], ": "}]],(*"Text",*)
Editable -> False, Selectable -> False, Deletable -> False]];
SetOptions[EvaluationNotebook[], InputAliases -> newAliases]
Since I don't have your style sheet, I need to set a couple of counters:
CellPrint[Cell["Setting the counters", "Text",
CounterAssignments -> {{"Chapter", 2}, {"Definition", 3}}]]
Now I can use the alias in an existing cell - it inherits the styling of the parent cell (unless otherwise specified):
Another option is to make a palette to go with your stylesheet. This would be useful since there's only a limited number of MenuCommandKey values that you can use for your new styles (n.b. overwriting the default ones will just confuse people). See this answer for an example of such a palette.
I am trying to plot multiple lists in the same plot in Mathematica (ListLinePlot) and use PlotMarkers and the PlotLegend Package to get the final figure. The issue is that Mathematica puts a marker for every point and this makes it hard to tell which marker is where in the plot. Is it possible to have a plot marker appear every n sample (e.g. every 10 points for a 100 point plot).
The Directive at the moment is PlotMarkers->{Automatic, Small}.
I think adding something like Mesh->10 should work for you:
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 10]
If you want more control over the location of the plot markers than Brett's answer gives you, then you probably have to place the markers manually. Eg (modifying Brett's example)
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
col = {Red, Blue, Green};
decimate[i_] := {col[[i]], PointSize -> Medium,
Point /# Transpose[{Range[1, 100, 10], data[[i, 1 ;; -1 ;; 10]]}]}
ListLinePlot[data, PlotStyle -> col, Epilog -> Table[decimate[i], {i, 3}]]
Of course Point can be replaced with any graphics object you want - eg Text, Inset etc...
Also remember you can use Tooltip to cause the marker coordinates to pop up when you pass the mouse pointer over it:
The example of what I was describing in the comment. The markers don't behave properly.
Apparently I cannot post images yet, but running the following code
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 5]
should give improper results. Also the number of data and plots in the same figure is quite large to individually select which points and I would like to keep the same Directives for different plots and data ranges as they tend to vary between 100 to around 300 in each case and I have to save them in different tables as they are used in other calculations along the way.
Plot Posted by belisarius, running the code above
I have a graph as a result of executing ListPlot[] function.
I can manually edit this graph by moving points to a different location
and also adding new points using the Drawing Tools.
How do I get the coordinates of new and changed points from the edited graphics?
I'm not sure if the following is anything like what you want,but nevertheless:
If I use ListPlot as follows:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}], "lp1"];
By double clicking on one of the red points twice to get the selection to the level of the points, I can then move the individual points, e.g., to make the points lie on a curve (rather than a straight line). I now want to extract these points (and say use them in a new ListPlot) [see plots below]
If I click on the bracket of the plot graphic and use "Show Expression" (Command Shift E on a Mac), I can 'see' the coordinates of the modified points which may then be extracted. For example:
expr = Cell[
BoxData[GraphicsBox[{RGBColor[1, 0, 0], PointSize[Large],
PointBox[{{0., 1.}, {0.8254488458250212,
2.886651181634783}, {1.9301795383300084`,
3.925201233010209}, {3.046546974446661,
4.597525796319094}, {4., 5.}}]},
AspectRatio -> NCache[GoldenRatio^(-1), 0.6180339887498948],
Axes -> True, PlotRange -> Automatic,
PlotRangeClipping -> True]], "Input",
CellChangeTimes -> {{3.504427833788156*^9, 3.50442786823486*^9}}];
Modifying a very useful approach originally suggested by Yaroslav Bulatov, which may be found here
modpoints = Flatten[Cases[expr, PointBox[___], Infinity][[All, 1]], {{2, 1}}]
EDIT
As pointed out by belisarius, it is desirable to be able to extract 'manually' added points (which may be added to the generated plot using 'point' from the Drawing Tools palette). A better way of extracting (after 'Show Expression' ...) is probably the following:
modpoints = Cases[Cases[expr, PointBox[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Of course, 'Show Expression' is not the only approach.
InputForm is another possibility. For example,
expr2 = InputForm[ListPlotGraphic]
modpoints = Cases[Cases[expr, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
where "ListPlotGraphic" is the modified graphic (inserted by 'copy and paste'), will also work.
Example plots
Addendum
The above can be automated with a little notebook programming:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}],
Button["Print points",
With[{nb = ButtonNotebook[]},
SelectionMove[nb, All, CellContents];
Print[Cases[NotebookRead[nb],
PointBox[{{_?NumericQ, _?NumericQ} ..}] |
PointBox[{_?NumericQ, _?NumericQ}], Infinity]]]]]
Running the above, moving the last two original (red) points and adding a couple of extra points in blue with the drawing tools then pressing the button yields
You can see that there is a single PointBox for the original data and a new PointBox for each of the added points. Of course, by modifying the above code, you can do more than simply print out the raw point coordinates.
This approach makes every data point a locator that can be moved. New locators can be added and old ones deleted as appropriate. The best fit and variance are updated after every change.
Here's some data of some exponential growth with some errors and a data point missing
data = Delete[Table[{t, (1 + RandomReal[{-.2, .2}])Exp[t]}, {t, 0, 2, .2}], 6];
A little formatting command:
nForm = NumberForm[#, {2, 2}, NumberPadding -> {"", "0"}] &;
Finally, here's the code to make the manipulable graphics. New locators/data points are added using Alt-Click (or Ctrl-Alt-Click on linux). If you click on the list of points on the left, then a new window is opened containing the points in input form.
Manipulate[
LocatorPane[Dynamic[pts, {None, Temporary, Automatic}],
nlm = Block[{a,b,t}, NonlinearModelFit[Sort[pts], a Exp[t] + b, {a, b}, t]];
Show[Plot[{Exp[t], nlm[t]}, {t, 0, 2},
PlotStyle -> {{Thick, LightGray}, Dotted}, PlotRangePadding -> Scaled[0.1]],
ListPlot[data, PlotStyle -> Blue], AxesLabel -> Block[{t,f}, {t, f[t]}]],
LocatorAutoCreate -> True, Appearance -> Style["\[CircleDot]", Red]],
{nlm, None}, {{pts, data}, None},
Dynamic[Pane[EventHandler[
nForm#Grid[Prepend[pts, {"x", "y"}], Dividers -> {False, 2 -> True}],
{"MouseClicked" :> (CreateDocument[{ExpressionCell[nlm["Data"], "Output"]},
WindowTitle -> "Data"])}], ImageSize -> {100, 250},
ImageSizeAction -> "Scrollable", Scrollbars -> {False, True}]],
Pane[Dynamic[nForm#Row#{nlm,Row[{"\tvariance = ",nlm["EstimatedVariance"]}]}]],
ControlPlacement -> {Left, Left, Left, Top}]
In the above I've used the locators to correct a couple of outliers and restored the missing data point.
The easy option is to use the "Get Coordinates" menu option. If you right click on the graphic, in the pop-up menu you'll see "Get Coordinates" which allows you to mouse-over a point and see that point's coordinates. Of course this isn't going to be accurate... but the way you're editing the graphic isn't very accurate either.
You could use the InputForm (or FullForm) function, but I am not sure how well this works...
In[1]:= a = ListPlot[{{1, 0}, {0, 1}, {1, 1}}];
a // InputForm
Out[2]//InputForm=
Graphics[{{{}, {Hue[0.67, 0.6, 0.6], Point[{{1., 0.}, {0., 1.}, {1., 1.}}]},
{}}}, {AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{0., 1.}, {0., 1.}}, PlotRangeClipping -> True,
PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]
You'll notice that there's a Point expression in there.
The third option would be to use Locator in some way I guess.
Given Graphics object, how do I determine the range of coordinates needed to include all of graphics? Basically I need something like what Show does by default, but I want to specify PlotRange,PlotRangePadding and ImagePadding explicitly.
Example, two Shows below should render the same
g = Graphics[{Thickness[1], CapForm["Round"], Line[{{0, 0}, {1, 1}}]}];
Show[g]
Show[g, PlotRange -> getPlotRange[g], PlotRangePadding->getPlotRangePadding[g], ImagePadding->getImagePadding[g]]
Motivation: fixing diagrams in this question
Update:
AbsoluteOptions gives me PlotRange but not the other two options. Explicitly specifying ImagePadding->Automatic changes appearance though it's supposedly Automatic by default.
Two images below show differently and I don't understand why
g = Graphics[{Thickness[1], CapForm["Round"], Line[{{0, 0}, {1, 1}}]}];
Show[g]
Show[g, Sequence ## AbsoluteOptions[Show[g]]]
Update 2:
A similar problem was brought up a year ago, with no solutions proposed, and not fixed as of Mathematica 8.0. To summarize
There's no way to reproduce Show[g] above with explicit setting of PlotRange
There's no way to get absolute ImagePadding used by Show[g]
Show[g,PlotRange->Automatic] looks different from Show[g]
AbsoluteOptions can give the wrong result for PlotRange
I can suggest the following Ticks hack:
pl = Plot[Sin[x], {x, 0, 10}];
Reap[Rasterize[Show[pl, Ticks -> {Sow[{##}] &, Sow[{##}] &}, ImageSize -> 0],
ImageResolution -> 1]][[2, 1]]
=> {{-0.208333, 10.2083}, {-1.04167, 1.04167}}
The trick is that real PlotRange is determined by the FrontEnd, not by the Kernel. So we must force the FrontEnd to render the graphics in order to get tick functions evaluated. This hack gives the complete PlotRange with explicit value of PlotRangePadding added.
More general solution taking into account a possibility that pl has non-standard value of DisplayFinction option and that it may have Axes option set to False:
completePlotRange[plot:(_Graphics|_Graphics3D|_Graph)] :=
Quiet#Last#
Last#Reap[
Rasterize[
Show[plot, Axes -> True, Frame -> False, Ticks -> (Sow[{##}] &),
DisplayFunction -> Identity, ImageSize -> 0], ImageResolution -> 1]]
One can get the exact PlotRange (without the PlotRangePadding added) with the following function:
plotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Quiet#Last#
Last#Reap[
Rasterize[
Show[plot, PlotRangePadding -> None, Axes -> True, Frame -> False,
Ticks -> (Sow[{##}] &), DisplayFunction -> Identity, ImageSize -> 0],
ImageResolution -> 1]]
P.S. On the Documentation page for PlotRange under the "More information" one can read: "AbsoluteOptions gives the actual settings for options used internally by Mathematica when the setting given is Automatic or All. " (emphasis mine). So it seems that the Documentation does not even guarantee that AbsoluteOptions will give correct values for PlotRange when it is not Automatic or All.
I, too, sometimes find it confusing how to get Mathematica to display Graphics in a consistent way, particularly when insetting graphics.
For the specified graphic g, it doesn't matter what you provide for the PlotRange, because Thickness[1] always draws a line whose thickness is equal to the horizontal plot range. In your example, Show[g, ___] gives the correct result:
.
Show[g], or simply g, is anomalous.
Why?
I don't know where/if this is documented, but here are a few things that might be relevant to the question.
Obviously DisplayForm[Graphics[___]] is a raster.
We can get a raster for g using Rasterize[g]. What is the RasterSize? From trial and
error, I found that RasterSize is 10 * screen resolution (reported as 72 pixels per inch on my system). How do I know this? If I rasterize g with resolutions less than 718, I get an image with dimensions {360,361}, whereas the default image size for g is 360 pixels on my system, so I figure to Show[] a graphic, Mathematica Rasterize's it at 10x the screen resolution. Anybody know if this is true? You can get your screen resolution (at least as Mathematica sees it) from the Options Inspector.
Edit
That the following expression evaluates as True seems to show that the displayed graphic is rasterized at the ImageSize:
ImportString[ExportString[Show[g,ImageSize->100],"PNG"]]
=== ImportString[ExportString[Rasterize[g,RasterSize->100,ImageSize->100],"PNG"]
To reproduce Show[g] when using PlotRange I need to use
Show[g,PlotRange->{{0,1},{0,1}},ImagePadding->90.3]
to get it to crop to the perimeter of the line. So it seems that Mathematica is telling the truth that the PlotRange is {{0,1},{0,1}} when using AbsoluteOptions[]. It is not reporting the actual value of ImagePadding. Perhaps because ImagePadding->Automatic is based on a rule that uses the current ImageSize, PlotRangeClipping,... settings? The ImagePadding of 90.3 only works for ImageSize->360; setting ImageSize->200 makes the ImagePadding value wrong. For your graphic, ImagePadding->90.3*OptionValue[ImageSize]/360 reproduces Show[g,ImageSize->_] on my system.
That's all I've found out so far.
You can try adding a recognizable object at a known location and then see where it shows up in the exported version to provide a scale reference. I thought a vector export (SVG or EPS) would be easier to parse, but I think raster is easier after playing around a bit.
For example, add a green rectangle covering the theoretical plot range:
g = Graphics[{Blue, Thickness[1], CapForm["Round"],
Line[{{0, 0}, {1, 1}}], Green, Rectangle[{0, 0}, {1, 1}]}];
im = Rasterize[g, ImageSize -> 360];
xy = Transpose[Position[ImageData[im], {0., 1., 0.}]];
pad = Map[{Min[#1], 360 - Max[#1] } &, xy];
Show[g, ImagePadding -> pad]
The code is basically identifying where all the green pixels are.
The padding in this case is {{92, 92}, {92, 92}}, but it need not be symmetrical.