view release on metacpan or  search on metacpan

lib/Chart/GGPlot/Layer.pm  view on Meta::CPAN

has data => (
    is  => 'ro',
    isa => Maybe [DataFrame],
);
has mapping => (
    is     => 'rw',
    coerce => 1,
    isa    => GGParams,
);
has geom        => ( is => 'ro', required => 1 );
has geom_params => (
    is     => 'rw',
    isa    => GGParams,
    coerce => 1,
);
has stat        => ( is => 'ro', required => 1 );
has stat_params => (
    is     => 'rw',
    isa    => GGParams,
    coerce => 1,
);
has aes_params => (
    is     => 'rw',
    isa    => AesMapping,
    coerce => 1,
);
has position    => ( is => 'ro', required => 1 );
has inherit_aes => ( is => 'ro', default  => sub { false } );


has show_legend => ( is => 'ro' );

around BUILDARGS( $orig, $class : @rest ) {
    my %params = @rest;
    return $class->$orig( %{ $class->_layer(%params) } );
};

classmethod _find_subclass ($super, $name) {
    return (
          $name =~ /^Chart::GGPlot::/
        ? $name
        : "Chart::GGPlot::${super}::"
          . join( '', map { ucfirst($_) } split( /_/, $name ) )
    );
}

classmethod _layer (Defined :$geom, Defined :$stat,
                    :$data = undef, :$mapping = undef,
                    Defined :$position,
                    :$params = { na_rm => false },
                    :$inherit_aes = true, :$check_aes = true,
                    :$check_param = true, :$show_legend = NA
  ) {
    $mapping //= Chart::GGPlot::Aes->new();
    unless ( defined $params->at("na_rm") ) {
        $params->set( "na_rm", "nan" );
    }

    my $find_subclass = fun( $super, $x ) {
        unless ( Ref::Util::is_ref($x) ) {  # $x is a class name
            my $subclass = $class->_find_subclass( $super, $x );
            load $subclass;
            return $subclass->new();
        }
        return $x;
    };
    $geom     = $find_subclass->( 'Geom',     $geom );
    $stat     = $find_subclass->( 'Stat',     $stat );
    $position = $find_subclass->( 'Position', $position );

    # Split up params between aesthetics, geom, and stat
    $params = Chart::GGPlot::Aes->new( $params->flatten );
    my $select_params = sub {
        my $names = shift;
        my %selected =
          map { $params->exists($_) ? ( $_ => $params->at($_) ) : () } @$names;
        return \%selected;
    };
    my $aes_params  = $geom ? &$select_params( $geom->aesthetics )       : {};
    my $geom_params = $geom ? &$select_params( $geom->parameters(true) ) : {};
    my $stat_params = $stat ? &$select_params( $stat->parameters(true) ) : {};

    # Warn about extra params and aesthetics

    my $all = [ $aes_params, $geom_params, $stat_params ]
      ->map( sub { $_->keys->flatten } );
    my $extra_param = $params->keys->setdiff($all);
    if ( $check_param and not $extra_param->isempty ) {
        carp( "Ignoring unknown parameters: " . join( ", ", @$extra_param ) );
    }

    my %seen_aes =
      map { $_ => 1 } ( @{ $geom->aesthetics }, @{ $stat->aesthetics } );
    my @extra_aes =
      grep { !exists $seen_aes{$_} }
      grep { defined $mapping->at($_) } @{ $mapping->keys };

    if ( $check_aes and @extra_aes ) {
        carp( "Ignoring unknown aesthetics: " . join( ", ", @extra_aes ) );
    }

    return {
        geom        => $geom,
        stat        => $stat,
        data        => $data,
        mapping     => $mapping,
        position    => $position,
        inherit_aes => $inherit_aes,
        show_legend => $show_legend,
        geom_params => $geom_params,
        stat_params => $stat_params,
        aes_params  => $aes_params,
    };
}


method string () {
    my $s = '';
    if ( $self->mapping ) {
        $s .= sprintf( "mapping: %s\n", clist( $self->mapping ) );