Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex13


Ignore:
Timestamp:
Jan 29, 2009, 6:57:50 AM (13 years ago)
Author:
jmckenna
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • PerlMapScriptExamples35ex13

    v1 v1  
     1= thin.pl =
     2{{{
     3#!perl
     4#!/usr/bin/perl
     5
     6# Script: Thin.pl
     7#
     8# Purpose: An adaption of the ArcView Avenue example script genfeat.ave. It's
     9#          basically the Douglas-Peucker generalization algorithm.
     10#
     11# Initial Coding: 04/10/2000
     12# Last Modified: 04/17/2000
     13# Version: 1.1
     14#
     15# Author: Stephen Lime (steve.lime@dnr.state.mn.us)
     16
     17use POSIX;
     18use XBase;
     19use mapscript;
     20use Getopt::Long;
     21
     22&GetOptions("input=s", \$infile,
     23            "output=s", \$outfile,
     24            "tolerance=n", \$tolerance
     25           );
     26
     27if(!$infile or !$outfile or !$tolerance) {
     28  print "Syntax: thin.pl -input=[filename] -output=[filename] -tolerance=[maximum distance between vertices]\n";
     29  exit 0;
     30}
     31
     32die "Tolerance must be greater than zero." unless $tolerance > 0;
     33
     34# initialize counters for reporting
     35$incount = 0;
     36$outcount = 0;
     37
     38# open the input shapefile
     39$inSHP = new shapefileObj($infile, -1) or die "Unable to open shapefile $infile.";
     40die "Cannot thin point/multipoint shapefiles." unless ($inSHP->{type} == 5 or $inSHP->{type} == 3);
     41
     42# create the output shapefile
     43system("rm $outfile.shp $outfile.shx $outfile.dbf $outfile.qix");
     44$outSHP = new shapefileObj($outfile, $inSHP->{type}) or die "Unable to create sh
     45apefile '$outfile'. ", $mapscript::ms_error->{message};
     46system("cp $infile.dbf $outfile.dbf");
     47
     48$inshape = new shapeObj(-1); # something to hold shapes
     49
     50for($i=0; $i<$inSHP->{numshapes}; $i++) {
     51
     52  $inSHP->get($i, $inshape);
     53  $outshape = new shapeObj(-1);
     54
     55  for($j=0; $j<$inshape->{numlines}; $j++) {
     56
     57    $inpart = $inshape->get($j);
     58    $outpart = new lineObj();
     59
     60    @stack = ();
     61
     62    $incount += $inpart->{numpoints};
     63
     64    $anchor = $inpart->get(0); # save first point
     65    $outpart->add($anchor);
     66    $aIndex = 0;
     67
     68    $fIndex = $inpart->{numpoints} - 1;
     69    push @stack, $fIndex;
     70
     71    # Douglas - Peucker algorithm
     72    while(@stack) {
     73
     74      $fIndex = $stack[$#stack];
     75      $fPoint = $inpart->get($fIndex);
     76
     77      $max = $tolerance; # comparison values
     78      $maxIndex = 0;
     79
     80      # process middle points
     81      for (($aIndex+1) .. ($fIndex-1)) {
     82
     83        $point = $inpart->get($_);
     84        $dist = $point->distanceToLine($anchor, $fPoint);
     85
     86        if($dist >= $max) {
     87          $max = $dist;
     88          $maxIndex = $_;
     89        }
     90      }
     91      if($maxIndex > 0) {
     92        push @stack, $maxIndex;
     93      } else {
     94        $outpart->add($fPoint);
     95        $anchor = $inpart->get(pop @stack);
     96        $aIndex = $fIndex;
     97      }
     98    }
     99
     100    # check for collapsed polygons, use original data in that case
     101    if(($outpart->{numpoints} < 4) and ($inSHP->{type} == 5)) {
     102      $outpart = $inpart;
     103    }
     104
     105    $outcount += $outpart->{numpoints};
     106    $outshape->add($outpart);
     107
     108  } # for each part
     109
     110  $outSHP->add($outshape);
     111  undef($outshape); # free memory associated with shape
     112
     113} # for each shape
     114
     115$outSHP = ''; # write the file
     116print "The old file ($incount vertices) has been generalized to $outcount vertices.\n";
     117}}}
     118----
     119back to PerlMapScript