This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hash::Util - fixes to hash stats and add bucket_stats_formatted()
authorYves Orton <demerphq@gmail.com>
Sun, 13 Apr 2014 11:29:44 +0000 (13:29 +0200)
committerYves Orton <demerphq@gmail.com>
Sun, 1 Jun 2014 22:42:07 +0000 (00:42 +0200)
* we should do the mean/stddev on the on the occupied buckets not all buckets.

This was always intended to the be average chain-length, which implies
that empty buckets with no-chains at all are excluded.

* Add bucket_stats_formatted(), bump version

Creates reports like this:

    Keys: 500 Buckets: 314/512 Quality-Score: 1.01 (Good)
    Utilized Buckets: 61.33% Optimal: 97.66% Keys In Collision: 37.20%
    Chain Length - mean: 1.59 stddev: 0.81
    Buckets 512         [0000000000000000000000000111111111111111111111122222222222233334]
    Len   0 Pct:  38.67 [#########################]
    Len   1 Pct:  34.57 [######################]
    Len   2 Pct:  19.53 [############]
    Len   3 Pct:   5.47 [####]
    Len   4 Pct:   1.17 [#]
    Len   5 Pct:   0.59 []
    Keys    500         [1111111111111111111111111111111111111111222222222222222222333334]
    Pos   1 Pct:  62.80 [########################################]
    Pos   2 Pct:  27.40 [##################]
    Pos   3 Pct:   7.40 [#####]
    Pos   4 Pct:   1.80 [#]
    Pos   5 Pct:   0.60 []

* Make it possible to get stats on PL_strtab

* bump version to 0.17

ext/Hash-Util/Changes
ext/Hash-Util/Util.xs
ext/Hash-Util/lib/Hash/Util.pm
pod/perldelta.pod

index 06589b5..ddef72c 100644 (file)
@@ -1,9 +1,12 @@
 Revision history for Perl extension Hash::Util.
 
-0.05
+0.17
+    Add bucket_stats_formatted() as utility method to Hash::Util
+    Bug fixes to hash_stats()
 
-Pre /ext version of the code. By Michael G Schwern <schwern@pobox.com>
-on top of code by Nick Ing-Simmons and Jeffrey Friedl.
+0.07 Sun Jun 11 21:24:15 CEST 2006
+        - added front-end support for the new Hash::Util::FieldHash
+        (Anno Siegel)
 
 0.06  Thu Mar 25 20:26:32 2004
        - original XS version; created by h2xs 1.21 with options
@@ -13,8 +16,8 @@ on top of code by Nick Ing-Simmons and Jeffrey Friedl.
         developed to support restricted hashes in Data::Dump::Streamer
         (shameless plug :-)
 
+0.05
 
+Pre /ext version of the code. By Michael G Schwern <schwern@pobox.com>
+on top of code by Nick Ing-Simmons and Jeffrey Friedl.
 
-0.07 Sun Jun 11 21:24:15 CEST 2006
-        - added front-end support for the new Hash::Util::FieldHash
-        (Anno Siegel)
index 2758d69..3210200 100644 (file)
@@ -128,8 +128,13 @@ bucket_info(rhv)
     nothing (the empty list).
 
     */
+    const HV * hv;
     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
+        hv = (const HV *) SvRV(rhv);
+    } else if (!SvOK(rhv)) {
+        hv = PL_strtab;
+    }
+    if (hv) {
         U32 max_bucket_index= HvMAX(hv);
         U32 total_keys= HvUSEDKEYS(hv);
         HE **bucket_array= HvARRAY(hv);
@@ -183,8 +188,13 @@ bucket_array(rhv)
      * of the hash store, combined with regular remappings means that relative
      * order of keys changes each remap.
      */
+    const HV * hv;
     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
+        hv = (const HV *) SvRV(rhv);
+    } else if (!SvOK(rhv)) {
+        hv = PL_strtab;
+    }
+    if (hv) {
         HE **he_ptr= HvARRAY(hv);
         if (!he_ptr) {
             XSRETURN(0);
index 8ae25d1..fb98d5a 100644 (file)
@@ -29,12 +29,12 @@ our @EXPORT_OK  = qw(
                      hidden_ref_keys legal_ref_keys
 
                      hash_seed hash_value hv_store
-                     bucket_stats bucket_info bucket_array
+                     bucket_stats bucket_stats_formatted bucket_info bucket_array
                      lock_hash_recurse unlock_hash_recurse
 
                      hash_traversal_mask
                     );
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 require XSLoader;
 XSLoader::load();
 
@@ -523,21 +523,19 @@ See also bucket_stats() and bucket_array().
 
 Returns a list of statistics about a hash.
 
-    my ($keys, buckets, $used, $utilization_ratio, $collision_pct,
-        $mean, $stddev, @length_counts) = bucket_info($hashref);
-
+    my ($keys, $buckets, $used, $quality, $utilization_ratio, $collision_pct,
+        $mean, $stddev, @length_counts) = bucket_stats($hashref);
 
 Fields are as follows:
 
-
     0: Number of keys in the hash
     1: Number of buckets in the hash
     2: Number of used buckets in the hash
     3: Hash Quality Score
     4: Percent of buckets used
     5: Percent of keys which are in collision
-    6: Average bucket length
-    7: Standard Deviation of bucket lengths.
+    6: Mean bucket length of occupied buckets
+    7: Standard Deviation of bucket lengths of occupied buckets
     rest : list of counts, Kth element is the number of buckets
            with K keys in it.
 
@@ -581,21 +579,128 @@ sub bucket_stats {
     my ($keys, $buckets, $used, @length_counts) = bucket_info($hash);
     my $sum;
     my $score;
-    for (0 .. $#length_counts) {
+    for (1 .. $#length_counts) {
         $sum += ($length_counts[$_] * $_);
         $score += $length_counts[$_] * ( $_ * ($_ + 1 ) / 2 );
     }
     $score = $score /
              (( $keys / (2 * $buckets )) * ( $keys + ( 2 * $buckets ) - 1 ))
                  if $keys;
-    my $mean= $sum/$buckets;
-    $sum= 0;
-    $sum += ($length_counts[$_] * (($_-$mean)**2)) for 0 .. $#length_counts;
+    my ($mean, $stddev)= (0, 0);
+    if ($used) {
+        $mean= $sum / $used;
+        $sum= 0;
+        $sum += ($length_counts[$_] * (($_-$mean)**2)) for 1 .. $#length_counts;
 
-    my $stddev= sqrt($sum/$buckets);
+        $stddev= sqrt($sum/$used);
+    }
     return $keys, $buckets, $used, $keys ? ($score, $used/$buckets, ($keys-$used)/$keys, $mean, $stddev, @length_counts) : ();
 }
 
+=item B<bucket_stats_formatted>
+
+  print bucket_stats_formatted($hashref);
+
+Return a formatted report of the information returned by bucket_stats().
+An example report looks like this:
+
+    Keys: 50 Buckets: 33/64 Quality-Score: 1.01 (Good)
+    Utilized Buckets: 51.56% Optimal: 78.12% Keys In Collision: 34.00%
+    Chain Length - mean: 1.52 stddev: 0.66
+    Buckets 64          [0000000000000000000000000000000111111111111111111122222222222333]
+    Len   0 Pct:  48.44 [###############################]
+    Len   1 Pct:  29.69 [###################]
+    Len   2 Pct:  17.19 [###########]
+    Len   3 Pct:   4.69 [###]
+    Keys    50          [11111111111111111111111111111111122222222222222333]
+    Pos   1 Pct:  66.00 [#################################]
+    Pos   2 Pct:  28.00 [##############]
+    Pos   3 Pct:   6.00 [###]
+
+The first set of stats gives some summary statistical information,
+including the quality score translated into "Good", "Poor" and "Bad",
+(score<=1.05, score<=1.2, score>1.2). See the documentation in
+bucket_stats() for more details.
+
+The two sets of barcharts give stats and a visual indication of performance
+of the hash.
+
+The first gives data on bucket chain lengths and provides insight on how
+much work a fetch *miss* will take. In this case we have to inspect every item
+in a bucket before we can be sure the item is not in the list. The performance
+for an insert is equivalent to this case, as is a delete where the item
+is not in the hash.
+
+The second gives data on how many keys are at each depth in the chain, and
+gives an idea of how much work a fetch *hit* will take. The performance for
+an update or delete of an item in the hash is equivalent to this case.
+
+Note that these statistics are summary only. Actual performance will depend
+on real hit/miss ratios accessing the hash. If you are concerned by hit ratios
+you are recommended to "oversize" your hash by using something like:
+
+   keys(%hash)= keys(%hash) << $k;
+
+With $k chosen carefully, and likely to be a small number like 1 or 2. In
+theory the larger the bucket array the less chance of collision.
+
+=cut
+
+
+sub _bucket_stats_formatted_bars {
+    my ($total, $ary, $start_idx, $title, $row_title)= @_;
+
+    my $return = "";
+    my $max_width= $total > 64 ? 64 : $total;
+    my $bar_width= $max_width / $total;
+
+    my $str= "";
+    if ( @$ary < 10) {
+        for my $idx ($start_idx .. $#$ary) {
+            $str .= $idx x sprintf("%.0f", ($ary->[$idx] * $bar_width));
+        }
+    } else {
+        $str= "-" x $max_width;
+    }
+    $return .= sprintf "%-7s         %6d [%s]\n",$title, $total, $str;
+
+    foreach my $idx ($start_idx .. $#$ary) {
+        $return .= sprintf "%-.3s %3d %6.2f%% %6d [%s]\n",
+            $row_title,
+            $idx,
+            $ary->[$idx] / $total * 100,
+            $ary->[$idx],
+            "#" x sprintf("%.0f", ($ary->[$idx] * $bar_width)),
+        ;
+    }
+    return $return;
+}
+
+sub bucket_stats_formatted {
+    my ($hashref)= @_;
+    my ($keys, $buckets, $used, $score, $utilization_ratio, $collision_pct,
+        $mean, $stddev, @length_counts) = bucket_stats($hashref);
+
+    my $return= sprintf   "Keys: %d Buckets: %d/%d Quality-Score: %.2f (%s)\n"
+                        . "Utilized Buckets: %.2f%% Optimal: %.2f%% Keys In Collision: %.2f%%\n"
+                        . "Chain Length - mean: %.2f stddev: %.2f\n",
+                $keys, $used, $buckets, $score, $score <= 1.05 ? "Good" : $score < 1.2 ? "Poor" : "Bad",
+                $utilization_ratio * 100,
+                $keys/$buckets * 100,
+                $collision_pct * 100,
+                $mean, $stddev;
+
+    my @key_depth;
+    $key_depth[$_]= $length_counts[$_] + ( $key_depth[$_+1] || 0 )
+        for reverse 1 .. $#length_counts;
+
+    if ($keys) {
+        $return .= _bucket_stats_formatted_bars($buckets, \@length_counts, 0, "Buckets", "Len");
+        $return .= _bucket_stats_formatted_bars($keys, \@key_depth, 1, "Keys", "Pos");
+    }
+    return $return
+}
+
 =item B<hv_store>
 
   my $sv = 0;
index 6c32a7b..2760ad2 100644 (file)
@@ -236,6 +236,13 @@ L<Unicode::Normalize> has been upgraded from version 1.17 to 1.18.
 
 The XSUB implementation has been removed in favour of pure Perl.
 
+=item *
+
+L<Hash::Util> has been upgraded from version 0.16 to 0.17.
+
+Minor bug fixes and documentation fixes to Hash::Util::hash_stats()
+
+
 =back
 
 =head2 Removed Modules and Pragmata