# Copyright 2015 Kevin Ryde
#
# This file is part of Graph-Graph6.
#
# Graph-Graph6 is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Graph-Graph6 is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with Graph-Graph6.  If not, see <http://www.gnu.org/licenses/>.

package Graph::Graph6;
use 5.006;  # for 3-arg open
use strict;
use warnings;
use List::Util 'max';
use Carp 'croak';

our $VERSION = 3;
our @ISA = ('Exporter');
our @EXPORT_OK = ('read_graph','write_graph');

# uncomment this to run the ### lines
# use Smart::Comments;


use constant 1.02 _HEADER_GRAPH6  => '>>graph6<<';
use constant      _HEADER_SPARSE6 => '>>sparse6<<';

sub _read_header {
  my ($fh) = @_;
  my $str = '>';
  for (;;) {
    my $s2 = getc $fh;
    if (! defined $str) { return; }

    $str .= $s2;
    if ($str eq substr(_HEADER_GRAPH6, 0, length($str))) {
      if (length($str) == length(_HEADER_GRAPH6)) {
        ### header: $str
        return;
      }

    } elsif ($str eq substr(_HEADER_SPARSE6, 0, length($str))) {
      if (length($str) == length(_HEADER_SPARSE6)) {
        ### header: $str
        # $sparse = 1;
        return;
      }
    } else {
      return $str;
    }
  }
}

