waltz.ops

drools 一个开放源码的规则引擎

                                                ;and the RHS actions that
                                                ;are user defined
 
 
;Our WM elements.  Lines have the lable line followed by the 2 points
;defining the line.  Edges are like lines accept that they can be labeled,
;permanently labelled and plotted.  Junctions are defined by 4 points.  The
;basepoint is where the 3 (2) lines intersect.  The points p1, p2, p3 are the
;other endpoints of the lines at this junction
 
(literalize stage value)
(literalize line p1 p2)
(literalize edge p1 p2 joined label plotted)
(literalize junction p1 p2 p3 base_point type)
 
;The Waltz Algorithm using OPS5 Production System Interpreter
;This is our production memory
 
;Our starting production.  It checks to see if the start flag is in WM,
;and if it is, it deletes it, and clears the screen
(p begin
	(stage ^value start)
	-->
;	(write clr)
	(make line ^p1 0122 ^p2 0107)
	(make line ^p1 0107 ^p2 2207)
	(make line ^p1 2207 ^p2 3204)
	(make line ^p1 3204 ^p2 6404)
	(make line ^p1 2216 ^p2 2207)
	(make line ^p1 3213 ^p2 3204)
	(make line ^p1 2216 ^p2 3213)
	(make line ^p1 0107 ^p2 2601)
	(make line ^p1 2601 ^p2 7401)
	(make line ^p1 6404 ^p2 7401)
	(make line ^p1 3213 ^p2 6413)
	(make line ^p1 6413 ^p2 6404)
	(make line ^p1 7416 ^p2 7401)
	(make line ^p1 5216 ^p2 6413)
	(make line ^p1 2216 ^p2 5216)
	(make line ^p1 0122 ^p2 5222)
	(make line ^p1 5222 ^p2 7416)
	(make line ^p1 5222 ^p2 5216)
	(modify 1 ^value duplicate))
 
;If the duplicate flag is set, and there is still a line in WM, delete the line
;and add two edges. One edge runs from p1 to p2 and the other runs from p2 to
;p1.  We then plot the edge.
(p reverse_edges
	(stage ^value duplicate)
	(line ^p1 <p1> ^p2 <p2>)
	-->
;	(write draw <p1> <p2> (crlf))
	(make edge ^p1 <p1> ^p2 <p2> ^joined false)
        (make edge ^p1 <p2> ^p2 <p1> ^joined false)
	(remove 2))
 
;If the duplicating flag is set, and there are no more lines, then remove the
;duplicating flag and set the make junctions flag.
(p done_reversing
	(stage ^value duplicate)
	- (line)
	-->
	(modify 1 ^value detect_junctions))
 
 
;If three edges meet at a point and none of them have already been joined in
;a junction, then make the corresponding type of junction and label the
;edges joined.  This production calls make-3_junction to determine
;what type of junction it is based on the angles inscribed by the
;intersecting edges
(p make-3_junction
	(stage ^value detect_junctions)
	(edge ^p1 <base_point> ^p2 <p1> ^joined false)
	(edge ^p1 <base_point> ^p2 {<p2> <> <p1>} ^joined false)
	(edge ^p1 <base_point> ^p2 {<p3> <> <p1> <> <p2>} ^joined false)
	-->
	(make junction
	      ^type (make_3_junction <base_point> <p1> <p2> <p3>)
              ^base_point <base_point>)
	(modify 2 ^joined true)
	(modify 3 ^joined true)
	(modify 4 ^joined true))
 
;If two, and only two, edges meet that have not already been joined, then
;the junction is an "L"
(p make_L
	(stage ^value detect_junctions)
	(edge ^p1 <base_point> ^p2 <p2> ^joined false)
	(edge ^p1 <base_point> ^p2 {<p3> <> <p2>} ^joined false)
	- (edge ^p1 <base_point> ^p2 {<> <p2> <> <p3>})
	-->
	(make junction
		^type L
		^base_point <base_point>
		^p1 <p2>
		^p2 <p3>)
	(modify 2 ^joined true)
	(modify 3 ^joined true))
 
 
;If the detect junctions flag is set, and there are no more un_joined edges,
;set the find_initial_boundary flag
(p done_detecting
	(stage ^value detect_junctions)
	- (edge ^joined false)
	-->
	(modify 1 ^value find_initial_boundary))
 
