Skip to content

Commit 40d6765

Browse files
mohawk2mohawk2
committed
oplot to leave {x,y}range alone
1 parent 6f47666 commit 40d6765

File tree

5 files changed

+108
-91
lines changed

5 files changed

+108
-91
lines changed

‎Changes‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
- exception when oplot in multiplot mode
2+
- oplot now leaves {x,y}range alone
23

34
1.013 2024-09-24
45
- adjust tests to avoid spurious "UNKNOWN" results

‎lib/PDL/Graphics/Simple.pm‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1509,7 +1509,12 @@ C<oplot>, C<xrange>, C<yrange>, C<crange>, C<wedge>, and C<justify>
15091509
parameters are always both present and defined.
15101510
15111511
If the C<oplot> plot option is set, then the plot should be overlain on
1512-
a previous plot - otherwise the module should display a fresh plot.
1512+
a previous plot, not losing any range settings, nor obeying any given.
1513+
B<NOTE> that if any data given to the original plot or any overplots might
1514+
be changed before plot updates happen, it is the user's responsibility
1515+
to pass in copies, since some engines (Prima and Gnuplot) only store
1516+
data by reference for performance reasons.
1517+
Otherwise the module should display a fresh plot.
15131518
15141519
Each curve block consists of an ARRAY ref with a hash in the 0 element
15151520
and all required data in the following elements, one PDL per

‎lib/PDL/Graphics/Simple/Gnuplot.pm‎

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -304,16 +304,16 @@ sub plot {
304304
my $ipo = shift;
305305

306306
my $po = {
307-
title => $ipo->{title},
308-
xlab => $ipo->{xlabel},
309-
ylab => $ipo->{ylabel},
310-
key => $ipo->{key},
311-
xrange => $ipo->{xrange},
312-
yrange => $ipo->{yrange},
313-
cbrange => $ipo->{crange},
314-
colorbox => $ipo->{wedge},
315-
justify => $ipo->{justify}>0 ? $ipo->{justify} : undef,
316-
clut => 'sepia',
307+
title => $ipo->{title},
308+
xlab => $ipo->{xlabel},
309+
ylab => $ipo->{ylabel},
310+
key => $ipo->{key},
311+
xrange => $ipo->{xrange},
312+
yrange => $ipo->{yrange},
313+
cbrange => $ipo->{crange},
314+
colorbox => $ipo->{wedge},
315+
justify => $ipo->{justify}>0 ? $ipo->{justify} : undef,
316+
clut => 'sepia',
317317
};
318318

319319
if ( defined($ipo->{legend}) ) {
@@ -337,7 +337,7 @@ sub plot {
337337

338338
$po->{logscale} = [$ipo->{logaxis}] if $ipo->{logaxis};
339339

340-
unless($ipo->{oplot}) {
340+
unless ($ipo->{oplot}) {
341341
$me->{curvestyle} = 0;
342342
}
343343

@@ -348,7 +348,7 @@ sub plot {
348348
my @blocks = ref($ct) eq 'CODE' ? $ct->($me, $po, @$block) : [{%{$block->[0]}, with=>$ct}, @$block[1..$#$block]];
349349
# Now parse out curve options and deal with line styles...
350350
for my $b (@blocks) {
351-
my $co = shift @$b;
351+
my ($co, @rest) = @$b;
352352
my $gco = { with => $co->{with} };
353353
unless($co->{with} eq 'labels') {
354354
$me->{curvestyle} = $co->{style} // ($me->{curvestyle}//0)+1;
@@ -359,7 +359,7 @@ sub plot {
359359
}
360360
}
361361
$gco->{legend} = $co->{key} if defined $co->{key};
362-
push @arglist, $gco, @$b;
362+
push @arglist, $gco, @rest;
363363
}
364364
}
365365

@@ -376,7 +376,6 @@ sub plot {
376376
$me->{obj}->plot(@arglist);
377377
}
378378

379-
380379
if ($me->{nplots}) {
381380
$me->{plot_no}++;
382381
if ($me->{plot_no} >= $me->{nplots}) {

‎lib/PDL/Graphics/Simple/Prima.pm‎

Lines changed: 77 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -425,16 +425,16 @@ sub plot {
425425

426426
my $plot;
427427

428-
if($ipo->{oplot} and defined($me->{last_plot})) {
428+
if ($ipo->{oplot} and defined($me->{last_plot})) {
429429
$plot = $me->{last_plot};
430430
} else {
431431
$me->{curvestyle} = 0;
432432

433-
if( $me->{multi} ) {
433+
if ($me->{multi}) {
434434
# Multiplot - handle logic and plot placement
435435

436436
# Advance to the next plot position. Erase the window if necessary.
437-
if($me->{next_plotno} and $me->{next_plotno} >= $me->{multi}->[0] * $me->{multi}->[1]) {
437+
if ($me->{next_plotno} and $me->{next_plotno} >= $me->{multi}->[0] * $me->{multi}->[1]) {
438438
map {$_->destroy} @{$me->{widgets}};
439439
$me->{widgets} = [];
440440
$me->{next_plotno} = 0;
@@ -474,87 +474,88 @@ sub plot {
474474
}
475475
}
476476

477-
## Set global plot options: titles, axis labels, and ranges.
478-
$plot->hide;
479-
$plot->lock;
480-
$plot->title( $ipo->{title} ) if(defined($ipo->{title}));
481-
$plot->x->label( $ipo->{xlabel} ) if(defined($ipo->{xlabel}));
482-
$plot->y->label( $ipo->{ylabel} ) if(defined($ipo->{ylabel}));
483-
484-
$plot->x->scaling(sc::Log()) if($ipo->{logaxis}=~ m/x/i);
485-
$plot->y->scaling(sc::Log()) if($ipo->{logaxis}=~ m/y/i);
486-
487-
$plot->x->min($ipo->{xrange}[0]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[0]));
488-
$plot->x->max($ipo->{xrange}[1]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[1]));
489-
$plot->y->min($ipo->{yrange}[0]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[0]));
490-
$plot->y->max($ipo->{yrange}[1]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[1]));
491-
492-
##############################
493-
# I couldn't find a way to scale the plot to make the plot area justified, so
494-
# we cheat and adjust the axis values instead.
495-
# This is a total hack, but at least it produces justified plots.
496-
if( !!($ipo->{justify}) ) {
497-
my ($dmin,$pmin,$dmax,$pmax,$xscale,$yscale);
498-
499-
($dmin,$dmax) = $plot->x->minmax;
500-
$pmin = $plot->x->reals_to_pixels($dmin);
501-
$pmax = $plot->x->reals_to_pixels($dmax);
502-
$xscale = ($pmax-$pmin)/($dmax-$dmin);
503-
504-
($dmin,$dmax) = $plot->y->minmax;
505-
$pmin = $plot->y->reals_to_pixels($dmin);
506-
$pmax = $plot->y->reals_to_pixels($dmax);
507-
$yscale = ($pmax-$pmin)/($dmax-$dmin);
508-
509-
my $ratio = $yscale / $xscale;
510-
if($ratio > 1) {
511-
# More Y pixels per datavalue than X pixels. Hence we expand the Y range.
512-
my $ycen = ($dmax+$dmin)/2;
513-
my $yof = ($dmax-$dmin)/2;
514-
my $new_yof = $yof * $yscale/$xscale;
515-
$plot->y->min($ycen-$new_yof);
516-
$plot->y->max($ycen+$new_yof);
517-
} elsif($ratio < 1) {
518-
# More X pixels per datavalue than Y pixels. Hence we expand the X range.
519-
($dmin,$dmax) = $plot->x->minmax;
520-
my $xcen = ($dmax+$dmin)/2;
521-
my $xof = ($dmax-$dmin)/2;
522-
my $new_xof = $xof * $xscale/$yscale;
523-
$plot->x->min($xcen-$new_xof);
524-
$plot->x->max($xcen+$new_xof);
525-
}
477+
if (!$ipo->{oplot}) {
478+
## Set global plot options: titles, axis labels, and ranges.
479+
$plot->hide;
480+
$plot->lock;
481+
$plot->title( $ipo->{title} ) if(defined($ipo->{title}));
482+
$plot->x->label( $ipo->{xlabel} ) if(defined($ipo->{xlabel}));
483+
$plot->y->label( $ipo->{ylabel} ) if(defined($ipo->{ylabel}));
484+
485+
$plot->x->scaling(sc::Log()) if($ipo->{logaxis}=~ m/x/i);
486+
$plot->y->scaling(sc::Log()) if($ipo->{logaxis}=~ m/y/i);
487+
488+
$plot->x->min($ipo->{xrange}[0]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[0]));
489+
$plot->x->max($ipo->{xrange}[1]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[1]));
490+
$plot->y->min($ipo->{yrange}[0]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[0]));
491+
$plot->y->max($ipo->{yrange}[1]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[1]));
492+
493+
##############################
494+
# I couldn't find a way to scale the plot to make the plot area justified, so
495+
# we cheat and adjust the axis values instead.
496+
# This is a total hack, but at least it produces justified plots.
497+
if ($ipo->{justify}) {
498+
my ($dmin,$pmin,$dmax,$pmax,$xscale,$yscale);
499+
500+
($dmin,$dmax) = $plot->x->minmax;
501+
$pmin = $plot->x->reals_to_pixels($dmin);
502+
$pmax = $plot->x->reals_to_pixels($dmax);
503+
$xscale = ($pmax-$pmin)/($dmax-$dmin);
504+
505+
($dmin,$dmax) = $plot->y->minmax;
506+
$pmin = $plot->y->reals_to_pixels($dmin);
507+
$pmax = $plot->y->reals_to_pixels($dmax);
508+
$yscale = ($pmax-$pmin)/($dmax-$dmin);
509+
510+
my $ratio = $yscale / $xscale;
511+
if($ratio > 1) {
512+
# More Y pixels per datavalue than X pixels. Hence we expand the Y range.
513+
my $ycen = ($dmax+$dmin)/2;
514+
my $yof = ($dmax-$dmin)/2;
515+
my $new_yof = $yof * $yscale/$xscale;
516+
$plot->y->min($ycen-$new_yof);
517+
$plot->y->max($ycen+$new_yof);
518+
} elsif($ratio < 1) {
519+
# More X pixels per datavalue than Y pixels. Hence we expand the X range.
520+
($dmin,$dmax) = $plot->x->minmax;
521+
my $xcen = ($dmax+$dmin)/2;
522+
my $xof = ($dmax-$dmin)/2;
523+
my $new_xof = $xof * $xscale/$yscale;
524+
$plot->x->min($xcen-$new_xof);
525+
$plot->x->max($xcen+$new_xof);
526+
}
527+
}
526528
}
527529

528-
529530
##############################
530531
# Rubber meets the road -- loop over data blocks and
531532
# ship out each curve to the appropriate dispatcher in the $types table
532533
for my $block (@_) {
533-
my $co = shift @$block;
534+
my ($co, @rest) = @$block;
534535

535-
# Parse out curve style (for points type selection)
536-
if (defined $co->{style}) {
537-
$me->{curvestyle} = $co->{style};
538-
} else {
539-
$me->{curvestyle}++;
540-
}
536+
# Parse out curve style (for points type selection)
537+
if (defined $co->{style}) {
538+
$me->{curvestyle} = $co->{style};
539+
} else {
540+
$me->{curvestyle}++;
541+
}
541542

542-
my $cprops = [
543-
color => $colors[ ($me->{curvestyle}-1) % @colors ],
544-
linePattern => $patterns[ ($me->{curvestyle}-1) % @patterns ],
545-
lineWidth => $co->{width} || 1
546-
];
547-
548-
my $with = $co->{with};
549-
my $type = $types->{$with};
550-
die "$with is not yet implemented in PDL::Graphics::Simple for Prima.\n"
551-
if !defined $type;
552-
if ( ref($type) eq 'CODE' ) {
553-
$type->($me, $plot, $block, $cprops, $co, $ipo);
554-
} else {
555-
my $pt = ref($type) eq 'ARRAY' ? $type->[ ($me->{curvestyle}-1) % (0+@{$type}) ] : ppair->can($type)->();
556-
$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair(@$block, plotType => $pt, @$cprops);
557-
}
543+
my $cprops = [
544+
color => $colors[ ($me->{curvestyle}-1) % @colors ],
545+
linePattern => $patterns[ ($me->{curvestyle}-1) % @patterns ],
546+
lineWidth => $co->{width} || 1
547+
];
548+
549+
my $with = $co->{with};
550+
my $type = $types->{$with};
551+
die "$with is not yet implemented in PDL::Graphics::Simple for Prima.\n"
552+
if !defined $type;
553+
if ( ref($type) eq 'CODE' ) {
554+
$type->($me, $plot, \@rest, $cprops, $co, $ipo);
555+
} else {
556+
my $pt = ref($type) eq 'ARRAY' ? $type->[ ($me->{curvestyle}-1) % (0+@{$type}) ] : ppair->can($type)->();
557+
$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair(@rest, plotType => $pt, @$cprops);
558+
}
558559
}
559560

560561
if ($me->{type} !~ m/f/i) {

‎t/simple.t‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,17 @@ for my $engine (@engines) {
168168
}
169169
$pgplot_ran ||= $engine eq 'pgplot';
170170

171+
# overplot
172+
eval { $w=PDL::Graphics::Simple->new(engine=>$engine); };
173+
is($@, '', "window open OK");
174+
my ($sq1, $p1) = (pdl('-3 1; -1 1; -1 -1; -3 -1; -3 1'), pdl('1 1 1 1 0'));
175+
$w->plot(with=>'polylines', $sq1, $p1,
176+
{xrange=>[-4,4],yrange=>[-4,4],j=>1});
177+
my $sq2 = pdl('1 1; 3 1; 3 -1; 1 -1; 1 1');
178+
$w->oplot(with=>'polylines', $sq2, $p1);
179+
ask_yn
180+
qq{Testing $engine engine: You should see 2 squares}, "oplot OK";
181+
171182
eval { $w = PDL::Graphics::Simple->new(engine=>$engine, multi=>[2,2], size=>[6,6]) };
172183
is($@, '', "constructor for $engine worked OK");
173184
isa_ok($w, 'PDL::Graphics::Simple', "constructor for $engine worked OK");

0 commit comments

Comments
 (0)