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. ------