package FermionicSpaces;
use strict;
use warnings;

{
	package FermionicSpaces::Fermion;
	use Scalar::Util qw(weaken);

	my $absolute_seqno=0;
	sub new
	{
		my $pkg = shift;
		my %init = @_;
		bless {
			spaces => {},
			id => 'f'.$absolute_seqno++,
			%init,
		}, $pkg
	}
	sub id { $_[0]{'id'} }

	sub states_as_string
	{
		my $self = shift;
		join ',', sort $self->states
	}
	sub as_string
	{
		my $self = shift;
		my $s = "Fermion ".$self->id."\n";
		$s .= "Is in Spaces:";
		$s .= " ".$_->id for $self->spaces;
		$s .= "\nIs in states:";
		$s .= " ".$_ for $self->states;
		$s .= "\n";
		$s
	}

	# spaces

	sub spaces
	{
		my( $self, ) = @_;
		sort { $a->id cmp $b->id } values %{ $self->{'spaces'} }
	}

	sub add_space
	{
		my( $self, $space ) = @_;
		# value is the space obj ref, key is the stringified form of that ref
		weaken( $self->{'spaces'}{$space} = $space );
		$self
	}

	# states

	sub states
	{
		my( $self, $state ) = @_;
		keys %{ $self->{'states'} }
	}

	sub is_state_allowed
	{
		my( $self, $state ) = @_;
		exists $self->{'states'}{$state}
	}

	sub allow_states
	{
		my( $self, @state ) = @_;
		$self->{'states'}{$_} = 1  for @state;
		$self
	}

	sub disallow_states
	{
		my( $self, @states ) = @_;
		my @orig_states = sort keys %{ $self->{'states'} };
		delete $self->{'states'}{$_} for @states;
		$self->states == 0 and die "integrity constraint violation:
fermion ".$self->id." had states [@orig_states], and was told to eliminated [@states]";
		$self
	}
	sub disallow_states_other_than
	{
		my( $self, @states ) = @_;
		my %s; @s{@states} = @states;
		delete $self->{'states'}{$_} for grep { not exists $s{$_} } $self->states;
		$self->states == 0 and die "integrity constraint violation";
		$self
	}
	sub allow_only_states
	{
		my( $self, @states ) = @_;
		$self->disallow_states_other_than( @states )
	}

	# collapsitude

	sub is_collapsed
	{
		my( $self, ) = @_;
		$self->{'collapsed'}
	}

	# notifies other fermions in all my spaces
	# state argument is optional, and normally omitted.
	# if given, it must be a state the fermion can still be in.
	# if omitted, the fermion must have exactly one valid state.
	sub collapse
	{
		my( $self, $state ) = @_;
		$self->is_collapsed and die "already collapsed!";
		# pass a state arg if you want to force a collapse to a specific state
		if ( defined $state )
		{
			$self->is_state_allowed( $state ) or die "pre-condition violated ( @_ )";
			# leave just the one
			$self->disallow_states( grep { $_ != $state } $self->states );
		}
		else
		{
			my @s = $self->states;
			@s == 1 or die "pre-condition violated ( @_ )";
			$state = $s[0];
		}
		for my $space ( $self->spaces ) 
		{
			$_->exclude( $state ) for grep { $_ != $self } $space->fermions;
		}
		$self->{'collapsed'}=1;
		$self
	}

}
{
	package FermionicSpaces::Space;
	use Scalar::Util qw(weaken);

	my $absolute_seqno=0;
	sub new
	{
		my $pkg = shift;
		my %init = @_;
		bless {
			exclusibles_found => [],
			id => 's'.$absolute_seqno++,
			%init,
		}, $pkg
	}
	sub id { $_[0]{'id'} }

	sub as_string
	{
		my $self = shift;
		my $s = "Space " . $self->id . " has Fermions:\n";
		$s .= "\t".$_->id . "\t".$_->states_as_string . "\n"
			for $self->fermions;
		$s
	}

	sub add_fermion
	{
		my( $self, $f ) = @_;
		weaken( $self->{'fermions'}{$f} = $f );
		$self
	}

	sub fermions
	{
		my $self = shift;
		sort { $a->id cmp $b->id } values %{ $self->{'fermions'} }
	}

		# returns a list consisting of the generated key, followed by
		# the fermions in "proper" order, which is simply sorted.
		sub _normalized_set_key # NOT a method
		{
			@_ = sort @_;
			( "@_", @_ )
		}

		sub _replace_hash_values_with_array(\$)
		{
			my( $sr ) = @_;
			my( $k, @v ) = _normalized_set_key( values %{ $$sr } );
			$$sr = \@v;
		}

	sub find_exclusibles
	{
		my( $self, $arity ) = @_;
		$arity ||= 1;

		my %state_fermions;
		my %fermions_with_N_states; # key = stateset_key
		for my $f ( $self->fermions )
		{
			my( $stateset_key, @states ) = _normalized_set_key( $f->states );
			$state_fermions{$_}{$f} = $f for @states;

			if ( @states == $arity )
			{
				$fermions_with_N_states{ $stateset_key }{'fermions'}{$f} = $f;
				$fermions_with_N_states{ $stateset_key }{'states'} = \@states;
			}
		}

		_replace_hash_values_with_array( $fermions_with_N_states{$_}{'fermions'} )
			for keys %fermions_with_N_states;

		# if it's the wrong arity, skip it:
		delete $fermions_with_N_states{$_}
			for grep {
				@{ $fermions_with_N_states{$_}{'fermions'} } < $arity
			} keys %fermions_with_N_states;



		my %fermionsetkey; # key = a string of N fermion IDs, as returned by _normalized_set_key()
		for my $st ( grep { keys %{ $state_fermions{$_} } == $arity } keys %state_fermions )
		{
			# we've found a state which is valid in exactly N fermions
			my( $fermionset_key, @f ) = _normalized_set_key( values %{ $state_fermions{$st} } );
			$fermionsetkey{ $fermionset_key }{'states'}{ $st } = $st;
			$fermionsetkey{ $fermionset_key }{'fermions'} = \@f;
		}

		# convert state hash-sets into arrays:
		_replace_hash_values_with_array( $fermionsetkey{$_}{'states'} )
			for keys %fermionsetkey;

		# if it's the wrong arity, skip it:
		delete $fermionsetkey{$_}
			for grep {
				@{ $fermionsetkey{$_}{'states'} } != $arity
			} keys %fermionsetkey;

		# make a combined result
		my %result;
			# this is all just to avoid dups
		for my $hr (
			values(%fermionsetkey),
			values(%fermions_with_N_states),
		)
		{
			my( $fk ) = _normalized_set_key( @{ $hr->{'fermions'} } );
			my( $sk ) = _normalized_set_key( @{ $hr->{'states'} } );
			my $k = "$sk / $fk";
			#warn "[ $k ]\n";
			$result{$k} = $hr;
		}

		# if we've seen it before, skip it:
		delete $result{$_}
			for grep {
				exists $self->{'exclusibles_found'}[$arity]{$_}
			} keys %result;

		# add these to the list of ones we've found already:
		$self->{'exclusibles_found'}[$arity]{$_} = $result{$_} for keys %result;

		values %result
	}

	# arg is a hashref like a value in %fsetkey.
	sub do_exclusion
	{
		my( $self, $excl ) = @_;
		my @s = @{ $excl->{'states'} };
		my @f = @{ $excl->{'fermions'} };

		print <<EOF;

Doing exclusion:
	States = @s
	Fermions = @{[ map $_->id, @f ]}

EOF

		$_->disallow_states_other_than(@s) for @f;
		$_->disallow_states(@s) for $self->fermions_other_than(@f);
	}

	# this returns an array; each slot represents an arity corresponding to the index of the slot.
	sub exclusibles_found
	{
		my $self = shift;
		@{ $self->{'exclusibles_found'} }
	}

	sub fermions_other_than
	{
		my( $self, @f ) = @_;
		my %f; @f{@f} = ();
		grep { not exists $f{$_} } $self->fermions
	}
}

