Chart-GGPlot
view release on metacpan or search on metacpan
lib/Chart/GGPlot/Scale/Functions.pm view on Meta::CPAN
}
}
return;
}
fun scale_type ($x) {
if ( $x->$_DOES('PDL::Factor') ) {
return $x->DOES('PDL::Factor::Ordered')
? [qw(ordinal discrete)]
: ['discrete'];
}
elsif ( $x->$_DOES('PDL::SV') ) {
return ['discrete'];
}
elsif ( $x->$_DOES('PDL::DateTime') ) {
return ['datetime'];
}
elsif ( $x->$_DOES('PDL') ) {
if ( $x->type eq 'byte' ) {
return ['discrete'];
}
else {
return ['continuous'];
}
}
return ['identity'];
}
fun _check_breaks_labels ( $breaks, $labels ) {
state $check = Type::Params::compile(
Maybe [ Piddle->plus_coercions(PiddleFromAny) | CodeRef ],
Maybe [
Piddle->plus_coercions( Any, sub { PDL::SV->new($_) } ) | CodeRef ]
);
( $breaks, $labels ) = $check->( $breaks, $labels );
return ( $breaks, $labels )
unless ( defined $breaks and !$breaks->isempty );
return ( $breaks, $labels )
unless ( defined $labels and !$labels->isempty );
# In R code there is check for is.atomic(breaks) && is.atomic(labels).
# List or function is not atomic in R.
if ( $breaks->$_isa('PDL')
&& $labels->$_isa('PDL')
&& ( $breaks->length != $labels->length ) )
{
die("`breaks` and `labels` must have the same length");
}
return ($breaks, $labels);
}
fun continuous_scale (:$aesthetics, :$scale_name,
:$palette, :$name=undef,
:$breaks=undef, :$minor_breaks=undef,
:$labels=undef, :$limits=null(),
:$rescaler=\&rescale, :$oob=\&censor, :$expand=undef,
:$na_value='nan',
:$trans="identity", :$guide="legend",
PositionEnum :$position="left",
Str :$super='Chart::GGPlot::Scale::Continuous',
%rest
) {
($breaks, $labels) = _check_breaks_labels( $breaks, $labels );
if ( ( defined $breaks and $breaks->isempty )
and !is_position_aes($aesthetics)
and $guide ne "none" )
{
$guide = "none";
}
$trans = as_trans($trans);
if ( defined $limits ) {
$limits = $trans->transform->( pdl($limits) );
}
load $super;
return $super->new(
pairgrep { defined $b }
(
aesthetics => $aesthetics,
scale_name => $scale_name,
palette => $palette,
range => continuous_range(),
limits => $limits,
trans => $trans,
na_value => $na_value,
expand => $expand,
rescaler => $rescaler, # Used by diverging and n color gradients
oob => $oob,
name => $name,
breaks => $breaks,
minor_breaks => $minor_breaks,
labels => $labels,
guide => $guide,
position => $position,
%rest
)
);
}
fun discrete_scale (:$aesthetics, :$scale_name,
:$palette, :$name=undef,
:$breaks=undef, :$labels=undef,
:$limits=PDL::SV->new([]),
:$expand=undef, :$na_translate=true, :$na_value=undef,
:$drop=true, :$guide="legend",
PositionEnum :$position = "left",
Str :$super = 'Chart::GGPlot::Scale::Discrete',
%rest
) {
($breaks, $labels) = _check_breaks_labels( $breaks, $labels );
if ( ( defined $breaks and $breaks->isempty )
and !is_position_aes($aesthetics)
and $guide ne "none" )
{
$guide = "none";
}
load $super;
return $super->new(
pairgrep { defined $b }
(
aesthetics => $aesthetics,
scale_name => $scale_name,
palette => $palette,
range => discrete_range(),
limits => $limits,
na_value => $na_value,
na_translate => $na_translate,
expand => $expand,
name => $name,
breaks => $breaks,
labels => $labels,
drop => $drop,
guide => $guide,
position => $position,
%rest
)
);
}
# In place modification of a scale to change the primary axis
fun scale_flip_position ($scale) {
state $switch = {
top => "bottom",
bottom => "top",
left => "right",
right => "left",
};
$scale->position( $switch->{ $scale->position } );
return $scale;
}
fun _scale_hue ($aes) {
return fun(:$h = pdl( [ 0, 360 ] ) + 15,
:$c = 100, :$l = 65,
:$h_start = 0,
:$direction = 1,
:$na_value = 'grey50',
%rest
) {
return discrete_scale(
aesthetics => $aes,
scale_name => 'hue',
lib/Chart/GGPlot/Scale/Functions.pm view on Meta::CPAN
:$sec_axis = undef,
%rest,
)
{
if ( defined $sec_axis ) {
if ( is_formula($sec_axis) ) {
$sec_axis = sec_axis($sec_axis);
}
if ( $sec_axis->$_isa('Chart::GGPlot::AxisSecondary') ) {
die(
"Secondary axes must be specified using a Chart::GGPlot::AxisSecondary object"
);
}
}
return continuous_scale(
pairgrep { defined $b } (
aesthetics => $aes,
scale_name => 'position_c',
palette => \&identity,
name => $name,
breaks => $breaks,
minor_breaks => $minor_breaks,
labels => $labels,
limits => $limits,
expand => $expand,
oob => $oob,
na_value => $na_value,
trans => $trans,
guide => "none",
position => $position,
( $sec_axis ? ( secondary_axis => $sec_axis ) : () ),
super => 'Chart::GGPlot::Scale::ContinuousPosition',
%rest
)
);
};
}
*scale_x_continuous = _scale_position_continuous(
[
qw(x xmin xmax xend xintercept xmin_final xmax_final xlower xmiddle xupper)
]
);
*scale_y_continuous = _scale_position_continuous(
[qw(y ymin ymax yend yintercept ymin_final ymax_final lower middle upper)]
);
for my $trans (qw(log10 reverse sqrt)) {
for my $aes (qw(x y)) {
my $scale_func = "scale_${aes}_${trans}";
my $continuous_func = "scale_${aes}_continuous";
no strict 'refs';
*{$scale_func} = sub { $continuous_func->( @_, trans => $trans ) }
}
}
fun scale_size_continuous (:$name=undef, :$breaks=undef, :$labels=undef,
:$limits=[], :$range=[1, 6],
:$trans='identity', :$guide='legend') {
return continuous_scale(
pairgrep { defined $b } (
aesthetics => 'size',
scale_name => 'area',
palette => area_pal($range),
name => $name,
breaks => $breaks,
labels => $labels,
limits => $limits,
trans => $trans,
guide => "none",
)
);
}
fun _scale_discrete ($aes) {
return fun( :$expand = undef, :$position = _default_position($aes),
%rest ) {
return discrete_scale(
pairgrep { defined $b } (
aesthetics => $aes,
scale_name => 'position_c',
palette => \&identity,
expand => $expand,
guide => "none",
position => $position,
range_c => continuous_range(),
super => 'Chart::GGPlot::Scale::DiscretePosition',
%rest
)
);
};
}
*scale_x_discrete = _scale_discrete( [qw(x xmin xmax xend)] );
*scale_y_discrete = _scale_discrete( [qw(y ymin ymax yend)] );
fun scale_continuous_identity ( :$aesthetics, :$guide='none', %rest ) {
return continuous_scale(
pairgrep { defined $b } {
aesthetics => $aesthetics,
scale_name => 'identity',
palette => identity_pal(),
guide => $guide,
super => 'Chart::GGPlot::Scale::ContinuousIdentity',
%rest,
}
);
}
fun scale_discrete_identity ( :$aesthetics, :$guide='none', %rest ) {
return discrete_scale(
pairgrep { defined $b } (
aesthetics => $aesthetics,
scale_name => 'identity',
palette => identity_pal(),
guide => $guide,
super => 'Chart::GGPlot::Scale::DiscreteIdentity',
%rest,
)
);
}
for my $aes (qw(fill shape linetype color)) {
my $scale_func = "scale_${aes}_identity";
no strict 'refs';
*{$scale_func} = fun(%rest) {
scale_discrete_identity( %rest, aesthetics => $aes )
};
}
for my $aes (qw(alpha size)) {
my $scale_func = "scale_${aes}_identity";
no strict 'refs';
*{$scale_func} = fun(%rest) {
scale_continuous_identity( %rest, aesthetics => $aes )
};
}
#=func scale_x_date
#
# scale_x_date(:$name = undef, :$breaks = undef,
# :$date_breaks = undef, :$labels = undef, :$date_labels = undef,
# :$minor_breaks = undef, :$date_minor_breaks = undef,
# :$limits = undef, :$expand = undef,
# PositionEnum :$position = "bottom",
# :$sec_axis = undef)
#
#=func scale_y_date
#
# scale_y_date(:$name = undef, :$breaks = undef,
# :$date_breaks = undef, :$labels = undef, :$date_labels = undef,
# :$minor_breaks = undef, :$date_minor_breaks = undef,
# :$limits = undef, :$expand = undef,
# PositionEnum :$position = "left",
# :$sec_axis = undef)
fun datetime_scale (:$aesthetics, :$trans, :$palette,
:$breaks = pretty_breaks(), :$minor_breaks = undef,
:$labels = undef, :$date_breaks = undef,
:$date_labels = undef,
:$date_minor_breaks = undef, :$timezone = undef,
:$guide = 'legend',
%rest) {
# TODO: handle timezone
if ( defined $date_breaks ) {
$breaks = date_breaks($date_breaks);
}
if ( defined $date_minor_breaks ) {
$minor_breaks = date_breaks($date_minor_breaks);
}
if ( defined $date_labels ) {
$labels = sub {
my ($x) = @_;
return $x->as_pdlsv;
};
}
my $name = 'datetime';
state $positional_aes =
{ map { $_ => 1 } qw(x xmin xmax xend y ymin ymax yend) };
my $scale_class;
if ( List::AllUtils::all { $positional_aes->exists($_) }
$aesthetics->flatten )
{
if ($name eq 'datetime') {
$scale_class = 'Chart::GGPlot::Scale::ContinuousDateTime';
}
}
else {
$scale_class = 'Chart::GGPlot::Scale::Continuous';
}
my $sc = continuous_scale(
pairgrep { defined $b } (
aesthetics => $aesthetics,
scale_name => $name,
palette => $palette,
breaks => $breaks,
minor_breaks => $minor_breaks,
labels => $labels,
guide => $guide,
trans => $trans,
super => $scale_class,
%rest,
)
);
#$sc->timezone($timezone);
return $sc;
}
fun _scale_datetime ($aes) {
return fun(:$name = undef, :$breaks = undef, :$date_breaks = undef,
:$labels = undef, :$date_labels = undef,
:$minor_breaks = undef, :$date_minor_breaks = undef,
:$timezone = undef,
:$limits = undef, :$expand = undef,
PositionEnum :$position = _default_position($aes),
:$sec_axis = undef) {
lib/Chart/GGPlot/Scale/Functions.pm view on Meta::CPAN
*scale_x_datetime = _scale_datetime([qw(x xmin xmax xend)]);
*scale_y_datetime = _scale_datetime([qw(y ymin ymax yend)]);
fun _mid_rescaler ($mid) {
return fun( $v, $to = [ 0, 1 ], $from = range( $v, true ) ) {
rescale_mid( $v, $to, $from, $mid );
};
}
# TODO: remove this
sub _na_value_color { $_[0] }
sub _default_position {
my ($aes) = @_;
$aes = $aes->[0] if ref($aes);
return ($aes =~ /^x/ ? 'bottom' : 'left');
}
# register scale functions within this pacakge
fun _register_scale (Str $name, CodeRef $func) {
$scale_funcs{$name} = $func;
}
use Package::Stash;
my $stash = Package::Stash->new(__PACKAGE__);
my $symbols = $stash->get_all_symbols('CODE');
for my $key ( grep { /^scale_/ } keys %$symbols ) {
_register_scale( $key, $symbols->{$key} );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Chart::GGPlot::Scale::Functions - Scale functions
=head1 VERSION
version 0.002003
=head1 FUNCTIONS
=head2 find_scale($aes, $x)
Find scale function by aes name and data type. The scale function is in the
form of C<scale_${aes}_${type}>, where C<$type> is decided by C<$x>.
=head2 continuous_scale
continuous_scale (:$aesthetics, :$scale_name, :$palette, :$name=undef,
:$breaks=undef, :$minor_breaks=undef, :$labels=undef,
:$limits=null(), :$rescaler=\&rescale, :$oob=\&censor,
:$expand=undef, :$na_value='nan', :$trans="identity",
:$guide="legend", PositionEnum :$position="left",
Str :$super='Chart::GGPlot::Scale::Continuous',
%rest)
Continuous scale constructor.
It's internally used by the continous scales in this module.
Arguments:
=over 4
=item * $aesthetics
The name of the aesthetics that this scale works with.
=item * $scale_name
The name of the scale.
=item * $palette
A palette function that when called with a numeric piddle with values
between 0 and 1 returns the corresponding values in the range the scale maps
to.
=item * $name
The name of the scale. Used as the axis or legend title.
If C<undef>, the default, the name of the scale is taken from the first
mapping used for that aesthetic.
=item * $breaks
Major breaks.
One of:
=over 8
=item *
An empty piddle for no breaks
=item *
C<undef> for default breaks computed by the transformation object
=item *
A numeric piddle of positions
=item *
A function that given the limits and returns a piddle of breaks
=back
=item * $minor_breaks
One of:
=over 8
=item *
An empty piddle for no minor breaks
=item *
C<undef> for the default breaks (one minor break betwen each major break)
=item *
A numeric piddle of positions
=item *
A function that given the limits and return a piddle of minor breaks
=back
=item * $labels
One of:
=over 8
=item *
lib/Chart/GGPlot/Scale/Functions.pm view on Meta::CPAN
A function that given the breaks and returns labels
=back
=item * $limits
A numeric piddle of length two providing limits of the scale. Use C<BAD>
to refer to the existing minimum or maximum.
=item * $rescaler
A function used to scale the input values to the range C<[0, 1]>.
Used by diverging and n color gradients (i.e. C<scale_color_gradient2()>,
C<scale_colour_gradientn()>).
=item * $oob
Function that handles limits outside of the scale limits (out of bounds).
The default replaces out of bounds values with C<BAD>.
=item * $expand
Vector of range expansion constants used to add some padding around the
data, to ensure that they are placed some distance away from the axes.
Use the convenience function C<expand_scale()> to generate the values for
the expand argument.
The defaults are to expand the scale by 5% on each side for continuous
variables, and by 0.6 units on each side for discrete variables.
=item * $na_value
Missing values will be replaced with this value.
=item * $trans
Either the name of a transformation object, or the object itself.
See L<Chart::GGPlot::Trans::Functions> for built-in transformations.
Default is C<"identity">.
=item * $guide
A function used to create a guide or its name.
=item * $position
The position of the axis. C<"left"> or C<"right"> for vertical scales,
C<"top"> or C<"bottom"> for horizontal scales.
=item * super
The class to use for the constructed scale.
Default is L<Chart::GGPlot::Scale::Continuous>.
=back
=head2 discrete_scale
discrete_scale(:$aesthetics, :$scale_name, :$palette, :$name=undef,
:$breaks=undef, :$labels=undef, :$limits=PDL::SV->new([]),
:$expand=undef, :$na_translate=true, :$na_value=undef,
:$drop=true, :$guide="legend", PositionEnum :$position = "left",
Str :$super = 'Chart::GGPlot::Scale::Discrete',
%rest)
Discrete scale constructor.
It's internally used by the discrete scales in this module.
Arguments:
=over 4
=item * $aesthetics
The name of the aesthetics that this scale works with.
=item * $scale_name
The name of the scale.
=item * $palette
A palette function that when called with a single argument (the number of
levels in the scale) returns the values that they should take.
=item * $name
The name of the scale. Used as the axis or legend title.
If C<undef>, the default, the name of the scale is taken from the first
mapping used for that aesthetic.
=item * $breaks
Major breaks.
One of:
=over 8
=item *
An empty piddle for no breaks
=item *
C<undef> for default breaks computed by the transformation object
=item *
A L<PDL::SV> piddle of positions
=item *
A function that given the limits and returns a piddle of breaks
=back
=item * $minor_breaks
One of:
=over 8
=item *
An empty piddle for no minor breaks
=item *
C<undef> for the default breaks (one minor break betwen each major break)
=item *
A L<PDL::SV> piddle of positions
=item *
A function that given the limits and return a piddle of minor breaks
=back
=item * $labels
One of:
=over 8
=item *
( run in 1.151 second using v1.01-cache-2.11-cpan-39bf76dae61 )