TEACH WALTZ2 A. Sloman Dec 1982
Reformatted 1996
;;; Reduced version of LIB WALTZ.
;;; See TEACH * WALTZ demo for details.
;;;
;;; See also LIB * LABELS and LIB * TETRA.
;;; The procedure filter is given a set of possible junction
;;; interpretations returns a filtered version. It repeatedly
;;; tries to prune possible interpretations from junctions
;;; by checking consistency, until nothing is left to be
;;; filtered out.
;;; Lines starting with **** are to be programmed by students
;;; **** some utility programs ****
vars chatty; true -> chatty;
define report(list);
if chatty then list ==> endif;
enddefine;
define sometrue(X, List, Pred) -> result;
;;; apply Pred to X and one element of List at a time, to see if at
;;; least one result is TRUE. If so return TRUE, otherwise FALSE.
until List==[] do
if Pred(X,hd(List))
then true -> result; return
else tl(List) -> List
endif
enduntil;
false -> result
enddefine;
define otherpoint(point,line);
;;; line is something like [label point1 point2]
;;; return point2 if point=point1 otherwise return point1
**** complete this ****
enddefine;
;;; **** procedures for doing the Waltz filtering ****
vars consistent prune somebadlabel nointerp labelfitsinterp;
define filter(interps) -> interps;
;;; interps is a list of points associated with possible
;;; interpretations. Filter out impossible interpretations.
;;; the format of interps is the list produced by interpall.
vars list vertex new nochange;
false -> nochange;
until nochange do
true -> nochange; ;;; remains true if nothing is pruned
;;; repeatedly chug down list of vertex interpretations,
;;; trying to prune interpretations for each vertex
interps -> list;
until list == [] do
hd(list) -> vertex;
report([pruning ^vertex]);
if (prune(vertex,interps) ->> new) then
false -> nochange;
report([pruned to ^new]);
**** delete vertex from the list interps, and put new in its place
else report([^(hd(vertex)) unchanged]);
endif;
tl(list) -> list;
enduntil;
enduntil;
enddefine;
define prune(vertex, interps) -> result;
;;; vertex has a list of possible interpretations.
;;; Remove all those not consistent with other vertices
;;; in interps. Return false if no pruning possible.
vars point labels list newinterp;
false -> result;
hd(vertex) -> point; tl(vertex) -> list;
;;; list is a list of possible interpretations,
;;; each a set of line labels
[] -> newinterp; ;;; will be the pruned interpretation
until list == [] do
hd(list) -> labels; ;;; hd(labels) is type
;;; e.g. tee3 or ell2
if somebadlabel(point, tl(labels), interps)
then true -> result ;;; i.e. pruning needed
else labels :: newinterp -> newinterp;
;;; i.e. reuse this interpretation
endif;
tl(list) -> list
enduntil;
if result then point :: newinterp -> result endif
enddefine;
define somebadlabel(point, labels, interps) -> result;
;;; if at least one of the labels associated with point
;;; lacks a consistent interpretation at the opposite
;;; vertex return TRUE otherwise FALSE
**** Each label is of the form [label point1 point2]
**** use otherpoint to find the neighboring point,
**** and use nointerp to see if none of the interpretations
**** there is consistent with the label.
**** Do this for all the labels.
**** You may find it easy to use sometrue. but be carful
**** about its arguments, especially the procedure to give
**** to it as third argument
enddefine;
define nointerp(linelabel, neighbour, interps);
;;;false if at least one interpretation of the
;;; neighbour (a point) is consistent with the linelabel.
;;; Otherwise true.
vars list ;
interps --> [ == [^neighbour ??list] == ];
not(sometrue(linelabel, list, labelfitsinterp))
enddefine;
define labelfitsinterp(linelabel, interp);
;;; given a label, check that at least one element of
;;; interp is consistent with it
**** what should the third argument for sometrue be here:
sometrue(linelabel, tl(interp), ???????)
enddefine;
define consistent(line1, line2) -> result;
;;; Given two lines defined by a label and two points,
;;; make sure they are consistent.
;;; If the label is "occ" the points must be
;;; in the same order. Otherwise they may be reversed.
vars label;
if line1 = line2
then true -> result
else
hd(line1) -> label;
**** and then?? ****
endif
enddefine;
;;; NOTE
;;; The filter procedure is not very efficient.
;;; TEACH WALTZ suggests a possible improvement.
--- $poplocal/local/teach/waltz2
--- Copyright University of Sussex 1996. All rights reserved. ------