# back to package FermionicSpaces...

	my $absolute_seqno=0;
	sub new
	{
		my $pkg = shift;
		my %init = @_;
		bless {
			id => 'FS'.$absolute_seqno++,
			%init,
			# must include states => [ states... ]
		}, $pkg
	}
	sub id { $_[0]{'id'} }

	# this root object owns the factories and the products.

	my $space_seq=0;
	sub new_space
	{
		my $self = shift;
		my $f = new FermionicSpaces::Space
			id => $self->id . '.s' . $space_seq++,
			@_;
		$self->{'spaces'}{$f} = $f
	}

	my $ferm_seq=0;
	sub new_fermion
	{
		my $self = shift;
		my $f = new FermionicSpaces::Fermion
			id => $self->id . '.f' . $ferm_seq++,
			@_;
		$f->allow_states( @{ $self->{'states'} } );
		$self->{'fermions'}{$f} = $f
	}

	sub spaces
	{
		my $self = shift;
		sort { $a->id cmp $b->id } values %{ $self->{'spaces'} }
	}

	sub fermions
	{
		my $self = shift;
		sort { $a->id cmp $b->id } values %{ $self->{'fermions'} }
	}

	sub add_fermion_to_space
	{
		my( $self, $f, $s ) = @_;
		$f->add_space($s);
		$s->add_fermion($f);
		$self
	}

	sub as_string
	{
		my $self = shift;
		my $s = '';
		$s .= "\nFermionicSpaces ".$self->id."\n";
		$s .= "Spaces:\n";
		$s .= $_->as_string."\n" for $self->spaces;
		$s .= "Fermions:\n";
		$s .= $_->as_string."\n" for $self->fermions;
		$s .= "\n";
		$s
	}

	sub do_all_possible_exclusions
	{
		my $self = shift;
		my $limit = @{ $self->{'states'} };
		for ( my $arity = 1; $arity < $limit; $arity++ )
		{
			my $did_exclusion;
			for my $space ( $self->spaces )
			{
				for my $excl ( $space->find_exclusibles( $arity ) )
				{
					$space->do_exclusion( $excl );
					$did_exclusion++;
				}
			}
			if ( $did_exclusion )
			{
				$did_exclusion = 0;
				$arity = 0;
			}
		}
		$self
	}


1;


##</code><code>##


use FermionicSpaces;
use strict;
use warnings;

my $fs = new FermionicSpaces states => [ 0, 1 ];

my $s1 = $fs->new_space;
my $s2 = $fs->new_space;

my $A = $fs->new_fermion( id => 'A' );
my $B = $fs->new_fermion( id => 'B' );
my $C = $fs->new_fermion( id => 'C' );

$fs->add_fermion_to_space( $A, $s1 );
$fs->add_fermion_to_space( $B, $s1 );
$fs->add_fermion_to_space( $B, $s2 );
$fs->add_fermion_to_space( $C, $s2 );

print "Before:\n", $fs->as_string;

$A->disallow_states(1);

$fs->do_all_possible_exclusions;

print "After:\n", $fs->as_string;