sub read_graph {
  my %options = @_;

  my $error;

  my $fh = $options{'fh'};
  if (defined $options{'str'}) {
    require IO::String;
    $fh = IO::String->new($options{'str'});
  }

  my $skip_newlines = 1;
  my $allow_header = 1;
  my $sparse;

  # Return: byte 0 to 63
  #         -1 and $error=undef if end of file
  #         -1 and $error if something bad
  my $read_byte = sub {
    for (;;) {
      my $str;
      my $len = read($fh, $str, 1);
      if (! defined $len) {
        $error = "Error reading: $!";
        return -1;
      }
      ### read byte: $str

      if ($skip_newlines && $str eq "\n") {
        # secret undocumented skipping of newlines, so skip blank lines
        # rather than reckoning one newline as immediate end of file
        ### skip initial newline ...
        next;
      }
      $skip_newlines = 0;

      if ($allow_header && $str eq '>') {
        $str = _read_header($fh);
        if (defined $str) {
          $error = "Incomplete header: $str";
          return -1;
        }
        $allow_header = 0;
        next;
      }
      $allow_header = 0;

      my $n = ord($str) - 63;
      if ($n >= 0 && $n <= 63) {
        return $n;
      }

      if ($str eq '' || $str eq "\n") {
        ### end of file or end of line ...
        return -1;
      }

      if ($str eq ':') {
        $sparse = 1;
        next;
      }
      if ($str eq "\r") {
        ### skip CR ...
        next;
      }

      $error = "Unrecognised character: $str";
      return -1;
    }
  };

  # Return: number 0 to 2^36-1
  #         -1 and $error=undef if end of file before any part of number
  #         -1 and $error if something bad, including partial number
  my $read_number = sub {
    my $n = $read_byte->();
    if ($n <= 62) {
      return $n;
    }
    $n = $read_byte->();
    if ($n < 0) {
      $error ||= "Unexpected EOF";
      return -1;
    }
    my $len;
    if ($n <= 62) {
      $len = 2;
    } else {
      $n = 0;
      $len = 6;
    }
    foreach (1 .. $len) {
      my $n2 = $read_byte->();
      if ($n2 < 0) {
        $error ||= "Unexpected EOF";
        return -1;
      }
      $n <<= 6;
      $n += $n2;
    }
    return $n;
  };

  # Return: 1 if good
  #         empty and $error if something bad
  #         empty and $error=undef if EOF
  my $read = sub {

    if (! defined $fh) {
      if (defined(my $filename = $options{'filename'})) {
        open $fh, '<', $filename
          or do {
            $error = "Cannot open file $filename: $!";
            return;
          };
      }
    }

    my $num_vertices = $read_number->();
    ### $num_vertices
    if ($num_vertices < 0) {
      return;  # eof or possible error
    }

    if (my $num_vertices_func = $options{'num_vertices_func'}) {
      $num_vertices_func->($num_vertices);
    }
    if (my $num_vertices_ref = $options{'num_vertices_ref'}) {
      $$num_vertices_ref = $num_vertices;
    }
    ### $num_vertices
    ### $sparse

    my $edge_func = $options{'edge_func'};
    my $edge_aref = $options{'edge_aref'};
    if ($edge_aref) { @$edge_aref = (); }

    if ($sparse) {
      ### sparse6 ...
      my $v = 0;

      # number of bits required to represent $num_vertices - 1
      my $width = 0;
      while (($num_vertices-1) >> $width) { $width++; }

      my $bits = 0;
      my $n = 0;
      my $mask = (1 << $width) - 1;

      while ($v < $num_vertices) {
        if ($bits < 1) {
          $n = $read_byte->();
          if ($n < 0) {
            ### end of line or end of file ok ...
            return 1;
          }
          $bits = 6;
        }
        $bits--;
        my $b = ($n >> $bits) & 1;
        ### $b

        if ($b) {
          $v++;
          ### increment v to: $v
        }

        while ($bits < $width) {
          my $n2 = $read_byte->();
          if ($n2 < 0) {
            ### end of line or end of file ok ...
            return 1;
          }
          $bits += 6;
          $n <<= 6;
          $n |= $n2;
        }
        $bits -= $width;
        my $x = ($n >> $bits) & $mask;
        ### $x

        if ($x > $v) {
          ### set v: $x
          $v = $x;
        } elsif ($v < $num_vertices) {  # padding can make v>n-1
          ### edge: "$x - $v"
          if ($edge_func) { $edge_func->($x, $v); }
          if ($edge_aref) { push @$edge_aref, [$x, $v]; }
        }
      }
      ### end ...

    } else {
      ### graph6 ...

      my $from = 0;
      my $to = 1;
      while ($to < $num_vertices) {
        my $n = $read_byte->();
        if ($n < 0) {
          $error ||= "Unexpected EOF";  # end of file is not ok
          return;
        }
        for (my $mask = 1 << 5; $mask != 0; $mask >>= 1) {
          if ($n & $mask) {
            if ($edge_func) { $edge_func->($from, $to); }
            if ($edge_aref) { push @$edge_aref, [$from, $to]; }
          }
          $from++;
          if ($from >= $to) {
            $to++;
            last unless $to < $num_vertices;
            $from = 0;
          }
        }
      }

      # read \n or \r\n, so can take multiple graphs from handle
      for (;;) {
        my $str;
        my $len = read($fh, $str, 1);
        if (! defined $len) {
          $error = "Error reading: $!";
          last;
        }
        if ($str eq "\r") {
          next;  # skip CR in case reading MS-DOS file as bytes
        }
        if ($str eq '' || $str eq "\n") {
          last;  # EOF or EOL, good
        }
      }
    }

    return 1;
  };


  if ($read->()) {
    return 1;  # successful read
  }
  if (defined $error) {
    ### $error
    my $error_func = $options{'error_func'} || do {
      require Carp;
      \&Carp::croak
    };
    $error_func->($error);
    return undef;
  }
  return 0;  # EOF
}

#------------------------------------------------------------------------------

# not documented yet
sub _number_to_string {
  my ($n) = @_;
  my $str = '';
  my $bitpos = 0;
  if ($n > 258047) {  # binary 0b_111110_111111_111111 octal 0767777
    $str = '~~';
    $bitpos = (6-1)*6;
  } elsif ($n > 62) {
    $str = '~';
    $bitpos = (3-1)*6;
  }
  for ( ; $bitpos >= 0; $bitpos -= 6) {
    $str .= chr( (($n >> $bitpos) & 0x3F) + 63 );
  }
  return $str;
}

sub _edges_iterator_none {
  return;
}
sub _edge_predicate_none {
  return 0;
}

