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

package submission

  • To: mathgroup at yoda.physics.unc.edu
  • Subject: package submission
  • From: Gossett <gossett at bethel.edu>
  • Date: Sat, 15 Aug 1992 12:10:52 -0500

The package histogram.m exports a function, Histogram, for drawing a histogram
of a set of data values. A non-trivial application is presented after the
package listing.


BeginPackage["Histogram`"]

Histogram::usage = "Histogram[Data_?VectorQ,Bins_MatrixQ,BinLabels_List:{},ShowLabels_:True] produces a histogram of Data, using Bins to group the data. 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,Bats,\"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}]"

(* 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.0
*)

Begin["`Private`"]
Unprotect[Histogram]
Clear[Histogram];

Histogram[Data_?VectorQ,Bins_,BinLabels_List:{},ShowLabels_:True] := 
Module[{BinCenters,Total,i,NumBins,Percents,SBins,Heights,
        MaxHeight},
  
  (* turn off spell checking *)

  Off[General::spell1];
  
  (* Compute secondary values *)
  
  SBins = Sort[Bins];  (* This will slow things down if there are many bins *)
  Total = Length[Data];
  NumBins = Length[SBins];
  BinCenters = Map[(N[#[[1]]+(#[[2]]-#[[1]])/2])&,SBins];
  Minx = SBins[[1,1]];
  Maxx = SBins[[NumBins,2]];
  
  (* Count the number and % of data values in each bin *)
  
  BinCounts = Table[0,{i,NumBins}];
  For[i=1,i<=NumBins,i++,
    BinCounts[[i]] = Length[Select[Data,
      ((#>SBins[[i,1]])&&(#<=SBins[[i,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 *)
  
  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];

]

End[]
Protect[Histogram]
EndPackage[]





Application showing the transition from a discrete to a continuous density function. (Compares the histogram for a set of 1000 measurements of pencil
lengths in centimeters, with the normal curve with mu = 19 and sigma = .06.)
The lines represent inputs to Mathematica.


<<histogram.m
<<Statistics/NormalDistribution.m

pencils=Join[Table[18.81,{i,2}],
             Table[18.83,{i,1}],
             Table[18.84,{i,2}],
             Table[18.85,{i,2}],
             Table[18.86,{i,4}],
             Table[18.87,{i,7}],
             Table[18.88,{i,9}],
             Table[18.89,{i,10}],
             Table[18.90,{i,17}],
             Table[18.91,{i,22}],
             Table[18.92,{i,28}],
             Table[18.93,{i,32}],
             Table[18.94,{i,40}],
             Table[18.95,{i,51}],
             Table[18.96,{i,56}],
             Table[18.97,{i,59}],
             Table[18.98,{i,63}],
             Table[18.99,{i,65}],
             Table[19.00,{i,69}],
             Table[19.01,{i,66}],
             Table[19.02,{i,61}],
             Table[19.03,{i,59}],
             Table[19.04,{i,50}],
             Table[19.05,{i,48}],
             Table[19.06,{i,38}],
             Table[19.07,{i,33}],
             Table[19.08,{i,26}],
             Table[19.09,{i,22}],
             Table[19.10,{i,15}],
             Table[19.11,{i,13}],
             Table[19.12,{i,9}],
             Table[19.13,{i,8}],
             Table[19.14,{i,4}],
             Table[19.15,{i,5}],
             Table[19.16,{i,2}],
             Table[19.17,{i,1}],
             Table[19.18,{i,1}]
             ];
	   
PencilBins = Table[{18.795+i,18.805+i},{i,0,.39,.01}];
BinLabels=Table[18.80+i,{i,0,.39,.01}];

hist = Histogram[pencils,PencilBins,BinLabels,False]

nc[mu_,sigma_,x_] := PDF[NormalDistribution[mu,sigma],x]

normalcurve=Plot[nc[19,.06,x],{x,18.79,19.21},
Axes->{True,False},PlotRange->{-.5,7},
Ticks->{{18.8,18.9,19.0,19.1,19.1,19.2},{}}]

Show[hist,normalcurve]






  • Prev by Date: Binary data files
  • Next by Date: minor revision of histogram.m
  • Previous by thread: Can't get RecordSeparators t
  • Next by thread: minor revision of histogram.m