/var/log/rant: November 2011

2011/11/28

Improving my SSHFS script

I can name more than a dozen machines whose file systems I would want to mount from work. I don't mount those file systems all the time, but I do often enough that I have a Perl script I use to manage my SSHFS mounting and unmounting of them.

Here's a problem. This weekend, the servers for work were taken down for scheduled maintenance. That's fine, but it does mean that I had to remount a bunch of them this AM, and when the script went through the already-mounted filesystems, it would ask for a password and say "this is already mounted". What I probably want is some way of knowing quickly whether there's something mounted and then doing that check before I do the mount.

And this is what initially draws my attention: mount points are directories. And directories can contain files. It is a known trick for hackers to unmount shares, hide files in the mount point, and remount, where sysadmins won't notice it. It strikes me that I can touch a file like .unmounted into each mount point, and then look for that file on each remounting, and skip it if I can't -f that file.

But really, this has to be a solved problem somehow, so there might be a better way. Pointers?

ETA: The code, a few revisions back, is part of a previous post. A twitter response is leading me to start the process of finally using my github account and setting it up there. Will add again when I get to there.

2011/11/16

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 } ;
    }

2011/11/10

Beyond Firebug to NYTProf

Clearly, the problem is in the core application, not the CSS and JS surrounding it. And Firebug only covers the outside of the application.

So I got NYTProf going. A little search gave me the knowledge that calling a page at http://example.com/myprog.cgi?foo=bar is the same as calling it with perl myprog.cgi 'foo=bar', which is so good to know, especially since the addition of the NYTProf step is perl -d:NYTProf myprog.cgi 'foo=bar' .

So, I was able to shave off a second by caching. I could have HOP'd it and just used Memoize, but I like having all the details of a program visible so I don't get bit by something I can't see.

{
    # all lines of code with  %url_cache are new
    # URLs have been changed to protect the innocent.
    my %url_cache ;
    sub get_service_page {
        my ( $pi ) = @_ ;
        if ( $url_cache{ $pi } ) {
            return $url_cache{ $pi } ;
            }
        my $readfile = pi_Readfile() ;
        my $url = 'http://www.example.edu/~user/projects/XXXXX/' ;
        my $alt =
            'http://www.example.edu/~user/something_else.cgi'
            ;
        my $attr   = 'SGNAME_PUTATIVE' ;
        my $sgname = $readfile->{ $pi }->{ $attr } ;

        if ( ! defined $sgname || '' eq $sgname ) {
            $url_cache{ $pi } = $alt ;
            return $alt ;
            }
        $url =~ s/XXXXX/$sgname/ ;
        $url_cache{ $pi } = $url ;
        return $url ;
        }
    }

So, simply by holding onto that little piece of information instead of checking against the same pi_Readfile() each time, I was able to go from 2-3 seconds to 1.2 seconds. And, now that I'm seeing it, I could hold onto the data structure I get from pi_Readfile() the same way I hold onto the cache, and could probably tighten up even more.

I don't know why it didn't occur to me to do that in the first place....

2011/11/09

Just Ran Firebug

Pretty clear where the lag is, isn't it?

2011/11/07

Even More Traveling, Even Less Sales

Here's some table descriptions from MySQL, from which you should be able to reverse engineer the table creation. State Capitals

+-----------+-------------+------+-----+---------+----------------+
| Field     | Type        | Null | Key | Default | Extra          |
+-----------+-------------+------+-----+---------+----------------+
| id        | int(10)     | NO   | PRI | NULL    | auto_increment |
| state     | varchar(25) | YES  |     | NULL    |                |
| st        | varchar(2)  | YES  |     | NULL    |                |
| city      | varchar(25) | YES  |     | NULL    |                |
| latitude  | float(12,6) | YES  |     | NULL    |                |
| longitude | float(12,6) | YES  |     | NULL    |                |
+-----------+-------------+------+-----+---------+----------------+

Combinations - Connecting each one to each other

+------------+---------+------+-----+---------+----------------+
| Field      | Type    | Null | Key | Default | Extra          |
+------------+---------+------+-----+---------+----------------+
| id         | int(10) | NO   | PRI | NULL    | auto_increment |
| state_id_1 | int(10) | YES  |     | NULL    |                |
| state_id_2 | int(10) | YES  |     | NULL    |                |
+------------+---------+------+-----+---------+----------------+

