TEACH WALTZ2 A. Sloman Dec 1982 ;;; 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 **** 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 **** 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); ;;; 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 else hd(line1) -> label; **** and then?? endif enddefine; ;;; NOTE ;;; The filter procedure is not very efficient. * TEACH WALTZ suggests a ;;; possible improvement.