# This file is part of the graph-includes package
#
# (c) 2005 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

package graphincludes::graph;
use strict;
use warnings;

use Hash::Util qw(lock_keys);
use graphincludes::node;

sub new {
  my $class = shift;
  my $self = {};

  $self->{_NODES} = undef;
  $self->{_EDGES} = undef;
  $self->{_DROPCOUNT} = 0;

  bless ($self, $class);
  lock_keys (%$self);
  return $self;
}

sub copy {
  my $self = shift;
  my $class = ref $self;

  my %nodes = %{$self->{_NODES}};
  my %edges = %{$self->{_EDGES}};

  my $copy = {
	      _NODES => \%nodes,
	      _EDGES => \%edges,
	      _DROPCOUNT => 0,
	     };
  bless ($copy, $class);
  lock_keys (%$copy);
  return $copy;
}

sub set_nodes {
  my $self = shift;

  # store nodes as a hash indexed by label
  my %nodes = map { ($_->{LABEL} => $_) } @_;

  $self->{_NODES} = \%nodes;
}
sub set_nodes_from_names {
  my $self = shift;
  my ($files) = @_;

  $self->set_nodes(map { new graphincludes::node($_); } @$files);
}
sub get_nodes {
  my $self = shift;

  values %{$self->{_NODES}};
}

sub record_edge {
  my $self = shift;
  my ($src, $dst) = @_;

#   if (defined $self->{IGNOREDDEPS}{$src}{$dst}) {
#     print STDERR "ignoring $src -> $dst\n" if $graphincludes::params::debug;
#     $self->{IGNOREDEDGES}{$src}{$dst} =
#       $self->{IGNOREDDEPS}{$src}{$dst};
#   }

  $self->{_EDGES}{$src}{$dst} ++;
}

sub has_children {
  my $self = shift;
  my ($src) = @_;

  # FIXME: use the in-node cache
  defined $self->{_EDGES}{$src};
}

sub has_edge {
  my $self = shift;
  my ($src, $dst) = @_;
  defined $self->{_EDGES}->{$src}->{$dst};
}
sub has_path {
  my $self = shift;
  my ($from, $to, @seen) = @_;	# @seen is a private parameter
  return 1 if $from eq $to;
  return 0 if grep { $_ eq $from } @seen;
  return 1 if $self->has_edge($from,$to); # superfluous ?
  foreach my $child ($self->get_edges($from)) {
    return 1 if $self->has_path($child, $to, (@seen, $from));
  }
  return 0;
}

sub drop_edge {
  my $self = shift;
  my ($src, $dst) = @_;

  delete $self->{_EDGES}{$src}{$dst};
}

sub get_edge_origins {
  my $self = shift;
  keys %{$self->{_EDGES}};
}
sub get_edges {
  my $self = shift;
  my ($origin) = @_;
  keys %{$self->{_EDGES}->{$origin}};
}

# FIXME: weight should not be stored that way
sub get_edge_weight {
  my $self = shift;
  my ($src,$dst) = @_;
  $self->{_EDGES}->{$src}->{$dst};
}

sub reduced {
  my $self = shift;
  my $reduced = $self->copy;

  print STDERR "Doing transitive reduction " if $graphincludes::params::verbose;
  foreach my $node ($reduced->get_edge_origins) {
    print STDERR '.' if $graphincludes::params::verbose;
    print STDERR "node $node\n" if $graphincludes::params::debug;
    if ($reduced->has_children($node)) {
      my %droppedchildren;	# hash (indexed list) of children to drop

      # first, get the list of children to be dropped
      my @considered = ($node);
      foreach my $child ($reduced->get_edges($node)) {
	# do not explore children already removed, or some circles cause lost edges
	next if defined $droppedchildren{$child};
	print STDERR " child $child\n" if $graphincludes::params::debug;
	if ($reduced->has_children($child)) {
	  foreach my $gchild ($reduced->get_edges($child)) {
	    if ($gchild ne $node and $gchild ne $child) { # XXX
	      print STDERR "  gchild $gchild\n" if $graphincludes::params::debug;
	      $reduced->_suppress (\%droppedchildren, $gchild, \@considered,
				   ($node, $child, $gchild));
	    }
	  }
	}
      }

      # then drop those children we just marked
      foreach my $child (%droppedchildren) {
	$self->drop_edge ($node, $child);
      }
    }
  }
  print STDERR " $reduced->{_DROPCOUNT} cleared.\n" if $graphincludes::params::verbose;

  $reduced->is_reduction_of ($self)
    or die "internal error in transitive reduction (please use --debug)";

  return $reduced;
}

sub _suppress {
  my $self = shift;
  my ($dropped,			# hash (indexed list) of children to drop
      $suspect,			# node to consider this time
      $considered,		# graph nodes already seen, not to reconsider
      @context)			# current path
    = @_;

  # Do not consider $suspect twice, prevent looping on circular deps.
  # We must take care of the special case of the child that led us to
  # the current node, or we would have to do special things to $gchild
  return if $suspect eq $context[1] or grep { $suspect eq $_ } (@$considered);
  push @$considered, $suspect;

  # mark $suspect for removal
  if ($self->has_edge($context[0],$suspect) and !defined $dropped->{$suspect}) {
    if ($graphincludes::params::showdropped) {
      $self->{SPECIALEDGES}{$context[0]}{$suspect} = {color      => "#FFCCCC",
						      constraint => 'false'};
    } elsif (grep { $_ eq $context[0] } @graphincludes::params::focus) {
      $self->{SPECIALEDGES}{$context[0]}{$suspect} = {color => "#FFCCCC"};
    } else {
      $self->{_DROPCOUNT}++;
      # increment "use count" on each step of the alternate path in @context
      my $weight = $self->get_edge_weight($context[0],$suspect);
      for (my $i = 0; $i < $#context; $i++) {
	$self->{_EDGES}{$context[$i]}{$context[$i+1]} += $weight;
      }
      # remove it
      $dropped->{$suspect} = 1;
    }
    print STDERR "    --$suspect (", join (',', @context), ")\n" if $graphincludes::params::debug;
  }

  # look at $suspect's children
  if ($self->has_children($suspect)) {
    foreach my $child ($self->get_edges($suspect)) {
      if ($graphincludes::params::debug) {
	foreach (@context) {
	  print STDERR " ";
	}
	print STDERR "$child\n";
      }
      $self->_suppress ($dropped, $child, $considered, (@context, $child));
    }
  }
}

sub is_reduction_of {
  my $self = shift;
  my ($complete) = @_;

  print STDERR "Verifying validity of transitive reduction "
    if $graphincludes::params::verbose;

  my $ok = 1;
  foreach my $node ($complete->get_edge_origins) {
    print STDERR '.' if $graphincludes::params::verbose;
    foreach my $child ($complete->get_edges($node)) {
      if (!$self->has_path($node, $child)) {
	print STDERR "ERROR: missing edge from $node to $child\n"
	  if $graphincludes::params::debug;
	$ok = 0;
      }
    }
  }
  printf STDERR " %s.\n", ($ok ? "ok" : "FAILED")
    if $graphincludes::params::verbose;

  return $ok;
}

1;