view release on metacpan or  search on metacpan

lib/Geo/Raster/Image.pm  view on Meta::CPAN

# @param[in] p The upper left corner cell.
# @param[in] q The lower right corner cell.
# @param[in] value (optional) The value for the cells within the rectangle.
# @return the values of the cells within the rectangle if value is not
# given. The returned value is a reference to an anonymous array of
# the form: (\@cell, value, \@cell, value, ...).
sub rect {
    my($self, $i1, $j1, $i2, $j2, $pen) = @_;
    unless (defined $pen) {
	return ral_grid_get_rect($self->{GRID}, $i1, $j1, $i2, $j2);
    } else {
	ral_grid_filled_rect($self->{GRID}, $i1, $j1, $i2, $j2, $pen);
    }
}

## @method listref circle(@center, $r, $value)
#
# @brief Get or set the cells within a circle.
# 
# @param[in] center The center cell of the circle.
# @param[in] r The radius of the circle.
# @param[in] value (optional) The value for the cells within the circle.
# @return the values of the cells within the circle if value is not
# given. The returned value is a reference to an anonymous array of
# the form: (\@cell, value, \@cell, value, ...).
sub circle {
    my($self, $i, $j, $r, $pen) = @_;
    unless (defined $pen) {
	return ral_grid_get_circle($self->{GRID}, $i, $j, $r);
    } else {
	ral_grid_filled_circle($self->{GRID}, $i, $j, $r, $pen);
    }
}

## @method void floodfill(@cell, $value, $connectivity)
#
# @brief Floodfill a zone.
#
# @param[in] cell A cell identifying the zone.
# @param[in] value New value for the zone.
# @param[in] connectivity (optional). Connectivity between cells,
# either 4 or 8. Default is 8.
sub floodfill {
    my($self, $i, $j, $pen, $connectivity) = @_;
    $connectivity = 8 unless $connectivity;
    ral_grid_floodfill($self->{GRID}, $i, $j, $pen, $connectivity);
}

