#!/usr/bin/perl
package MasRaster;
use strict;
use warnings;
use SimpleObject;
use CtUtilities qw/is_in_list/;
use Storable;
use Carp;
use List::Util qw(first);
our @ISA = qw(SimpleObject);

sub create {
	my ($class, $c, $r, $nd) = @_;
	my @Cols;
	$#Cols = $c -1 ;
	my @Rows;
	$#Rows = $r -1 ;
	@Rows = ($nd) x @Rows;

	for my $i (0..$#Cols){
		$Cols[$i] = [(@Rows)];
	}
	my $self = \@Cols;
	bless $self , $class;
}
sub create_from_preinitialized {
	my ($class, $arrayref) = @_;
	die "Only array references can be passed to MasRaster->create_from_preinitialized!\n" unless (ref($arrayref) eq "ARRAY");
	bless  $arrayref, $class;
}


sub fill {
	my ($self, $value) = @_;
	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			$self->set_cell($i,$j,$value);
		}
	}
}
sub get_cell {
	$_[0]->[$_[1]]->[$_[2]];
}
sub set_cell {
	$_[0]->[$_[1]]->[$_[2]] = $_[3];
}
sub reclass {
	my ($self,$reclasstab,$others_to) = @_;
	#foreach my $r (keys %$reclasstab) {
		#print "$r -- $reclasstab->{$r}\n";
	#}
	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			my $oldvaluekey = $self->get_cell($i,$j);
			if (exists $reclasstab->{$oldvaluekey}) {
				$self->set_cell($i,$j,$reclasstab->{$oldvaluekey}) ;
				#print "$oldvaluekey  $reclasstab->{$oldvaluekey}   " ;
			}
			else {
				$self->set_cell($i,$j,$others_to) if (defined $others_to);
			}
		}
	}
}
sub round {
	my ($self) = @_;
	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
				$self->set_cell($i,$j,sprintf("%d", $self->get_cell($i,$j)   )) ;		
		}
	}
}


sub set_missing_if {
      my ($self,$condition, $missing) = @_;
      for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			$self->set_cell($i,$j,$missing) if ( eval ($self->get_cell($i,$j) . " ". $condition  ) );;	
		}
	}
}
sub random_reclass {
	my ($self, $reclasstab, $others_to) = @_;
	foreach my $r (keys %$reclasstab) {
		#print "$r -- $reclasstab->{$r}\n";
	}
	

	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			my $oldvaluekey = $self->get_cell($i,$j);
			if (exists $reclasstab->{$oldvaluekey}) {
				unless (ref $reclasstab->{$oldvaluekey}) {
					$self->set_cell($i,$j,$reclasstab->{$oldvaluekey}) ;
				}
				elsif (ref $reclasstab->{$oldvaluekey} eq "HASH") {
					my $sum =  0;
					my %cumul;
					for my $k (keys	%{ $reclasstab->{$oldvaluekey} } ) {
						$sum +=	$reclasstab->{$oldvaluekey}->{$k};
						$cumul{$sum} = $k;
					}
					die "Error: Sum of Probabilities in Probability Reclass for Old Value $oldvaluekey is not 1\n" unless ($sum == 1);
					my $draw = rand(1);
					my $newvalue = "NA";
					for my $ub (sort{$a <=> $b} keys %cumul) {
						if ($ub >= $draw) {
							$newvalue = $cumul{$ub};
							last;
						}
					}			
					$self->set_cell($i,$j,$newvalue);
		
				}
				else {
					print "Error: Argument to random_reclass should be a value or a hash\n";
				}
		
				#print "$oldvaluekey  $reclasstab->{$oldvaluekey}   " ;
			}
			else {
				$self->set_cell($i,$j,$others_to) if (defined $others_to);
			}
		}
	}
}

sub overlay {
	my ($self, $operation, $ogrid, $missing1, $missing2) = @_;
	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			my $f = $self->get_cell($i,$j);
			my $g = $ogrid->get_cell($i,$j);
				warn "Cell value undefined: $i, $j \n" if (not defined $g);
				if ($operation eq "multiply") {
					$self->set_cell($i,$j, $f*$g);
					$self->set_cell($i,$j, $missing1) if ( ( defined $missing1 and $f == $missing1 ) or (defined $missing2 and $g == $missing2) );
				}
				elsif ($operation eq "add") {
					$self->set_cell($i,$j, $f+$g) ;
					$self->set_cell($i,$j, $missing1) if ( ( defined $missing1 and $f == $missing1 ) or (defined $missing2 and $g == $missing2) );
				}
				elsif ($operation eq "diff") {
					$self->set_cell($i,$j, $f-$g) ;
					$self->set_cell($i,$j, $missing1) if ( ( defined $missing1 and $f == $missing1 ) or (defined $missing2 and $g == $missing2) );
				} 
				elsif ($operation eq "update") {
					my $new = $g;
					$new = $f if (defined $missing2 and $g == $missing2);
					$self->set_cell($i,$j,$new);
				}	
				elsif ($operation eq "complete") {
					my $new = $f;
					$new = $g if (defined $missing1 and $f == $missing1 and (not defined $missing2 or not $g == $missing2 ));
					$self->set_cell($i,$j,$new);
				}
				elsif ($operation eq "clip") {
				      $self->set_cell($i,$j, $missing1) if ( defined $missing2 and  $g == $missing2);
				}
				elsif ($operation eq "differing_cells") {
				      my $new = ($g == $f) ? 0 : 1;
				      $self->set_cell($i,$j, $new) ;
				}
		}
	}
	
}
sub report_cells_equal_to {
	my ($self, @testvalues) = @_;
	
	my @reported_cells;
	for my $i (0..$#{$self}) {
		for my $j (0..$#{$self->[$i]}) {
			my $v = $self->get_cell($i, $j);
			
			push @reported_cells, {x => $i, y=> $j, z => $v}  if ( is_in_list($v, \@testvalues) ); 
		}
	}
	return \@reported_cells;
}

