Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1992
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1992

[Date Index] [Thread Index] [Author Index]

Search the Archive

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[]





  • Prev by Date: mma 2.1 PostScript codes
  • Next by Date: Re: Integrating Normal Distributions gives the wrong answer
  • Previous by thread: mma 2.1 PostScript codes
  • Next by thread: Graphics using external data list.