## @method Geo::Raster thin(%opt)
#
# @brief Thin lines in the raster.
#
# This is an implementation of the algorithm in Jang, B-K., Chin,
# R.T. 1990. Analysis of Thinning Algorithms Using Mathematical
# Morphology. IEEE Trans. Pattern Analysis and Machine
# Intelligence. 12(6). 541-551. (Same as in GRASS but done in a bit
# different, and more generic way, I believe). 
#
# The thinning algorithm defines a set of structuring templates and
# applies them in several passes until there are no matches or until the
# maxiterations is reached. Trimming means certain structuring templates
# are applied to kill emerging short limbs which appear because of the
# noise in the raster.
# 
# Exple of thinning:
# @code
# $thinned_img = $img->thin(%options);
# @endcode
# or
# @code
# $img->thin(%options);
# @endcode
#
# @param[in] opt Includes as named parameters:
# - <I>algorithm</I> => character (optional). By default "B", the other option 
# is "A".
# - <I>trimming</I> => binary (optional). By default 0, the other option is 1. 
# Trimming removes artificial branches which grow on the side of wide lines in 
# thinnning, but it also shortens a bit the real branches.
# - <I>maxiterations</I> => integer (optional). By default 0 (no maximum, will 
# iterate until no cells are deleted).
# - <I>width</I> => double (optional). Used to define the maximum iterations 
# count. In case the width is given then the maxiterations is set to 
# int(width/2).
# @return a new raster. In void context changes this raster.
# @note The thinned raster must be a binary raster.
sub thin {
    my($self, %opt) = @_;
    $self = Geo::Raster->new($self) if defined wantarray;
    my @D1 = (+0,+0,-1,
	      +0,+1,+1,
	      -1,+1,-1);
    my @D2 = (-1,+0,+0,
	      +1,+1,+0,
	      -1,+1,-1);
    my @D3 = (-1,+1,-1,
	      +1,+1,+0,
	      -1,+0,+0);
    my @D4 = (-1,+1,-1,
	      +0,+1,+1,
	      +0,+0,-1);
    my @E1 = (-1,+0,-1,
	      +1,+1,+1,
	      -1,+1,-1);
    my @E2 = (-1,+1,-1,
	      +1,+1,+0,
	      -1,+1,-1);
    my @E3 = (-1,+1,-1,
	      +1,+1,+1,
	      -1,+0,-1);
    my @E4 = (-1,+1,-1,
	      +0,+1,+1,
	      -1,+1,-1);
    # G are the trimming templates
    my @G1 = (-1,+1,-1,
	      +0,+1,+0,
	      +0,+0,+0);
    my @G2 = (+0,+0,+1,
	      +0,+1,+0,
	      +0,+0,+0);
    my @G3 = (+0,+0,-1,
	      +0,+1,+1,
	      +0,+0,-1);
    my @G4 = (+0,+0,+0,
	      +0,+1,+0,
	      +0,+0,+1);
    my @G5 = (+0,+0,+0,
	      +0,+1,+0,
	      -1,+1,-1);
    my @G6 = (+0,+0,+0,
	      +0,+1,+0,
	      +1,+0,+0);
    my @G7 = (-1,+0,+0,
	      +1,+1,+0,
	      -1,+0,+0);
    my @G8 = (+1,+0,+0,
	      +0,+1,+0,
	      +0,+0,+0);
    my @trimmer = (\@G1,\@G2,\@G3,\@G4,\@G5,\@G6,\@G7,\@G8);
    my $algorithm = $opt{algorithm};
    $algorithm = 'B' unless $algorithm;
    my $trimming = $opt{trimming};
    $trimming = 0 unless $trimming;
    my $maxiterations = $opt{maxiterations};
    $maxiterations = 0 unless $maxiterations;
    my $width = $opt{width};
    $maxiterations = int($width/2) if $width;
    my @thinner;
    if ($algorithm eq 'B') {
	if ($trimming) {
	    @thinner = (\@D1,\@D2,\@E1,@trimmer,
			\@D2,\@D3,\@E2,@trimmer,
			\@D3,\@D4,\@E3,@trimmer,
			\@D4,\@D1,\@E4,@trimmer);
	} else {
	    @thinner = (\@D1, \@D2, \@E1, \@D2, \@D3, \@E2,
			\@D3, \@D4, \@E3, \@D4, \@D1, \@E4);
	}
    } elsif ($algorithm eq 'A') {
	if ($trimming) {
	    @thinner = (\@D1, \@E1, @trimmer,
			\@D2, \@E2, @trimmer,
			\@D3, \@E3, @trimmer,
			\@D4, \@E4, @trimmer);
	} else {
	    @thinner = (\@D1, \@E1, \@D2, \@E2, \@D3, \@E3, \@D4, \@E4);
	}
    } else {
	croak "thin: $algorithm: unknown algorithm";
    }
    my ($m, $M, $i) = (0,0,1);
    do {
	$M = $m;
	foreach (@thinner) {
	    $m += ral_grid_applytempl($self->{GRID}, $_, 0);
	    print STDERR "#" unless $opt{quiet};
	}
	print STDERR " thinning, pass $i/$maxiterations: deleted ", $m-$M, " cells\n" unless $opt{quiet};
	$i++;
    } while ($m > $M and !($maxiterations > 0 and $i > $maxiterations));
    return $self if defined wantarray;
}

## @method Geo::Raster borders(%params)
#
# @brief Borders between zones.
# 
# This method returns a binary raster, where the borders have the
# value of 1.
# 
# @param[in] params Named parameters:
# - <I>method</I> => string (optional). Either simple or
# recursive. Default is recursive.
# @return a new raster. In void context changes this raster.
sub borders {
    my($self, %opt) = @_;
    $opt{method} = 'recursive' unless $opt{method};
    if ($opt{method} eq 'simple') {
	if (defined wantarray) {
	    my $g = new Geo::Raster(ral_grid_borders($self->{GRID}));
	    return $g;
	} else {
	    $self->_new_grid(ral_grid_borders($self->{GRID}));
	}
    } elsif ($opt{method} eq 'recursive') {
	if (defined wantarray) {
	    my $g = new Geo::Raster(ral_grid_borders_recursive($self->{GRID}));
	    return $g;
	} else {
	    $self->_new_grid(ral_grid_borders_recursive($self->{GRID}));
	}
    } else {
	croak "borders: $opt{method}: unknown method";
    }
}

## @method Geo::Raster areas($k)
#
# @brief Marks if cell belong to an area.
#
# @param[in] k (optional). A cell is part of an area if there are at least k 
# consecutive nonzero cells as neighbors and the cell has also a nonzero value. 
# By default the value is 3, in which case the smallest area is 2*2 cells.
# @return a new raster. In void context changes this raster.
# @note The grid has to have as datatype integer.
sub areas {
    my $self = shift;
    my $k = shift;
    $k = 3 unless $k;
    if (defined wantarray) {
	my $g = new Geo::Raster(ral_grid_areas($self->{GRID}, $k));
	return $g;
    } else {
	$self->_new_grid(ral_grid_areas($self->{GRID}, $k));
    }
}

## @method Geo::Raster connect()
#
# @brief Connects broken lines.