in reply to Re: Data visualisation.
in thread Data visualisation.
Do you have a way to check whether the coordinates look reasonable against your original data? I'm curious at how good the program works.
Sorry for the delay in getting back to you Roboticus, but I was caught up with my own efforts. I tried C&ping my dataset into your code but something broke and I couldn't immediately see what.
I finally just got back to it and it was simply that you use split /\s+/ rather than split ' ' and my data had leading whitespace which screwed everything up. Fixed that, ran it and got:
Those undefs are the points you had trouble with I assume. Everyone has found problems with the dataset -- it comes from TSPLIB and there was never any guarantee that it was a plottable dataset; that's part of the reason for whating to try and visualise it.
However, everyone seems to have problems with different points.
I eventually gave up with the Law of Cosines method. Not only are there four quadrants that each point could be in, there are two points (+-y) that need to be considered. Instead I went the Circle-Circle intersection route, which proved to be far simpler.
This animated gif shows the problem with the dataset quite nicely. The green arcs are the distances from B & P. The cyan arc is from the 3rd point (in this case the A point), which is used to decide (nearest wins) which of the two intersect points of the green arcs is chosen. It also highlights the accuracy or lack thereof of the correspondence between them.
It shows that -- with A as the third point -- D is a particularly bad fit; but chose a different 3rd reference point and D might be spot on but some other previously good fit point becomes bad.
Anyway, many thanks for your code -- you're first attempt was the cluebat I needed to get started. I've added my code below, but it is also very obfuscated with the image generation code. I need to separate the two, but it was very useful when coding.
My code:
#! perl -slw use strict; use Data::Dump qw[ pp ]; $Data::Dump::WIDTH = 200; use List::Util qw[ min max sum ]; use GD; use enum qw[ X Y ]; use constant PI => 3.1415926535897932384626433832795; my @N2A; @N2A[ 0 .. 25 ] = 'A'..'Z'; sub acos { atan2( sqrt( 1 - $_[0] * $_[0] ), $_[0] ) } sub asin { atan2( $_[0], sqrt( 1 - $_[0] * $_[0] ) ) } sub rgb2n{ local $^W; unpack 'N', pack 'CCCC', 0, @_ } my $BLACK = rgb2n( 0,0,0 ); my $RED = rgb2n( 255, 0, 0 ); my $GREEN = rgb2n( 0, 255, 0 ); my $BLUE = rgb2n( 0, 0, 255 ); my $YELLOW = rgb2n( 255, 255, 0 ); my $MAGENTA = rgb2n( 255, 0, 255 ); my $CYAN = rgb2n( 0, 255, 255 ); my $WHITE = rgb2n( 255,255,255 ); my( $xOrg, $yOrg, @pts, @dists ); sub plotPt{ my( $im, $pt, $label ) = @_; $im->filledArc( $pt->[X] +$xOrg, $pt->[Y] +$yOrg, 14, +14, 0, 360, $RED ); $im->string( gdSmallFont, $pt->[X]-1+$xOrg, $pt->[Y]-7+$yOrg, $lab +el, $BLACK ) } sub plotRoute{ my( $im, $pt1, $pt2 ) = @_; $im->line( $pt1->[X]+$xOrg, $pt1->[Y]+$yOrg, $pt2->[X]+$xOrg, $pt2 +->[Y]+$yOrg, $BLUE ); } sub plotArc { my( $im, $p1, $p2, $color ) = @_; $im->arc( $pts[ $p1 ][X]+$xOrg, $pts[ $p1 ][Y]+$yOrg, ( $dists[ $p1 ][ $p2 ]*2 )x2, 0,360, $color ); } @dists = map[ split ' ' ], <DATA>; shift @dists; shift @$_ for @dists; sub d{ $dists[ $_[0] ][ $_[1] ] } my $dMax = max( map max( @$_ ), @dists ); my $xMax = 200+$dMax; my $yMax = 40+sqrt( $dMax**2 - ( $dMax / 2 )**2 ) * 2; ( $xOrg, $yOrg ) = ( 100, $yMax / 2 ); my $im = GD::Image->new( $xMax, $yMax, 1 ); $im->fill( 0,0, $WHITE ); $im->line( $xOrg, 0, $xOrg, $yMax, $BLACK ); $im->line( 0, $yOrg, $xMax, $yOrg, $BLACK ); my( $p1, $p2 ) = map{ my $y = $_; map{ $dists[$y][$_] == $dMax ? ( $_, $y ) : () } 0 .. $#dists; } 0 .. $#dists; print "$p1, $p2"; $pts[ $p2 ] = [ 0, 0]; $pts[ $p1 ] = [ $dMax, 0 ]; $pts[ 0 ] = do { my( $d, $r, $R ) = ( $dMax, d( $p1, 0 ), d( $p2, 0 ) ); my $x = ( $d**2 - $r**2 + $R**2 ) / ( 2 * $d ); my $y = ( 1/$d * sqrt( (-$d+$r-$R)*(-$d-$r+$R)*(-$d+$r+$R)*($d+$r+ +$R) ) ) / 2; [ $x, $y ]; }; plotPt( $im, $pts[ 0 ], $N2A[ 0 ] ); plotRoute( $im, @pts[ $p1, $p2 ] ); plotPt( $im, $pts[ $p1 ], $N2A[ $p1 ] ); plotPt( $im, $pts[ $p2 ], $N2A[ $p2 ] ); my $ani = $im->gifanimbegin( 1, 10 ); for my $p ( 1 .. $#dists ) { next if $p == $p1 or $p == $p2 ; my( $d, $r, $R ) = ( $dMax, d( $p1, $p ), d( $p2, $p ) ); my $x = ( $d**2 - $r**2 + $R**2 ) / ( 2 * $d ); my $y = ( 1/$d * sqrt( (-$d+$r-$R)*(-$d-$r+$R)*(-$d+$r+$R)*($d+$r+ +$R) ) ) / 2; plotArc( $im, $p1, $p, $GREEN ); plotArc( $im, $p2, $p, $GREEN ); plotArc( $im, 0, $p, $CYAN ); my $checkD1 = sqrt( ( $pts[0][X] - $x )**2 + ( $pts[0][Y] - $y )** +2 ); my $checkD2 = sqrt( ( $pts[0][X] - $x )**2 + ( $pts[0][Y] + $y )** +2 ); printf "$N2A[ $p ]: %u $checkD1 $checkD2\n", d( 0, $p ); $pts[ $p ] = [ $x, ( abs( $checkD1 - d( 0, $p ) ) < abs( $checkD2 +- d( 0, $p ) ) ) ? $y : -$y ]; plotPt( $im, $pts[ $p ], $N2A[ $p ] ); $ani .= $im->gifanimadd( 1, 0, 0, 300, ); open PNG, '>:raw', "$0.png" or die $!; print PNG $im->png; close PNG; system "$0.png"; plotArc( $im, $p1, $p, $WHITE ); plotArc( $im, $p2, $p, $WHITE ); plotArc( $im, 0, $p, $WHITE ); } $ani .= $im->gifanimend(); open GIF, '>:raw', "$0.gif" or die $!; print GIF $ani; close GIF; system "$0.gif"; my @route = ( 0, 15, 11, 8, 3, 12, 6, 7, 5, 2, 10, 4, 1, 9, 14, 13, 16 + ); plotRoute( $im, @pts[ @route[ $_-1, $_ ] ] ) for 1..$#route; plotPt( $im, $pts[ $_ ], $N2A[ $_ ] ) for 0 .. $#pts; open PNG, '>:raw', "$0.png" or die $!; print PNG $im->png; close PNG; system "$0.png"; print ' ', join ' ' x 26, 'B' .. 'Q'; for my $i ( 0 .. $#dists ) { printf "$N2A[ $i ]: "; for my $j ( $i+1 .. $#dists ) { my $checkD1 = sqrt( ( $pts[$i][X] - $pts[$j][X] )**2 + ( $pts[ +$i][Y] - $pts[$j][Y] )**2 ); my $checkD2 = sqrt( ( $pts[$i][X] - $pts[$j][X] )**2 + ( $pts[ +$i][Y] + $pts[$j][Y] )**2 ); my $checkD3 = sqrt( ( $pts[$i][X] + $pts[$j][X] )**2 + ( $pts[ +$i][Y] - $pts[$j][Y] )**2 ); my $checkD4 = sqrt( ( $pts[$i][X] + $pts[$j][X] )**2 + ( $pts[ +$i][Y] + $pts[$j][Y] )**2 ); printf "%4u (%4.f %4.f %4.f %4.f) ", d( $i, $j ), $checkD1, $c +heckD2, $checkD3, $checkD4; } print ''; } __DATA__ A B C D E F G H I J K L M +N O P Q A: 0 633 257 91 412 150 80 134 259 505 353 324 70 21 +1 268 246 121 B: 633 0 390 661 227 488 572 530 555 289 282 638 567 46 +6 420 745 518 C: 257 390 0 228 169 112 196 154 372 262 110 437 191 7 +4 53 472 142 D: 91 661 228 0 383 120 77 105 175 476 324 240 27 18 +2 239 237 84 E: 412 227 169 383 0 267 351 309 338 196 61 421 346 24 +3 199 528 297 F: 150 488 112 120 267 0 63 34 264 360 208 329 83 10 +5 123 364 35 G: 80 572 196 77 351 63 0 29 232 444 292 297 47 15 +0 207 332 29 H: 134 530 154 105 309 34 29 0 249 402 250 314 68 10 +8 165 349 36 I: 259 555 372 175 338 264 232 249 0 495 352 95 189 32 +6 383 202 236 J: 505 289 262 476 196 360 444 402 495 0 154 578 439 33 +6 240 685 390 K: 353 282 110 324 61 208 292 250 352 154 0 435 287 18 +4 140 542 238 L: 324 638 437 240 421 329 297 314 95 578 435 0 254 39 +1 448 157 301 M: 70 567 191 27 346 83 47 68 189 439 287 254 0 14 +5 202 289 55 N: 211 466 74 182 243 105 150 108 326 336 184 391 145 +0 57 426 96 O: 268 420 53 239 199 123 207 165 383 240 140 448 202 5 +7 0 483 153 P: 246 745 472 237 528 364 332 349 202 685 542 157 289 42 +6 483 0 336 Q: 121 518 142 84 297 35 29 36 236 390 238 301 55 9 +6 153 336 0
|
|---|