Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

(I considered submitting this as a meditation, but due to my lack of knowledge on the topic, I thought better of posting there.)

Recently I was thinking about a problem. Specifically, I was considering the idea from the point of view of "ants" (for lack of a better term) following all of the possible paths, and trying to think through how to determine if a path has been completed. As a starting thought experiment, I considered 6 points, with ants moving from each point to each remaining point. I thought of 5 different cases that could occur (points labeled '1'..'6', paths written ordered least to greatest):

  1. Incomplete connection - existing connections are 1-2 and 2-3.
  2. Incomplete connection - existing connections are 1-2, 2-3, 4-5, 5-6, and 1-6
  3. Incomplete connection - existing connections are 1-2, 2-3, 4-5, 5-6, and 1-6, extra connection 4-6
  4. Complete connection - existing connections are 1-2, 2-3, 3-4, 4-5, 5-6, and 1-6
  5. Complete connection - existing connections are 1-2, 2-3, 3-4, 4-5, 5-6, and 1-6, extra connections 3-5, 3-6, and 4-6

The cases map out (roughly) as follows:

Case 1:

    1 - 2 - 3

        6   5   4

Case 2:

    1 - 2 - 3
      \
        6 - 5 - 4

Case 3:

    1 - 2 - 3
      \
        6 - 5 - 4
          \   /
            +

Case 4:

    1 - 2 - 3
      \       \
        6 - 5 - 4

Case 5:

    1 - 2 - 3
      \   / | \
        6 - 5 - 4
          \   /
            +

(I realized as I was writing this that being able to find that a path might not be as useful as I thought, but that does not take *that much* away from this question.)

I'm not aware of (or at least remember) dealing with graphs in the CS classes I took (years ago), so there may be a nice theory or approach I am not aware of. What I came up with was to create a matrix containing the number of connections between between points. (By writing all of the connections in least-greatest ordering, only half the matrix had to be used, as illustrated by the following. Unfilled entries are noted as '-', otherwise the count of connections is filled in in row-column order.)

Case 1           Case 2           Case 3           Case 4           Case 5       
X 1 2 3 4 5 6    X 1 2 3 4 5 6    X 1 2 3 4 5 6    X 1 2 3 4 5 6    X 1 2 3 4 5 6
1 - 1 0 0 0 0    1 - 1 0 0 0 1    1 - 1 0 0 0 1    1 - 1 0 0 0 1    1 - 1 0 0 0 1
2 - - 1 0 0 0    2 - - 1 0 0 0    2 - - 1 0 0 0    2 - - 1 0 0 0    2 - - 1 0 0 0
3 - - - 0 0 0    3 - - - 0 0 0    3 - - - 0 0 0    3 - - - 1 0 0    3 - - - 1 1 1
4 - - - - 0 0    4 - - - - 1 0    4 - - - - 1 1    4 - - - - 1 0    4 - - - - 1 1
5 - - - - - 0    5 - - - - - 1    5 - - - - - 1    5 - - - - - 1    5 - - - - - 1
6 - - - - - -    6 - - - - - -    6 - - - - - -    6 - - - - - -    6 - - - - - -

What I noticed was that in the cases (1-3) where a connection did not exist, there was at least one row in which the sum of entries on the row was zero, but in cases where a full path existed all rows had a non-zero sum. Is this approach too simplistic-minded (or did I just stumble upon something I should have known)?

Sample code:

