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.