DeltaBlue.ns

Newspeak3
'Benchmarks'
class DeltaBlue usingPlatform: p = (
(* One-way constraint solver, originally written in Smalltalk by John Maloney and Mario Wolczko. *)
|
private List = p collections List.

private required = Strength name: 'required' value: 0.
private strongPreferred = Strength name: 'strongPreferred' value: 1.
private preferred = Strength name: 'preferred' value: 2.
private strongDefault = Strength name: 'strongDefault' value: 3.
private normal = Strength name: 'normal' value: 4.
private weakDefault = Strength name: 'weakDefault' value: 5.
private weakest = Strength name: 'weakest' value: 6.

private descendingStrengths = {required. strongPreferred. preferred. strongDefault. normal. weakDefault. weakest}.

private forward = Direction named: 'forward'.
private backward = Direction named: 'backward'.

private planner = Planner new.
|) (
class Direction named: n = (|
name <String> = n.
|) (
) : (
)
class Plan = (
(* A Plan is an ordered list of constraints to be executed in sequence to resatisfy all currently satisfiable constraints in the face of one or more changing inputs. *)
|
private constraints = List new.
|) (
public addConstraint: c <Constraint> = (
	constraints addLast: c.
)
public execute = (
	(* Execute my constraints in order. *)
	constraints do: [:c | c execute].
)
) : (
)
class Planner = (
(* I embody the DeltaBlue algorithm described in: ''The DeltaBlue Algorithm: An Incremental Constraint Hierarchy Solver'' by Bjorn N. Freeman-Benson and John Maloney. See January 1990 Communications of the ACM or University of Washington TR 89-08-06 for further details. *)
|
currentMark <Integer> ::= 0.
|) (
class BinaryConstraint var: v1 var: v2 strength: s = Constraint strength: s (
(* I am an abstract superclass for constraints having two possible output variables. *)
|
v1 <Variable> = v1.
v2 <Variable> = v2.
direction <Direction>
|) (
public addToGraph = (
	(* Add myself to the constraint graph. *)
	v1 addConstraint: self.
	v2 addConstraint: self.
	direction:: nil.
)
protected chooseMethod: mark <Integer> = (
	(* Decide if I can be satisfied and which way I should flow based on the relative strength of the variables I relate, and record that decision. *)
	v1 mark = mark ifTrue:
		[((v2 mark = mark) not and: [strength strongerThan: v2 walkStrength])
			ifTrue: [direction:: forward]
			ifFalse: [direction:: nil].
		^self].
	v2 mark = mark ifTrue:
		[((v1 mark = mark) not and: [strength strongerThan: v1 walkStrength])
			ifTrue: [direction:: backward]
			ifFalse: [direction:: nil].
		^self].

	(* If we get here, neither variable is marked, so we have a choice. *)
		(v1 walkStrength weakerThan: v2 walkStrength)
		ifTrue:
			[direction:: (strength strongerThan: v1 walkStrength)
				ifTrue: [backward]
				ifFalse: [nil]]
		ifFalse:
			[direction:: (strength strongerThan: v2 walkStrength)
				ifTrue: [forward]
				ifFalse: [(*nil*) backward]].
)
public input ^<Constraint> = (
	(* Answer my current input variable *)
	^direction = forward ifTrue: [v1] ifFalse: [v2]
)
public inputsKnown: mark <Integer> ^<Boolean> = (
	| in <Variable> = input. |
	^in mark = mark or: [in stay or: [in determinedBy isNil]]
)
public isSatisfied ^<Boolean> = (
	(* Answer true if this constraint is satisfied in the current solution. *)
	^(nil = direction) not
)
public markInputs: mark <Integer> = (
	(* Mark the input variable with the given mark. *)
	input mark: mark
)
public markUnsatisfied = (
	(* Record the fact that I am unsatisfied. *)
	direction:: nil.
)
public output ^<Constraint> = (
	(* Answer my current output variable. *)
	^direction = forward ifTrue: [v2] ifFalse: [v1]
)
public recalculate = (
	(* Calculate the walkabout strength, the stay flag, and, if it is 'stay', the value for the current output of this constraint. Assume this constraint is satisfied. *)
	| in <Variable> = input. out <Variable> = output. |
	out walkStrength: (strength weakest: in walkStrength).
	out stay: in stay.
	out stay ifTrue: [execute].
)
public removeFromGraph = (
	(* Remove myself from the constraint graph. *)
	v1 isNil ifFalse: [v1 removeConstraint: self].
	v2 isNil ifFalse: [v2 removeConstraint: self].
	direction:: nil.
)
) : (
)
class Constraint strength: s = (
(* I am an abstract class representing a system-maintainable relationship (or "constraint") between a set of variables. I supply a strength instance variable; concrete subclasses provide a means of storing the constrained variables and other information required to represent a constraint. *)
|
public strength <Strength> = s.
|) (
public addConstraint = (
	(* Activate this constraint and attempt to satisfy it. *)
	addToGraph.
	incrementalAdd: self.
)
public addToGraph = (
	(* Add myself to the constraint graph. *)
	subclassResponsibility
)
public chooseMethod: mark <Integer> = (
	(* Decide if I can be satisfied and record that decision. The output of the chosen method must not have the given mark and must have a walkabout strength less than that of this constraint. *)
	subclassResponsibility
)
public destroyConstraint = (
	(* Deactivate this constraint, remove it from the constraint graph, possibly causing other constraints to be satisfied, and destroy it. *)
	isSatisfied ifTrue: [incrementalRemove: self].
	removeFromGraph.
)
public execute = (
	(* Enforce this constraint. Assume that it is satisfied. *)
	subclassResponsibility
)
public inputsKnown: mark <Integer> ^<Boolean> = (
	(* Assume that I am satisfied. Answer true if all my current inputs are known. A variable is known if either a) it is 'stay' (i.e. it is a constant at plan execution time), b) it has the given mark (indicating that it has been computed by a constraint appearing earlier in the plan), or c) it is not determined by any constraint. *)
	subclassResponsibility
)
public isInput ^<Boolean> = (
	(* Normal constraints are not input constraints. An input constraint is one that depends on external state, such as the mouse, the keyboard, a clock, or some arbitrary piece of imperative code. *)
	^false
)
public isSatisfied ^<Boolean> = (
	(* Answer true if this constraint is satisfied in the current solution. *)
	subclassResponsibility
)
public markInputs: mark <Integer> = (
	(* Set the mark of all input from the given mark. *)
	subclassResponsibility
)
public markUnsatisfied = (
	(* Record the fact that I am unsatisfied. *)
	subclassResponsibility
)
public output ^<Variable> = (
	(* Answer my current output variable. Raise an error if I am not currently satisfied. *)
	subclassResponsibility
)
public recalculate = (
	(* Calculate the walkabout strength, the stay flag, and, if it is 'stay', the value for the current output of this constraint. Assume this constraint is satisfied. *)
	subclassResponsibility
)
public removeFromGraph = (
	(* Remove myself from the constraint graph. *)
	subclassResponsibility
)
public satisfy: mark <Integer> ^<Constraint> = (
	(* Attempt to find a way to enforce this constraint. If successful, record the solution, perhaps modifying the current dataflow graph. Answer the constraint that this constraint overrides, if there is one, or nil, if there isn't. Assume: I am not already satisfied. *)
	| out <Variable> overridden <Constraint> |
	chooseMethod: mark.
	isSatisfied ifFalse:
		[strength = required ifTrue:
			[Error signal: 'Could not satisfy a required constraint'].
		^nil].
	(* constraint can be satisfied *)
	(* mark inputs to allow cycle detection in addPropagate *)
	markInputs: mark.
	out:: output.
	overridden:: out determinedBy.
	overridden isNil ifFalse: [overridden markUnsatisfied].
	out determinedBy: self.
	(addPropagate: self mark: mark) ifFalse: [Error signal: 'Cycle encountered'].
	out mark: mark.
	^overridden
)
) : (
)
class EditConstraint var: v strength: s = UnaryConstraint var: v strength: s (
(* I am a unary input constraint used to mark a variable that the client wishes to change. *)addConstraint) (
public execute = (
	(* Edit constraints do nothing. *)
)
public isInput ^<Boolean> = (
	(* I indicate that a variable is to be changed by imperative code. *)
	^true
)
) : (
)
class EqualityConstraint var: v1 var: v2 strength: s = BinaryConstraint var: v1 var: v2 strength: s (
(* I constrain two variables to have the same value: "v1 = v2". *)addConstraint) (
public execute = (
	(* Enforce this constraint. Assume that it is satisfied. *)
	output value: input value.
)
) : (
)
class ScaleConstraint source: src scale: scale offset: offset destination: dest strength: s = BinaryConstraint var: src var: dest strength: s (
(* I relate two variables by the linear scaling relationship: "v2 = (v1 * scale) + offset". Either v1 or v2 may be changed to maintain this relationship but the scale factor and offset are considered read-only. *)
|
	scale <Variable> = scale. (* scale factor input variable *)
	offset <Variable> = offset. (* offset input variable *)
|addConstraint) (
public addToGraph = (
	(* Add myself to the constraint graph. *)
	super addToGraph.
	scale addConstraint: self.
	offset addConstraint: self.
)
public execute = (
	(* Enforce this constraint. Assume that it is satisfied. *)
	direction = forward
		ifTrue: [v2 value: v1 value * scale value + offset value]
		ifFalse: [v1 value: (v2 value - offset value) // scale value].
)
public markInputs: mark <Integer> = (
	(* Mark the inputs from the given mark. *)
	super markInputs: mark.
	scale mark: mark.
	offset mark: mark.
)
public recalculate = (
	(* Calculate the walkabout strength, the stay flag, and, if it is 'stay', the value for the current output of this constraint. Assume this constraint is satisfied. *)
	| in <Variable> = input. out <Variable> = output. |
	out walkStrength: (strength weakest: in walkStrength).
	out stay: (in stay and: [scale stay and: [offset stay]]).
	out stay ifTrue: [execute]. (* stay optimization *)
)
public removeFromGraph = (
	(* Remove myself from the constraint graph. *)
	super removeFromGraph.
	scale isNil ifFalse: [scale removeConstraint: self].
	offset isNil ifFalse: [offset removeConstraint: self].
)
) : (
)
class StayConstraint var: v strength: s = UnaryConstraint var: v strength: s (
(* I mark variables that should, with some level of preference, stay the same. I have one method with zero inputs and one output, which does nothing. Planners may exploit the fact that, if I am satisfied, my output will not change during plan execution. This is called "stay optimization". *)addConstraint) (
public execute = (
	(* Stay constraints do nothing. *)
)
) : (
)
class UnaryConstraint var: v strength: s = Constraint strength: s (
(* I am an abstract superclass for constraints having a single possible output variable. *)
|
public output <Variable> = v.
protected satisfied <Boolean> ::= false.
|) (
public addToGraph = (
	(* Add myself to the constraint graph. *)
	output addConstraint: self.
	satisfied: false.
)
public chooseMethod: mark <Integer> = (
	(* Decide if I can be satisfied and record that decision. *)
	satisfied:: ((output mark = mark) not and: [strength strongerThan: output walkStrength])
)
public inputsKnown: mark <Integer> ^<Boolean> = (
	^true
)
public isSatisfied ^<Boolean> = (
	(* Answer true if this constraint is satisfied in the current solution. *)
	^satisfied
)
public markInputs: mark <Integer> = (
	(* I have no inputs. *)
)
public markUnsatisfied = (
	(* Record the fact that I am unsatisfied. *)
	satisfied: false
)
public recalculate = (
	(* Calculate the walkabout strength, the stay flag, and, if it is 'stay', the value for the current output of this constraint. Assume this constraint is satisfied. *)
	output walkStrength: strength.
	output stay: isInput not.
	output stay ifTrue: [execute]. (* Stay optimization *)
)
public removeFromGraph = (
	(* Remove myself from the constraint graph. *)
	output isNil ifFalse: [output removeConstraint: self].
	satisfied: false.
)
) : (
)
class Variable name: n initialValue: v = (
(* I represent a constrained variable. In addition to my value, I maintain the structure of the constraint graph, the current dataflow graph, and various parameters of interest to the DeltaBlue incremental constraint solver. *)
|
public value <Integer> ::= v.
public constraints <List[Constraint]> = List new: 2.
public determinedBy <Constraint>
public mark <Integer> ::= 0.
public walkStrength <Strength> ::= weakest.
public stay <Boolean> ::= true.
public name <String> = n.
|) (
public addConstraint: c <Constraint> = (
	(* Add the given constraint to the set of all constraints that refer to me. *)
	constraints addLast: c.
)
public removeConstraint: c <Constraint> = (
	(* Remove all traces of c from this variable. *)
	constraints remove: c ifAbsent: [].
	determinedBy = c ifTrue: [determinedBy: nil].
)
) : (
)
public addConstraintsConsuming: v <Variable> to: list <List[Constraints]> = (
	| determining <Constraint> = v determinedBy. |
	v constraints do: [:c | ((c = determining) not and: [c isSatisfied]) ifTrue: [list addLast: c]].
)
public addPropagate: c <Constraint> mark: mark <Integer> ^<Boolean> = (
	(* Recompute the walkabout strengths and stay flags of all variables downstream of the given constraint and recompute the actual values of all variables whose stay flag is true. If a cycle is detected, remove the given constraint and answer false. Otherwise, answer true. *)
	(* Details: Cycles are detected when a marked variable is encountered downstream of the given constraint. The sender is assumed to have marked the inputs of the given constraint with the given mark. Thus, encountering a marked node downstream of the output constraint means that there is a path from the constraint's output to one of its inputs. *)
	| todo <List[Constraint]> = List new. |
	todo addLast: c.
	[todo isEmpty] whileFalse: [
		| d <Constraint> = todo removeLast. |
		d output mark = mark ifTrue: [incrementalRemove: c. ^false].
		d recalculate.
		addConstraintsConsuming: d output to: todo.
	].
	^true
)
public chainTest: n = (
	(* This is the standard DeltaBlue benchmark. A long chain of equality constraints is constructed with a stay constraint on one end. An edit constraint is then added to the opposite end and the time is measured for adding and removing this constraint, and extracting and executing a constraint satisfaction plan. There are two cases. In case 1, the added constraint is stronger than the stay constraint and values must propagate down the entire length of the chain. In case 2, the added constraint is weaker than the stay constraint so it cannot be accommodated. The cost in this case is, of course, very low. Typical situations lie somewhere between these two extremes. *)
	| prev <Variable> first <Variable> last <Variable>
	 editC <Constraint> editV <List[Constraint]> plan <Plan> |
	1 to: n do: [:i |
		| name v |
		name:: 'v', i printString.
		v:: Variable name: name initialValue: 0.
		prev isNil ifFalse: [EqualityConstraint var: prev var: v strength: required].
		i = 1 ifTrue: [first:: v].
		i = n ifTrue: [last:: v].
		prev:: v.
	].

	StayConstraint var: last strength: strongDefault.
	editC:: EditConstraint var: first strength: preferred.
	editV:: List new.
	editV addLast: editC.
	plan:: extractPlanFromConstraints: editV.
	1 to: n do: [:i |
		first value: i.
		plan execute.
		last value = i ifFalse: [Error signal: 'Chain test failed!'].
	].
	editC destroyConstraint.
)
public extractPlanFromConstraints: constraints <List[Constraint]> ^<Plan> = (
	(* Extract a plan for resatisfaction starting from the outputs of the given constraints, usually a set of input constraints. *)
	| sources <List[Constraint]> = List new. |
	constraints do: [:c | (c isInput and: [c isSatisfied]) ifTrue: [sources addLast: c]].
	^makePlan: sources
)
public incrementalAdd: c <Constraint> = (
	(* Attempt to satisfy the given constraint and, if successful, incrementally update the dataflow graph.  Details: If satisfying the constraint is successful, it may override a weaker constraint on its output. The algorithm attempts to resatisfy that constraint using some other method. This process is repeated until either a) it reaches a variable that was not previously determined by any constraint or b) it reaches a constraint that is too weak to be satisfied using any of its methods. The variables of constraints that have been processed are marked with a unique mark value so that we know where we've been. This allows the algorithm to avoid getting into an infinite loop even if the constraint graph has an inadvertent cycle. *)
	|
	mark <Integer> = newMark.
	overridden <Constraint> ::= c satisfy: mark.
	|
	[overridden isNil] whileFalse: [overridden:: overridden satisfy: mark].
)
public incrementalRemove: c <Constraint> = (
	(* Entry point for retracting a constraint. Remove the given constraint and incrementally update the dataflow graph. *)
	(* Details: Retracting the given constraint may allow some currently unsatisfiable downstream constraint to be satisfied. We therefore collect a list of unsatisfied downstream constraints and attempt to satisfy each one in turn. This list is traversed by constraint strength, strongest first, as a heuristic for avoiding unnecessarily adding and then overriding weak constraints. Assume: c is satisfied. *)
	| out <Variable> unsatisfied <List[Constraint]> |
	out:: c output.
	c markUnsatisfied.
	c removeFromGraph.
	unsatisfied:: removePropagateFrom: out.
	descendingStrengths do: [:strength |
		unsatisfied do: [:u |
			u strength = strength
				ifTrue: [incrementalAdd: u]]].
)
public makePlan: sources <List[Constraint]> ^<Plan> = (
	(* Extract a plan for resatisfaction starting from the given source constraints, usually a set of input constraints. This method assumes that stay optimization is desired; the plan will contain only constraints whose output variables are not stay. Constraints that do no computation, such as stay and edit constraints, are not included in the plan. *)
	(*Details: The outputs of a constraint are marked when it is added to the plan under construction. A constraint may be appended to the plan when all its input variables are known. A variable is known if either a) the variable is marked (indicating that has been computed by a constraint appearing earlier in the plan), b) the variable is 'stay' (i.e. it is a constant at plan execution time), or c) the variable is not determined by any constraint. The last provision is for past states of history variables, which are not stay but which are also not computed by any constraint. Assume: sources are all satisfied. *)
	|
	mark <Integer> = newMark.
	plan <Plan> = Plan new.
	todo <List[Constraint]> = sources.
	|
	[todo isEmpty] whileFalse: [
		| c <Constraint> = todo removeLast. |
		((c output mark = mark) not and: [c inputsKnown: mark]) ifTrue: [
			(* not in plan already and eligible for inclusion *)
			plan addConstraint: c.
			c output mark: mark.
			addConstraintsConsuming: c output to: todo.
		]
	].
	^plan
)
public newMark ^<Integer> = (
	(* Select a previously unused mark value. *)
	currentMark:: currentMark + 1.
	^currentMark
)
public projectionTest: n <Integer> = (
	(* This test constructs a two sets of variables related to each other by a simple linear transformation (scale and offset). The time is measured to change a variable on either side of the mapping and to change the scale and offset factors. *)
	| scale <Variable> offset <Variable> src <Variable> dst <Variable>
	 dests <List[Variable]> |
	scale:: Variable name: 'scale' initialValue: 10.
	offset:: Variable name: 'offset' initialValue: 1000.
	dests:: List new.
	0 to: n-1 do: [:i |
		src:: Variable name: 'src', i printString initialValue: i.
		dst:: Variable name: 'dst', i printString initialValue: i.
		dests addLast: dst.
		StayConstraint var: src strength: normal.
		ScaleConstraint source: src scale: scale offset: offset destination: dst strength: required.
	].

	setValueOf: src to: 17.
	dst value = 1170 ifFalse: [Error signal: 'Projection test 1 failed!'].

	setValueOf: dst to: 1050.
	src value = 5 ifFalse: [Error signal: 'Projection test 2 failed!'].

	setValueOf: scale to: 5.
	0 to: n - 2 do:
		[:i | (dests at: i + 1) value = (i * 5 + 1000)
			ifFalse: [Error signal: 'Projection test 3 failed!'] ].

	setValueOf: offset to: 2000.
	0 to: n - 2 do:
		[:i | (dests at: i + 1) value = (i * 5 + 2000)
			ifFalse: [Error signal: 'Projection test 4 failed!']].
)
public propagateFrom: v <Variable> = (
	(* The given variable has changed. Propagate new values downstream. *)
	| todo <List[Constraint]> = List new. |
	addConstraintsConsuming: v to: todo.
	[todo isEmpty] whileFalse: [
		| c <Constraint> = todo removeLast. |
		c execute.
		addConstraintsConsuming: c output to: todo.
	].
)
public removePropagateFrom: out <Variable> ^<List[Constraint]> = (
	(* Update the walkabout strengths and stay flags of all variables downstream of the given constraint. Answer a collection of unsatisfied constraints sorted in order of decreasing strength. *)
	| unsatisfied <List[Constraint]> todo <List[Variable]> |
	out determinedBy: nil.
	out walkStrength: weakest.
	out stay: true.
	unsatisfied:: List new.
	todo:: List new.
	todo addLast: out.
	[todo isEmpty] whileFalse: [
		| v <Variable> determining <Constraint> |
		v:: todo removeLast.
		v constraints do: [:c | c isSatisfied ifFalse: [unsatisfied addLast: c]].
		determining:: v determinedBy.
		v constraints do: [:nextC |
			((nextC = determining) not and: [nextC isSatisfied])
				ifTrue: [nextC recalculate. todo addLast: nextC output]].
	].
	^unsatisfied
)
public setValueOf: var <Variable> to: newValue = (
	| editC <Constraint> editV <List[Constraint]> plan <Plan> |
	editC:: EditConstraint var: var strength: preferred.
	editV:: List new.
	editV addLast: editC.
	plan:: extractPlanFromConstraints: editV.
	10 timesRepeat: [var value: newValue. plan execute].
	editC destroyConstraint.
)
) : (
)
class Strength name: n value: v = (
(* Strengths are used to measure the relative importance of constraints. New strengths may be inserted in the strength hierarchy without disrupting current constraints. Strengths cannot be created outside this class, so pointer comparison can be used for value comparison. *)
|
public name <String> = n.
public value <Integer> = v.
|) (
public strongerThan: other <Strength> ^<Boolean> = (
	^self value < other value
)
public strongest: other <Strength> ^<Strength> = (
	^(self strongerThan: other) ifTrue: [self] ifFalse: [other]
)
public weakerThan: other <Strength> ^<Boolean> = (
	^self value > other value
)
public weakest: other <Strength> ^<Strength> = (
	^(self weakerThan: other) ifTrue: [self] ifFalse: [other]
)
) : (
)
public bench = (
	planner chainTest: 100.
	planner projectionTest: 100.
)
) : (
)