#!/usr/local/bin/perl

## Schelling Model
## Author: Jason W. Martinez, Institute of Applied Research, CSUSB
## Last Modified: 9/18/2005

use Tk;
use Tk qw/DoOneEvent DONT_WAIT/;
use Tk::Canvas;
use Math::Random qw(
		    random_binomial
		    random_permutation
		    random_uniform_integer
		    );

use strict;

# Global Variables;
my $size = 15;      # UNITS......
my $rows = 15;      # Number of ROWS
my $columns = 15;   # Number of COLUMNS
my %matrix;         # Two dimensional array.
                    #     Displays empty and occupied
                    #     Cells.

my ($red_unhappy, $blue_unhappy);

# Create the MainWindow
my ($mw, $canvas);
$mw = MainWindow->new();

# Create the canvas.
($mw, $canvas, $red_unhappy) = canvas($mw, $rows, $columns);

# Populate the cells and return the number of agents in
# the model. Total number of actors in the model.
# This is more or less randomly Determined.
# There is a 50% chance that any cell may
# be occupied, so there will approximately
# be (rows * columns) * .50 number of agents.

my $N = &Populate($canvas, $rows, $columns);





MainLoop;           ### Event Loop:
                    ### This is necessary when we use use
                    ### the Tk modules (i.e., the gui).

################################################################

sub Populate {
    my($c, $rows, $columns) = @_;    
    my ($n, $tag);

    my ($reds, $blues);

    for my $x (1..$columns) {
	for my $y (1..$rows) {
	    
	    $matrix{mat}[$x][$y]  = random_uniform_integer(1, -1, 2);
	    #print "$matrix{mat}[$x][$y]\n";

	    if ($matrix{mat}[$x][$y] eq 1) { $reds++; }
	    if ($matrix{mat}[$x][$y] eq 2) { $blues++; }

	    if( $matrix{mat}[$x][$y]  >= 1) {
		
		# Count the total number of individuals.
		$n++;
		$tag = "t";
		$tag .= $n;

		$matrix{$tag}{x} = $x;
		$matrix{$tag}{y} = $y;

		&create($c, $tag, $x, $y, $matrix{mat}[$x][$y]);
	    }
	}
    }

    print "Number of REDS: \t $reds\n";
    print "Number of BLUES: \t $blues\n";

    return($n);
}


sub create {
    my ($c, $tag, $x, $y, $color) = @_;

    if($color == 1) {
	$c->createOval($x*$size, -$y*$size, $x*$size+$size, -$y*$size+$size,
		       -fill => 'red',
		       -tag => "$tag" );
	DoOneEvent(DONT_WAIT);
    } else {
	$c->createOval($x*$size, -$y*$size, $x*$size+$size, -$y*$size+$size,
		       -fill => 'blue',
		       -tag => "$tag" );
	DoOneEvent(DONT_WAIT);

    }
}




sub move {
    my ($c,$tag, $x, $y) = @_;
    
    DoOneEvent(DONT_WAIT);
    $c->coords("$tag", $x*$size, -$y*$size, $x*$size+$size, -$y*$size+$size);
    DoOneEvent(DONT_WAIT);
}


sub random_walk {

    my @mov = ( 
		" 0 , 1",
		" 0 ,-1",
		" 1 , 0",
		"-1 , 0",
		"-1 ,-1",
		"-1 , 1",
		" 1 ,-1",
		" 1 , 1"
		);
    
    # Do 60,000 iterations. Randomly select an actor in our
    # population.

    for my $j (0..60000) {
	
	# Generate a random tag -- used to identify each agent.
	my $tag = "t";
	$tag .= random_uniform_integer(1, 1, $N);

	# Get the coordinates of the respective agent.
	my $x = $matrix{$tag}{x};
	my $y = $matrix{$tag}{y};

	# In order make this into a schelling model,
	# we need to simply find out who one's neighbors
	# are and determine if he is comfortable or not.
	my $p = &neighbors($x, $y);

	     # 1	0.125
	     # 2	0.25
	     # 3	0.375
	     # 4	0.5
             # 5	0.625
	     # 6	0.75
	     # 7	0.875
	     # 8	1

	# Each agent requires that a percentage of individuals
	# surrounding them are of their "kind". If 50% (or more) of your
	# neighbors are like you then don't move.
	#

	if($matrix{mat}[$x][$y] eq 1) { 
	    if($p > $red_unhappy->get()) {
		next;
	    }
	}

	if($matrix{mat}[$x][$y] eq 2) { 
	    if($p > $blue_unhappy->get()) {
		next;
	    }
	}

	# Permute the list of possible movments
	# and generate a new x and y location (xx, yy).
	@mov = random_permutation(@mov);
	my $neighbor = @mov[0];
	my($xx, $yy) = split(/,/, $neighbor);
	my $newx = $x + $xx; my $newy = $y + $yy;


	# Now that we have picked a random cell that is next
	# to us, we need to find out if it is empty. If it is
	# empty, then move to that cell. Else don't move.
	my $el = $matrix{mat}[$newx][$newy];
	
	# if cell is empty, then move to it.
	if($el >= 1 ) {
	    
	    next;
	} elsif($el eq undef) {
	
	    next;
	} else {
	    my $color = $matrix{mat}[$x][$y];
	    $matrix{$tag}{x} = $newx;
	    $matrix{$tag}{y} = $newy;
	    $matrix{mat}[$x][$y] = 0;
	    $matrix{mat}[$newx][$newy] = $color;

	    &move($canvas, $tag, $newx, $newy);
	}
    }
   print "Done\n";

}


