<> <> DIRECTORY Basics, List, Random, TopoSort; TopoSortTest: CEDAR PROGRAM IMPORTS Basics, List, Random, TopoSort = BEGIN LORA: TYPE ~ LIST OF REF ANY; Node: TYPE ~ REF NodePrivate; NodePrivate: TYPE ~ RECORD [ x, y, id: INT, prev, next: Node]; IntPair: TYPE ~ RECORD [x, y, id: INT]; first: Node _ NIL; loraFirst: LORA _ NIL; count: INT _ 0; Clear: PROC ~ {first _ NIL; loraFirst _ NIL; count _ 0}; Add: PROC [x, y, id: INT] ~ { n: Node ~ NEW [NodePrivate _ [x, y, id, NIL, first]]; n.prev _ IF first=NIL THEN n ELSE first.prev; n.prev.next _ n; n.next.prev _ n; first _ n; loraFirst _ CONS[NEW[IntPair _ [x, y, id]], loraFirst]; count _ count + 1; RETURN}; Adds: PROC [n, scope, seed: INT, easy: BOOL] ~ { divisor: INT ~ INT.LAST/scope; rs: Random.RandomStream ~ Random.Create[range: scope*divisor, seed: seed]; FOR i: INT DECREASING IN [1 .. n] DO x: INT ~ rs.NextInt/divisor; Add[x, IF easy THEN x ELSE rs.NextInt/divisor, i]; ENDLOOP; RETURN}; SortRing: PROC RETURNS [cost: INT _ 0] ~ {IF first#NIL THEN { Handle: TYPE ~ TopoSort.Handle; last: Node _ first.prev; GetLink: PROC [from: Handle] RETURNS [Handle] ~ { n: Node ~ NARROW[from]; IF n=NIL THEN RETURN [first]; IF n=last THEN RETURN [NIL]; RETURN [n.next]}; SetLink: PROC [from, to: Handle] ~ { nf: Node ~ NARROW[from]; nt: Node ~ NARROW[to]; IF nf=NIL THEN first _ nt ELSE nf.next _ nt; IF nt=NIL THEN last _ nf ELSE nt.prev _ nf; RETURN}; Compare: PROC [a, b: Handle] RETURNS [TopoSort.PartialComparison] ~ { na: Node ~ NARROW[a]; nb: Node ~ NARROW[b]; cx: Basics.Comparison ~ Basics.CompareInt[na.x, nb.x]; cy: Basics.Comparison ~ Basics.CompareInt[na.y, nb.y]; cost _ cost+1; IF cx=cy THEN RETURN [LOOPHOLE[cx]]; RETURN [incomparable]}; TopoSort.ListSort[NIL, NIL, GetLink, SetLink, Compare]; SetLink[last, first]; RETURN}}; SortList2: PROC RETURNS [cost: INT _ 0] ~ {IF first#NIL THEN { GetLink: PROC [from: REF ANY] RETURNS [REF ANY] ~ { n: LORA ~ NARROW[from]; IF n=NIL THEN RETURN [loraFirst]; RETURN [n.rest]}; SetLink: PROC [from, to: REF ANY] ~ { nf: LORA ~ NARROW[from]; nt: LORA ~ NARROW[to]; IF nf=NIL THEN loraFirst _ nt ELSE nf.rest _ nt; RETURN}; Compare: PROC[ref1: REF ANY, ref2: REF ANY] RETURNS [TopoSort.PartialComparison] ~ { n1: LORA ~ NARROW[ref1]; n2: LORA ~ NARROW[ref2]; r1: REF IntPair ~ NARROW[n1.first]; r2: REF IntPair ~ NARROW[n2.first]; cx: Basics.Comparison ~ Basics.CompareInt[r1.x, r2.x]; cy: Basics.Comparison ~ Basics.CompareInt[r1.y, r2.y]; cost _ cost+1; IF cx#cy THEN ERROR; RETURN [LOOPHOLE[cx]]}; TopoSort.ListSort[NIL, NIL, GetLink, SetLink, Compare]; RETURN}}; SortList1: PROC RETURNS [cost: INT _ 0] ~ {IF first#NIL THEN { Compare: PROC[ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison] ~ { r1: REF IntPair ~ NARROW[ref1]; r2: REF IntPair ~ NARROW[ref2]; cx: Basics.Comparison ~ Basics.CompareInt[r1.x, r2.x]; cy: Basics.Comparison ~ Basics.CompareInt[r1.y, r2.y]; cost _ cost+1; IF cx#cy THEN ERROR; RETURN [cx]}; loraFirst _ List.Sort[loraFirst, Compare]; RETURN}}; Check: PROC ~ { seen: INT _ 0; na: Node _ first; IF na=NIL THEN {IF count#0 THEN ERROR; RETURN}; DO noteq: BOOL _ FALSE; FOR nb: Node _ na.next, nb.next WHILE nb#first DO cx: Basics.Comparison ~ Basics.CompareInt[na.x, nb.x]; cy: Basics.Comparison ~ Basics.CompareInt[na.y, nb.y]; eq: BOOL ~ cx=equal AND cy=equal; IF cx=equal AND cy=equal THEN { IF noteq THEN ERROR--didn't bunch equal values--; IF nb.id < na.id THEN ERROR--not stable--; } ELSE noteq _ TRUE; IF cx#cy THEN LOOP; IF cx=greater THEN ERROR; ENDLOOP; na _ na.next; seen _ seen + 1; IF na=first THEN EXIT; ENDLOOP; IF seen # count THEN ERROR}; Comparem: PROC ~ { n: Node _ first; l: LORA _ loraFirst; DO r: REF IntPair ~ NARROW[l.first]; IF r.id # n.id THEN ERROR; n _ n.next; l _ l.rest; IF (l=NIL) # (n=first) THEN ERROR; IF l=NIL THEN EXIT; ENDLOOP; RETURN}; ListForm: TYPE ~ LIST OF IntPair; Report: PROC [from, thru: Node _ NIL, count: CARDINAL _ 60000] RETURNS [l: ListForm] ~ { l _ NIL; IF from=NIL THEN from _ first; IF first=NIL THEN RETURN; {tail: ListForm _ l _ LIST[[0, 0, 0]]; n: Node _ from; WHILE count#0 DO tail _ tail.rest _ CONS[[n.x, n.y, n.id], NIL]; IF n=thru THEN EXIT; n _ n.next; count _ count - 1; IF n=from THEN EXIT; ENDLOOP; RETURN [l.rest]}}; END.