;If the initial boundary junction is an L, then we know it's labelling
(p initial_boundary_junction_L
	(stage ^value find_initial_boundary)
        (junction ^type L ^base_point <base_point> ^p1 <p1> ^p2 <p2>)
	(edge ^p1 <base_point> ^p2 <p1>)
	(edge ^p1 <base_point> ^p2 <p2>)
        - (junction ^base_point > <base_point>)
	-->
        (modify 3 ^label B)
	(modify 4 ^label B)
	(modify 1 ^value find_second_boundary))
 
;Ditto for an arrow
(p initial_boundary_junction_arrow
	(stage ^value find_initial_boundary)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1>)
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p3>)
	- (junction ^base_point > <bp>)
	-->
	(modify 3 ^label B)
	(modify 4 ^label +)
	(modify 5 ^label B)
	(modify 1 ^value find_second_boundary))
 
;If we have already found the first boundary point, then find the second
;boundary point, and label it.
 
(p second_boundary_junction_L
	(stage ^value find_second_boundary)
        (junction ^type L ^base_point <base_point> ^p1 <p1> ^p2 <p2>)
	(edge ^p1 <base_point> ^p2 <p1>)
	(edge ^p1 <base_point> ^p2 <p2>)
        - (junction ^base_point < <base_point>)
	-->
        (modify 3 ^label B)
	(modify 4 ^label B)
	(modify 1 ^value labeling))
 
(p second_boundary_junction_arrow
	(stage ^value find_second_boundary)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1>)
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p3>)
	- (junction ^base_point < <bp>)
	-->
	(modify 3 ^label B)
	(modify 4 ^label +)
	(modify 5 ^label B)
	(modify 1 ^value labeling))
 
 
;If we have an edge whose label we already know definitely, then
;label the corresponding edge in the other direction
(p match_edge
	(stage ^value labeling)
	(edge ^p1 <p1> ^p2 <p2> ^label {<label> << + - B >>})
	(edge ^p1 <p2> ^p2 <p1> ^label nil)
	-->
	(modify 2 ^plotted t)
	(modify 3 ^label <label> ^plotted t)
;	(write plot <label> <p1> <p2> (crlf))
	) 
;The following productions propogate the possible labellings of the edges
;based on the labellings of edges incident on adjacent junctions.  Since
;from the initial boundary productions, we have determined the labellings of
;of atleast two junctions, this propogation will label all of the junctions
;with the possible labellings.  The search space is pruned due to filtering,
;i.e. - only label a junction in the ways physically possible based on the
;labellings of adjacent junctions.
 
 
(p label_L
	(stage ^value labeling)
	(junction ^type L ^base_point <p1>)
	(edge ^p1 <p1> ^p2 <p2> ^label << + - >>)
	(edge ^p1 <p1> ^p2 <> <p2> ^label nil)
	-->
	(modify 4 ^label B))
 
 
(p label_tee_A
	(stage ^value labeling)
	(junction ^type tee ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1> ^label nil)
	(edge ^p1 <bp> ^p2 <p3>)
	-->
	(modify 3 ^label B)
	(modify 4 ^label B))
 
 
(p label_tee_B
	(stage ^value labeling)
	(junction ^type tee ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1>)
	(edge ^p1 <bp> ^p2 <p3> ^label nil)
	-->
	(modify 3 ^label B)
	(modify 4 ^label B))
 
 
(p label_fork-1
	(stage ^value labeling)
	(junction ^type fork ^base_point <bp>)
	(edge ^p1 <bp> ^p2 <p1> ^label +)
	(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label nil)
	(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>})
	-->
	(modify 4 ^label +)
	(modify 5 ^label +))
 
 
