&args cover
/* shreve and strahler ordering a coverage
/* same as owl3 version, but it takes an argument
&ty shreve.aml version 1.01 Wed Nov 19 16:23:47 PST 1997
/* version 1.0 Mon Jul 22 13:26:49 PDT 1996
/* version 1.01: fixed error messge "Error looking upstream fro..."
/* version 1.02: shreve had better be 4 digits
&if [show program] ne 'ARCEDIT' &then &do
   &type this starts from arcedit
   &pause &seconds 3
   &return
&end
/* assume the item JORDER numbers the arcs from the outlet,
/* and that there are no pseudo-nodes
ec %cover%
ef arc
&if ^ [iteminfo %cover% -ARC JORDER -exists] &then
  &return 'This program expects %cover% to have the item JORDER
&if ^ [iteminfo %cover% -ARC SHREVE -exists] &then
  additem SHREVE 4 4 I
&if ^ [iteminfo %cover% -ARC STRAHLER -exists] &then
  additem STRAHLER 2 2 I
sel all
calc %cover%-ID = %cover%#
calc SHREVE = 0
calc STRAHLER = 0
/* statistics
/*   maximum JORDER
/*   maximum %cover%-ID
/*   END
/* &set ord [show statistic 1 1]
/* &set maxid [show statistic 2 1]
/* &type %maxid% arcs up %ord% levels from the mouth.

sel dangle
resel jorder ne 1
calc SHREVE = 1
calc STRAHLER = 1  /* all sources are coded

sel SHREVE = 0
&label bigloop    /* look at every uncoded arc
  sel SHREVE = 0
  &s num [show number select]
  &ty We now have %num% uncoded arcs
  &if %num% eq 0 &then
     &goto done
  &do index = 1 &to %num%
     &s id = [show arc [show select %index%] item %cover%-ID]
     &set id%index% = %id%  /* write each one to an array
  &end
  &do index = 1 &to %num%   /* for each uncoded arc
    &set id = [value id%index%]
    sel %cover%-ID = %id%
/* &ty ID %index% is %id%
    &s jo = [show arc [show select 1] item jorder]
    select connect
    resel jorder gt %jo%
    &s upnum =  [show number select]
    &if %upnum% eq 0 &then
      &return Error looking upstream from %cover%-ID, arc %id%
    resel shreve gt 0
    &if [show number select] lt %upnum% &then
       &goto continue
    &s thisshreve = 0
    &s maxstrahler = 0
/* we can handle more than two upstream arcs, though results may not be perfect
    &s ui = 1  /* build my own loop
    &label innerloop  /*****&do ui = 1 &to %upnum% 
       &s ushreve = [show arc [show select %ui%] item shreve]
/*       &if %ushreve% eq 0 &then;&goto continue
       &s thisshreve = %thisshreve% + %ushreve%
       &s ustrahler = [show arc [show select %ui%] item strahler]
       &if %ustrahler% eq %maxstrahler% &then 
         &s maxstrahler = %maxstrahler% + 1
       &if %ustrahler% gt %maxstrahler% &then
	 &s maxstrahler = %ustrahler%
     &s ui = [calc %ui% + 1]
     &if %ui% le %upnum% &then; &goto innerloop        /******    &end
/* &ty recoding arc %index% %id%
    sel %cover%-ID = %id%
    calc shreve  = %thisshreve%
    calc strahler = %maxstrahler%
    &label continue  /* finished this arc
/* &ty that was arc %index% %id%
  &end  /* finished iteration through all uncoded arcs
&goto bigloop  /* look at all uncoded arcs again
&label done

save