Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

matrix 'graphic' problem

by Angharad (Pilgrim)
on Oct 15, 2007 at 16:54 UTC ( #644978=perlquestion: print w/replies, xml ) Need Help??

Angharad has asked for the wisdom of the Perl Monks concerning the following question:

Hi there I'm just putting this out there with the hope that someone will know how best to tackle this. I have a plot to do and I was wondering how to proceed. I'll have a matrix file like so
1 1 20 1 2 45 1 3 46 2 1 45 etc ...
If one imagines the first two columns as 'objects' the third column is a measure of similarity between those two objects. I want to create a 2D grid as an image (.png/.ps file or similar) - it will probably be about 40 squares by 40 squares in size. I would like the measure of similarity between the two objects to be highlighted as a specific colour and the objects to become the 'x' 'y' co-ordinates of the matrix. Any pointers in the right direction would be appreciated.

Replies are listed 'Best First'.
Re: matrix 'graphic' problem
by zentara (Archbishop) on Oct 15, 2007 at 20:32 UTC
    Here is how you might do it in Tk. Check out the Tk::Graph module for something better. I did a quick hack on the axis and you need to figure out a way to convert your variance number to a hex string between 0 and 65536. Also the circles I make are not on-center. (Hey, I have to leave some work for you. :-) ) But a nice save-to-postscript sub is shown.
    #!/usr/bin/perl use warnings; use strict; use Tk; my $margin = 50; my $offset = 20; #axis offset my $x_max = 400; my $y_max = 400; my $mw = tkinit; my $scanvas = $mw->Scrolled('Canvas', -width => 500, -height => 500, -scrollregion => [-$margin,-$margin, $x_max + $margin, $y_max + $margin + $offset ], -scrollbars => 'osoe', -bg => 'black')->pack(-expand=>1, -fill=>'both'); &build_axis(); my $canvas = $scanvas->Subwidget('scrolled'); $canvas->Tk::bind("<Button-1>", [ \&print_xy, Ev('x'), Ev('y') ]); sub print_xy { my ($canv, $x, $y) = @_; print "(x,y) = ", $canv->canvasx($x), ", ", $y_max - $canv->canvasy( +$y) + $offset, "\n"; } my $subframe = $mw->Frame(-background =>'gray50')->pack(-fill => 'x'); $subframe->Button( -text => "Save", -command => [sub { $canvas->update; my @capture=(); my ($x0,$y0,$x1,$y1)=$canvas->bbox('all'); @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-$x +0); $canvas -> postscript(-colormode=>'color', -file=>$0.'.ps', -rotate=>90, -width=>800, -height=>500, @capture); } ] )->pack; $subframe->Button(-text =>'Exit', -background => 'hotpink', -activebackground => 'red', -command => sub{ exit } )->pack(-side=>'left',-padx=>40); while( <DATA> ){ chomp; my ($x,$y,$var) = split / /,$_; my $hexcolor = sprintf "%x", $var + 2000; print $hexcolor,"\n"; my $circle=$canvas->createOval($x, $y, $x + 10, $y + 10, -fill => '#'.$hexcolor.$hexcolor.$hexcolor, ); } MainLoop; ###################################################################### +# sub build_axis{ # axis my $xaxis = $scanvas->createLine( 0, $y_max + $offset, $x_max, $y_max ++ $offset, -width => 1, -fill => 'lightblue'); my $yaxis = $scanvas->createLine( 0, $y_max + $offset ,0,0, -width => 1, -fill => 'lightgreen'); # x axis ticks my $tflag; my $labflag; my $min =0 ; my $hour = 0; my $minflag = 0; my $hourflag = 0; my $tlength; my $color; for(1..$x_max){ $tflag = 0; $tlength = 5; $color = 'white'; $labflag = 0; if( ($_ % 10) == 0 ){ $tflag = 1 } #minutes are broken into 10 se +c intervals if( ($_ % 50) == 0 ){ $tlength = 15 ; $color = 'yellow'; $min++; $minflag = 1; $labflag = 1; } if( ($_ % 100) == 0 ){ $tlength = 25; $color = 'hotpink'; $hour++; $hourflag = 1; $labflag = 1; $minflag = 0; } if( $tflag ){ $scanvas->createLine( $_, $y_max + $offset, $_, $y_max + $offset + + $tlength, -width => 1, -fill => $color); if($labflag){ my $label; if($minflag){ $label = 100*($hour + .5); } else { if($hourflag){ $label = $hour * 100; } } $scanvas->createText( $_, $y_max + $offset + 1.2*$tlength, -text => $label, -fill => $color, -anchor => 'n', ); } } } # y axis ticks my $uflag; my $midflag; my @array = reverse(0..$y_max ); for(@array){ my $num = $y_max - $_; #reverse normal axis $tflag = 0; $tlength = 5; $color = 'white'; $uflag = 0; $midflag = 0; $labflag = 0; if( ($num % 10) == 0 ){ $tflag = 1 } if( ($num % 50) == 0 ){ $tlength = 10 ; $color = 'yellow'; $midflag = 1; $labflag = 1; } if( ($num % 100) == 0 ){ $tlength = 20; $color = 'hotpink'; $uflag = 1; $labflag = 1; $midflag = 0; } if( $tflag ){ $scanvas->createLine( 0 - $tlength, $num + $offset, 0, $num + $o +ffset, -width => 1, -fill => $color); if($labflag){ my $label; if($midflag){ $label = $num; } if($uflag){ $label = $num; } $scanvas->createText( -20 , $y_max + $offset - $num , -text => $label, -fill => $color, -anchor => 'e', ); } } } $scanvas->xview('moveto',0); $scanvas->yview('moveto',1); } __DATA__ 10 100 45 10 200 50 30 300 60 400 400 500

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
Re: matrix 'graphic' problem
by samtregar (Abbot) on Oct 15, 2007 at 17:31 UTC
    Take a step back, what are you really trying to do? It's hard to imagine what your real goal is based on what you've told us. What are you trying to visualize?

    Given just what you've asked, I'd say you should take a look at Imager (or possible Image::Magick or GD, although I much prefer Imager). You can easily create an image with colored boxes for your coordinates using that library.

    -sam