sub neighbors {
    my ($x, $y) = @_;
    my ($reds, $blues, $nobody, $p);

    my @mov = ( 
		" 0 , 1",
		" 0 ,-1",
		" 1 , 0",
		"-1 , 0",
		"-1 ,-1",
		"-1 , 1",
		" 1 ,-1",
		" 1 , 1"
		);

    # For all possible squares surrounding the focal agent,
    # find out how many are blue and how many are red.
        #### 1 = reds;
        #### 2 = blues;

    foreach(@mov) {
	my ($xx, $yy) = split(/,/, $_);
	$xx += $x;
	$yy += $y;

	if($matrix{mat}[$xx][$yy] == 1) {
	    $reds++;
	} elsif($matrix{mat}[$xx][$yy] == 2) {
	    $blues++;
	}

    }

    my $total = $reds + $blues;

    if($total) {
	if($matrix{mat}[$x][$y] == 1) {
	    $p = $reds / $total;
	    return $p;
	}   elsif($matrix{mat}[$x][$y] == 2) {
	    $p = $blues / $total;
	    return $p;
	}
    }

    return(0);
}

# The following code will create the canvas object
sub canvas {
    my $mw = shift;
    my $rows = shift;
    my $columns = shift;

    $mw->title('Schelling2.pl');

    # Draw the label and text box. The paramter
    # which is to be set in there should determine
    # whether or not the agent is happy.
    #
    # The default setting is .75. In other words,
    # if 75% of the agents surrounding an actor
    # are not the same "color" then the agent
    # by definition is "unhappy" and will be required
    # to move to an adjacent square.
    $mw->Label(-text  => "Unhappiness Setting (red)")->pack;
    $red_unhappy = $mw->Entry(-text => ".75")->pack;
    
    # Same as above. Draw a label and text box.
    $mw->Label(-text  => "Unhappiness Setting (blue)")->pack;
    $blue_unhappy = $mw->Entry(-text => ".75")->pack;

    $mw->Button(-text => "Run Simulation", -command => sub { &random_walk($canvas) } )->pack;
    
    $mw->Button(-text => "Done", -command => sub {exit})->pack;
    
    # Create a canvas object
    my $c = $mw->Canvas(-background=>"white",
			-cursor => "crosshair",
			-height => $size * ($rows+1),
			-width => $size * ($columns+1),
			-borderwidth => '1',
			)->pack(
				-side=>"left",
				-fill=>'both',
				-expand=>1);
    
    
    for my $x (1..$columns+1) {	
	$c->createLine($x * $size, 0*$size, $x * $size, $rows*-$size, -fill => 'gray');
    }
    for my $y (0..$rows) {
	$c->createLine($size, -$y * $size, ($columns+1)*$size, -$y * $size, -fill => 'gray');
    }
    
    ### Set the screen just so......
    $c->scanDragto(-1, $rows + ($rows/2)+1);

    return $mw, $c, $red_unhappy, $blue_unhappy;
    
}

__END__


    * Grid size: 15 x 15 squares

    * Number of actors: This may vary. Simply put, approximatley 1/2
      of the squares will be occupied by an agent. Approximately, 1/4
      of the squares will be occupied by blue actors. And approximately
      1/4 of the squares will be occupied by red actors. 

    * Happiness: Actors will move to adjacent squares only if they are
      unhappy. The default parameter is .75, for both red and blues.
      In other words, if 75% of the neighbors are not of the same group
      then move to an adjacent square. Valid Parameters range from zero
      (do not move--I am completely happy) to 1 (I absolutely refuse to 
      have a neighbor that is not of the same "color").

    * Distance: We use Moore distance (as opposed to Von Neuman distance).
      This implies that all eight squares surrounding an actor are
      included as a part of an actors neighborhood.

    * Movement: Actors  move to a random square near to them.

    * Grid: The grid does not wrap.

    * When the "Run Simulations" button is clicked, the application
      will randomly select an agent and determine whether or not the
      agent is happy or unhappy. If the agent is unhappy, the algorithm
      will select an an adjacent square. If the square is empty then
      move to it. If it is occupied, then stay where you are at. This
      will continue for 60,000 iterations.

    * If it appears that everyone is still not happy after the 60,000
      iterations, then one should click "Run Simulations" to execute
      another 60,000 tries.

    * The program will not generate output: Sorry! But the source code
      is provided!