improved version of histogram.m
- To: mathgroup at yoda.physics.unc.edu
- Subject: improved version of histogram.m
- From: Gossett <gossett at noether.bethel.edu>
- Date: Tue, 8 Sep 1992 08:33:58 -0500
The revision of histogram.m listed below adds additional flexibility
in how data may be entered. In particular, data may be entered as
(value,frequency) pairs.
BeginPackage["Histogram`"]
Histogram::usage =
"Histogram[Data_?ValidData,Bins_MatrixQ,BinLabels_List:{},ShowLabels_
:True] produces a histogram of Data, using Bins to group the data.
ValidData accepts vectors of numbers (the actual data) or a matrix
consisting of {value,frequency} pairs. Bins is a list of data pairs,
listing the minimum and maximum values for each bin. BinLabels is an
optional list of strings or expressions to use as labels below the
bars. If the bar widths are too small to have labels, set the
optional parameter ShowLabels to False. The bin widths need not be
equal. The area of the bar corresponds to the percentage of data in
the bin (the height of the bar may not show the percentage). Very
little validity checking is done on the bins.
Examples:
Histogram[{2,3,4,2,3,1,5,3,7},{{0,2},{4,6},{2,4},{6,8}},{Aardvarks,Ba
ts,\"Cows\",6+3}]
Histogram[Table[Random[],{i,50}],Table[{i,i+.05},{i,0,.95,.05}],False
]
Histogram[Table[Random[],{i,1000}],{{0,.2},{.2,.5},{.5,.6},
{.6,.95},{.95,1}},{a,b,c,d,e}]
Histogram[{{.5,10},{1.5,40},{2.5,12},{4.5,30},{2.2,8}},
{{0,1},{1,2},{2,3},{3,4},{4,5}},True]"
(* This package may be freely used for non-commercial purposes.
Copyright August 1992
Dr. Eric Gossett
Bethel College
3900 Bethel Drive
St. Paul, MN 55112
gossett at bethel.edu
Version 1.2 (adds {value,frequency} pairs as a valid data form)
Tested and Developed under Mathematica 2.0.4.
*)
Begin["`Private`"]
Unprotect[Histogram]
Clear[Histogram];
ValidData[x_] := VectorQ[x, NumberQ] ||
(MatrixQ[x, NumberQ] && Dimensions[x][[2]] == 2);
Histogram[Data_?ValidData,Bins_,BinLabels_List:{},ShowLabels_:True]
:=
Module[{BinCenters,Total,i,NumBins,Percents,SBins,Heights,SelData,
MaxHeight, graph},
(* turn off spell checking *)
Off[General::spell1];
(* Compute secondary values *)
SBins = Sort[Bins]; (* This will slow things down if there are
many bins *)
NumBins = Length[SBins];
BinCenters = Map[(N[#[[1]]+(#[[2]]-#[[1]])/2])&,SBins];
Minx = SBins[[1,1]];
Maxx = SBins[[NumBins,2]];
If[VectorQ[Data],
(* a vector of data *)
Total = Length[Data],
(* a matrix of value-frequency pairs *)
Total = Apply[Plus,Transpose[Data][[2]]]
];
(* Count the number and % of data values in each bin *)
BinCounts = Table[0,{i,NumBins}];
If[VectorQ[Data],
(* a vector of data *)
For[i=1,i<=NumBins,i++,
BinCounts[[i]] = Length[Select[Data,
((#>SBins[[i,1]])&&(#<=SBins[[i,2]]))&]];
],
(* a matrix of value-frequency pairs *)
For[i=1,i<=NumBins,i++,
SelData = Select[Data,
((#[[1]]>SBins[[i,1]])&&(#[[1]]<=SBins[[i,2]]))&]
;
BinCounts[[i]] = If[Length[SelData]==0,0,
Apply[Plus,Transpose[SelData][[2]]]
]
]
];
Percents = N[BinCounts/Total];
(* Compute the bar heights *)
Heights = Table[
N[Percents[[i]]/(SBins[[i,2]] - SBins[[i,1]])],
{i,NumBins}];
MaxHeight = Max[Heights];
(* Produce default lables *)
If[BinLabels == {},Labels = SBins,Labels=BinLabels];
(* Plot the histogram *)
graph = Show[
(* The filled bars *)
Graphics[Prepend[Table[
Polygon[{{SBins[[i,1]],0},{SBins[[i,1]],Heights[[i]]},
{SBins[[i,2]],Heights[[i]]},{SBins[[i,2]],0}}],
{i,NumBins}],GrayLevel[.6667]]],
(* The lines around the edges *)
Graphics[Prepend[Table[
Line[{{SBins[[i,1]],0},{SBins[[i,1]],Heights[[i]]},
{SBins[[i,2]],Heights[[i]]},{SBins[[i,2]],0}}],
{i,NumBins}],Thickness[.002]]],
(* the x-axis *)
Graphics[{Thickness[.002],Line[{{Minx,0},{Maxx,0}}]}],
(* the x-axis (bin) labels *)
If[ShowLabels,Graphics[Table[
Text[Labels[[i]],{BinCenters[[i]],-.02 MaxHeight},
{0,1}],
{i,NumBins}]],Graphics[]],
(* the bar labels (percents ) *)
If[ShowLabels,Graphics[Table[
Text[ToString[NumberForm[100Percents[[i]],{5,60}]] <> "%",
{BinCenters[[i]], Heights[[i]] + .02 MaxHeight},{0,-1}],
{i,NumBins}]],Graphics[]],
(* Kludge to get labels to print without being clipped *)
Graphics[{GrayLevel[1],Line[{{SBins[[1,1]],-.01 MaxHeight},
{SBins[[1,1]],-.05 MaxHeight}}],GrayLevel[0]}],
Graphics[{GrayLevel[1],
Line[{{SBins[[1,1]],MaxHeight+.01 MaxHeight},
{SBins[[1,1]],MaxHeight+.05 MaxHeight}}],GrayLevel[0]}]
];
(* turn spell checking on again *)
On[General::spell1];
Return[graph]
]
End[]
Protect[Histogram]
EndPackage[]