ANSI-Heatmap

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

      q{Class::Accessor::Fast} => 0,
      q{Test::More}            => 0,
    },
    MAN3PODS          => {
      'lib/ANSI/Heatmap.pm' => 'blib/man3/ANSI::Heatmap.3',
    },
    dist                => { COMPRESS => q{gzip -9f}, SUFFIX => q{gz}, },
    clean               => { FILES    => q{ANSI-Heatmap-*} },
);

sub WriteMakefile1 {
    my %params = @_;
    my $eumm_version = $ExtUtils::MakeMaker::VERSION;
    $eumm_version = eval $eumm_version;
    die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
    die "License not specified" if not exists $params{LICENSE};
    if ($params{AUTHOR} and ref($params{AUTHOR}) eq q{ARRAY}
        and $eumm_version < 6.5705) {
          $params{META_ADD}->{author}=$params{AUTHOR};
          $params{AUTHOR}=join(', ',@{$params{AUTHOR}});
    }

lib/ANSI/Heatmap.pm  view on Meta::CPAN

our @_fields = ('half', 'interpolate', 'width', 'height', @_minmax_fields);
__PACKAGE__->mk_accessors(@_fields);

my $TOPBLOCK = "\N{U+2580}";
my %SWATCHES = (
    'blue-red'  => [0x10 .. 0x15, 0x39, 0x5d, 0x81, 0xa5, reverse(0xc4 .. 0xc9)],
    'grayscale' => [0xe8 .. 0xff],
);
my $DEFAULT_SWATCH = 'blue-red';

sub new {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    my $self = bless { map => [], minmax => {} }, $class;
    $self->swatch($DEFAULT_SWATCH);
    $self->interpolate(0);
    $self->half(0);
    for my $field (@_fields, 'swatch') {
        $self->$field(delete $args{$field}) if exists $args{$field};
    }
    if (keys %args) {
        croak "Invalid constructor argument(s) " . join(', ', sort keys %args);
    }
    return $self;
}

sub swatch_names {
    my $self = shift;
    return (sort keys %SWATCHES);
}

sub set {
    my ($self, $x, $y, $z) = @_;
    $self->{map}[$y][$x] = $z;
    $self->_set_minmax(x => $x, y => $y, z => $z);
}

sub get {
    my ($self, $x, $y) = @_;
    return $self->{map}[$y][$x] || 0;
}

sub inc {
    my ($self, $x, $y) = @_;
    $self->set( $x, $y, $self->get($x, $y) + 1 );
}

sub swatch {
    my $self = shift;
    if (@_) {
        my $sw = shift;
        @_ == 0 or croak "swatch: excess arguments";
        if (ref $sw) {
            ref $sw eq 'ARRAY' or croak "swatch: invalid argument, should be string or arrayref";
            @$sw > 0 or croak "swatch: swatch is empty";
            $self->{swatch} = $sw;
        }
        else {
            defined $sw or croak "swatch: swatch name is undefined";
            exists $SWATCHES{$sw} or croak "swatch: swatch '$sw' does not exist";
            $self->{swatch} = $SWATCHES{$sw};
        }
    }
    return $self->{swatch};
}

sub to_string {
    my $self = shift;
    return $self->render($self->data);
}

# Convert heatmap hash to a 2D grid of intensities, normalised between 0 and 1,
# cropped to the min/max range supplied and scaled to the desired width/height.
sub data {
    my ($self, $mm) = @_;
    my %mm = $self->_figure_out_min_and_max;
    my $inv_max_z = $mm{zrange} ? 1 / $mm{zrange} : 0;
    my @out;

    my $xscale = $mm{width} / ($mm{max_x} - $mm{min_x} + 1);
    my $yscale = $mm{height} / ($mm{max_y} - $mm{min_y} + 1);
    my $get = sub { $self->{map}[ $_[1] ][ $_[0] ] || 0 };
    my $sample;
    if (!$self->interpolate
        || $xscale == int($xscale) && $yscale == int($yscale)) {
        $sample = $get;  # nearest neighbour/direct lookup
    }
    else {
        $sample = _binterp($get);
    }

    for my $y (0..$mm{height}-1) {

lib/ANSI/Heatmap.pm  view on Meta::CPAN

            $z -= $mm{min_z};
            $z *= $inv_max_z;

            $out[$y][$x] = $z;
        }
    }

    return \@out;
}

sub render {
    my ($self, $matrix) = @_;
    my $half = $self->half;

    my @s;
    for my $y (0..$#{$matrix}) {
        next if $half && $y % 2 == 1;

        for my $x (0..$#{$matrix->[$y]}) {
            my $top = $matrix->[$y][$x] || 0;
            my $bottom = $half ? ($y == $#{$matrix} ? undef : $matrix->[$y+1][$x] || 0)

lib/ANSI/Heatmap.pm  view on Meta::CPAN

            push @s, $char . "\e[0m";
        }
        push @s, "\n";
    }
    return join '', @s;
}


# Return hash of min/max values for each axis.
sub _figure_out_min_and_max {
    my $self = shift;
    my %calc = (
        (map { $_ => 0 } @_minmax_fields),
        %{$self->{minmax}},
        ($self->{minmax}{min_z}||0) >= 0 ? (min_z => 0) : (),
    );

    # Override with user-specified values, if supplied.
    for my $k (keys %calc) {
        $calc{$k} = $self->{$k} if defined $self->{$k};
    }

    # If user did not specify width/height, assume 1x scale.
    $calc{width}  = $self->{width} || ($calc{max_x} - $calc{min_x} + 1);
    $calc{height} = $self->{height} || ($calc{max_y} - $calc{min_y} + 1);
    $calc{zrange} = $calc{max_z} - $calc{min_z};

    return %calc;
}

sub _binterp {
    my $get = shift;
    return sub {
        my ($x, $y) = @_;
        my ($fx, $bx) = modf($x);
        my ($fy, $by) = modf($y);
        my @p = map { $get->($bx + $_->[0], $by + $_->[1]) } ([0,0],[0,1],[1,0],[1,1]);

        my $y1 = $p[0] + ($p[1] - $p[0]) * $fy;
        my $y2 = $p[2] + ($p[3] - $p[2]) * $fy;
        my $z = $y1 + ($y2 - $y1) * $fx;
        return $z;
    };
}

sub _set_minmax {
    my ($self, %vals) = @_;
    my $mm = $self->{minmax};
    while (my ($k, $v) = each %vals) {
        if (!defined $mm->{"min_$k"}) {
            $mm->{"min_$k"} = $mm->{"max_$k"} = $v;
        }
        else {
            $mm->{"min_$k"} = min($mm->{"min_$k"}, $v);
            $mm->{"max_$k"} = max($mm->{"max_$k"}, $v);
        }
    }
}

# Maps a number from [0,1] to a swatch colour.
sub _swatch_lookup {
    my ($self, $index) = @_;
    return $self->{swatch}->[$index * $#{$self->{swatch}} + .5];
}

1;

=head1 NAME

ANSI::Heatmap - render heatmaps to your terminal