sub draw_rectangle {
	my $self = shift;
	my $x1 = shift;
	my $y1 = shift;
	my $x2 = shift;
	my $y2 = shift;
	my $value = shift;
	die "X-Coordinate of Cell out of bounds !!! "  if $self->out_of_x_bounds($x1, $x2);
	die "Y-Coordinate of Cell out of bounds !!! "  if $self->out_of_y_bounds($y1,$y2);

	for my $i ($x1..$x2) {
		for my $j ($y1..$y2) {
			$self->set_cell($i,$j,$value);
		}
	}
}
sub neighborhood {
	my ($self, $c, $size) = @_;
	$size = 4 unless (defined $size);
	my @neighboring_cells;
	push @neighboring_cells, {x => $c->{x} + 1, y => $c->{y}} unless ($self->out_of_x_bounds($c->{x} +1) or $self->out_of_y_bounds($c->{y}));
	push @neighboring_cells, {x => $c->{x} - 1, y => $c->{y}} unless ($self->out_of_x_bounds($c->{x} - 1) or $self->out_of_y_bounds($c->{y}));
	push @neighboring_cells, {x => $c->{x}, y => $c->{y} + 1} unless ($self->out_of_x_bounds($c->{x}) or $self->out_of_y_bounds($c->{y} + 1));;
	push @neighboring_cells, {x => $c->{x}, y => $c->{y} - 1} unless ($self->out_of_x_bounds($c->{x}) or $self->out_of_y_bounds($c->{y} - 1));;
	return @neighboring_cells;
}
sub a_connection_exists_between {
	my ($self, $cell1, $cell2) = @_;
	$| = 1;
	my $v = $self->get_cell($cell1->{x},$cell1->{y});
	croak "Error in function a_connection_exists_between: Cell $cell1->{x},$cell1->{y} and Cell $cell2->{x},$cell2->{y} do not have the same value\n" if ($v != $self->get_cell($cell2->{x},$cell2->{y}) );
	my %visited;
	my %dirhash = (
		l => {	
			x_add => -1,
			y_add => 0,
			from => "right",
			not_from => "left"
		},
		r => {	
			x_add => 1,
			y_add => 0,
			from => "left",
			not_from => "right"
		},
		u => {	
			x_add => 0,
			y_add => 1,
			from => "below",
			not_from => "above"
		},
		d => {	
			x_add => 0,
			y_add => -1,
			not_from => "below",
			from => "above"
		}
	
	);
	my @stack;
	unshift @stack, {x=> $cell1->{x}, y=> $cell1->{y}, from => "start"};
	while (@stack) {
		
		my $c = shift @stack;
		my $curX = $c->{x};
		my $curY = $c->{y};
		#print "Visiting $curX, $curY, Value:". $self->get_cell($curX, $curY)."\n";
		my $from = $c->{from};
		my $x_diff = $cell2->{x} - $c->{x};
		my $y_diff = $cell2->{y} - $c->{y};
		#connection found if we have got to a directly neighboring cell
		return 1 if (( $x_diff <=  1 and $x_diff >=  -1 and $y_diff ==  0) or ( $y_diff <=  1 and $y_diff >=  -1 and $x_diff ==  0));
		#make sure we proceed in the straightest direction towards the goal by putting the cells closest to the goal on top of the stack
		$visited{$curX}->{$curY} = 1;
		
		my @sorted_dir;
		my $h1 = "l";
		my $h2 = "r";
		my $v1 = "d";
		my $v2 = "u";
		if ($x_diff >= 0) {
			$h1 = "r";
			$h2 = "l";
		}
		if ($y_diff >= 0) {
			$v1 = "u";
			$v2 = "d";
		}
		if (abs($x_diff) >= abs($y_diff)) {
			@sorted_dir = ($h2,$v2,$v1,$h1);#reverse priority - because values are shifted one by one, so the first in @sorted_dir is visited last
		}
		else {
			@sorted_dir = ($v2,$h2,$h1,$v1); #reverse priority - because values are shifted one by one, so the first in @sorted_dir is visited last
		}
	
		for my $dir (@sorted_dir) {
			my $newX = $curX + $dirhash{$dir}->{x_add};
			my $newY = $curY + $dirhash{$dir}->{y_add};
			if (  $from ne $dirhash{$dir}->{not_from} and not $self->out_of_x_bounds( $newX)
				and not $self->out_of_y_bounds($newY)	and not exists $visited{$newX}->{$newY} 
				and $self->get_cell($newX, $newY) == $v ) {
					
				unshift @stack, {x => $newX, y=> $newY, from => $dirhash{$dir}->{from} };   
			}
		}
		
	}
	return 0;
}
sub out_of_x_bounds {
	my ($self, @values) = @_;
	return first{ $_ < 0 or $_ > $#{$self} } @values;
}
sub out_of_y_bounds {
	my ($self, @values) = @_;
	return first{ $_ < 0 or $_ > $#{$self->[0]} } @values;
}
1;