Distances

+----------+-------------+------+-----+---------+----------------+
| Field    | Type        | Null | Key | Default | Extra          |
+----------+-------------+------+-----+---------+----------------+
| id       | int(10)     | NO   | PRI | NULL    | auto_increment |
| distance | float(12,6) | YES  |     | NULL    |                |
+----------+-------------+------+-----+---------+----------------+

I'll say again, I think I made a mistake by not including distance in the combination table. I didn't write perl code to put the state capital information into the database. I copied it from a source and recrafted it into SQL by hand.

INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 01 , "Delaware" , "DE" , "Dover" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 02 , "Pennsylvania" , "PA" , "Harrisburg" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 03 , "New Jersey, NJ" , "Trenton" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 04 , "Georgia" , "GA" , "Atlanta" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 05 , "Connecticut" , "CT" , "Hartford" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 06 , "Massachusetts" , "MA" , "Boston" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 07 , "Maryland" , "MD" , "Annapolis" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 08 , "South Carolina" , "SC" , "Columbia" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 09 , "New Hampshire" , "NH" , "Concord" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 10 , "Virginia" , "VA" , "Richmond" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 11 , "New York" , "NY" , "Albany" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 12 , "North Carolina" , "NC" , "Raleigh" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 13 , "Rhode Island" , "RI" , "Providence" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 14 , "Vermont" , "VT" , "Montpelier" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 15 , "Kentucky" , "KY" , "Frankfort" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 16 , "Tennessee" , "TN" , "Nashville" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 17 , "Ohio" , "OH" , "Columbus" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 18 , "Louisiana" , "LA" , "Baton Rouge" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 19 , "Indiana" , "IN" , "Indianapolis" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 20 , "Mississippi" , "MS" , "Jackson" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 21 , "Illinois" , "IL" , "Springfield" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 22 , "Alabama" , "AL" , "Montgomery" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 23 , "Maine" , "ME" , "Augusta" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 24 , "Missouri" , "MO" , "Jefferson City" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 25 , "Arkansas" , "AR" , "Little Rock" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 26 , "Michigan" , "MI" , "Lansing" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 27 , "Florida" , "FL" , "Tallahassee" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 28 , "Texas" , "TX" , "Austin" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 29 , "Iowa" , "IA" , "Des Moines" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 30 , "Wisconsin" , "WI" , "Madison" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 31 , "California" , "CA" , "Sacramento" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 32 , "Minnesota" , "MN" , "Saint Paul" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 33 , "Oregon" , "OR" , "Salem" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 34 , "Kansas" , "KS" , "Topeka" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 35 , "West Virginia" , "WV" , "Charleston" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 36 , "Nevada" , "NV" , "Carson City" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 37 , "Nebraska" , "NE" , "Lincoln" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 38 , "Colorado" , "CO" , "Denver" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 39 , "North Dakota" , "ND" , "Bismarck" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 40 , "South Dakota" , "SD" , "Pierre" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 41 , "Montana" , "MT" , "Helena" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 42 , "Washington" , "WA" , "Olympia" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 43 , "Idaho" , "ID" , "Boise" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 44 , "Wyoming" , "WY" , "Cheyenne" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 45 , "Utah" , "UT" , "Salt Lake City" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 46 , "Oklahoma" , "OK" , "Oklahoma City" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 47 , "New Mexico" , "NM" , "Santa Fe" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 48 , "Arizona" , "AZ" , "Phoenix" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 49 , "Alaska" , "AK" , "Juneau" ) ;
INSERT INTO state_capitals ( id , state , st , city ) VALUES ( 50 , "Hawaii" , "HI" , "Honolulu" ) ;

The latitudes and longitudes were also hand-crafted.