sub write_graph {
  my %options = @_;
  ### %options

  my $fh = $options{'fh'};
  if (! $fh
      && defined(my $str_ref = $options{'str_ref'})) {
    ### str_ref ...
    require IO::String;
    $fh = IO::String->new($$str_ref);
  }
  if (! $fh
      && defined(my $filename = $options{'filename'})) {
    ### $filename
    open $fh, '>', $filename
      or return 0;
  }

  my $sparse = (defined $options{'format'}
                && $options{'format'} eq 'sparse6');
  my $num_vertices = $options{'num_vertices'};
  if (! defined $num_vertices
      && (my $edge_aref = $options{'edge_aref'})) {
    # from maximum in edge_aref
    $num_vertices = -1;
    foreach my $edge (@$edge_aref) {
      $num_vertices = max($num_vertices, @$edge);
    }
    $num_vertices += 1;
  }
  if (! defined $num_vertices) {
    croak 'Missing num_vertices';
  }
  ### $num_vertices

  print $fh
    ($options{'header'}
     ? ($sparse ? _HEADER_SPARSE6 : _HEADER_GRAPH6)
     : ()),
       ($sparse ? ':' : ()),
       _number_to_string($num_vertices)
       or return 0;

  my $bitpos = 5;
  my $word = 0;
  my $put_bit = sub {
    my ($bit) = @_;
    $word |= $bit << $bitpos;
    if ($bitpos > 0) {
      $bitpos--;
    } else {
      print $fh chr($word + 63) or return 0;
      $bitpos = 5;
      $word = 0;
    }
    return 1;
  };

  if ($sparse) {
    my $edge_iterator;

    if (my $edge_aref = $options{'edge_aref'}) {
      ### edge_aref ...
      # swap to [from <= to]
      my @edges = map { $_->[0] > $_->[1]
                          ? [ $_->[1], $_->[0] ]
                          : $_
                        } @$edge_aref;
      # sort to ascending "to", and within those ascending "from"
      @edges = sort { ($a->[1] <=> $b->[1]) || ($a->[0] <=> $b->[0]) } @edges;
      $edge_iterator = sub {
        return @{(shift @edges) || []};
      };
    }

    if (! $edge_iterator
        && (my $edge_predicate = $options{'edge_predicate'})) {
      ### edge_predicate ...
      my $from = 0;
      my $to = -1;
      $edge_iterator = sub {
        for (;;) {
          $from++;
          if ($from > $to) {
            $to++;
            if ($to >= $num_vertices) {
              return;
            }
            $from = 0;
          }
          if ($edge_predicate->($from,$to)) {
            return ($from,$to);
          }
        }
      };
    }

    $edge_iterator ||= \&_edges_iterator_none;

    # number of bits required to represent $num_vertices - 1
    my $width = 0;
    if ($num_vertices > 0) {
      while (($num_vertices-1) >> $width) { $width++; }
    }
    ### $width

    my $put_n = sub {
      my ($n) = @_;
      for (my $i = $width-1; $i >= 0; $i--) {
        $put_bit->(($n >> $i) & 1) or return 0;
      }
      return 1;
    };

    my $v = 0;
    while (my ($from, $to) = $edge_iterator->()) {
      ### edge: "$from $to"

      if ($to == $v + 1) {
        ### increment v ...
        $put_bit->(1) or return 0;

      } else {
        if ($to != $v) {   # $to >= $v+2
          ### set v ...
          ($put_bit->(1)   # set v done with b[i]=1
           && $put_n->($to))
            or return 0;
        }
        $put_bit->(0) or return 0;     # v unchanged
      }
      ### write: $from
      $put_n->($from) or return 0;     # edge ($from, $v)

      $v = $to;
    }

    if ($bitpos != 5) {
      ### pad: $bitpos+1
      ### $v

      # Rule for padding so not to look like self-loop n-1 to n-1.
      # There are $bitpos+1 many bits to pad.
      # b[i]=0 bit if num_vertices = 2,4,8,16 so width=1,2,3,4
      #               and pad >= width+1
      #               and edge involving n-2 so final v=n-2
      # 0 111 is set v=n-1 provided prev <= n-2
      # 1 111 is a v+1 and edge n-1,v which is n-1,n out of range
      if (($width >= 1 && $width <= 4)
          && $num_vertices == (1 << $width)    # 1,2,4,8
          && $bitpos >= $width                 # room for final b[i] and x[i]
          && $v == $num_vertices - 2) {
        ### pad 0 ...
        $put_bit->(0) or return 0;
      }

      ### pad with 1s: $bitpos
      until ($bitpos == 5) {
        $put_bit->(1) or return 0;
      }
    }

  } else {
    my $edge_predicate = $options{'edge_predicate'};

    if (! $edge_predicate
        && (my $edge_aref = $options{'edge_aref'})) {
      ### edge_predicate from edge_aref ...
      my %edge_hash;
      foreach my $edge (@$edge_aref) {
        my ($from, $to) = @$edge;
        if ($from > $to) { ($from,$to) = ($to,$from); }
        $edge_hash{$from}->{$to} = undef;
      }
      $edge_predicate = sub {
        my ($from, $to) = @_;
        return exists $edge_hash{$from}->{$to};
      };
    }

    $edge_predicate ||= \&_edge_predicate_none;

    foreach my $to (1 .. $num_vertices-1) {
      foreach my $from (0 .. $to-1) {
        $put_bit->($edge_predicate->($from,$to) ? 1 : 0) or return 0;
      }
    }
    until ($bitpos == 5) {
      $put_bit->(0) or return 0;
    }
  }

  print $fh "\n" or return 0;
  return 1;
}

    # if (! $edge_predicate
    #     && (my $edge_matrix = $options{'edge_matrix'})) {
    #   $edge_predicate = sub {
    #     my ($from, $to) = @_;
    #     return $edge_matrix->[$from]->[$to];
    #   };
    # }

