package Data::CloudWeights; # @(#)$Id: CloudWeights.pm 29 2008-02-27 15:51:08Z pjf $ # Originally WWW::CloudCreator. Now returns even more raw result use strict; use warnings; use base qw(Class::Accessor::Fast); use Readonly; use version; our $VERSION = qv( sprintf '0.1.%d', q$Rev: 29 $ =~ /\d+/gmx ); Readonly my %ATTRS => ( # Input. Set in constructor or call mutator before formation method cold_colour => q(0000FF), # Blue colour_pallet => [ qw(CC33FF 663399 3300CC 99CCFF 00FFFF 66FFCC 66CC99 006600 CCFF66 FFFF33 FF6600 FF0000) ], decimal_places => 2, # Defaults for ems hot_colour => q(FF0000), # Red max_size => 2.0, # Output size no more than min_size => 0.66, # Output size no less than # Output. Calling accessors becomes useful after last call to add method max_count => 0, # Current max value across all tags cloud min_count => -1, # Current min total_count => 0, # Current total for all tags in the cloud # Private. _base => undef, _counts_ref => undef, _step => undef, _values_ref => undef ); __PACKAGE__->mk_accessors( keys %ATTRS ); sub new { # Constructor accepts a hash ref or a list of key value pairs my ($me, @rest) = @_; my $args = $me->_arg_list( @rest ); my $self = bless { %ATTRS }, ref $me || $me; for (grep { exists $self->{ $_ } } keys %{ $args }) { $self->$_( $args->{ $_ } ); } $self->_base( [] ); $self->_counts_ref( {} ); $self->_step( [] ); $self->_values_ref( {} ); return $self; } sub add { # Include the passed args in this cloud's formation my ($me, $tag, $count, $value) = @_; return unless ($tag); # Mandatory arg used as a key in counts and values # Mask out null strings and negative numbers from the passed count value $count = defined $count ? abs $count : 0; # Add this count to the total for this cloud $me->total_count( $me->total_count + $count ); # Store the count. Calls with the same tag are cumulative $count += $me->_counts_ref->{ $tag } || 0; $me->_counts_ref->{ $tag } = $count; # Update this cloud's max and min values $me->max_count( $count ) if ($count > $me->max_count); $me->min_count( $count ) if ($me->min_count == -1); $me->min_count( $count ) if ($count < $me->min_count); if (defined $value) { my $tag_value = $me->_values_ref->{ $tag }; # Make an array if there are two or more calls to add the same tag if ($tag_value && ref $tag_value ne q(ARRAY)) { $me->_values_ref->{ $tag } = [ $tag_value ]; } # Push passed value in each call onto the values array. if ($tag_value) { push @{ $me->_values_ref->{ $tag } }, $value } else { $me->_values_ref->{ $tag } = $value } } # Return the current cumulative count for this tag return $me->_counts_ref->{ $tag }; } sub formation { # Calculate the result set for this cloud my ($count, $me, $ntags, $out, $prec, $ratio, $rng, $size, $step, @tags); $me = shift; $prec = 10**$me->decimal_places; $rng = abs $me->max_count - $me->min_count || 1; $step = ($me->max_size - $me->min_size) / $rng; $ntags = @tags = keys %{ $me->_counts_ref }; $out = []; return $out if ($ntags == 0); # No calls to add were made if ($ntags == 1) { # One call to add was made $out = [ { colour => $me->hot_colour || pop @{ $me->colour_pallet }, count => $me->_counts_ref->{ $tags[0] }, percent => 100, size => $me->max_size, tag => $tags[0], value => $me->_values_ref->{ $tags[0] } } ]; return $out; } for (sort @tags) { # Multiple calls to add were made $count = $me->_counts_ref->{ $_ }; $ratio = $count / $me->total_count; $size = $me->min_size + $step * ($count - $me->min_count); # Push the return array with a hash ref for each key value pair # passed to the add method push @{ $out }, { colour => $me->_calculate_temperature( $count ), count => $count, percent => (int 0.5 + $prec * 100 * $ratio) / $prec, size => (int 0.5 + $prec * $size) / $prec, tag => $_, value => $me->_values_ref->{ $_ } }; } return $out; } # Private methods begin with _ sub _arg_list { my ($me, @rest) = @_; return $rest[0] && ref $rest[0] eq q(HASH) ? $rest[0] : { @rest }; } sub _hex2dec { # Simple conversion sub my ($me, $index, $val) = @_; return 16 * (hex substr $val, 2 * $index, 1) + (hex substr $val, 2 * $index + 1, 1); } sub _calculate_temperature { # Generate an RGB colour for a given count my ($me, $cnt) = @_; my ($bands, $cold, $colour, $hot, $index, $rng); $cnt -= $me->min_count; $rng = (abs $me->max_count - $me->min_count) || 1; # Unsetting hot or cold colour strings in the constructor will cause # the pallet to be used instead of the exact calculation method if ($me->hot_colour && $me->cold_colour) { unless (defined $me->_base->[0]) { # Setup the RGB colour increment steps for (0 .. 2) { $cold = $me->_base->[$_] = $me->_hex2dec( $_, $me->cold_colour ); $hot = $me->_hex2dec( $_, $me->hot_colour ); $me->_step->[$_] = ($hot - $cold) / $rng; } } # Exact calculation method for (0 .. 2) { $colour .= sprintf '%02x', $me->_base->[$_] + $cnt * $me->_step->[$_]; } } else { # Select colour from the pallet by allocating the value to a band $bands = scalar @{ $me->colour_pallet }; $index = int 0.5 + ($cnt * ($bands - 1) / $rng); $colour = $me->colour_pallet->[$index]; } return $colour; } 1; __END__ =pod =head1 Name Data::CloudWeights - Calculate values for an HTML tag cloud =head1 Version 0.1.$Rev: 29 $ =head1 Synopsis use Data::CloudWeights; # Create a new cloud my $cloud = Data::CloudWeights->new( \%cfg ); # Add one or more tags to the cloud $cloud->add( $name, $count, $value ); # Calculate the tag cloud values my $nimbus = $cloud->formation(); =head1 Description Each tag added to the cloud has a unique name to identify it, a count which represents the size of the tag and a value that is associated with the tag. The reference returned by C<$cloud-E<gt>formation()> is a list of hash refs, one hash ref per tag. In addition to the input parameters each hash ref contains the scaled size, the percentage of total and a colour value in the range hot to cold. The cloud typically displays the tag name and count in the calculated colour with a font size set equal to the scaled value in the result =head1 Configuration and Environment =head2 new $cloud = Data::CloudWeights->new( [{] attr => value, ... [}] ) This is a class method, the constructor for Data::CloudWeights. Options are passed as either a list of keyword value pairs or a hash ref. Options are: =head3 cold_colour The six character hex colour for the smallest count in the cloud. Defaults to 0000FF (blue) =head3 colour_pallet An array ref of hex colour values. If the cold_colour attribute is set to null then the colour values from the pallet are used instead of calculating the colour value from the scaled count. Defaults to twelve values that give an even transition from blue to red =head3 decimal_places The number of decimal places returned in the size attribute. Defaults to 2. With the default values for high and low this lets you set the tags font size in ems. If set to 0 and the high/low values suitably changed tag font size can be set in pixies =head3 hot_colour The six character hex colour for the highest count in the cloud. Defaults to FF0000 (red) =head3 max_size The upper boundary value to which the highest count in the cloud is scaled. Defaults to 2.0 (ems) =head3 min_size The lower boundary value to which the smallest count in the cloud is scaled. Defaults to 0.66 (ems) =head1 Subroutines/Methods =head2 add $cloud->add( $name, $count, $value ); Adds the tag name, count, and value triple to the cloud. The formation method returns a ref to an array of hash refs. Each hash ref contains one of these triples and the calculated attributes. The value arg is optional. Passing a count of zero will do nothing but returns the current cumulative total count for this tag name =head2 formation $cloud->formation(); Return a ref to an array of hash refs. The attributes of each hash ref are: =head3 colour Calculated or dereferenced via the pallet, this is the hex colour string for this tag =head3 count The supplied size for this tag. Multiple calls to the add method for the same tag cause these counts to accumulate =head3 percent The percentage of the total count that this tag represents =head3 size The count scaled to a value between max_size and min_size =head3 tag The supplied name for this tag =head3 value The supplied value for this tag. This is usually an href but can be any scalar. If multiple calls to add the same tag were made this will be an array ref containing each of the passed values =head2 _hex2dec $class->_hex2dec( $index, $hex_value ); Private method converts a two character string representation of a number to a decimal integer in the range 0 - 255 =head2 _calculate_temperature $obj->_calculate_temperature( $count ); Private method used internally to calculate a colour value for a tag. If the 'hot' or 'cold' value is undefined a discreet colour value will be selected from the 'pallet' instead of calculating it using a continuous function =head1 Diagnostics None =head1 Acknowledgements =over 4 =item Originally L<WWW::CloudCreator> This did not let me calculate font sizes in ems =back =head1 Dependencies =over 4 =item L<Class::Accessor::Fast> =back =head1 Incompatibilities There are no known incompatibilities in this module. =head1 Bugs and Limitations There are no known bugs in this module. Please report problems to the address below. Patches are welcome. =head1 Author Peter Flanigan, C<< <Support at RoxSoft.co.uk> >> =head1 License and Copyright Copyright (c) 2007 Peter Flanigan. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<perlartistic>. This program is distributed in the hope that it will be useful, but WITHOUT WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut # Local Variables: # mode: perl # tab-width: 3 # End: