How to convert PDL image to GdkPixbuf - perl

I'm trying to display a graph generated by PDL (using PLplot) inside a Gtk3 app. When I try the following code, I see two problems:
$pdlImg isn't a GdkPixbuf so new_from_pixbuf() doesn't work.
$pdlImg appears to be empty as because the error message prints out the 10x10x3 array as a string and they're all zeroes.
Code:
#!/usr/bin/perl -w
use strict;
use PDL;
use PDL::Graphics::PLplot;
use Gtk3 -init;
my $pdlImg = zeroes(byte, 10, 10, 3);
my $pl = PDL::Graphics::PLplot->new(DEV => 'mem', MEM => $pdlImg);
my $x = sequence(10);
my $y = $x**2;
$pl->xyplot($x, $y);
$pl->close;
my $win = Gtk3::Window->new;
my $img = Gtk3::Image->new_from_pixbuf($pdlImg);
$win->add($img);
$win->show_all;
Gtk3::main();

To answer your first question, you are having PLplot put the plot into a piddle that is 10 pixels wide and 10 pixels high. I'm not sure if you're just going to get one corner of the normal plot in that case, or if you're getting the whole plot sampled into those 10x10 pixels. But in either case it's no surprise that $pdlImg is entirely zeroes. Try passing in a piddle with larger size (perhaps 1000, 1000, 3), or perhaps even using MEM => $pdlImg=null when you create the PLplot plot object.
I can't help with your second question, I have no experience with Gtk3, sorry.

Related

Can't get Perl Chart (gnuplot) to label all tics on axis

