Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Fermions and FermionicSpaces

by jdporter (Paladin)
on Jan 18, 2010 at 02:57 UTC ( [id://817922]=CUFP: print w/replies, xml ) Need Help?? 

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 t
+hat 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 elimi
+nated [@states]";
        $self
    }
    sub disallow_states_other_than
    {
        my( $self, @states ) = @_;
        my %s; @s{@states} = @states;
        delete $self->{'states'}{$_} for grep { not exists $s{$_} } $s
+elf->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 specif
+ic state
        if ( defined $state )
        {
            $self->is_state_allowed( $state ) or die "pre-condition vi
+olated ( @_ )";
            # leave just the one
            $self->disallow_states( grep { $_ != $state } $self->state
+s );
        }
        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->fer
+mions;
        }
        $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->st
+ates );
            $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 retur
+ned 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 key
+s %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 correspondi
+ng 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;

[download]

The thing that makes this interesting, and different from physical reality (afaik), is that a fermion can live in more than one space. If it does, it has the same state(s) in all of the spaces it lives in.

Imagine, if you will, two fermionic spaces, and three fermions. Each space contains two fermions, and one of the three fermions lives in both spaces. Label the fermions A, B, and C: 

      _
 
 | A  B |

      C
      _
so that B is in both spaces.
The fermions have two possible states: 0 and 1. Initially, each fermion is in a superposition of states (0,1).
Now suppose that A collapses to state 0. This forces* B to collapse to state 1. This in turn forces* C to collapse to state 0.

* due to the Pauli exclusion principle, which Fermions obey.

Here is code which implements the above example: 


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;

[download]
What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?

Replies are listed 'Best First'.
Re: Fermions and FermionicSpaces
by zentara (Archbishop) on Jan 18, 2010 at 12:36 UTC
    This reveals too much about how the universe works. :-) I submit it should be classified as NSFSA....

    Not Safe For Sourcerer's Apprentice :-)

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]
Re: Fermions and FermionicSpaces
by merlyn (Sage) on Jan 18, 2010 at 15:51 UTC
    I see a lot of clever and presumably well-written code, but without documentation or examples or even a context or purpose for posting... meh.

    -- Randal L. Schwartz, Perl hacker

    The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT", "SHOULD", "SHOULD NOT", "RECOMMENDED", "MAY", and "OPTIONAL" in this document are to be interpreted as described in RFC 2119.

[reply]
Re: Fermions and FermionicSpaces
by CountZero (Bishop) on Jan 18, 2010 at 21:11 UTC
    If your module is run at sufficiently high energy and all the fermions collapse, would it not create a black hole and destroy the world? Maybe access to your module should indeed be restricted.

    ;-)

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

[reply]
[d/l]

Back to Cool Uses for Perl

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: CUFP [id://817922]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others meditating upon the Monastery: (3)
As of 2024-04-26 04:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found