package SmilesScripts::Aromaticity;

use strict;
use warnings;

use Algorithm::Combinatorics qw( combinations );
use Chemistry::OpenSMILES qw(
    is_double_bond
    is_single_bond
    is_triple_bond
);
use Graph::SSSR;
use Graph::Traversal::DFS;
use Graph::Undirected;
use List::Util qw( all any sum0 );
use Set::Object qw( set );

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
    aromatise
    electron_cycles
    is_aromatic
);

sub aromatise
{
    my( $moiety ) = @_;

    my @aromatic_rings;
    my %SSSR = map { join( '', sort @$_ ) => $_ } Graph::SSSR::get_SSSR( $moiety, 8 );
    for my $SSSR (map { $SSSR{$_} } sort keys %SSSR) {
        push @aromatic_rings, $SSSR if is_aromatic( $moiety, @$SSSR );
    }

    for my $ring (@aromatic_rings) {
        for my $i (0..$#$ring) {
            # Set bond to aromatic
            $moiety->set_edge_attribute( $ring->[$i],
                                         $ring->[($i + 1) % scalar @$ring],
                                         'bond',
                                         ':' );
            # Set atoms to aromatic
            if( $ring->[$i]{symbol} =~ /^([BCNOPS]|Se|As)$/ ) {
                $ring->[$i]{symbol} = lcfirst $ring->[$i]{symbol};
            }
        }
    }
}

sub electron_cycles
{
    my( $moiety ) = @_;

    my %SSSR = map { join( '', sort @$_ ) => $_ } Graph::SSSR::get_SSSR( $moiety, 8 );

    # Detect which atoms participate in which rings
    my %ring_participation;
    for my $ring (values %SSSR) {
        my @edges = $moiety->subgraph( $ring )->edges;
        next unless all { is_single_bond( $moiety, @$_ ) ||
                          is_double_bond( $moiety, @$_ ) } @edges;
        next unless any { is_double_bond( $moiety, @$_ ) } @edges;

        for my $atom (@$ring) {
            push @{$ring_participation{$atom}}, $ring;
        }
    }

    # Construct a graph with rings as nodes and shared atoms as edges
    my $ring_graph = Graph::Undirected->new( refvertexed => 1 );
    for (keys %ring_participation) {
        $ring_graph->add_vertices( @{$ring_participation{$_}} );
        if( @{$ring_participation{$_}} > 1 ) {
            $ring_graph->add_edges( combinations( $ring_participation{$_}, 2 ) );
        }
    }

    # Check each subgraph for electron cycle criteria
    my @electron_cycles;
    for my $component ($ring_graph->connected_components) {
        SUBGRAPH:
        for my $ring_subgraph (induced_trees( $ring_graph->subgraph( $component ) )) {
            my $subgraph = Graph::Undirected->new( refvertexed => 1 );
            my @bonds_seen_more_than_once;
            for my $ring ($ring_subgraph->vertices) {
                for my $bond ($moiety->subgraph( $ring )->edges) {
                    if( $subgraph->has_edge( @$bond ) ) {
                        push @bonds_seen_more_than_once, $bond;
                    }
                    $subgraph->add_edge( @$bond );
                }
            }
            # Remove bonds appearing in more than one smallest ring
            $subgraph->delete_edges( map { @$_ } @bonds_seen_more_than_once );

            # Skip unless the subgraph is a cycle
            next unless all { $subgraph->degree( $_ ) == 2 } $subgraph->vertices;

            my @atoms = Graph::Traversal::DFS->new( $subgraph )->dfs;
            my $is_single = is_single_bond( $moiety, @atoms[0..1] );
            my $two_singles_found;
            push @atoms, shift @atoms;
            for (1..$#atoms) {
                if( is_single_bond( $moiety, @atoms[0..1] ) == $is_single ) {
                    if( @atoms % 2 && $is_single && !$two_singles_found ) {
                        $two_singles_found = 1;
                    } else {
                        next SUBGRAPH;
                    }
                }
                $is_single = is_single_bond( $moiety, @atoms[0..1] );
                push @atoms, shift @atoms;
            }

            push @electron_cycles, \@atoms;
        }
    }

    return @electron_cycles;
}

# This algorithm is a rewrite of Chemistry::Ring::is_aromatic(), v0.21
# An exception is introduced in Hückel's rule check to allow antiaromatic compounds.
sub is_aromatic
{
    my( $moiety, @ring ) = @_;

    my $n_pi = 0;
    for my $atom (@ring) {
        my $hcount = $atom->{hcount} ? $atom->{hcount} : 0;
        return '' if $hcount + $moiety->degree( $atom ) > 3;

        return '' if any { is_triple_bond( $moiety, $atom, $_ ) }
                         $moiety->neighbours( $atom );

        my $n_double = grep { is_double_bond( $moiety, $atom, $_ ) }
                            $moiety->neighbours( $atom );
        return '' if $n_double > 1;
        if( $n_double ) {
            $n_pi += 1;
        } elsif( $atom->{symbol} =~ /^[NOS]$/ ) {
            $n_pi += 2;
        }
    }

    return !($n_pi % 2);
}

sub induced_trees
{
    my( $graph ) = @_;

    my @subgraphs = ( [ map { set( $_ ) } $graph->vertices ] );
    for (2..scalar $graph->vertices) {
        my %seen;
        for my $subgraph (@{$subgraphs[-1]}) {
            for my $neighbour ((set( map { $graph->neighbours($_) } $subgraph->members ) - $subgraph)->members) {
                next if (grep { $graph->has_edge( $neighbour, $_ ) } $subgraph->members) > 1;
                my $new_subgraph = set( $subgraph->members, $neighbour );
                my $key = join '|', @$new_subgraph;
                next if exists $seen{$key};
                $seen{$key} = $new_subgraph;
            }
        }
        push @subgraphs, [values %seen];
    }
    return map { $graph->subgraph( [$_->members] ) } map { @$_ } @subgraphs;
}

1;