UPDATE state_capitals SET latitude="32.361538", longitude="-86.279118" where state = "Alabama" ;
UPDATE state_capitals SET latitude="58.301935", longitude="-134.419740" where state = "Alaska" ;
UPDATE state_capitals SET latitude="33.448457", longitude="-112.073844" where state = "Arizona" ;
UPDATE state_capitals SET latitude="34.736009", longitude="-92.331122" where state = "Arkansas" ;
UPDATE state_capitals SET latitude="38.555605", longitude="-121.468926" where state = "California" ;
UPDATE state_capitals SET latitude="39.7391667", longitude="-104.984167" where state = "Colorado" ;
UPDATE state_capitals SET latitude="41.767", longitude="-72.677" where state = "Connecticut" ;
UPDATE state_capitals SET latitude="39.161921", longitude="-75.526755" where state = "Delaware" ;
UPDATE state_capitals SET latitude="30.4518", longitude="-84.27277" where state = "Florida" ;
UPDATE state_capitals SET latitude="33.76", longitude="-84.39" where state = "Georgia" ;
UPDATE state_capitals SET latitude="21.30895", longitude="-157.826182" where state = "Hawaii" ;
UPDATE state_capitals SET latitude="43.613739", longitude="-116.237651" where state = "Idaho" ;
UPDATE state_capitals SET latitude="39.783250", longitude="-89.650373" where state = "Illinois" ;
UPDATE state_capitals SET latitude="39.790942", longitude="-86.147685" where state = "Indiana" ;
UPDATE state_capitals SET latitude="41.590939", longitude="-93.620866" where state = "Iowa" ;
UPDATE state_capitals SET latitude="39.04", longitude="-95.69" where state = "Kansas" ;
UPDATE state_capitals SET latitude="38.197274", longitude="-84.86311" where state = "Kentucky" ;
UPDATE state_capitals SET latitude="30.45809", longitude="-91.140229" where state = "Louisiana" ;
UPDATE state_capitals SET latitude="44.323535", longitude="-69.765261" where state = "Maine" ;
UPDATE state_capitals SET latitude="38.972945", longitude="-76.501157" where state = "Maryland" ;
UPDATE state_capitals SET latitude="42.2352", longitude="-71.0275" where state = "Massachusetts" ;
UPDATE state_capitals SET latitude="42.7335", longitude="-84.5467" where state = "Michigan" ;
UPDATE state_capitals SET latitude="44.95", longitude="-93.094" where state = "Minnesota" ;
UPDATE state_capitals SET latitude="32.320", longitude="-90.207" where state = "Mississippi" ;
UPDATE state_capitals SET latitude="38.572954", longitude="-92.189283" where state = "Missouri" ;
UPDATE state_capitals SET latitude="46.595805", longitude="-112.027031" where state = "Montana" ;
UPDATE state_capitals SET latitude="40.809868", longitude="-96.675345" where state = "Nebraska" ;
UPDATE state_capitals SET latitude="39.160949", longitude="-119.753877" where state = "Nevada" ;
UPDATE state_capitals SET latitude="43.220093", longitude="-71.549127" where state = "New Hampshire" ;
UPDATE state_capitals SET latitude="40.221741", longitude="-74.756138" where state = "New Jersey" ;
UPDATE state_capitals SET latitude="35.667231", longitude="-105.964575" where state = "New Mexico" ;
UPDATE state_capitals SET latitude="42.659829", longitude="-73.781339" where state = "New York" ;
UPDATE state_capitals SET latitude="35.771", longitude="-78.638" where state = "North Carolina" ;
UPDATE state_capitals SET latitude="48.813343", longitude="-100.779004" where state = "North Dakota" ;
UPDATE state_capitals SET latitude="39.962245", longitude="-83.000647" where state = "Ohio" ;
UPDATE state_capitals SET latitude="35.482309", longitude="-97.534994" where state = "Oklahoma" ;
UPDATE state_capitals SET latitude="44.931109", longitude="-123.029159" where state = "Oregon" ;
UPDATE state_capitals SET latitude="40.269789", longitude="-76.875613" where state = "Pennsylvania" ;
UPDATE state_capitals SET latitude="41.82355", longitude="-71.422132" where state = "Rhode Island" ;
UPDATE state_capitals SET latitude="34.000", longitude="-81.035" where state = "South Carolina" ;
UPDATE state_capitals SET latitude="44.367966", longitude="-100.336378" where state = "South Dakota" ;
UPDATE state_capitals SET latitude="36.165", longitude="-86.784" where state = "Tennessee" ;
UPDATE state_capitals SET latitude="30.266667", longitude="-97.75" where state = "Texas" ;
UPDATE state_capitals SET latitude="40.7547", longitude="-111.892622" where state = "Utah" ;
UPDATE state_capitals SET latitude="44.26639", longitude="-72.57194" where state = "Vermont" ;
UPDATE state_capitals SET latitude="37.54", longitude="-77.46" where state = "Virginia" ;
UPDATE state_capitals SET latitude="47.042418", longitude="-122.893077" where state = "Washington" ;
UPDATE state_capitals SET latitude="38.349497", longitude="-81.633294" where state = "West Virginia" ;
UPDATE state_capitals SET latitude="43.074722", longitude="-89.384444" where state = "Wisconsin" ;
UPDATE state_capitals SET latitude="41.145548", longitude="-104.802042" where state = "Wyoming" ;

