# How to plot frequency polygon?

I have data sample. Built and plotted histogram based on the sample. How can I plot frequency polygon now?

That's example of the desired result.

Here is code:

 n = 100;
a = 0;
b = π;

datapointsperbin = 10;
numberofbins = IntegerPart[Length[data]/datapointsperbin];

data = Sort[
Sin[(b - a)*RandomVariate[UniformDistribution[{0, 1}], n] + a]];

(*even bins*)
Histogram[data, Automatic, "PDF", LabelingFunction -> Above, ChartStyle -> Pink]

(*uneven bins*)
Histogram[data, {Table[Quantile[data, i/numberofbins], {i, 1, numberofbins}]}, "PDF"]


I'd like to understand how i could plot polygon for both cases: with even and uneven bins. Thank You.

• Provide your sample data and your code for the Histogram. Commented May 16, 2015 at 20:38

Update: An alternative approach is to extract coordinates of the Rectangles and use Show similar to the approach @Algohi's answer.

We define an auxiliary function lF to generate the coordinates for the line we need, and use it in the function showF that takes an Histogram as input and Shows it together with a line joining the midpoints of the rectangle tops:

ClearAll[lF, showF]
lF = Cases[#, RectangleBox[a_, b_, ___] :> ({Mean[#1], Last@#2} & @@ Transpose[{a, b}]),
{0, Infinity}] &;
showF[dirs_: {Thick, Red}] := Show[#, Epilog -> {## & @@ dirs, Line@lF@#}] &;

hist = Histogram[data, bF[10][data], "PDF", LabelingFunction -> Above,
ChartElementFunction -> "GlassRectangle", ChartStyle -> Pink];
showF[] @ hist


showF[{Thick, Blue}] @ hist


This approach avoids the glitch mentioned by the OP in the comments below. It seems that there is glitch/bug with the Joined option of RectangleChart. The method proposed in the original post gives

SeedRandom[1]
data = Sort[Sin[RandomVariate[UniformDistribution[{a, b}], n]]];

rc = With[{hl = HistogramList[data, bF[10][data], "PDF"]},
RectangleChart[Transpose[{Differences@First@hl, Last@hl}],
Joined -> Automatic, BarSpacing -> 0,
LabelingFunction -> (Placed[N@Last@#, Above] &), ChartStyle -> Pink,
Frame -> {Bottom, Left}, AxesOrigin -> {0, 0}]]


The last point in the Line produced by the Joined option is wrong:

Cases[rc, _Line, {0, Infinity}][[1]]


Line[{{0.124947, 0.500214}, {0.321742, 0.869881}, {0.422127, 2.19024}, {0.512293, 1.01411}, {0.609398, 1.76182}, {0.68612, 1.51524}, {0.760101, 1.9094}, {0.787629, 4.17077}}]

Original post:

You can also use HistogramList as input to BarChart which has the option Joined:

BarChart[N@Last@HistogramList[data, Automatic, "PDF"],
Joined -> Automatic, LabelingFunction -> Above, ChartStyle -> Pink]


You can also add ticks to get a look closer to the output of Histogram:

With[{hl = HistogramList[data, Automatic, "PDF"]},
BarChart[N@Last@hl, Joined -> Automatic,
BarSpacing -> 0, LabelingFunction -> Above, ChartStyle -> Pink,
Frame -> {Bottom, Left}, AxesOrigin -> {1/2, 0},
FrameTicks -> {Thread[{Range@Length@First@hl - 1/2, First@hl}] &, Automatic}]]


Update: Perhaps, RectangleChart, which also has the option Joined, is more flexible in that (1) Ticks are automatically picked from input data, and (2) you can have unequal bin widths.

With[{hl = HistogramList[data, Automatic, "PDF"]},
RectangleChart[Transpose[{Differences@First@hl, Last@hl}],
Joined -> Automatic,
BarSpacing -> 0, LabelingFunction -> (Placed[N@Last@#, Above] &),
ChartStyle -> Pink,
Frame -> {Bottom, Left}, AxesOrigin -> {0, 0}]]


bF[n_] := {Quantile[#, Range[# - 1]/# &[Quotient[Length@#, n]]]} &


To have each bin to contain 10 data points, use the bin specs bF[10][data]:

With[{hl = HistogramList[data, bF[10][data], "PDF"]},
RectangleChart[Transpose[{Differences@First@hl, Last@hl}],
Joined -> Automatic,
BarSpacing -> 0, LabelingFunction -> (Placed[N@Last@#, Above] &),
ChartStyle -> Pink,
Frame -> {Bottom, Left}, AxesOrigin -> {0, 0}]]


• Well, again absolutely beautiful. Thanks a lot. Commented May 16, 2015 at 21:47
• excuse me, faced the problem: i.imgur.com/ZnTbWUk.png How to fix this? As i understand, i can't just set Y-axis range. Commented May 16, 2015 at 21:59
• @instajke, could you post the code that produced the picture in the link? And the Mathematica version you are using?
– kglr
Commented May 16, 2015 at 22:10
• i just used my data, u can find it in the question. Mathematica version is 10.0.1.0 Thanks. Commented May 16, 2015 at 22:19
• @instajke, could you add the value of numberofbins in your question?
– kglr
Commented May 16, 2015 at 22:21

Your histogram doesn't have regular binning, so you will want to specify how you want the binning done in your question. To get you started, however, here is an idea with regular binning. Otherwise you could adapt the code from your previous question on uneven binning to this problem.

SeedRandom[10]
sample = RandomVariate[NormalDistribution[], 200];

histogramdata = HistogramList[sample, Automatic, "PDF"];
frequencypolygondata = Transpose[{
Mean /@ Partition[histogramdata[[1]], 2, 1],
histogramdata[[2]]
}];

Show[
Histogram[sample, Automatic, "PDF"],
ListPlot[frequencypolygondata, Joined -> True, PlotStyle -> Thick]
]


Update:

For the sake of completeness, if you want to use the conditions from your previous question (i.e. ten data points per bin), of course you can use the same approach that I outlined there:

SeedRandom[10]
sample = RandomVariate[NormalDistribution[], 200];
datapointsperbin = 10;
numberofbins = IntegerPart[Length[sample]/datapointsperbin];

histogramdata = HistogramList[
sample,
{Table[Quantile[sample, i/numberofbins], {i, 1, numberofbins - 1}]},
"PDF"];
frequencypolygondata = Transpose[{
Mean /@ Partition[histogramdata[[1]], 2, 1],
histogramdata[[2]]
}];

Show[
Histogram[sample,
{Table[Quantile[sample, i/numberofbins], {i, 1, numberofbins - 1}]},
"PDF"],
ListPlot[frequencypolygondata, Joined -> True, PlotStyle -> Thick]
]


• Wow, wow! Thanks a lot again :) Commented May 16, 2015 at 20:44
• @instajke No problem, glad to be of help! I am guessing that you may want to combine the results from the previous question about uneven binning with this one, to produce a plot like the one in the example. If that's the case, you could amend the question to be more specific, and I'll see what I can do to match the answer. Commented May 16, 2015 at 20:47
• yes, that's exactly what i need, to combine polygon and the histogram from previous question. Commented May 16, 2015 at 20:53
• @instajke I updated my answer to include uneven binning as well Commented May 17, 2015 at 2:59

Here is another way:

histogram := Histogram[
RandomVariate[NormalDistribution[0, 1], 200],
Automatic,
Function[{bins, counts}, Sow[bins, "bins"]; Sow[counts, "counts"]]
]

{g, bins} = Reap[histogram];

Show[
g,
Graphics@Line@MapThread[{Mean[#], #2} &, Flatten[bins, 1]]
]


sample = RandomVariate[NormalDistribution[], 200];
histogramdata =
Histogram[sample, {Sort@RandomReal[{-4, 4}, 20]}, "PDF"];
h = Cases[histogramdata, StatusArea[_, x_] :> x, -1];
w = Cases[histogramdata,
RectangleBox[{x_, _}, {y_, _} | NCache[{y_, _}, _], __] :>
Mean@{x, y}, -1];
Show[histogramdata, ListLinePlot[Transpose[{w, h}]]]


• That's it! Thank You! Commented May 16, 2015 at 21:40