Using Chart::Gnuplot in perl.
The x axis is to be for date/time.
I'm specifying
timeaxis => "x" (seems to work)
I'm using
timefmt => '%Y-%m-%d_%H:%M:%S'
to read the elements in the array ref passed to xdata in the Chart::Gnuplot::DataSet->new. (that seems to work too)
Using
xtics => {labelfmt => "%m-%d %H", rotate => -90}
to display the labels the way I want them. (that all seems to work too)
And indeed, everything looks good except for the fact that it's only labeling a handful of tics on the x (date/time) axis. I want to label them all (or every other one, or have some control over this)
I found lots of examples of how to do this for numbers (note dates) using... start, incr, end, etc... . And I tried lots of experiments to get this to work. But I think I've exhausted all that I can find on this googling around and I'm still stuck :-(
And so, if there is any advise on how to get this to label all the tics with the date/time, I'd very much appreciate it.
You can use xtics => { labels=>[...] } but you need to respect that
In case of timeseries data, position values must be given as quoted dates or times according to the format timefmt.
from gnuplot documentation.
Assuming the array #x contains the data set's time values in timefmt, x-tick labels can be forced at each of those times like this.
xtics => {
labels=>[map { q(').$_.q(') } #x]
}
There are plenty of ways to add single quotes around each time, but I think the map above is cleanest.
You can of course provide your own labels, just make sure they are quoted properly and the same as timefmt. I think Perl's q() quoting operator is the way to go.
labels=>[ q('2005-6-7_07:04:53') , q('2005-6-7_07:05:10') ]
Full working example
Here is a full working example, modified from the gnuplot tick examples.
#!/usr/bin/perl -w
use strict;
use Chart::Gnuplot;
# Change the date time format of the tic labels
# - the solution is the same as change the number format
# Date array
my #x = qw(
2005-6-7_07:00:00
2005-6-7_07:05:00
2005-6-7_07:10:00
2005-6-7_07:15:00
);
my #y = qw(
3562279127
3710215571
3877469703
3876354871
);
# Create the chart object
my $chart = Chart::Gnuplot->new(
output => 'test.png',
xtics => {
rotate => -90,
labelfmt => "%m-%d %H",
labels=>[map { q(').$_.q(') } #x]
},
timeaxis => "x", # declare that x-axis uses time format
);
# Data set object
my $data = Chart::Gnuplot::DataSet->new(
xdata => \#x,
ydata => \#y,
style => 'linespoints',
timefmt => '%Y-%m-%d_%H:%M:%S',
);
# Plot the graph
$chart->plot2d($data);
Without the labels, you'll get something like this.
With the labels, you'll get something like this.

How to read elevation from USGS NED DEM GridFloat file in Perl

I have downloaded a large set of GridFloat (.flt, .hdr) DEM files from USGS NED (1") in order to implement my own elevation service on my website. I would like to be able to look up an elevation from this fileset, given latitude and longitude as inputs. I use Perl for my website development. The files have a conventional naming scheme, and I am able to get the appropriate tile filename using the lat/lng. Howevever, accessing the internals of the file is where I'm having an issue.
I know the file is in a fairly straightforward format (.flt, apparently called "Gridfloat"), but I could use some help figuring out the magic numbers for calculating where in the file I need to seek to for a given lat/lng, and how to handle byte order and so on so that I end up with an elevation. From what I understand, apparently row ordering can be an issue, as well as byte ordering. I am looking for a recipe that does not involve use of any third party libraries such as GDAL, which I think are overly complicated and slow for what I want to do. I think it should be possible to just open the file, seek to a position based on some calculation, read some bytes and then unpack them into the correct byte order. Here is an example .hdr file that accompanies floatn48w097_1.flt, I think it has the necessary info. There are a bunch of other files that come with the .zip, including .prj, but I believe those are for a commercial program like ArcInfo. I think everything I need should be in the following .hdr file.
ncols 3612
nrows 3612
xllcorner -97.00166666667
yllcorner 46.99833333333
cellsize 0.000277777777778
NODATA_value -9999
byteorder LSBFIRST
What I'm really hoping for is a formula for calculating the row and column from the lat/lng, then another formula for translating the row/column into a position for seek, how many bytes to read, and how to convert those raw bytes into an integer (or whatever it is these files contain). I feel that this could be a very fast operation, without all the overhead involved with the larger libraries which seem to be focused on doing a lot of stuff that I don't need.
I don't need Perl code, just pseudocode showing the calculations for row/col offsets etc would be more than enough. I believe the files are binary format, a straightforward grid of 4-byte numbers. The file example that goes with the .hdr file above has a size of 52186176, and when you multiply the ncols by nrows (from the .hdr), you get 13046544. which divides nicely into the file size by 4. So I assume it's just a matter of getting the right formula for row/col based on lat/lng, and then getting the bytes swizzled into the right order. I've just not done this much.
I found some reference to the Gridfloat format here: coolutils.com/formats/flt so apparently the file consists of a grid of 64-bit floating point values.
Thanks!
Ok, I think I have an answer. The following is Perl routine, which seems to give back reasonable looking elevation values when tested with the USGS NED1 .flt files. The script takes latitude and longitude as command line arguments, looks up the file and indexes into the grid.
#!/usr/bin/perl
use strict;
use POSIX;
use Math::Round;
sub get_elevation
{
my ($lat, $lng) = #_;
my $lat_degree = ceil ($lat);
my $lng_degree = floor ($lng);
my $lat_letter = ($lat >= 0) ? 'n' : 's';
my $lng_letter = ($lng >= 0) ? 'e' : 'w';
my $lng_tilenum = abs($lng_degree);
my $lat_tilenum = abs($lat_degree);
my $tilename = $lat_letter . sprintf('%02d', $lat_tilenum) . $lng_letter . sprintf('%03d',$lng_tilenum);
my $path = "/data/elevation/ned1/$tilename/float${tilename}_1.flt";
print "path = $path\n";
die "No such file" if (!-e($path));
my ($lat_fraction, $lat_integral) = modf (abs($lat));
my $row = floor ((1 - $lat_fraction) * 3600);
my ($lng_fraction, $lng_integral) = modf (abs($lng));
my $col = floor ((1 - $lng_fraction) * 3600);
open(FILE, "<$path");
my $pos = (3612 * 4 * 6) + (3612 * 4 * $row) + (4 * 6) + ($col * 4);
seek (FILE, $pos, SEEK_SET);
my $buffer;
read (FILE, $buffer, 4);
close (FILE);
my ($elevation) = unpack('f', $buffer);
if ($elevation == -9999)
{
return 'undefined';
}
return $elevation;
}
my $lat = $ARGV[0];
my $lng = $ARGV[1];
my $elevation = get_elevation ($lat, $lng);
print "Elevation for ($lat, $lng) = $elevation meters (", $elevation * 3.28084, " feet)\n";
Hope this might be useful to anyone else trying to do the same kind of thing... I've tested this method now and it seems to produce good looking elevation profiles which are smoother than those from the 3" SRTM data.
Neil put me on the right track but I think there's a few problems with his original answer. I've added some fixes and improvements including on-the-fly download of the needed tile from the 1/3 arc second (10 meter) dataset, proper parsing of the header file, and what I believe is corrected indexing.
This is still mostly illustrative and should be improved before production use, particularly, hanging on to the header information and the file handle for repeated queries.
https://gist.github.com/biomiker/32fe34e1fa1bb49ae1135ab6652f596d

sprintf/printf right pad float with zeros in fixed width field

I am using PERL (for legacy reasons) and I would like to format fixed width columns in a CSV file. How do I format the following values:
1.0001
10.0001
100.0001
1000.0001
1000000.1
100000001
into fixed width of 8 by right padding floats with zeros or truncating, BUT if a large integer is encountered the field width must grow to accomodate:
1.000100
10.00010
100.0001
1000.000
1000000.
100000001
I am not performing any operations, so they could possibly be treated as strings or other. I've tried about every combination in the sprintf documentation.
Thanks.
[The question was changed after this was posted. This no longer answers the question.]
substr(sprintf("%.6f", $x), 0, 8)
or
substr($x.("0"x5), 0, 8)
There's probably a neater way, but this example should work:
my #array = qw(1.0001 10.0001 100.0001 1000.0001);
for my $nums (#array) {
$nums .= '0' while length $nums < 8;
print "$nums\n";
}
1.000100
10.00010
100.0001
1000.0001

FPDF print MultiCell() adjacently

I've googled around and found this question very common but I can't seem to find a proper and direct answer. I'm using FPDF and I want to generate tables using MultiCell() since I need the line break property of it. Tried Cell() but it can't read the line break.
$col1="PILOT REMARKS\n\n";
$pdf->MultiCell(189, 10, $col1, 1, 1);
$col2="Pilot's Name and Signature\n".$name;
$pdf->MultiCell(63, 10, $col2, 1);
$pdf->Ln(0);
$col3="Date Prepared\n".$date;
$pdf->MultiCell(63, 10, $col3, 1);
But I can't generate it properly 'cause MultiCell() stacks the result. How can I achieve having MultiCell() printed adjacently with each other in a most simple and easy way?
Found this similar question but it doesn't provide a clear answer. Any help will be appreciated. Thanks in advance.
Try storing the X and Y co-ordinates and then setting them after the write
$x = $pdf->GetX();
$y = $pdf->GetY();
$col1="PILOT REMARKS\n\n";
$pdf->MultiCell(189, 10, $col1, 1, 1);
$pdf->SetXY($x + 189, $y);
$col2="Pilot's Name and Signature\n".$name;
$pdf->MultiCell(63, 10, $col2, 1);
$pdf->Ln(0);
$col3="Date Prepared\n".$date;
$pdf->MultiCell(63, 10, $col3, 1);
Just to add to Danny's answer. I like keeping the Width of each column stored and then use that when executing the SetXY method.
Example:
$x = $this->x;
$y = $this->y;
$push_right = 0;
$this->MultiCell($w = 100,3,"Column\r\nNumber 1",1,'C',1);
$push_right += $w;
$this->SetXY($x + $push_right, $y);
$this->MultiCell($w = 60,3,"Column\r\nNumber 2",1,'C',1);
$push_right += $w;
$this->SetXY($x + $push_right, $y);
$this->MultiCell(0,3,"Column 3\r\nFilling in the Rest",1,'C',1);
You can use SetXY(x,y) function to set cursor in pdf .
$pdf->SetXY(x,y);
Set cursor to print data in pdf
Where x is x-axis value and y is y-axis value
None of these worked for me. I had to SetXY before each element (for some reason it's reseting to the start of the multicell after write of any element). So before each and every element, manually SetXY.
use $pdf->Ln(10);
with $pdf->cell();
Example:
$pdf->cell(100,10,"your content");
$pdf->Ln(10);

How can I write in scientific notation using Perl formats?

I've always used printf, and I've never used write/format. Is there any way to reproduce printf("%12.5e", $num) using a format? I'm having trouble digesting the perlform documentation, but I don't see a straightforward way of doing this.
EDIT: based on the answers I got, I'm just gonna keep on using printf.
Short answer, don't use formats.
Unresearched answer, sure, just use sprintf:
#!/usr/bin/perl
use strict;
use warnings;
our $num = .005;
write;
format STDOUT =
#>>>>>>>>>>>>>>>>>
sprintf("%12.5e", $num)
.
Seriously, if you need something like Perl 5 formats, take a look at Perl6::Form (note, this is a Perl 5 module, it just implements the proposed Perl 6 version of formats).
I totally agree with Chas. Owens on formats in general. Format was really slick 15 years ago, but format has not kept up with the advancements of the rest of Perl.
Here is a technique for line oriented output that I use time to time. You can use formline which is one of the public internal functions used by format. Format is page oriented. It is very hard to do things like span columns or change the format by line depending on the data. You can format a single line using the same text formatting logic used by format and then output that result yourself.
A (messy) example:
use strict; use warnings;
sub print_line {
my $pic=shift;
my #args=#_;
formline($pic,#args);
print "$^A\n";
$^A='';
}
my ($wlabel, $wlow, $whigh, $wavg)=(0,0,0,0);
my ($plabel,$plow,$phigh, $pavg);
my ($s_low,$s_high,$s_avg)=qw(%.2f %.2e %.2f);
my #results=( ["Label 1", 3.445, 0.00006678, .025],
["Label 2", 12.5555556, 55.112, 1.11],
["Wide Label 3", 1231.11, 1555.0, 66.66] );
foreach (#results) {
my $tmp;
$tmp=length($_->[0]);
$wlabel=$tmp if $tmp>$wlabel;
$tmp=length(sprintf($s_low,$_->[3]));
$wlow=$tmp if $tmp>$wlow;
$tmp=length(sprintf($s_high,$_->[2]));
$whigh=$tmp if $tmp>$whigh;
$tmp=length(sprintf($s_avg,$_->[1]));
$wavg=$tmp if $tmp>$wavg;
}
print "\n\n";
my #a1=("Label", "Rate - Operations / sec");
my #a2=("Text", "Average", "High", "Low");
my #a3=("----------", "-------", "----", "---");
my $l1fmt="#".'|' x $wlabel." #".'|'x($whigh+$wavg+$wlow+6);
my $l2fmt="#".'|' x $wlabel." #".'|' x $wavg." #".'|' x $whigh .
" #".'|' x $wlow;
print_line($l1fmt,#a1);
print_line($l2fmt,#a2);
print_line($l2fmt,#a3);
$plabel="#".'>' x $wlabel;
$phigh="#".'>' x $whigh;
$pavg="#".'>' x $wavg;
$plow="#".'<' x $wlow;
foreach (#results) {
my $pic="$plabel $pavg $phigh $plow";
my $mark=$_->[0];
my $avg=sprintf($s_avg,$_->[1]);
my $high=sprintf($s_high,$_->[2]);
my $low=sprintf($s_low,$_->[3]);
print_line($pic,$mark,$avg,$high,$low);
}
print "\n\n";
Outputs this:
Label Rate - Operations / sec
Text Average High Low
---------- ------- ---- ---
Label 1 3.44 6.68e-05 0.03
Label 2 12.56 5.51e+01 1.11
Wide Label 3 1231.11 1.56e+03 66.66
Notice that the width of the columns is set based on the width of the data as formatted by the sprintf format string. You can then left, center, right justify that result. The "Low" data column is left justified, the rest of the data are right justified. You can change this by the symbol used in the scalar $plow and it is the same as format syntax. The labels at the top are centered and the "Rate - Operations / sec" label spans 3 columns.
This is obviously not "production ready" code, but you get the drift I think. You would need to further check the total width of the columns against desired width, etc. You have to manually do some of the work that format does for you, but you have far more flexibility with this approach. It is very easy to use this method for several sections of a line with sprintf for example.
Cheers.