The distances themselves were generated mathematically, with the help of Google and Wikipedia to find the how-to.

#!/usr/bin/perl

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

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

use subs qw{ get_combos get_states set_distance } ;

my $pi = atan2( 1, 1 ) * 4 ;
my $states = get_states() ;
my $combos = get_combos() ;

for my $combo ( (sort { $a<=>$b } keys %$combos ) ) {
    my $c_obj = $combos->{$combo} ;
    my ( $state_1 , $state_2 ) =  sort { $a <=> $b } $c_obj->{ state_id_1 } , $c_obj->{ state_id_2 } ;
    my $obj_s1 = $states->{ $state_1 } ;
    my $obj_s2 = $states->{ $state_2 } ;
    my $dist = haversine(
            $obj_s1->{ latitude } , $obj_s1->{ longitude } ,
            $obj_s2->{ latitude } , $obj_s2->{ longitude } ) ;
    say $combo ;
    say join ' - ' ,
    ( join ', ' , $obj_s1->{ city } , $obj_s1->{ state } ) ,
    ( join ', ' , $obj_s2->{ city } , $obj_s2->{ state } ) ;
    say join "\t" , '' , $dist . ' miles';
    set_distance( $combo , $dist ) ;
    }

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 set_distance {
    my ( $combo , $dist ) = @_ ;
    my $dbh = db_connect() ;
    my $sql = "INSERT INTO distances ( id , distance ) VALUES ( $combo , $dist ) " ;
    say $sql ;
    $dbh->do( $sql ) or croak $dbh->errstr;
    }

sub haversine {
    my ( $lat1, $lon1, $lat2, $lon2 ) = @_ ;

    my $theta = $lon1 - $lon2 ;
    my $dist =
        sin( deg2rad( $lat1 ) ) *
        sin( deg2rad( $lat2 ) ) +
        cos( deg2rad( $lat1 ) ) *
        cos( deg2rad( $lat2 ) ) *
        cos( deg2rad( $theta ) ) ;

    $dist = acos( $dist ) ;
    $dist = rad2deg( $dist ) ;
    $dist = $dist * 60 * 1.1515 ;
    return sprintf '%5.2f' , $dist ;
    }

sub acos {
    my ( $rad ) = @_ ;
    my $ret = atan2( sqrt( 1 - $rad**2 ), $rad ) ;
    return $ret ;
    }

sub deg2rad {
    my ( $deg ) = @_ ;
    return ( $deg * $pi / 180 ) ;
    }

sub rad2deg {
    my ( $rad ) = @_ ;
    return ( $rad * 180 / $pi ) ;
    }

More Details on Traveling Salesman

I have just received mail from a programmer in France who is interested in learning Perl and asked about some of the constructs in my Traveling Salesman code, specifically asking about MyDB.pm and do_connect. That module and that function are about one thing: getting a DBI object without having to have my login and password and all that within the body of the program, so I can do things like paste it into my blog without worrying. Adapted, it looks like this:

package MyDB ;
use strict;
use warnings;
use DBI;

use Exporter qw(import);
our %EXPORT_TAGS = ('all' => [ qw(
                                   db_connect
                            ) ],
                    );
our @EXPORT_OK   = ( @{$EXPORT_TAGS{'all'}} );
our $VERSION = 0.0.1;
our %_DB = (
    default => {
        user       => 'YouDontGetThis',
        password   => 'YouDontGetThis',
        host       => 'YouDontGetThis',
        port       => '3306',
        database   => 'YouDontGetThis',
        },
    test => {
        user       => 'YouDontGetThis',
        password   => 'YouDontGetThis',
        host       => 'YouDontGetThis',
        port       => '3306',
        database   => 'YouDontGetThis',
        },
    );

