Re: How many triangles does your perl script "see"?
by Perl Mouse (Chaplain) on Oct 27, 2005 at 16:24 UTC
|
Here's my solution, finding 35 triangles.
#!/usr/bin/perl
use strict;
use warnings;
#
# Input, lines of the figure.
#
my @l = (
[qw [A B]],
[qw [A C F I]],
[qw [A D G J]],
[qw [A E]],
[qw [B C D E]],
[qw [B F H J]],
[qw [B I]],
[qw [E G H I]],
[qw [E J]],
[qw [I J]],
);
# Process the lines. Create a datastructure with nodes as keys.
# For each node, record which nodes are reachable in one step,
# and which nodes are passed to get there.
my $g;
foreach my $l (@l) {
for (my $i1 = 0; $i1 < @$l-1; $i1++) {
for (my $i2 = $i1+1; $i2 < @$l; $i2++) {
$$g{$$l[$i1]}{$$l[$i2]} = {map {$_, 1} @$l[$i1+1 .. $i2-1]
+};
$$g{$$l[$i2]}{$$l[$i1]} = {map {$_, 1} @$l[$i1+1 .. $i2-1]
+};
}
}
}
# Find all non-trivial 3-cycles.
local $" = " - ";
my @n = sort keys %$g;
for (my $i1 = 0; $i1 < @n-2; $i1++) {
for (my $i2 = $i1+1; $i2 < @n-1; $i2++) {
for (my $i3 = $i2+1; $i3 < @n; $i3++) {
# Form a cycle
print "@n[$i1,$i2,$i3]\n" if $$g{$n[$i1]}{$n[$i2]} &&
$$g{$n[$i2]}{$n[$i3]} &&
$$g{$n[$i3]}{$n[$i1]}
&& # Avoid trivial cycle
!$$g{$n[$i1]}{$n[$i2]}{$n[$i3]
+} &&
!$$g{$n[$i1]}{$n[$i3]}{$n[$i2]
+} &&
!$$g{$n[$i2]}{$n[$i3]}{$n[$i1]
+};
}
}
}
__END__
A - B - C
A - B - D
A - B - E
A - B - F
A - B - I
A - B - J
A - C - D
A - C - E
A - D - E
A - E - G
A - E - I
A - E - J
A - F - J
A - G - I
A - I - J
B - C - F
B - C - I
B - D - J
B - E - H
B - E - I
B - E - J
B - F - I
B - H - I
B - I - J
C - E - I
D - E - G
D - E - J
E - G - J
E - H - J
E - I - J
F - H - I
F - I - J
G - H - J
G - I - J
H - I - J
| [reply] [Watch: Dir/Any] [d/l] |
|
Wow that's wordy. Here's a shorter version; I borrowed (i.e. "ripped off") your initial configuration array:
#!/usr/bin/perl
use strict;
use warnings;
# Input, lines of the figure.
my @l = (
[qw [A B]],
[qw [A C F I]],
[qw [A D G J]],
[qw [A E]],
[qw [B C D E]],
[qw [B F H J]],
[qw [B I]],
[qw [E G H I]],
[qw [E J]],
[qw [I J]],
);
my %line = ();
my %flat = ();
for my $l (@l) {
for my $p (@$l) {
for my $q (@$l) {
$line{$p,$q}=1;
for my $r (@$l) {$flat{$p,$q,$r}=1}
}
}
}
my @p = 'A'..'J';
for my $p (@p) {
for my $q (@p) {
if ($q gt $p and $line{$p,$q}) {
print "[$p,$q,$_]\n"
for grep {$_ gt $q and
$line{$p,$_} and
$line{$q,$_} and
not $flat{$p,$q,$_}} @p;
}
}
}
None of that double-$, three-level-deep hashref stuff.
--
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How many triangles does your perl script "see"?
by jdalbec (Deacon) on Oct 28, 2005 at 01:02 UTC
|
my @lines = ("AB","ACFI","ADGJ","AE","BCDE","BFHJ","BI","EGHI","EJ","I
+J");
foreach my $i ("A".."H") {
foreach my $j (++(my $ii = $i) .. "I") {
foreach my $k (++(my $jj = $j) .. "J") {
print "$i$j$k\n" if 3 == grep {/$i.*$j|$i.*$k|
+$j.*$k/} @lines;
}
}
}
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How many triangles does your perl script "see"?
by !1 (Hermit) on Oct 28, 2005 at 05:14 UTC
|
#!/usr/bin/perl -l
"AB~ACFI~ADGJ~AE~BCDE~BFHJ~BI~EGHI~EJ~IJ" =~ /([^~])[^~]*([^~]).*~[^~]
+*([^~])[^~]*([^~])(?{local$z=$1 and local$y=$2 and local$x=$1 eq$3?$4
+:$1 eq$4?$3:($z=$2)&&($y=$1)&&$2 eq$3?$4:$2 eq$4?$3:0}).*~[^~]*((??{$
+y})[^~]*(??{$x})|(??{$x})[^~]*(??{$y}))(?{$x{join" - ",sort$x,$y,$z}+
++})(?!)/;
print for sort(keys %x), keys(%x) . " triangles found";
Sure it's overkill but it was fun =P
Only tested on perl 5.8.7 on windows and freebsd. | [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How many triangles does your perl script "see"?
by Skeeve (Parson) on Oct 27, 2005 at 15:08 UTC
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How many triangles does your perl script "see"?
by diotalevi (Canon) on Oct 27, 2005 at 15:38 UTC
|
35 triangles found when I quit ignoring some lines in a misguided optimization. Thanks again to Perl Mouse for posting something which showed that I was missing some results.
27 triangles found when I accounted for lines that don't actually exist. This corrects the problem that Perl Mouse found.
46 triangles found when I stopped to remove lines. Again, this takes no time worth reporting. $" = '';
$\ = "\n";
chomp( my @edges = map /--/
? join( '', sort /\w/g )
: (),
<DATA> );
my @nodes = sort { $a cmp $b }
uniq( map /\w/g,
@edges );
for $node ( @nodes ) {
my $edge_rx = qr/$node/;
my @other_nodes = map /$edge_rx/
? grep( $_ ge $node, split( //, $_ ) )
: (),
@edges;
my $last_step = qr/(.).*(.)(?{print "$node -- $1 -- $2"})(?!)/;
my $node_rx = qr/$node/;
my $third_edge_rx = qr/[@other_nodes].*[@other_nodes]/;
grep $_ ge $node
&& ! /$node_rx/
&& /$third_edge_rx/
&& /$last_step/,
@edges;
}
sub uniq {
my %seen;
grep !$seen{$_}++, @_
}
__DATA__
graph triangles {
A -- B
A -- C -- F -- I
A -- D -- G -- J
A -- E
B -- C -- D -- E
B -- F -- H -- J
B -- I
E -- G -- H -- I
E -- J
I -- J
}
51 triangles found, no runtime worth reporting. Except that drat, I didn't notice that some "triangles" are actually just line segments.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
If I run your program, it tells me that 'A - B - H' is a triangle - however, there's no line between A and H.
| [reply] [Watch: Dir/Any] |
Re: How many triangles does your perl script "see"?
by eric256 (Parson) on Oct 27, 2005 at 22:43 UTC
|
Fun puzzle. Here is my kind of hybrid answer. 4 nested loops + some regex to weed out straight lines.
use strict;
use warnings;
my $data = {
A => [qw/B C D E F I G J/],
B => [qw/A C D E F H J I/],
C => [qw/A B F I D E/],
D => [qw/A C B G J E/],
E => [qw/A D C B G H I J/],
F => [qw/A C B I H J/],
G => [qw/D A E H I J/],
H => [qw/F B I J G E/],
I => [qw/B F C A H G E J/],
J => [qw/A B F H I E/],
};
my $line = qr/[ACFI]{3}|[ADGJ]{3}|[BCDE]{3}|[BFHJ]{3}|[EGHI]{3}/;
my $triangles = {};
for my $p1 (keys %$data) {
for my $p2 (@{$data->{$p1}}) {
for my $p3 (@{$data->{$p2}}) {
next if $p3 eq $p1;
for my $p4 (@{$data->{$p3}}) {
if ($p4 eq $p1) {
my $tri = join( "", sort @{[$p1,$p2, $p3]});
$triangles->{$tri}++ unless $tri =~ $line;
}
}
}
}
}
print $_,"\n" for sort keys %$triangles;
print 0+keys %$triangles;
___________
Eric Hodges
$_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9';
s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
| [reply] [Watch: Dir/Any] [d/l] |
Re: How many triangles does your perl script "see"?
by Thelonius (Priest) on Oct 28, 2005 at 00:25 UTC
|
#!perl -w
use strict;
sub choose {
my ($str, $n) = @_;
my @result;
choose1(\@result, "", $str, $n, 0);
return @result;
}
sub choose1 {
my ($parray, $this, $str, $n, $x) = @_;
if ($n == 0) {
push @{$parray}, $this;
return;
}
return if $x + $n > length($str);
choose1($parray, $this . substr($str, $x, 1), $str, $n - 1, $x+1);
choose1($parray, $this, $str, $n, $x+1);
}
my %edges;
my %nodes;
my %collinear;
for (qw(ab acfi adgj ae bcde bfhj bi ej eghi ij)) {
$nodes{$_} = 1 for choose($_, 1);
$edges{$_} = 1 for choose($_, 2);
$collinear{$_} = 1 for choose($_, 3);
}
my $allnodes = join "", sort keys %nodes;
for my $triple (grep {!$collinear{$_}} choose($allnodes, 3)) {
print "$triple\n" if 3 == grep { $edges{$_} } choose($triple, 2);
}
| [reply] [Watch: Dir/Any] [d/l] |
Re: How many triangles does your perl script "see"?
by tye (Sage) on Oct 27, 2005 at 20:05 UTC
|
| [reply] [Watch: Dir/Any] [d/l] |
Re: How many triangles does your perl script "see"?
by Perl Mouse (Chaplain) on Oct 27, 2005 at 15:20 UTC
|
What's the puzzle? Is the puzzle to scan the image can reconstruct the graph - and once you've done so, count the triangles? Or can you just give the edges and vertices to the program as input? In the latter case, the puzzle becomes really simple, as any non-trivial 3-cycle will be a triangle. (JH - HF - FJ is a trivial cycle, but JB - BI - IJ isn't).
| [reply] [Watch: Dir/Any] |
|
Actually the latter case can not be logically resolved, as the number of triangles not only depends on the linkage, but also the geo-location of each point (things like what if three points are located on one straight line etc.)
In the latter case, the question needs to be changed to something like "what is the maximum number of triangles can be formed" or something similar.
| [reply] [Watch: Dir/Any] |
|
Actually the latter case can not be logically resolved, as the number of triangles not only depends on the linkage, but also the geo-location of each point (things like what if three points are located on one straight line etc.)
That's what I wrote, wasn't it? Three co-linear points form a trivial 3-cycle. And we want to avoid those.
| [reply] [Watch: Dir/Any] |
|
Don't scan. Just put in whatever you think is needed by you program (except for the solution of course).
When I wrote my script I gave it much information like: Which nodes are linked with which other nodes, which nodes are on one line and so on.
s$$([},&%#}/&/]+}%&{})*;#$&&s&&$^X.($'^"%]=\&(|?*{%
+.+=%;.#_}\&"^"-+%*).}%:##%}={~=~:.")&e&&s""`$''`"e
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How many triangles does your perl script "see"?
by kwaping (Priest) on Oct 27, 2005 at 19:42 UTC
|
I think this'd be better in CUFP. :) | [reply] [Watch: Dir/Any] |