summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Hash/Util.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Hash/Util.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Hash/Util.pm132
1 files changed, 119 insertions, 13 deletions
diff --git a/Master/tlpkg/tlperl/lib/Hash/Util.pm b/Master/tlpkg/tlperl/lib/Hash/Util.pm
index 8ae25d14d97..da0251059cf 100644
--- a/Master/tlpkg/tlperl/lib/Hash/Util.pm
+++ b/Master/tlpkg/tlperl/lib/Hash/Util.pm
@@ -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.18';
require XSLoader;
XSLoader::load();
@@ -523,21 +523,20 @@ 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 +580,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;