my $_db_params  = '';       # String of current database parameters.
my $_dbh;                   # Save the handle.

sub db_connect {
    my ($param_ptr, $attr_ptr) = @_;

    # If database is already opened then check for a fast return.

    if (defined $_dbh &&
        (!defined $param_ptr || $param_ptr eq ''))    { return $_dbh }

    # Check for a different set of parameters to use via a the name (string)
    #   of the parameter (e.g., 'test').

    my $which_db = 'default';

    if (defined $param_ptr && ref($param_ptr) eq '' && $param_ptr ne '') {
        if (defined $_DB{$param_ptr})   { $which_db = $param_ptr }
        else { return; }
    }

    # Get the base parameters ... copy and flatten from global array

    my %params = ();
    my %attr   = ();

    foreach (keys %{$_DB{$which_db}} ) {
        $params{$_} = $_DB{$which_db}{$_};
        }

    # Add in extra parameters if given and if the database is not the default.

    if (defined $param_ptr
        && ref($param_ptr) eq 'HASH'
        && (!defined $param_ptr->{database} ||
             $param_ptr->{database} ne 'default') ) {

        foreach (keys %{$_DB{default}})  {
            if (defined $param_ptr->{$_}) { $params{$_} = $param_ptr->{$_} }
            }
        }

    if (defined $attr_ptr && ref($attr_ptr) eq 'HASH') {
        foreach (keys %$attr_ptr)  { $attr{$_} = $attr_ptr->{$_} }
        }

    # Now make up an order string of the parameters so that we can compare
    #   them to the old ones.

    my $new_db_params = '';
    foreach (sort keys %params)  { $new_db_params .= $params{$_} };

    # Can also do a quick return if params are same as old ones

    if (defined $_dbh && $new_db_params eq $_db_params)  {
        return $_dbh;
        }

    # At this point either the database has never been opened or
    #   new parameters are to be used. Close database and reopen.

    $_db_params = $new_db_params;

    if (defined $_dbh) { $_dbh->disconnect }    # no error check

    my $source = "dbi:mysql:$params{database}:$params{host}:$params{port}";

    $_dbh = DBI->connect($source, $params{user},
                               $params{password}, \%attr);

    return $_dbh;

    } # End of db_connect

1;

For the particulars, I used something, I think WolframAlpha, to get the latitude and longitude of each capital, then looked into some geometry to calculate the distances. Perhaps I should include some database dumps here. for that info.

How I create my web applications

I handle our web stuff from soup to nuts, so here's a little bit of my methodology on how I do that work.

I think about what we're supposed to do and what we're supposed to store, and try to express it in SQL, culminating in the creation of a table in our MySQL database.
I write generalized functions for CRUD (creation, reading, updating and deleting) as needed, and create or add to existing Perl modules. I also make testing scripts for these functions to run on the command line.
I write the read functions into a Perl-driven CGI program. I'm old-school enough that each attempt to learn a framework such as Catalyst leaves me frustrated. Full creation of an element is usually handled in this program.
I write a jQuery-based Javascript module to run within the CGI that allows me to collect and add to all the information I need to make modifications.
I write an AJAX backend program in Perl that passes JSON back and forth between the client and server.

Right now, I'm in that last step. I know there are a few things that I need to start doing. I need to have development, test and production streams going for all this stuff. I need to have much more git going on. And, often there are small tweaks on the CSS throughout this process.

2011/11/03

Traveling Salesman without Farmer's Daughter

Have posted some related details to the problem, specifically some database access boilerplate.

The challenge is not traditional Traveling Salesman, which brings you back to the start. In this case, this is all the state capitals in the continental US, and the challenge is to get through all of them in the shortest distance, but was not getting back to the start.

This is my naive solution, which is starting from what I judged to be the furthest east (Maine) and going westward, choosing the shortest capital-to-capital distance. This is easy, and it avoids the biggest pitfall, the one that makes this a named problem.

Starting at one capital, you have 47 choices. For each of them, there are then 46 choices each, and then 45, and so on. The notation for that is n! (as opposed to !n which means not n) and it is big. 1.24x10⁶¹. This means that generating all possible paths would take forever even on big iron. The CS term is nondeterministic polynomial, or NP. Traveling Salesman is NP-Complete, IIRC. What this means is that, while finding a relatively fast way through this is pretty easy, finding the provably shortest isn't.

