I've Been Doin' Some Hard-Travelin', I Thought You Knowed

Back to the Traveling Salesman.

What I had before was 11298 miles, using the shortest available path to an unconnected state capital, and it had problems, problems where the path already chosen forced a great amount of backtracking. Knots, my friend Mark calls them. The knots are the thing that looked really wrong to me.

So, I added another step.

I modified choose_shortest_path() so that it returned an array with the path. I then do some substitutions. Take two capitals, switch their order, and if that gets us shorter, go with that. Not randomly. Iteratively. First those next to each other, then those separated by one, then by two, up to 5. Then again. Five times.

This gets me to 10886 miles. So far. I'm doing it again, five times going from one to forty, just to see if we can get better than that, because the Washington-to-Arizona knot looks wrong to me, but that's a gut feeling, not a proven issue. That is a near-1100-mile leap, but using it seems to save me 412 miles, so it must work. 

A CS professor once described NP-Complete problems as a license to hack, because there isn't an established best solution, you can play with it. This is a bit what I'm doing here. Certainly, this won't help you pack you knapsack, but if it helps you visit all the capitals that much faster, I'm happy.

#!/usr/bin/perl

# naive shortest-path determination - A little better

use 5.010 ;
use strict ;
use warnings ;
use Data::Dumper ;
use DBI ;

use lib '/home/jacoby/lib' ;
use MyDB 'db_connect' ;

my $states    = get_states() ;
my $combos    = get_combos() ;
my $distances = get_distances() ;
my %shortest ;

#for my $start ( 1..48 ) {
#    my $state = $states->{ $start }->{ state } ;
#    my @path = choose_shortest_path( $start ) ;
#    my $dist = find_distance( @path ) ;
#    say join "\t", (sprintf '%02.2f' , $dist), $start, $state ;
#    }
#exit ;

my @path = choose_shortest_path( 23 ) ;
my $distance = find_distance( @path ) ;
say $distance ;
say as_google_url( separate_by_pipes( @path ) ) ;
say '' ;

my $path = \@path ;
for my $pass ( 1 .. 5 ) {
    for my $offset ( 1 .. 40 ) {
        my $start = 0 ;
        $path = massage_path( $start, $offset, $path ) ;
        my $distance = find_distance( @$path ) ;
        say join "\t", $pass , $offset, scalar @$path , $distance ;
        }
    }
say as_google_url( separate_by_pipes( @$path ) ) ;
say separate_by_pipes( @$path ) ;

exit ;

######## ######## ######## ######## ######## ######## ######## ########
sub choose_shortest_path {
    my @path = @_ ;
    return @path if scalar @path == 48 ;
    my $s_id    = shift @path ;
    my $state   = $states->{ $s_id }->{ state } ;
    my @choices = sort { #sort by distance
        $distances->{ $a }->{ distance } <=> $distances->{ $b }->{ distance }
        }
        grep { # haven't been chosen yet
                is_not_in_array( $combos->{ $_ }->{ state_id_1 }, \@path )
            and is_not_in_array( $combos->{ $_ }->{ state_id_2 }, \@path )
            }
        grep { # must have the state current state
               $combos->{ $_ }->{ state_id_1 } == $s_id
            or $combos->{ $_ }->{ state_id_2 } == $s_id
            } keys %$combos ;
    my $c     = shift @choices ; #shortest
    my $c_obj = $combos->{ $c } ;
    my ( $o ) = grep { $_ != $s_id } $c_obj->{ state_id_1 },
        $c_obj->{ state_id_2 } ;
    my $o_state = $states->{ $o }->{ state } ;
    my $d = $distances->{ $c }->{ distance } || 'x' ;
    return choose_shortest_path( $o, $s_id, @path ) ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub massage_path {
    my ( $a, $offset, $path ) = @_ ;
    my $b = $a + $offset ;
    my $alt ;
    @$alt = @$path ;
    if ( $b >= 48 ) { return $path ; }
    $alt->[ $a ] = $path->[ $b ] ;
    $alt->[ $b ] = $path->[ $a ] ;
    my $d1 = find_distance( @$path ) ;
    my $d2 = find_distance( @$alt ) ;
    $path = $alt if $d2 < $d1 ;
    return massage_path( $a + 1, $offset, $path ) ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub find_distance {
    my @path     = @_ ;
    my $distance = 0 ;
    for my $i ( 1 .. 47 ) {
        my ( $s1, $s2 ) = sort { $a <=> $b } $path[ $i ], $path[ $i - 1 ] ;
        my ( $combo ) = grep {
                   $combos->{ $_ }->{ state_id_1 } == $s1
                && $combos->{ $_ }->{ state_id_2 } == $s2
                }
            sort keys %$combos ;
        $distance += $distances->{ $combo }->{ distance } ;
        }
    return sprintf '%0.02f', $distance ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub is_not_in_array {
    my ( $num, $path ) = @_ ;
    for my $p ( @$path ) {
        return 0 if $num == $p ;
        }
    return 1 ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub get_states {
    my $dbh    = db_connect() ;
    my $sql    = 'SELECT * from state_capitals ORDER BY id' ;
    my $states = $dbh->selectall_hashref( $sql, 'id' ) or croak $dbh->errstr ;
    return $states ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub get_combos {
    my $dbh    = db_connect() ;
    my $sql    = 'SELECT * from combinations ORDER BY id' ;
    my $combos = $dbh->selectall_hashref( $sql, 'id' ) or croak $dbh->errstr ;
    return $combos ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub get_distances {
    my $dbh    = db_connect() ;
    my $sql    = 'SELECT * from distances ORDER BY id' ;
    my $combos = $dbh->selectall_hashref( $sql, 'id' ) or croak $dbh->errstr ;
    return $combos ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub separate_by_pipes {
    return join '|', @_ ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub as_mark_list {
    my ( $path ) = @_ ;
    return join '', map { $states->{ $_ }->{ st } }
        split m{\|}mx, $path ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub as_google_url {
    my ( $path ) = @_ ;
    my $url1 =
        'http://maps.google.com/maps/api/staticmap?path=color:0xff0000ff|weight:1|'
        ;
    my $url2 = '&size=500x400&sensor=false' ;
    my $body = join '|', map {
        join ',', $states->{ $_ }->{ latitude },
            $states->{ $_ }->{ longitude }
            }
        split m{\|}mx, $path ;
    return join '', $url1, $body, $url2 ;
    }

######## ######## ######## ######## ######## ######## ######## ########
sub key_from_value {
    my ( $v ) = @_ ;
    my %rev = reverse %shortest ;
    return $rev{ $v } ;
    }