1;
__END__

=for stopwords Ryde undirected multi-edges arrayref ascii nauty tty

=head1 NAME

Graph::Graph6 - read and write graph6 or sparse6 format graphs

=for test_synopsis my ($graph)

=head1 SYNOPSIS

 use Graph::Graph6;
 my ($num_vertices, @edges);
 Graph::Graph6::read_graph(filename         => 'foo.g6',
                           num_vertices_ref => \$num_vertices,
                           edge_aref        => \@edges);

 Graph::Graph6::write_graph(filename     => 'bar.s6',
                            format       => 'sparse6',
                            num_vertices => $num_vertices,
                            edge_aref    => \@edges);

=head1 DESCRIPTION

This module reads and writes graph6 or sparse6 files.  These file formats
are per

=over 4

L<http://cs.anu.edu.au/~bdm/data/formats.txt>

=back

Both represent an undirected graph with vertices numbered 0 to n-1 encoded
into printable ascii characters in the range C<?> to C<~>.

The maximum number of vertices is 2^36-1.  sparse6 lists edges as pairs of
vertices i,j and is good for large graphs with relatively few edges.  graph6
is an upper triangle adjacency matrix of bits.  The encoding is 6 bits per
character so N vertices is a file size roughly N^2/12 bytes.  sparse6 can
have multi-edges and self loops.  graph6 does not.

=cut

=for Test-Pari-DEFINE  size_bits(n) = sum(j=1,n-1, sum(i=0, j-1, 1));

=for Test-Pari-DEFINE  size_bits_formula(n) = n*(n-1)/2;

=for Test-Pari  vector(100,n, size_bits_formula(n)) == vector(100,n, size_bits(n))

=for Test-Pari-DEFINE  size_bits_formula(n) = n^2/2 - n/2;

=for Test-Pari  vector(100,n, size_bits_formula(n)) == vector(100,n, size_bits(n))

=pod

This module reads and writes graph6 and sparse6 in a "native" way just as
integer vertex numbers.  See L</SEE ALSO> below for C<Graph.pm> and
C<Graph::Easy> interfaces reading and writing those graph objects.

=head1 FUNCTIONS

=head2 Reading

=over

=item C<$success = Graph::Graph6::read_graph(key =E<gt> value, ...)>

Read graph6 or sparse6.  The key/value options are

    filename           => filename (string)
    fh                 => filehandle (glob ref)
    str                => string
    num_vertices_ref   => scalar ref
    num_vertices_func  => coderef
    edge_aref          => array ref
    edge_func          => coderef
    error_func         => coderef

The return value is

    1       if graph successfully read
    0       if end of file (no graph)
    croak   if invalid content or file error
    undef   if error_func returns instead of dying

C<filename>, C<fh> or C<str> is the input.  The output is the number of
vertices and a list of edges.

The number of vertices n is stored to C<num_vertices_ref> or call to
C<num_vertices_func>, or both.

    $$num_vertices_ref = $n;
    $num_vertices_func->($n);

Each edge is pushed onto C<edge_aref> or call to C<edge_func>, or both.
C<$from> and C<$to> are integers in the range 0 to n-1 with C<$from E<lt>=
$to> (or C<$from E<lt> $to> for graph6).  For sparse6, multi-edges give
multiple elements stored and multiple calls made.  Any previous contents of
C<edge_aref> are discarded.

    push @$edge_aref, [ $from, $to ];
    $edge_func->($from, $to);