#!/usr/bin/env perl use 5.010; use strict; use warnings; use Carp; use Data::Dumper; use List::Util; $Data::Dumper::Deepcopy = 1; $Data::Dumper::Sortkeys = 1; $SIG{__DIE__} = sub { Carp::confess @_; }; $SIG{__WARN__} = sub { Carp::cluck @_; }; $| = 1; srand(); my %test_data = ( test_1 => { # Incomplete connection - 1-2-3 # # 1 - 2 - 3 # # 6 5 4 # symbol => [ 1, 2, 3, 4, 5, 6, ], segment => [ [ 1, 2, ], [ 2, 3, ], ], }, test_2 => { # Missing 1 connection - 4-5-6-1-2-3 # # 1 - 2 - 3 # \ # 6 - 5 - 4 # symbol => [ 1, 2, 3, 4, 5, 6, ], segment => [ [ 1, 2, ], [ 3, 2, ], [ 4, 5, ], [ 6, 5, ], [ 6, 1, ], ], # path_matrix => [ 1 2 3 4 5 6 # 1 - 1 0 0 0 1 # 2 - - 1 0 0 0 # 3 - - - 0 0 0 # 4 - - - - 1 0 # 5 - - - - - 1 # 6 - - - - - - }, test_3 => { # Missing 1 connection, extra connections - 1-2-3-4-5-6, 4-6 # # 1 - 2 - 3 # \ # 6 - 5 - 4 # \ / # + # symbol => [ 1, 2, 3, 4, 5, 6, ], segment => [ [ 1, 2, ], [ 2, 3, ], [ 4, 5, ], [ 5, 6, ], [ 1, 6, ], [ 4, 6, ], ], # path_matrix => [ 1 2 3 4 5 6 # 1 - 1 0 0 0 1 # 2 - - 1 0 0 0 # 3 - - - 0 0 0 # 4 - - - - 1 1 # 5 - - - - - 1 # 6 - - - - - - }, test_4 => { # Complete connection - 1-2-3-4-5-6-1 # # 1 - 2 - 3 # \ \ # 6 - 5 - 4 # symbol => [ 1, 2, 3, 4, 5, 6, ], segment => [ [ 1, 2, ], [ 2, 3, ], [ 3, 4, ], [ 4, 5, ], [ 5, 6, ], [ 6, 1, ], ], # path_matrix => [ 1 2 3 4 5 6 # 1 - 1 0 0 0 1 # 2 - - 1 0 0 0 # 3 - - - 1 0 0 # 4 - - - - 1 0 # 5 - - - - - 1 # 6 - - - - - - }, test_5 => { # Complete connection, extra connections - 1-2-3-4-5-6-1, 3-5, 3-6, 4- +6 # # 1 - 2 - 3 # \ / | \ # 6 - 5 - 4 # \ / # + # symbol => [ 1, 2, 3, 4, 5, 6, ], segment => [ [ 1, 2, ], [ 2, 3, ], [ 3, 4, ], [ 4, 5, ], [ 5, 6, ], [ 6, 1, ], [ 5, 3, ], [ 6, 3, ], [ 6, 4, ], ], # path_matrix => [ 1 2 3 4 5 6 # 1 - 1 0 0 0 1 # 2 - - 1 0 0 0 # 3 - - - 1 1 1 # 4 - - - - 1 1 # 5 - - - - - 1 # 6 - - - - - - }, ); foreach my $test ( sort { $a cmp $b } keys %test_data ) { say $test; my $symbol_string = join( q{|}, @{ $test_data{$test}{symbol} }, ); my @test_run = (); foreach my $i ( 0 .. $#{ $test_data{$test}{symbol} } ) { foreach my $j ( 0 .. $#{ $test_data{$test}{symbol} } ) { $test_run[$i][$j] = 0; } } foreach my $i ( 0 .. $#{ $test_data{$test}{segment} } ) { my $x = index( $symbol_string, $test_data{$test}{segment}[$i][0], ) / 2; my $y = index( $symbol_string, $test_data{$test}{segment}[$i][1], ) / 2; ( $x, $y, ) = sort { $a <=> $b } map { $_ + 0; } ( $x, $y, ); $test_run[$x][$y]++; } foreach my $i ( 0 .. $#test_run - 1 ) { if ( List::Util::sum0( @{ $test_run[$i] } ) == 0 ) { say "Missing row $test_data{$test}{symbol}[$i]"; } } # print_compact_segment( \@{$test_data{$test}{segment}}, ); # print_compact_array_header( $test_data{$test}{symbol}, ); # print_compact_array( \@{$test_data{$test}{symbol}}, \@test_run, ); } sub print_compact_segment { my ($arr) = @_; foreach my $i ( 0 .. $#{$arr} ) { print q{[}, join( q{,}, map { sprintf( qq{%3d}, $_, ) } sort { $a <=> $b } @{ $arr->[$i] } ), q{]}, q{ }; } say q{}; } sub print_compact_array_header { my ($arr) = @_; my $str = join( q{|}, map { sprintf( qq{%3s}, $_, ) } @{$arr} ); say q{ |}, $str; say q{---+}, q{-} x length $str; } sub print_compact_array { my ( $symbol, $arr ) = @_; foreach my $i ( 0 .. $#{$arr} - 1 ) { say join( q{|}, sprintf( qq{%3s}, $symbol->[$i], ), map { sprintf( qq{%3d}, $_, ) } @{ $arr->[$i] }[ 0 .. $#{$arr} ], ); } }

Output:

$ ./test.pl
test_1
Missing row 3
Missing row 4
Missing row 5
test_2
Missing row 3
test_3
Missing row 3
test_4
test_5

Thank you for your attention and insights. (And my apologies if I have wasted your time.)

Update: 2018-07-16

Thank you for your feedback. To answer OM and tobyink, yes, apparently what I am looking for is a Hamiltonian path through the set. (I didn't know the proper term(s) to use to search, among other things.) To answer bliako, yes, I know ants would have started from each point, but for simplicity I showed only completed paths of equal length. To apply this to the original problem, I can see two ways: a) follow the idea of an actual ant, and track each ant's actual position, or b) knowing the edges and their lengths, I would probably look to move down the list of all edges (tracking the sum total) and update the matrix form (above, or other method) to check if a complete path exists.


In reply to Is this a valid approach to finding if a path through a set of points has completed? by atcroft

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others musing on the Monastery: (6)
    As of 2021-05-08 15:31 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Perl 7 will be out ...





      Results (96 votes). Check out past polls.

      Notices?