But I'm sure I can do better than this naive solution. The backtracking to get Vermont in makes me think that starting with Vermont and New Hampshire might be the better solution, and the jump from Tennessee to Michigan tells me that simple shortest-path is not the best solution there. I can generate this fast with simple recursion, getting a simple ordered list, doing the transforms that could tweak this into a faster path is something I don't really know how to do, code-wise.

Here's my Perl code, including some dyked-out bits covering some other cases. The first thing I can think of is to check every edge and each time two edges cross, switch the order of the second node for each edge. I think that could work, if I could decide how to code it.

#!/usr/bin/perl

# naive shortest-path determination - sucks

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 $dist  = choose_shortest_path( $start ) ;
#    say join "\t", (sprintf '%02.2f' , $dist), $start, $state ;
#    }
#exit ;

# 23 = maine

#
##say 'long' ;
##say choose_longest_path( 23 ) ;
##say '' ;

#say 'short' ;
#choose_shortest_path( 23 ) ;
#say Dumper \%shortest ;
#say '' ;
#
#my ( $s ) = sort { $shortest{ $a } <=> $shortest{ $b } } keys %shortest ;
#
#say as_mark_list( $s ) ;
#say '' ;
#say as_google_url( $s ) ;
#say '' ;

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 %rev = reverse %shortest ;
    my ( $v ) = @_ ;
    return $rev{ $v } ;
    }

sub choose_shortest_path {
    my @path = @_ ;
    do {
        #say join '|', reverse map {
            #join ',',
        #        $states->{ $_ }->{ latitude },
        #        $states->{ $_ }->{ longitude }
        #        } @path ;
        #say as_mark_list( join '|', @path ) ;
        #say as_google_url( join '|', @path ) ;
        return 0 ;
        }
        if scalar @path == 48 ;

    #say join ' ' , scalar @path , '-' , @path ;
    my $s_id    = shift @path ;
    my $state   = $states->{ $s_id }->{ state } ;
    my @choices = sort {
        $distances->{ $a }->{ distance } <=> $distances->{ $b }->{ distance }
        }
        grep {
                is_not_in_array( $combos->{ $_ }->{ state_id_1 }, \@path )
            and is_not_in_array( $combos->{ $_ }->{ state_id_2 }, \@path )
            }
        grep {
               $combos->{ $_ }->{ state_id_1 } == $s_id
            or $combos->{ $_ }->{ state_id_2 } == $s_id
            } keys %$combos ;
    my $c     = shift @choices ;
    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' ;

    #say $state ;

    #say join "\t", '', $d, $c, $s_id, $state, $o, $o_state ;
    #say join "\t", '', join ' ' , @path ;
    #say '' ;
    my $dist = choose_shortest_path( $o, $s_id, @path ) ;
    return $dist + $d ;
    }

#sub choose_longest_path {
#    my @path = @_ ;
#    do {
#        say join '|', reverse map {
#            join ',',
#                $states->{ $_ }->{ latitude },
#                $states->{ $_ }->{ longitude }
#                } @path ;
#        say as_mark_list( join '|', @path ) ;
#        say as_google_url( join '|', @path ) ;
#        return 0 ;
#        }
#        if scalar @path == 48 ;
#
#    #say join ' ' , scalar @path , '-' , @path ;
#    my $s_id    = shift @path ;
#    my $state   = $states->{ $s_id }->{ state } ;
#    my @choices = sort {
#        $distances->{ $a }->{ distance } <=> $distances->{ $b }->{ distance }
#        }
#        grep {
#                is_not_in_array( $combos->{ $_ }->{ state_id_1 }, \@path )
#            and is_not_in_array( $combos->{ $_ }->{ state_id_2 }, \@path )
#            }
#        grep {
#               $combos->{ $_ }->{ state_id_1 } == $s_id
#            or $combos->{ $_ }->{ state_id_2 } == $s_id
#            } keys %$combos ;
#    my $c     = pop @choices ;
#    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' ;
#
#    #say $state ;
#
#    #say join "\t", '', $d, $c, $s_id, $state, $o, $o_state ;
#    #say join "\t", '', join ' ' , @path ;
#    #say '' ;
#    my $dist = choose_longest_path( $o, $s_id, @path ) ;
#    return $dist + $d ;
#    }

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 ;
    }

Cookie Notice