Re: matrix 'graphic' problem
by mwah (Hermit) on Oct 15, 2007 at 19:30 UTC
    Angharad 
    If one imagines the first two columns as 'objects' the third column is a measure of similarity between those two objects. I want to create a 2D grid as an image (.png/.ps file or similar)

    As has been said already, map the values on an array and map this array to an arbitary graphic output, like:

    ... use Imager; # OPEN FILE my $fn = 'datafile.dat'; open my $fh, '<', $fn or die "$fn $!"; # READ DATA INTO 2D MATRIX my @matrix = map [ qw(-1) x 40 ], 1..40; $matrix[$_->[1]][$_->[0]] = $_->[2] for map [split /\s+/ ], <$fh>; # PREPARE IMAGE my $scale=10; my $img = Imager->new(xsize=>40*$scale, ysize=>40*$scale, channels=>3 +); $img->box(filled=>1, color=>'#FFFFFF'); # CREATE IMAGE for my $row (0 .. @matrix-1) { for my $col (0 .. @{$matrix[$row]}-1) { my $val = $matrix[$row][$col]; next if $val == -1; # SELECT APPROPRIATE COLOR (BE CREATIVE HERE ;-) $img->box( color=>[ ($val/10)*25, $val*2.5, $val ], filled=>1, xmin=>$col*$scale, ymin=>$row*$scale, xmax=>($col+1)*$scale, ymax=>($row+1)*$scale ) } } # DUMP IMAGE TO FILE $img->write(file=>'my.jpg', jpegquality=>90) or die $img->errstr; ...

    (This is my first shot at Imager - after sams remark - and therefore the reason that I posted this, so feel free to give hints ...)

    Regards

    mwa

    Modification #1:

    • allow "black" squares to be drawn (similarity == 0): inititialize with -1
    • use filename and a lexical filehandle
    • don't draw anything if nothing got into the matrix cell (next if ...)

      Because it's Perl, I think I may try another shot (semi-golf version):

      use Imager; my ($n, $fac) = (40, 10); # 2D-SIZE, FACTOR TO IMAGE my $fn = shift || 'datafile.dat'; open my $fh, '<', $fn or die "$fn $!"; # OPEN FILE my $img = Imager->new(xsize=>$n*$fac, ysize=>$n*$fac, channels=>3); $img->box(filled=>1, color=>'#FFFFFF'); # BACKGROUND $img->box(color=>[($_->[2]/10)*25, $_->[2]*2.5, $_->[2] ], filled=>1, xmax=>($_->[0]+1)*$fac, ymax=>($_->[1]+1)*$fac, xmin=>$_->[0]*$fac, ymin=>$_->[1]*$fac) for map [split /\s+ +/], <$fh>; $img->write(file=>'my.jpg', jpegquality=>90) or die $img->errstr;

      the 2D matrix storage is't really necessary, this can be handled in "mid-air" ...

      Regards

      mwa

Re: matrix 'graphic' problem
by dwm042 (Priest) on Oct 15, 2007 at 18:25 UTC
    This problem seems like a natural for a 3D graph, with x, y and z projected onto the page and a surface used for the z elements. In any event, the PDL code (piddle) has some graphing routines that handle both 2 and 3D contexts, in the Module PDL::Graphics::TriD. I think this installs if you install PDL from CPAN.

    Update: A pure Perl graphing solution is GD::Graph, and a tutorial for this software is available here.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://644978]
Approved by NetWallah
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2023-02-05 19:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (32 votes). Check out past polls.

    Notices?