/*********************************
/* CHRISMAN-LESTER.AML
/* This AML performs the test described in Chrisman and 
/* Lester, 1991, Proceedings Auto-Carto 10.
/* Input coverages are called "red" and "blue".
/* Several preliminary steps are required to determine
/* the origin of each of the arcs in the overlay coverage
/* The meat of the test is towards the end of the code.
/*********************************

&args	red, blue, epsilon, red-attr, blue-attr, mmu, mdu
/* red and blue are input coverages
/* epsilon is fuzzy tolerance for overlay
/* red-attr and blue-attr are attribute names to match in 
/*   input coverages (step 1)
/* mmu is minimum mapping unit (step 4)
/* mdu is minimum discrimination unit (step 5)
/* Initialize constants
&setvar coincidence .85		/* Step 2
&setvar perim-pos .1		/* Step 6
&setvar perim-att .25		/* Step 6
&setvar orig-blue 1
&setvar orig-red  2
&setvar overlay   0

/* Change args to upper case for use with INFO
&sv red = [translate %red%]
&sv blue = [translate %blue%]
&sv red-attr = [translate %red-attr%]
&sv blue-attr = [translate %blue-attr%]

/* Overlay coverages to 'purple'; build lines in 'purple'
union %red% %blue% purple %epsilon% nojoin
build purple line

/*********************************
/* First, all of the preliminaries
/*********************************

/* Make a copy of overlay coverage's Polygon Attribute Table 
/*(PAT) and add PATs from input coverages to copy of PAT
copyinfo purple.pat purple2.pat
joinitem purple2.pat %red%.pat purple2.pat %red%# %red%#
joinitem purple2.pat %blue%.pat purple2.pat %blue%# %blue%#

/* Relate overlay PAT to enhanced overlay PAT copy
relate add
purple-relate
purple2.pat
info
purple#
purple#
ordered
ro
~

additem purple2.pat purple2.pat error_type 2 2 i
additem purple.aat purple.aat origin 2 3 i

/* Now determine which input coverage polygon is the source 
/* for each overlay coverage arc.  To accomplish this, rename
/* an index field in the PAT using INFO, then use joinitem to
/* add the polygon to the AAT.  Repeat for left and right 
/* polygons.

/* Switch index in overlay to left-polygon
&data arc info 
ARC
SELECT PURPLE2.PAT
ALTER PURPLE#, LPOLY#,,,,,,,
Q STOP
&end

/* Determine left polygon for each arc
indexitem purple.aat lpoly#  
indexitem purple2.pat lpoly#
joinitem purple.aat purple2.pat purple.aat lpoly# purple-id 

/* Switch index in overlay to right-polygon
&data arc info
ARC
SELECT PURPLE2.PAT
ALTER LPOLY#, RPOLY#,,,,,,,  
SELECT PURPLE.AAT
ALTER %BLUE%#, L-BLUE#,,,,,,,
ALTER %RED%#, L-RED#,,,,,,,
Q STOP
&end

/* Determine right polygon for each arc
indexitem purple.aat rpoly# 
indexitem purple2.pat rpoly#
joinitem purple.aat purple2.pat purple.aat rpoly# l-blue# 

/* Restore index in overlay, then 
/* determine the origin of arcs in the overlay file.
/* Arcs with polygons from same input coverage on either side
/* are from that coverage.
&data arc info
ARC
SELECT PURPLE2.PAT
ALTER RPOLY#, PURPLE#,,,,,,, 
SELECT PURPLE.AAT
ALTER %BLUE%#, R-BLUE#,,,,,,,
ALTER %RED%#, R-RED#,,,,,,,
RESELECT FOR L-BLUE# = R-BLUE#
CALCULATE ORIGIN = %orig-blue%
ASEL
RESELECT FOR L-RED# = R-RED#
CALCULATE ORIGIN = %orig-red%
ASEL
Q STOP
&end

/* Calculate arc length from different sources.
/* Make temporary copies of full PAT and Arc Attribute Table
/* and add items to PAT to hold results of arc length 
/* calculations.
copyinfo purple2.pat purple3.pat
copyinfo purple.aat purple2.aat
additem purple3.pat purple3.pat length-red 4 12 f 3
additem purple3.pat purple3.pat length-blue 4 12 f 3
additem purple3.pat purple3.pat length-purple 4 12 f 3


/* Create two INFO programs, APPEND and LENGCAL, which 
/* calculate arc length from different sources.
/* These two programs will be called below.

&data arc info
ARC
PROGRAM APPEND.PGM
SELECT PURPLE.AAT
RELATE PURPLE2.AAT 1 BY PURPLE# WITH APPEND
PROGRAM EVEN
CALCULATE $1LPOLY# = RPOLY#
CALCULATE $1LENGTH = LENGTH
CALCULATE $1ORIGIN = ORIGIN
PROGRAM ODD
~
COMPILE APPEND.PGM
/*******************************
PROGRAM LENGCAL.PGM
SELECT PURPLE2.AAT
RELATE PURPLE3.PAT 1 BY LPOLY# WITH INIT
PROGRAM EVEN
IF ORIGIN = %overlay% /* Arc is a result of overlay
CALCULATE $1LENGTH-PURPLE = $1LENGTH-PURPLE + LENGTH
ELSE
IF ORIGIN = %orig-blue% /* Arc is from blue coverage
CALCULATE $1LENGTH-BLUE = $1LENGTH-BLUE + LENGTH
ELSE			 /* Arc is from red coverage
CALCULATE $1LENGTH-RED = $1LENGTH-RED + LENGTH
ENDIF
ENDIF
PROGRAM ODD
~
Q STOP
&end

/******************************
/* Run APPEND and LENGCAL
&data arc info
ARC
SELECT PURPLE3.PAT
ALTER,PURPLE#, LPOLY#,,,,,,,
SORT ON LPOLY#
RUN APPEND.PGM
SELECT PURPLE2.AAT
SORT ON LPOLY#
COMPILE LENGCAL.PGM
RUN LENGCAL.PGM
SELECT PURPLE3.PAT
ALTER,LPOLY#, PURPLE#,,,,,,,   /* restore
Q STOP
&end

/* Add length items to full PAT
joinitem purple2.pat purple3.pat purple2.pat purple# ~
	error_type ordered

/* Add items used in actual test:  coincidence measure, amount
/* of perimeter from red and blue sources, compactness and 
/* perimeter indices.
additem purple2.pat purple2.pat coinc      8 8 f 3
additem purple2.pat purple2.pat perim-red  8 8 f 5
additem purple2.pat purple2.pat perim-blue 8 8 f 5
additem purple2.pat purple2.pat jcompact   8 8 f 5
additem purple2.pat purple2.pat jperim     8 8 f 5

/***************************
/* All preliminaries completed.  Now for the meat of the test:
/***************************
&data arc info
ARC
SELECT PURPLE2.PAT
CALCULATE ERROR_TYPE = 0 /* Initialize

/* Step 1:  Is there a disagreement in the first place?
RESELECT FOR %red-attr% EQ %blue-attr%
CALCULATE ERROR_TYPE = 99 /* No error
NSELECT

/* Step 2:  Are the boundaries mostly coincident?
CALCULATE COINC = LENGTH-PURPLE / PERIMETER
RESELECT FOR COINC GE .85
CALCULATE ERROR_TYPE = 11 /* Attribute error
NSELECT

/* Step 3:  Is the perimeter from one source only?
RESELECT FOR ERROR_TYPE EQ 0
/* Calculate amount of perimeter from red only
CALCULATE PERIM-RED = PERIMETER - LENGTH-RED  
/* calculate amount of perimeter from blue only
CALCULATE PERIM-BLUE = PERIMETER - LENGTH-BLUE  
RESELECT FOR PERIM-RED LE .001 OR PERIM-BLUE LE .001 
/* Virtually all of perimeter from one source, hence . . .
CALCULATE ERROR_TYPE = 12 /* Attribute error
NSELECT

/* Step 4:  Is the polygon smaller than the minimum map unit?
CALCULATE $NUM10 = %mmu%
RESELECT FOR ERROR_TYPE EQ 0 AND AREA LE $NUM10
CALCULATE ERROR_TYPE = 21 /* Positional error
NSELECT

/* Step 5:  Calculate compactness index; Is polygon "fat"?
CALCULATE $NUM10 = %mdu% ** 2
RESELECT FOR ERROR_TYPE EQ 0 AND AREA > $NUM10
CALCULATE JCOMPACT = 2 * ( ( 3.14159 * AREA ) / ~
	( PERIMETER ** 2 ) ) ** 0.5 
RESELECT FOR JCOMPACT GE .55 
CALCULATE ERROR_TYPE = 13 /* Attribute error
NSELECT

/* Step 6:  Calculate perimeter index
RESELECT FOR ERROR_TYPE EQ 0 /* for all polygons remaining
CALCULATE JPERIM = LENGTH-RED / ( LENGTH-RED + LENGTH-BLUE )
RESELECT FOR JPERIM GE .4 AND JPERIM LE .6
CALCULATE ERROR_TYPE = 22 /* Positional error
NSELECT
RESELECT FOR ERROR_TYPE EQ 0 
RESELECT FOR JPERIM LE .25 OR JPERIM GE .75
CALCULATE ERROR_TYPE = 14 /* Attribute error
NSELECT
RESELECT FOR ERROR_TYPE EQ 0 

/* Anything left is in the "Gray zone"
/* In this paper, gray zone polygons are treated as attribute error.
CALCULATE ERROR_TYPE = 1  /* "Gray zone"
Q STOP
&end
&return

/* To examine results of test, look at the ERROR_TYPE field in 
/* the resulting PURPLE2.PAT.
/* Error_type 	Interpretation
/* ----------    -----------------------------
/*   1				"Gray zone", in this paper treated as 
/*						attribute error
/*  11-14			Attribute error
/*  21-22			Position error
/*  99				No error