How is the BarSpacing option really implemented in Mathematica? - wolfram-mathematica

I'm trying to implement a DateListBarChart function that takes dated data and outputs a bar chart with the same placements as DateListPlot. It's essential that they plot data in the same horizontal position if given the same data, so they can be combined using Show. I am finding it difficult to get the settings for BarSpacing right so that the horizontal range of the plot doesn't change, and the bars stay in essentially the same place.
I have been unable to infer the correct scaling so that BarSpacing->{0.2,0.3} results in 20% of the x-axis length available for that group of bars is taken up with spacing between bars in that group, and 30% as spacing between groups of bars. For technical reasons I am doing this by passing things to RectangleChart. According to the documentation, BarSpacing is treated as absolute units in RectangleChart. Obviously the absolute sizes of the gaps need to be smaller if there are more series, and the bars need to be narrower.
Some examples:
arList = FoldList[0.9 #1 + #2 &, 0.01, RandomReal[NormalDistribution[0, 1], 24]]
{0.01, 0.334557, 2.02709, 1.1878, 1.9009, 3.08604, 2.36652, 3.04111,
3.32364, 3.22662, 3.12626, 2.59118, 1.69334, 1.21069, 0.23171,
0.689415, -0.852649, -0.124624, 0.58604, -0.481886, 0.221074,
-0.300329, 2.36137, 0.427789, -1.47747}
dists = RandomChoice[{3, 4}, Length[arList]]
{4, 4, 4, 3, 4, 3, 4, 3, 4, 4, 3, 4, 4, 3, 4, 4, 4, 4, 3, 4, 3, 3, 3, 3, 3}
Results in:
RectangleChart[Transpose[{dists - 0 - 0/2, arList}],
PlotRange -> {{0, 100}, {-2, 4}}, ChartStyle -> EdgeForm[None],
Frame -> True, GridLines -> Automatic, BarSpacing -> {0, 0}]
RectangleChart[Transpose[{dists - 0.7 - 0.5/2, arList}],
PlotRange -> {{0, 100}, {-2, 4}}, ChartStyle -> EdgeForm[None],
Frame -> True, GridLines -> Automatic, BarSpacing -> {0.7, 0.5}]
Notice how the data aren't spanning the same distance along the x-axis as the previous example.
It gets even messier when trying to chart multiple series (the same in this example, for illustration).
RectangleChart[
Transpose[{{dists - i/2 - j/2, arList}, {dists - i/2 - j/2,
arList}}, {2, 3, 1}], PlotRange -> {{0, 180}, {-2, 4}},
ChartStyle -> EdgeForm[None], Frame -> True, Ticks -> None,
GridLines -> Automatic, BarSpacing -> {i, j}]
I've been futzing for ages trying to find the right formula so that BarSpacing settings for the custom function (not seen here) induce the correct spacings and bar widths so that the horizontal plot range doesn't change as the BarSpacing does.
What am I missing?
EDIT: In response to belisarius, this is an example of where I am heading. It works, kind of (the bars aren't quite in alignment with the line, but this is probably the dates I am using) but the cases with stacked bars fail to plot with the bars where they should be, as do any kind of bar graph on its own where there are multiple series. (I'm quite proud of the date label placement algorithm: the powers that be at work don't want to give up that look.)
And here is one that just isn't working. The data should fill the horizontal range. (The different width bars are deliberate - it's a combination of annual and quarterly data.)
EDIT 2
I remember why I didn't use Filling in a DateListPlot to draw the bars as in Mike Honeychurch's package - if you have anything other than very skinny bars, they end up having the top edge in the wrong place.
DateListPlot[{dateARList},
PlotStyle -> {AbsolutePointSize[6], Yellow}, Filling -> {1 -> 0},
FillingStyle -> {1 -> {{AbsoluteThickness[12], Darker[Red, 0.25]}}},
PlotRange -> All]

Maybe using the ChartElementFunction option instead of BarSpacing helps. For example barplot in the code would plot a bar chart such that each bar has margins of gapl on the left and gapr on the right where gapl and gapr are fractions of the total width of the bar
scale[{{xmin_, xmax_}, {ymin_, ymax_}}, {gapl_, gapr_}] :=
{{xmin (1 - gapl) + xmax gapl, ymin}, {xmax (1 - gapr) + xmin gapr, ymax}}
barplot[dists_, arList_, {gapl_, gapr_}, opts___] :=
RectangleChart[Transpose[{dists, arList }], opts,
Frame -> True,
GridLines -> Automatic, BarSpacing -> 0,
ChartElementFunction -> (Rectangle ## scale[#, {gapl, gapr}] &)]
Usage:
To plot the original bar chart with no gaps
barplot[dists, arList, {0, 0}]
This would plot a bar chart with a margin of 0.2 on both sides which results in a bar chart with gaps of 0.4 times the total width of the bars. Note that the positions of the bars matches with those in the first figure.
barplot[dists, arList, {0.2, 0.2}]
You can plot multiple series by doing something like
Show[barplot[dists, arList 0.9, {0, 0.5}],
barplot[dists, arList 0.8, {0.5, 0}, ChartStyle -> LightGreen]]

You may relieve your complaint about FillingStyle by using CapForm["Butt"].
list = {0.01, -0.81, 0.12, 0.81, 1.79, 1.1, 0.41, 1., 1.33, 1.08,
2.16, 1.13, 1.92, 1.64, 1.31, 1.94, 1.71, 0.91, 2.32, 0.95, 1.29,
1.28, 2.97, 4.45, 5.11}
DateListPlot[list, {2000, 8},
PlotStyle -> {AbsolutePointSize[6], Yellow}, Filling -> {1 -> 0},
FillingStyle -> {1 -> {{CapForm["Butt"], AbsoluteThickness[14],
Darker[Red, 0.25]}}}, PlotRange -> {0, 6}, ImageSize -> 400]

Related

From Cartesian Plot to Polar Histogram using Mathematica

Please Consider:
dalist={{21, 22}, {26, 13}, {32, 17}, {31, 11}, {30, 9},
{25, 12}, {12, 16}, {18, 20}, {13, 23}, {19, 21},
{14, 16}, {14, 22}, {18,22}, {10, 22}, {17, 23}}
ScreenCenter = {20, 15}
FrameXYs = {{4.32, 3.23}, {35.68, 26.75}}
Graphics[{EdgeForm[Thick], White, Rectangle ## FrameXYs,
Black, Point#dalist, Red, Disk[ScreenCenter, .5]}]
What I would like to do is to compute, for each point, its angle in a coordinate system such as :
Above is the Deisred output, those are frequency count of point given a particular "Angle Bin".
Once I know how to compute the angle i should be able to do that.
Mathematica has a special plot function for this purpose: ListPolarPlot. You need to convert your x,y pairs to theta, r pairs, for instance as follows:
ListPolarPlot[{ArcTan[##], EuclideanDistance[##]} & ### (#-ScreenCenter & /# dalist),
PolarAxes -> True,
PolarGridLines -> Automatic,
Joined -> False,
PolarTicks -> {"Degrees", Automatic},
BaseStyle -> {FontFamily -> "Arial", FontWeight -> Bold,FontSize -> 12},
PlotStyle -> {Red, PointSize -> 0.02}
]
UPDATE
As requested per comment, polar histograms can be made as follows:
maxScale = 100;
angleDivisions = 20;
dAng = (2 \[Pi])/angleDivisions;
Some test data:
(counts = Table[RandomInteger[{0, 100}], {ang, angleDivisions}]) // BarChart
ListPolarPlot[{{0, maxScale}},
PolarAxes -> True, PolarGridLines -> Automatic,
PolarTicks -> {"Degrees", Automatic},
BaseStyle -> {FontFamily -> "Arial", FontWeight -> Bold, FontSize -> 12},
PlotStyle -> {None},
Epilog -> {Opacity[0.7], Blue,
Table[
Polygon#
{
{0, 0},
counts[[ang + 1]] {Cos[ang dAng - dAng/2],Sin[ang dAng- dAng/2]},
counts[[ang + 1]] {Cos[ang dAng + dAng/2],Sin[ang dAng+ dAng/2]}
},
{ang, 0, angleDivisions - 1}
]}
]
A small visual improvement using Disk sectors instead of Polygons:
ListPolarPlot[{{0, maxScale}},
PolarAxes -> True, PolarGridLines -> Automatic,
PolarTicks -> {"Degrees", Automatic},
BaseStyle -> {FontFamily -> "Arial", FontWeight -> Bold,
FontSize -> 12}, PlotStyle -> {None},
Epilog -> {Opacity[0.7], Blue,
Table[
Disk[{0,0},counts[[ang+1]],{ang dAng-dAng/2,ang dAng+dAng/2}],
{ang, 0, angleDivisions - 1}
]
}
]
A clearer separation of the 'bars' is obtained with the addition of EdgeForm[{Black, Thickness[0.005]}] in the Epilog. Now the numbers marking the rings still have the unnecessary decimal point trailing them. Following the plot with the replacement /. Style[num_?MachineNumberQ, List[]] -> Style[num // Round, List[]] removes those. The end result is:
The above plot can also be generated with SectorChart although this plot is primarily intended to show varying width and height of the data, and isn't fine-tuned for plots where you have fixed-width sectors and you want to highlight directions and data counts in those directions. But it can be done by using SectorOrigin. The problem is I take it that the midpoint of a sector codes for its direction so to have 0 deg in the mid of a sector I have to offset the origin by \[Pi]/angleDivisions and specify the ticks by hand as they get rotated too:
SectorChart[
{ConstantArray[1, Length[counts]], counts}\[Transpose],
SectorOrigin -> {-\[Pi]/angleDivisions, "Counterclockwise"},
PolarAxes -> True, PolarGridLines -> Automatic,
PolarTicks ->
{
Table[{i \[Degree] + \[Pi]/angleDivisions, i \[Degree]}, {i, 0, 345, 15}],
Automatic
},
ChartStyle -> {Directive[EdgeForm[{Black, Thickness[0.005]}], Blue]},
BaseStyle -> {FontFamily -> "Arial", FontWeight -> Bold,
FontSize -> 12}
]
The plot is almost the same, but it is more interactive (tooltips and so).
That seems to be the polar coordinate system. The Cartesian-to-polar conversion formulas are in that same article:
This returns the angle in radians.
This
N#ArcTan[#[[1]], #[[2]]] & /# (# - ScreenCenter & /# dalist)
returns the list of angles of the ray from ScreenCenter to each point, in radians and between -pi and pi.
That is, I assumed you want the angle between each point in your plot and the red dot.
Note the use of ArcTan[x,y] rather than ArcTan[y/x], which automatically chooses the appropriate sign (otherwise you'd have to do it by hand, as in #Blender's answer).

How to choose the numbers shown on the axes of a plot in mathemetica?

I have already checked all the examples and settings in the Mathematica documentation center, but couldn't find any example on how to choose the numbers that will be shown on the axes.
How do I change plot axis numbering like 2,4,6,.. to PI,2PI,3PI,...?
Howard has already given the correct answer in the case where you want the labels Pi, 2 Pi etc to be at the values Pi, 2 Pi etc.
Sometimes you might want to use substitute tick labels at particular values, without rescaling data.
One of the other examples in the documentation shows how:
Plot[Sin[x], {x, 0, 10},
Ticks -> {{{Pi, 180 \[Degree]}, {2 Pi, 360 \[Degree]}, {3 Pi,
540 \[Degree]}}, {-1, 1}}]
I have a suite of small custom functions for formatting Ticks the way I want them. This is probably too much information if you are just starting out, but it is worth knowing that you can use any number format and substitute anything into your ticks if desired.
myTickGrid[min_, max_, seg_, units_String, len_?NumericQ,
opts : OptionsPattern[]] :=
With[{adj = OptionValue[UnitLabelShift], bls = OptionValue[BottomLabelShift]},
Table[{i,
If[i == max,
DisplayForm[AdjustmentBox[Style[units, LineSpacing -> {0, 12}],
BoxBaselineShift -> If[StringCount[units, "\n"] > 0, adj + 2, adj]]],
If[i == min,
DisplayForm#AdjustmentBox[Switch[i, _Integer,
NumberForm[i, DigitBlock -> 3,
NumberSeparator -> "\[ThinSpace]"], _, N[i]],
BoxBaselineShift -> bls],
Switch[i, _Integer, NumberForm[i, DigitBlock -> 3,
NumberSeparator -> "\[ThinSpace]"], _, N[i]]]], {len, 0}}, {i,
If[Head[seg] === List, Union[{min, max}, seg], Range[min, max, seg]]}]]
And setting:
Options[myTickGrid] = {UnitLabelShift -> 1.3, BottomLabelShift -> 0}
SetOptions[myTickGrid, UnitLabelShift -> 1.3, BottomLabelShift -> 0]
Example:
Plot[Erfc[x], {x, -2, 2}, Frame -> True,
FrameTicks -> {myTickGrid[-2, 2, 1, "x", 0.02, UnitLabelShift -> 0],
myTickGrid[0, 2, {0.25, .5, 1, 1.8}, "Erfc(x)", 0.02]}]
You can find an example here:
Ticks -> {{Pi, 2 Pi, 3 Pi}, {-1, 0, 1}}
Ticks also accepts a function, which will save you the trouble of listing the points manually or having to change the max value each time. Here's an example:
xTickFunc[min_, max_] :=
Table[{i, i, 0.02}, {i, Ceiling[min/Pi] Pi, Floor[max/Pi] Pi, Pi}]
Plot[Sinc[x], {x, -5 Pi, 5 Pi}, Ticks -> {xTickFunc, Automatic},
PlotRange -> All]
If you want more flexibility in customizing your ticks, you might want to look into LevelScheme.

Effect of change in Viewpoint->{x,y,z} on the size of graphic objects is not what I expected. How to fix?

If you run the following code snippet:
Manipulate[
Graphics3D[
{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> {1, 1, a}, AxesOrigin -> {0,0,0}
],
{a, 1, 100}
]
and move the viewpoint from (1,1,1) to (1,1,100) with the slider you will see that after a while the objects remain fixed in size.
Questions.
1. When I move the viewpoint further away from the scene I want the objects to become smaller. How should this be done in Mathematica?
( EDIT: )
2. What is the position of the 'camera' in relation to Viewpoint?
See ViewAngle. Under "More Information", note that the default setting ViewAngle -> Automatic is effectively equivalent to ViewAngle -> All when you zoom far enough out.
You just need to add an explicit setting for ViewAngle:
Manipulate[
Graphics3D[{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> {1, 1, a}, AxesOrigin -> {0, 0, 0},
ViewAngle -> 35 Degree], {a, 1, 100}]
As far as I know, the camera viewpoint really coincides with the position given by ViewPoint. Because Mathematica scales the result to fit in about the same image you don't see much changes but they are there. The perspective changes considerably. Try, for instance, to move away from a semi-transparant square and you'll see that the farther you go, the more the projection becomes an orthogonal projection:
If you want to scale your image according to distance you can use ImageSize. SphericalRegion is good to stabilize the image.
Manipulate[
vp = {1, 1, a};
Graphics3D[{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> vp,
AxesOrigin -> {0, 0, 0},
SphericalRegion -> True,
ImageSize -> 500/Norm[vp]],
{a, 1, 100}
]
[animation made with some ImagePadding to keep object in the center. I stopped the animation at a = 10, the image gets pretty small after that]

Mathematica: is it possible to put AxesLabel for 3D graphics at the end of the axes as in 2D?

According to
http://reference.wolfram.com/mathematica/ref/AxesLabel.html
it says
"By default, axes labels in two-dimensional graphics are placed at the ends of the axes. In three-dimensional graphics, they are aligned with the middles of the axes."
I wanted to put the axes labels at the end of the axes also for my 3D plots, since that makes it easy for me to see which axes is now where when I do rotations and such on the 3D objects.
I was not able to find a trick to do it. Here is an example
g=Graphics3D[
{
Cuboid[{-.1,-.1,-.1},{.1,.1,.1}],
{Red,PointSize[.03],Point[{3,0,0}]},
{Black,PointSize[.03],Point[{0,3,0}]},
{Blue,PointSize[.03],Point[{0,0,3}]}
},
AxesOrigin->{0,0,0},
PlotRange->{{-3,3},{-3,3},{-3,3}},
Axes->True,
AxesLabel->{"X","Y","Z"},
LabelStyle->Directive[Bold,Red,16],
PreserveImageOptions->False,
Ticks->None,
Boxed->False
]
Also, it says that the axes labels for 3D are supposed to be in the 'middle' of the axes.
But looking at the resulting Graphics3D, it does not look to me the labels are in the middle at all. Might be a scaling thing, not sure now, but it looks like the labels are too close to the origin.
thanks,
You could draw the labels manually, at the location of your choosing:
Graphics3D[
{ Cuboid[{-.1,-.1,-.1},{.1,.1,.1}]
, Text[Style["X", Bold, Red, 16], {3, 0, 0}]
, Text[Style["Y", Bold, Black, 16], {0, 3, 0}]
, Text[Style["Z", Bold, Blue, 16], {0, 0, 3}]
}
, AxesOrigin -> {0, 0, 0}
, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}
, Axes -> True
, PreserveImageOptions -> False
, Ticks -> None
, Boxed -> False
]

Dynamic (or forced) scaling of ColorFunction

Reading this question on importing ColorData from matlab, I was wondering if there is a way to change the range of values over which the ColorFunction is scaled. That was probably not entirely clear, so let me show with a figure from matlab (the same example as in the previous question is used)
The plot on the left is the original, with the ColorData mapped to the data values between -1 and 1. Now, I can easily set it to be mapped to the data values between 0 and 1, the result being that all values less than 0 are assigned blue color (lowest in the colormap). PlotRange is the closest function, and using ClippingStyle in addition to that produces a similar figure. However, it doesn't re-scale the ColorData to map to the plot range.
How can I do this in Mathematica?
BTW, to insert colorbars using Mathematica, you can look at this function
Here's a function applied to a surface:
Plot3D[x + y, {x, -2, 2}, {y, -2, 2},
ColorFunction -> (ColorData["Rainbow", #3] &), Mesh -> {{1}, {1}}]
To look at the top-right corner, with the same color function and scaling, I set ColorFunctionScaling -> False, and manually scale the color function to map the (global) minimum to zero and the maximum to one using Rescale:
Plot3D[x + y, {x, 1, 2}, {y, 1, 2}, ColorFunctionScaling -> False,
ColorFunction -> (ColorData["Rainbow", Rescale[#3, {-4, 4}, {0, 1}]] &)]

Resources