view release on metacpan or  search on metacpan

lib/Chart/GGPlot/Backend/Plotly/Util.pm  view on Meta::CPAN

package Chart::GGPlot::Backend::Plotly::Util;

# ABSTRACT: Utilities used by Chart::GGPlot::Backend::Plotly

use Chart::GGPlot::Setup qw(:base :pdl);

our $VERSION = '0.002003'; # VERSION

use Data::Frame;
use Data::Munge qw(elem);
use List::AllUtils qw(all min max pairmap pairwise reduce);
use PDL::Primitive qw(which);
use Types::PDL qw(Piddle);
use Types::Standard qw(Str);

use parent qw(Exporter::Tiny);

use Chart::GGPlot::Util::Scales qw(
  csshex_to_rgb255 colorname_to_csshex
);
use Chart::GGPlot::Util qw(mm_to_px);

use constant br => '<br />';

our @EXPORT_OK = qw(
  to_px
  br
  to_rgb
  group_to_NA
  pdl_to_plotly
  ribbon
);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

my $dpi = 96;

sub to_px { mm_to_px($_[0], $dpi) }

sub _rgb {
    my ($c) = @_;
    return 'transparent' if $c eq 'BAD';
    return $c =~ /^#/ ? $c : colorname_to_csshex($c);
}

sub _rgba {
    my ($c, $a) = @_;

    return 'transparent' if $c eq 'BAD';
    $c = $c =~ /^#/ ? $c : colorname_to_csshex($c);
    return $c if $a == 1;

    if ($c =~ /^#/) {
        return sprintf(
            "rgba(%s,%s,%s,%s)",
            csshex_to_rgb255($c),
            0+sprintf("%.2f", $a)   # 0+ for removing trailing zeros
        );
    }
    return $c;
}

# plotly does not understands some non-rgb colors like "grey35"
fun to_rgb ($color, $alpha=pdl(1)) {
    state $check = Type::Params::compile((Piddle | Str), Piddle);
    ($color, $alpha) = $check->($color, $alpha);

    if ( !ref($color) ) {
        return _rgba($color, $alpha->at(0));
    }
    else {
        if ($alpha->length != $color->length and $alpha->length != 1) {
            die "alpha must be of length 1 or the same length as x";
        }
        $alpha = $alpha->setbadtoval(1);
        $alpha->where($alpha > 1) .= 1;
        $alpha->where($alpha < 0) .= 0;
        
        my @color = $color->flatten;
        my @rgba;
        if ($alpha->uniq->length == 1 and $alpha->at(0) == 1) {
            @rgba = map { _rgb($_) } @color;
        } else {
            my @alpha = $alpha->flatten;
            @rgba = pairwise { _rgba($a, $b) } @color, @alpha;
        }

        return PDL::SV->new(\@rgba);
    }
}


fun group_to_NA ($df, :$group_vars=['group'],
                 :$nested=[], :$ordered=[], :$retrace_first=false) {
    return $df if ( $df->nrow == 0 );

    my $df_names = $df->names;
    $group_vars = $group_vars->intersect($df_names);
    $nested     = $nested->intersect($df_names);
    $ordered    = $ordered->intersect($df_names);

    # if group does not exist, just order the rows and exit
    unless ( $group_vars->length ) {
        my @key_vars = ( @$nested, @$ordered );
        return ( @key_vars ? $df->sort( \@key_vars ) : $df );
    }

    if ( $df->nrow == 1 ) {
        return ( $retrace_first ? $df->append( $df->select_rows(0) ) : $df );