C<error_func> is called for any file error or invalid content.

    $error_func->($str, $str, ...);

The default C<error_func> is C<croak()>.  If C<error_func> returns then the
return from C<read_graph()> is C<undef>.

An immediate end of file (or an empty input string) gives the end of file
return 0.  It's common to have multiple graph6 or sparse6 in a file, one per
line.  They can be read successively with C<read_graph()> until at end of
file C<read_graph()> returns 0.

For C<num_vertices_ref> and C<edge_aref> a C<my> can be included in the ref
taking, as in the following.  This is compact and is similar to the common
C<open my $fh, ...> which declares the variable in a call which is its first
use.

    # "my" included in refs
    read_graph(filename         => 'foo.g6',
               num_vertices_ref => \my $num_vertices,
               edge_aref        => \my @edges);
    
The file formats have edges ordered by increasing C<$to> and within that
increasing C<$from>, although for sparse6 C<$from> can potentially jump
around.  But the suggestion is not to rely on edge order.

=back

=head2 Writing

=over

=item C<$ret = Graph::Graph6::write_graph(key =E<gt> value, ...)>

Write graph6 or sparse6.  The key/value options are

    filename           => filename (string)
    fh                 => filehandle (glob ref)
    str_ref            => output string (string ref)
    format             => "graph6" or "sparse6"
                             (string, default "graph6")
    header             => boolean (default false)
    num_vertices       => integer
    edge_aref          => array ref
    edge_predicate     => coderef

The return value is

    1       if graph successfully written
    0       if some write error, error in $!

C<filename>, C<fh> or C<str_ref> is the output destination.  C<str_ref> is a
scalar ref to store to, so for example

    my $str;
    write_graph(str_ref => \$str, ...)

    # or
    write_graph(str_ref => \my $str, ...)

C<format> defaults to the dense C<"graph6">, or choose C<"sparse6">

    write_graph(format => "sparse6", ...)

C<header> flag writes an initial C<"E<gt>E<gt>graph6E<lt>E<lt>"> or
C<"E<gt>E<gt>sparse6E<lt>E<lt>">.  This is optional for the nauty programs
and for C<read_graph()> above, but may help a human reader distinguish a
graph from tty line noise.

C<num_vertices> is mandatory, or if C<edge_aref> is given then the default
is from the maximum vertex number there (convenient as long as the maximum
vertex has at least one edge).

C<edge_aref> is an arrayref of edges which are arrayref pairs of integers
C<[$from,$to]>.  The edges and the C<$from,$to> can be in any order but all
must be integers be in the range 0 to <$num_vertices-1> inclusive.  sparse6
can have self-loops and repeated entries for multi-edges.  graph6 ignores
self-loops and writes duplicates just once each.

    edge_aref => [ [0,1], [5,6], [5,4] ]      # any order

C<edge_predicate> is another way to specify edges.  It is called with
integers C<$from,$to> to test whether such an edge exists.  Each call has
C<$from E<lt> $to> for graph6, or C<$from E<lt>= $to> for sparse6.  sparse6
self-loops can be written this way, but not multi-edges.

    $bool = $edge_predicate->($from, $to);    # $from <= $to

C<edge_predicate> is preferred for writing graph6 and C<edge_aref> is
preferred for writing sparse6, but whichever you have is used for either
output.

The output includes a final newline C<"\n"> so graphs can be written to a
file handle one after the other.

=back

=head1 EXPORTS

Nothing is exported by default, but the functions can be requested in usual
C<Exporter> style,

    use Graph::Graph6 'read_graph','write_graph';

=head1 SEE ALSO

L<Graph::Reader::Graph6>,
L<Graph::Writer::Graph6>,
L<Graph::Writer::Sparse6>

L<Graph::Easy::Parser::Graph6>,
L<Graph::Easy::As_graph6>,
L<Graph::Easy::As_sparse6>

L<nauty-showg(1)>, L<nauty-copyg(1)>

=head1 HOME PAGE

L<http://user42.tuxfamily.org/graph-graph6/index.html>

=head1 LICENSE

Copyright 2015 Kevin Ryde

Graph-Graph6 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3, or (at your option) any later
version.

Graph-Graph6 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
more details.

You should have received a copy of the GNU General Public License along with
Graph-Graph6.  If not, see L<http://www.gnu.org/licenses/>.

=cut
