view release on metacpan or  search on metacpan

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

package Chart::GGPlot::Position::Util;

# ABSTRACT: Utilities internally used by Chart::GGPlot::Position

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

our $VERSION = '0.002003'; # VERSION

use Data::Frame;
use List::AllUtils qw(reduce);
use PDL::Core;
use PDL::Primitive qw(which);

use Chart::GGPlot::Util qw(ifelse match pmax pmin);

use parent qw(Exporter::Tiny);

our @EXPORT_OK   = qw(collide collide2 pos_dodge pos_dodge2 pos_stack);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

fun collide_setup ($data, $width, $name, $strategy,
                   $check_width=true, $reverse=false) {
    # determine width
    if ( defined $width ) {
        unless ( List::AllUtils::all { $data->exists($_) } qw(xmin xmax) ) {
            $data->set( 'xmin', $data->at('x') - $width / 2 );
            $data->set( 'xmax', $data->at('x') + $width / 2 );
        }
    }
    else {
        unless ( List::AllUtils::all { $data->exists($_) } qw(xmin xmax) ) {
            $data->set( 'xmin', $data->at('x') );
            $data->set( 'xmax', $data->at('x') );
        }

        my $widths = ( $data->at('xmax') - $data->at('xmin') )->uniq;
        $widths = $widths->where( $widths->isgood ) if $widths->badflag;

        $width = $widths->at(0);
    }

    return { data => $data, width => $width };
}

fun collide ($data, $width, $name, $strategy,
             :$check_width=true, :$reverse=false, %rest) {
    my $dlist =
      collide_setup( $data, $width, $name, $strategy, $check_width, $reverse );
    $data  = $dlist->{data};
    $width = $dlist->{width};

    # Reorder by x position, then on group. The default stacking order
    # reverses the group in order to match the legend order.
    $data = $data->sort( [qw(xmin group)], $reverse ? true : [ true, false ] );

    # TODO: ddply to preserve the order.
    #  So firstly DF::split() shall preserve the order.
    state $ddply = sub {
        my ( $df, $vars, $func ) = @_;

        my $ids         = $df->select_columns($vars)->id;
        my $splitted    = $df->split($ids);
        my @transformed = map { $func->($_) } values %$splitted;
        return ( reduce { $a->append($b) } @transformed );
    };

    my $strategy_wrapped = sub { $strategy->( $_[0], $width, %rest ) };
    if ( $data->exists('ymax') ) {
        $data = $ddply->( $data, ['xmin'], $strategy_wrapped );
    }
    elsif ( $data->exists('y') ) {
        $data->set( 'ymax', $data->at('y') );
        $data = $ddply->( $data, ['xmin'], $strategy_wrapped );
        $data->set( 'y', $data->at('ymax') );
    }
    else {
        die "Neither y nor ymax defined";
    }

    # TODO: This is only to maintain some order to get some tests pass.
    # This should be not needed once we fix ddply.
    return $data->sort( [qw(xmin group)], $reverse ? true : [ true, false ] );
}

# Alternate version of collide() used by position_dodge2()
fun collide2 ($data, $width, $name, $strategy,
              :$check_width=true, :$reverse=false, %rest) {
    my $dlist =
      collide_setup( $data, $width, $name, $strategy, $check_width, $reverse );
    $data  = $dlist->{data};
    $width = $dlist->{width};

    # Reorder by x position, then on group. The default stacking order is
    # different than for collide() because of the order in which pos_dodge2
    # places elements
    $data = $data->sort( [qw(xmin group)], $reverse ? [ true, false ] : true );

   return $strategy->($data, $width, %rest); 
}

fun pos_dodge ($df, $width, :$n=undef) {
    $n //= $df->at('group')->uniq->length;
    if ( $n == 1 ) {
        return $df;
    }

    my $d_width = ( $df->at('xmax') - $df->at('xmin') )->max;

    my $group    = $df->at('group');
    my $groupidx = match( $group, $group->uniq->qsort );
    $df->set( 'x', $df->at('x') + $width * ( ( $groupidx + 0.5 ) / $n - 0.5 ) );

    my $half_width = $d_width / $n / 2;