Encyclopedia > Constraint system

Article Content

Constraint system

In computer programming, constraint system is one of design patterns.

Problem: Difficult to solve problem. All of the related logic is huge and no control structure or organisation seems to be adequate.

Solution: Model the problem using connectors and logic items. Let scenarios play themselves out recursively across the network.

This rather large example was adapted from code in Structure and interpretation of computer programs, an excellent book. The program was originally written in Scheme, the languaged featured in Structure and Interpretation. Even if you write nothing but Perl, C or Java all of your life, I highly recommend this book. Decomposing problems into functions is the first cautious step in learning to program; decomposing programs into objects could be seen as a second and factoring out the recursive nature of complex problems a third. Complexity is the program killer, and its management is paramount in scaling programs as well as solving problems.

In addition to adopting the example to Perl, I've adopted it to use objects rather than lambda closures. This made the code longer and less elegant, but verbose borish implementation is considered a virtue in this day and age.

Constrain::new() is a wee little factory that spits out subtypes on demand. We're not actually using this right now in our code because by the time we got to the bottom of the file we forgot that we had done that. Using a factory as such is a good policy: it adds a layer of abstraction in the creation of objects, and each layer of abstraction is insurance against change, giving us a single place where we can translate the old interface to whatever is new.

Constrain::Adder is our first and only serious logic componenet. It should be refactored into a base class with a TemplateFunction and a sample implementation. Perhaps I'll get around to this later XXX, as it would make this code more directly useful to random purposes. When told what its value should be, it lashes back, sending a message out on one of its connectors informing the objects on that connector what value they must have to satisfy the condition. The //Adder// object does whatever it must to satisfy the constraint. The three inputs are identical in that they are all connections that may be connected to any other logic devices. They differ in that the last will be the sum of the first two. If any single inputs value is unspecified, a value will be sent out on that connector. If all values are specified after a new value comes in, the last output is the one we force to fit the constraint. Should it not wish to do so, it may in turn push out a new value by calling //setvalue()// on the connector. Eventually, a solution that all nodes are happy with will be arrived at, or else every possibility will be exhausted. XXX, return failure should we be unable to arrive at a solution. This component has exactly three connections.

Constrain::Probe describes an object that merely repeats to the screen any value it is told to have. This componenet has exactly one connection.

Constrain::Constant asserts a value on the wire and refuses to accept any other value. Should it be told to be another value, it fights back, pushing its own value back out again. This componenet has exactly one connection.

