Just another Perl shrine PerlMonks

comment on

 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} ],
);
}
}
[download]```

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.

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: & & < < > > [ [ ] ]
• 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?