Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Re: How many triangles does your perl script "see"?

by Perl Mouse (Chaplain)
on Oct 27, 2005 at 16:24 UTC ( [id://503401]=note: print w/replies, xml ) Need Help??


in reply to How many triangles does your perl script "see"?

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
Perl --((8:>*

Replies are listed 'Best First'.
Re^2: How many triangles does your perl script "see"?
by fizbin (Chaplain) on Oct 27, 2005 at 19:39 UTC
    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@/
      None of that double-$, three-level-deep hashref stuff.
      True, your solution doesn't use Perl5 style nested hashes. Instead, your code used Perl4 style nested hashes - which aren't really nested and depend on a global variable instead.

      I've put Perl4 behind me. A long, long time ago.

      Perl --((8:>*
Re^2: How many triangles does your perl script "see"?
by Skeeve (Parson) on Oct 27, 2005 at 19:10 UTC
    I don't understand it (yet) but I really like it!

    s$$([},&%#}/&/]+}%&{})*;#$&&s&&$^X.($'^"%]=\&(|?*{%
    +.+=%;.#_}\&"^"-+%*).}%:##%}={~=~:.")&e&&s""`$''`"e

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://503401]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (5)
As of 2024-03-28 08:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found