Finally, Constrain::Connector isn't a logical component at all - just a wire or messenger between them. It has no behavior of its own other than to relay messages from one connection out on the other connections. The above components each have a fixed number of inputs - not so with a connector. A connector may be connected to any number of components.

  package Constrain;

  
  # component - anonymous functions that exert force on each other.
  #             these are generated by various functions, much as an
  #             object in OO Perl would be created.

  
  sub new {

  
    my $type = shift;
    my $subtype = shift;

    return new Constrain::Adder(@_)     if $subtype eq 'adder';
    return new Constrain::Constant(@_)  if $subtype eq 'constant';
    return new Constrain::Probe(@_)     if $subtype eq 'prober';
    return new Constrain::Connector(@_) if $subtype eq 'connector';

    warn "Unknown Constrain subtype: $subtype";

  
  package Constrain::Adder;

  
  sub new {
    my $type = shift;

  
    my $a1 = shift;         # the name of our first connector
    my $a2 = shift;         # the name of 2nd connector we are tied to
    my $sum = shift;        # the name of 3rd connector we are tied to

  
    my $obj = { a1=>$a1, a2=>$a2, sum=>$sum };
    bless $obj, $type;

  
    $a1->xconnect($obj);
    $a2->xconnect($obj);
    $sum->xconnect($obj);

  
    return $obj;

  
  sub forgetvalue {
     my $this = shift;

  
     $a1->forgetvalue($obj);
     $a2->forgetvalue($obj); 
     $sum->forgetvalue($obj); 
     $this->set_value(undef);
  }

  
  sub setvalue {
    my $this = shift;
    local *a1 = \$this->{a1};
    local *a2 = \$this->{a2};
    local *sum = \$this->{sum};

  
    if($a1->hasvalue() and $a2->hasvalue()) {
      $sum->setvalue($a1->getvalue() + $a2->getvalue(), $this);

  
    } elsif($a1->hasvalue() and $sum->hasvalue()) {
      $a2->setvalue($sum->getvalue($sum) - $a1->getvalue($a1), $this);

  
    } elsif($a2->hasvalue() and $sum->hasvalue()) {
      $a1->setvalue($sum->getvalue() - $a2->getvalue(), $this);
    }
  }

  
  sub dump {
     my $this = shift;
     local *a1 = \$this->{a1};
     local *a2 = \$this->{a2};
     local *sum = \$this->{sum};

  
     print("a1 has a value: ", $a1->getvalue(), "\n") if $a1->hasvalue();
     print("a2 has a value: ", $a2->getvalue(), "\n") if $a2->hasvalue();
     print("sum has a value: ", $sum->getvalue(), "\n") if $sum->hasvalue();
  }

  
  package Constrain::Constant;

  
  sub new {

  
    my $type = shift;

  
    my $value = shift;     # our value. we feed this to anyone who asks.
    my $connector = shift; # who we connect to.

  
    my $obj = { value => $value, connector => $connector };

  
    bless $obj, $type;

  
    $connector->xconnect($obj);
    $connector->setvalue($value, $obj);

  
    return $obj;

  
  sub setvalue {
    my $this = shift;
    my $value = shift; 
    $this->{connector}->setvalue($value, $this);
  }

  
  sub getvalue {
    my $this = shift;
    return $this->{value};
  }

  
  package Constrain::Probe;

  
  sub new {

  
    my $type = shift;
    my $connector = shift;
    my $name = shift;

  
    my $obj = { connector => $connector, name => $name };
    bless $obj, $type;

  
    $connector->xconnect($obj);

  
    return $obj;

  
  sub setvalue {
    my $this = shift;
    my $name = $this->{name};
    print "Probe $name: new value: ", $this->{connector}->getvalue(), "\n";
  }

  
  sub forgetvalue {
    my $this = shift;
    my $name = $this->{name};
    print "Probe $name: forgot value\n";
  }

  
  package Constrain::Connector;

  
  sub new {

  
    my $type = shift;
    my $obj = { informant=>undef, value=>undef, dontreenter=>0, constraints=>[] };
    bless $obj, $type;

  
  sub hasvalue {
    my $this = shift;
    return $this->{informant}; 
  }

  
  sub getvalue {
    my $this = shift;
    return $this->{value};
  }

  
  sub setvalue {
    my $this = shift;
    local *constraints = \$this->{constraints};
    my $newval = shift;
    my $setter = shift or die;

  
    return if $this->{dontreenter}; $this->{dontreenter} = 1;

  
    $this->{informant} = $setter;
    $this->{value} = $newval;

  
    foreach my $i (@$constraints) {
      $i->setvalue($newval, $this) unless $i eq $setter;
    }

  
    $this->{dontreenter} = 0; 
  }

  
  sub forgetvalue {
    my $this = shift;
    local *constraints = \$this->{constraints};
    my $retractor = shift;

  
    if($this->{informant} eq $retractor) {
      $this->{informant} = undef;
      foreach my $i (@$constraints) {
        $i->forgetvalue($this) unless $i eq $retractor;
      }
    }
  }

  
  sub xconnect {
    my $this = shift;
    local *constraints = \$this->{constraints};
    local *value = \$this->{value};
    my $newconstraint = shift or die;

  
    push @$constraints, $newconstraint;
    $newconstraint->setvalue($value, $obj) if $value;

  
  package main;

  
  my $a =         Constrain::Connector->new();
  my $a_probe =   Constrain::Probe->new($a, 'a_probe');

  
  my $b =         Constrain::Connector->new();
  my $b_probe =   Constrain::Probe->new($b, 'b_probe');

  
  my $c =         Constrain::Connector->new();
  my $c_probe =   Constrain::Probe->new($c, 'c_probe');

  
  my $a_b_adder = Constrain::Adder->new($a, $b, $c);

  
  my $a_const =   Constrain::Constant->new(128, $a);

  
  my $b_const =   Constrain::Constant->new(256, $b);