package Algorithm::Graphs::TransitiveClosure::Tiny;

use 5.010;
use strict;
use warnings;

use Exporter 'import';

our @EXPORT_OK = qw(floyd_warshall);

our $VERSION = '1.01';


sub floyd_warshall {
  my $graph    = shift;
  my $delEmpty = !shift;

  my @vertices = do {
    my %vertices;
    foreach my $v (keys(%$graph)) {
      if (%{$graph->{$v}}) {
        @vertices{$v, keys(%{$graph->{$v}})} = ();
      } elsif ($delEmpty) {
        delete $graph->{$v};
      }
    }
    keys %vertices;
  };
  foreach my $k (@vertices) {
    foreach my $i (@vertices) {
      foreach my $j (@vertices) {
        $graph->{$i}->{$j} = undef if (exists($graph->{$k}) && exists($graph->{$k}->{$j}) &&
                                       exists($graph->{$i}) && exists($graph->{$i}->{$k})
                                       && !exists($graph->{$i}->{$j}));
      }
    }
  }
  return $graph;
}



1; # End of Algorithm::Graphs::TransitiveClosure::Tiny




__END__


=head1 NAME

Algorithm::Graphs::TransitiveClosure::Tiny - Calculate the transitive closure.


=head1 VERSION

Version 1.01


=head1 SYNOPSIS

    use Algorithm::Graphs::TransitiveClosure::Tiny qw(floyd_warshall);

    # The hash values here need not to be undef, but floyd_warshall()
    # only adds undef.
    my $graph = {
                 0 => {0 => undef},
                 1 => {1 => undef, 2 => undef, 3 => undef},
                 2 => {1 => undef, 2 => undef},
                 3 => {0 => undef, 2 => undef, 3 => undef},
                };

    floyd_warshall $graph;

    print "There is a path from 2 to 0.\n" if
        exists($graph->{2}) && exists($graph->{2}->{0});

The latter can also be written shorter provided you accept autovivification:

    print "There is a path from 2 to 0.\n" if exists($graph->{2}->{0});



=head1 DESCRIPTION

This module provides a single function, C<floyd_warshall>, which is exported
on demand. It is an implementation of the well known I<Floyd-Warshall>
algorithm computing the transitive closure of a graph.

The code is taken from L<Algorithm::Graphs::TransitiveClosure> but has been
modified. The difference is that this implementation of C<floyd_warshall()>:

=over

=item *

works on hashes only,

=item *

uses C<undef> for hash values, so an incidence must be checked with
C<exists()> (but for the input hash you are not forced to use C<undef>),

=item *

fixes following problem of L<Algorithm::Graphs::TransitiveClosure>:

Example:

   my $g = {
            0 => { 2 => 1},
            1 => { 0 => 1},
           };

There is an edge from 0 to 2 and an edge from 1 to 0. So the transitive
closure would contain an edge from 1 to 2. But calling C<floyd_warshall($g)>
from L<Algorithm::Graphs::TransitiveClosure> results in:

           {
            0 => { 2 => 1},
            1 => { 0 => 1},
           }

No change. The edge from 1 to 2 is missing (you would need to add C<2=E<gt>{}>
to C<$g> to get it right). But if you call C<floyd_warshall($g)> from
C<Algorithm::Graphs::TransitiveClosure::Tiny>, then the result is correct:

           {
            0 => { 2 => 1},
            1 => { 0 => 1,
                   2 => undef},
           }

Edge from 1 to 2 has been added! (Also note that it was possible to use 1
instead of C<undef> as hash value. This value is kept, but the value added by
the function is still C<undef>!)


=item *

By default, C<floyd_warshall($graph)> removes empty subhashes from C<$graph>,
e.g.

    my $graph = {
                 this => {that => undef},
                 that => {}
                };
    floyd_warshall($graph);

will result in

   {
    this => {that => undef}
   }

This behavior can be changed by setting optional second argument of
C<floyd_warshall> to a true value, i.e., calling C<floyd_warshall($graph, 1)>
with the above example hash will not remove C<that =E<gt> {}>.


=back

For convenience, C<floyd_warshall> returns C<$graph>.

For further information refer to L<Algorithm::Graphs::TransitiveClosure>.


=head1 AUTHOR

Abdul al Hazred, C<< <451 at gmx.eu> >>


=head1 BUGS

Please report any bugs or feature requests to C<bug-algorithm-graphs-transitiveclosure-tiny at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Graphs-TransitiveClosure-Tiny>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.



=head1 SEE ALSO

L<Algorithm::Graphs::TransitiveClosure>,
L<Text::Table::Read::RelationOn::Tiny>



=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Algorithm::Graphs::TransitiveClosure::Tiny


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Algorithm-Graphs-TransitiveClosure-Tiny>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/Algorithm-Graphs-TransitiveClosure-Tiny>

=item * Search CPAN

L<https://metacpan.org/release/Algorithm-Graphs-TransitiveClosure-Tiny>

=back



=head1 LICENSE AND COPYRIGHT

This software is copyright (c) 2022 by Abdul al Hazred.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.