(p label_fork-2
	(stage ^value labeling)
	(junction ^type fork ^base_point <bp>)
	(edge ^p1 <bp> ^p2 <p1> ^label B)
	(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label -)
	(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
	-->
	(modify 5 ^label B))
 
 
(p label_fork-3
	(stage ^value labeling)
	(junction ^type fork ^base_point <bp>)
	(edge ^p1 <bp> ^p2 <p1> ^label B)
	(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label B)
	(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
	-->
	(modify 5 ^label -))
 
 
(p label_fork-4
	(stage ^value labeling)
	(junction ^type fork ^base_point <bp>)
	(edge ^p1 <bp> ^p2 <p1> ^label -)
	(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label -)
	(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
	-->
	(modify 5 ^label -))
 
 
 
(p label_arrow-1A
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1> ^label {<label> << B - >>})
	(edge ^p1 <bp> ^p2 <p2> ^label nil)
	(edge ^p1 <bp> ^p2 <p3>)
	-->
	(modify 4 ^label +)
	(modify 5 ^label <label>))
 
 
(p label_arrow-1B
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1> ^label {<label> << B - >>})
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p3> ^label nil)
	-->
	(modify 4 ^label +)
	(modify 5 ^label <label>))
 
 
(p label_arrow-2A
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p3> ^label {<label> << B - >>})
	(edge ^p1 <bp> ^p2 <p2> ^label nil)
	(edge ^p1 <bp> ^p2 <p1>)
	-->
	(modify 4 ^label +)
	(modify 5 ^label <label>))
 
(p label_arrow-2B
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p3> ^label {<label> << B - >>})
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p1> ^label nil)
	-->
	(modify 4 ^label +)
	(modify 5 ^label <label>))
 
 
(p label_arrow-3A
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1> ^label +)
	(edge ^p1 <bp> ^p2 <p2> ^label nil)
	(edge ^p1 <bp> ^p2 <p3>)
	-->
	(modify 4 ^label -)
	(modify 5 ^label +))
 
(p label_arrow-3B
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p1> ^label +)
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p3> ^label nil)
	-->
	(modify 4 ^label -)
	(modify 5 ^label +))
 
 
(p label_arrow-4A
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p3> ^label +)
	(edge ^p1 <bp> ^p2 <p2> ^label nil)
	(edge ^p1 <bp> ^p2 <p1>)
	-->
	(modify 4 ^label -)
	(modify 5 ^label +))
 
(p label_arrow-4B
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p3> ^label +)
	(edge ^p1 <bp> ^p2 <p2>)
	(edge ^p1 <bp> ^p2 <p1> ^label nil)
	-->
	(modify 4 ^label -)
	(modify 5 ^label +))
 
 
(p label_arrow-5A
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p2> ^label -)
	(edge ^p1 <bp> ^p2 <p1>)
	(edge ^p1 <bp> ^p2 <p3> ^label nil)
	-->
	(modify 4 ^label +)
	(modify 5 ^label +))
 
 
(p label_arrow-5B
	(stage ^value labeling)
	(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
	(edge ^p1 <bp> ^p2 <p2> ^label -)
	(edge ^p1 <bp> ^p2 <p1> ^label nil)
	(edge ^p1 <bp> ^p2 <p3>)
	-->
	(modify 4 ^label +)
	(modify 5 ^label +))
 
 
;The conflict resolution mechanism will onle execute a production if no
;productions that are more complicated are satisfied.  This production is
;simple, so all of the above dictionary productions will fire before this
;change of state production
(p done_labeling
	(stage ^value labeling)
	-->
	(modify 1 ^value plot_remaining_edges))
 
;At this point, some labellings may have not been plotted, so plot them
(p plot_remaining
	(stage ^value plot_remaining_edges)
	(edge ^plotted nil ^label {<label> <> nil} ^p1 <p1> ^p2 <p2>)
	-->
;	(write plot <label> <p1> <p2> (crlf))
	(modify 2 ^plotted t))
 
 
;If we have been un able to label an edge, assume that it is a boundary.
;This is a total Kludge, but what the hell. (if we assume only valid drawings
;will be given for labeling, this assumption generally is true!)
(p plot_boundaries
	(stage ^value plot_remaining_edges)
	(edge ^plotted nil ^label nil ^p1 <p1> ^p2 <p2>)
	-->
;	(write plot B <p1> <p2> (crlf))
	(modify 2 ^plotted t))
 
;If there is no more work to do, then we are done and flag it.
(p done_plotting
	(stage ^value plot_remaining_edges)
	- (edge ^plotted nil)
	-->
	(modify 1 ^value done))
 
;Prompt the user as to where he can see a trace of the OPS5
;execution
(p done
	(stage ^value done)
	-->
;    (write see trace.waltz for description of execution- hit CR to end (crlf))
	(halt))