Stefano Dissegna

Introduction

What's cells?

Cells is a Common Lisp library that extends the language, and in particular its object system, to let you write dataflow-driven programs. What does this mean? This means that the flow of control of the program depends no more on the sequence of function/method calls, but on the data. Cells lets you specify the dependencies beetwen different slots in a family of classes. Once these constraints have been registered, the cells system will take care of them, and will recalculate a value when some data on which it depends has changed. As a consequence, the programmer just has to tell the system the relationship between the data, the burden of maintaining them true is handled automatically by cells.

How could it improve your programs?

Cells may not be the panacea of programming, but it sure helps a lot in contexts where keeping a set of values consistent is crucial. A particular set of applications where this is important are graphical applications , where you need to maintain consistency between what the user sees and the real values held by the program in its internal data structures. An example is the state of the 'Cut' menu entry in an editor: it is usually clickable when the user has selected a piece of text and not clickable in all the other cases. In a normal application, to achieve this behavior you would need to track all the methods and all the user actions that could modify the region of text currently being selected, and add activate/disactivate calls in all those places to keep the menu entry in a consistent state. With cells, you just need to tell the system that the state of the menu depends on the length of the current text selection: if the length is 0 then the state is 'deactivated', else it is 'activated'. Now you can safely work on the rest of the application ignoring the state of the menu: it will be automatically recalculated every time the length of the current selection varies. Moreover, everything relating to the menu entry is placed near its definition, and not scattered across different functions/methods.

Installation

The installation is quite simple once you have a working Common Lisp system such as SBCL with Quicklisp already installed and loaded. Start an interactive session and evaluate the following expression:

> (ql:quickload 'cells)
To load "cells":
  Load 1 ASDF system:
    cells
; Loading "cells"
[package utils-kt]................................
[package cells]...................................
.......
(CELLS)

That's it. If everything went right cells should be up and running.

Our first cells program

The program

Write the following piece of code in a file named hello-cells.lisp:

(defmodel hello-cells ()
  ((num :accessor num :initarg :num :initform (c-in 0))
   (square-num :accessor square-num
               :initform (c? (* (num self) (num self))))))

(defun hello ()
  (let ((h (make-instance 'hello-cells)))
    (dolist (n '(10 20 30 40 50 60 60))
      (setf (num h) n)
      (format t "num is ~a and square-num is ~a~%" (num h) (square-num h)))))

Now start the SBCL interpreter in the same directory and evaluate the following:

> (asdf:oos 'asdf:load-op :cells)
...
> (use-package :cells)
T
> (load "hello-cells.lisp")
...
T
> (hello)
num is 10 and square-num is 100
num is 20 and square-num is 400
num is 30 and square-num is 900
num is 40 and square-num is 1600
num is 50 and square-num is 2500
num is 60 and square-num is 3600
num is 60 and square-num is 3600
NIL

What happens within the function 'hello'? First, an object of type hello-cells is created. After that the program iterates over the contents of the list '(10 20 30 40 50 60 60), and every number is used to set the num slot of the object h. Then the num slot is printed together with the slot square-num. The printed value of the slot num gives us no surprise: it has the value we gave it. This doesn't hold for the slot square-num, though: we never gave it a value within the loop, but it always holds the square of the slot num! This is just cells working for us: we told the system that the relation

 num*num=squarenum

must hold, and every time num changes, the expression

(* (num self) (num self))

is re-evaluated. Note that the relation isn't a mathematical equation: you can't change square-num and expect to find its square root in num.

The program line-by-line

Lets now analyze the program. The very first line uses the construct defmodel:

(defmodel hello-cells ()

defmodel is very similar to defclass and everything valid in a defclass construct is valid within defmodel (defmodel is a layer built on top of defclass). The main difference is that all the slots defined within it will be tracked by cells, except slots that are explicitly declared to be ignored by the system by specifying :cell nil in the definition.

((num :accessor num :initarg :num :initform (c-in 0))

Here we define the slot num as we would do within a standard class declaration. The difference is in its initialization expression: instead of the number 0 we have (c-in 0). Why? (c-in <expr>) is a construct that tells cells that the value of num may be changed, so whenever it does change a re-evaluation of all the slots that depend on it must be triggered. If we did just write 0 instead of (c-in 0) a runtime error would have been raised during the execution of (setf (num h) ...). So, when a slot is writable it must be signalled to cells with the (c-in ...) construct. This is necessary to let cells do some optimizations like avoiding to remember dependencies on slots that will never change. Slots initialized with c-in are usually called "input cells".

(square-num :accessor square-num
            :initform (c? (* (num self) (num self))))))

Now we define the slot square-num. There are two things to note here: (c? <expr>) and 'self'.The first is a construct that says: "To calculate the value of square-num, evaluate the expression <expr>". Within (c? ...) the variable self is bound to the object itself. (c? ...) automatically tracks any dependency, in this case the dependency on the value of num: when num changes, (* (num self) (num self)) will be re-evaluated. Slots initialized with c? are called " ruled cells".

(let ((h (make-instance 'hello-cells)))

Here we use the function (make-instance <model-name> args*), to create an object of type <model-name>, in this case hello-cells, as we would do to instantiate a normal class. You could specify an initial value for num now:

(let ((h (make-instance 'hello-cells :num (c-in 50))))

Note that you must repeat the (c-in ...) construct. This is because the behavior of the slot (input cell, constant, ruled cell) is decided on a per instance basis, not on a per class basis. This means that, in our example, we could have two objects of type hello-cells, one where the slot num is settable and one where it is has a constant value. When an object is created, all the values of its slots are computed for the first time, in this case the expression (* (num self) (num self)) is evaluated and the value given to the slot square-num.

(setf (num h) n)

This expression sets the value of the slot num to n. This is when cells comes into action: square-num depends on num, so (* (num self) (num self)) is re-evaluated after n has changed.

(format t "num is ~a and square-num is ~a~%" (num h)
(square-num h))

Finally, we print the values of the two slots and discover that the value of square-num is correctly the square of num. As a side note, you can reset the cells system by calling (cell-reset):

> (cells-reset)
NIL

This could be necessary after an error has corrupted the system and cells doesn't seem to work correctly anymore. It's also a good practice to reset the system before running code that uses cells.

The family system

Objects whose type have been defined using defmodel can be organized in families. A family is a tree of model instances (not of model classes!) that can reference each other using the functions (fm-other ...), (fm^ ...) and others. You can specify the family tree at object creation time passing a list of children to the argument :kids. Alternatively, you can access the slot .kids (automatically created by defmodel) and set it at runtime to change the family components. .kids is, by default, a slot of type c-in, and you can access it through the method (kids object). You can change the .kids slot to be of a type other than c-in as you could do with any other slot. To access the members of a family you can give them a name with the argument :md-name and then reference them by their name. Another way to access them is through their type: you could say, for example, "give me all the successors of type my-type" . To use these features your models must inherit from the model 'family'. Models that inherit from family have also a .value slot associated, which you can access through the method (value self). The following example shows some of these things in action:

(defmodel node (family)
  ((val :initform (c-in nil) :initarg :val)))

(defun math-op-family ()
  (let ((root
         (make-instance
          'node
          :val (c? (apply #'+ (mapcar #'val (kids self))))
          :kids
          (c?
            (the-kids
              (make-kid 'node :md-name :n5 :val (c-in 5))
              (make-kid
               'node
               :val (c? (apply #'* (mapcar #'val (kids self))))
               :kids
               (c?
                 (the-kids
                  (make-kid 'node :md-name :n7 :val (c-in 7))
                  (make-kid 'node :md-name :n9 :val (c-in 9))))))))))
    (format t "value of the tree is ~a~%" (val root))
    (setf (val (fm-other :n7 :starting root)) 10)
    (format t "new value of the tree is ~a~%" (val root))))

Write it in a file (in this case hello-cells.lisp) and load it:

> (load "hello-cells.lisp")
T
> (math-op-family)
value of the tree is 68
new value of the tree is 95
NIL

Lets' see the most important parts of the program:

(defmodel node (family)
  ((val :initform (c-in nil) :initarg :val)))

Here we define the model node: we plan to build a family of nodes, so we inherit from the model family. The slot val will contain the value of the node.

(make-instance
 'node
 :val (c? (apply #'+ (mapcar #'val (kids self))))

Now we create the main node: its value is defined as the sum of all its children values. To get the children list we use the method (kids self).

:kids
(c?
  (the-kids

We specify the children list using the :kids argument. the-kids builds a list of children using the following arguments. the-kids also removes nil kids and if an argument is a list then it is flattened, e.g. (the-kids (list k1 (list (list k2 nil) k3))) will return a list with the kids k1, k2 and k3.

(make-kid 'node :md-name :n5 :val (c-in 5))

This is the first child of the main node: we give it a name with the :md-name argument to reference the node through it in the future. To create an instance of a model intended to be a child you must specify to make-instance its parent through the argument :fm-parent. make-kid does this for us passing self as the parent.

(make-kid
 'node
 :val (c? (apply #'* (mapcar #'val (kids self))))
 :kids
 (c?
   (the-kids
     (make-kid 'node :md-name :n7 :val (c-in 7))
     (make-kid 'node :md-name :n9 :val (c-in 9)))))

The second child of the main node has two children and its value is the product of their values.

(format t "value of the tree is ~a~%" (val root))
(setf (val (fm-other :n7 :starting root)) 10)
(format t "new value of the tree is ~a~%" (val root))))

The body of the function prints the value of the tree, and through the output you can see that it depends correctly on the values of its children. Then we change the value of the node named :n7 and see that the new output has changed accordingly. (fm-other <member-name> <starting-point>) searches the family tree starting from <starting-point>, and returns the object named <member-name>. If it is not found, and error is raised. <starting-point> is optional, and it defaults to 'self'. We used fm-other outside of a defmodel, so there is no self and we must supply a starting point.

Defining an observer

Cells lets you define a function to execute immediately after a c-in slot is modified. This function is called an "observer". To define it, use the defobserver construct:

(defobserver <slot-name> (&optional (<self> self)
                                    (<new-value> old-value)
                                    (<old-value> new-value)
                                    (<old-value-boundp> old-value-boundp))
  <function-body>)

This function will be executed every time the slot <slot-name> of an object of type <model-name> is modified. <old-value> will hold the previous value of the slot, <new-value> the new one and <old-value-boundp> will be nil if this is the first time the slot gets a value and t otherwise. If not given, <self>, <new-value>, <old-value> and <old-value-boundp> will default to 'self', 'new-value', 'old-value' and 'old-value-bound-p'. In older releases of cells defobserver was called def-c-output. Suppose we want to log all the values that the num slot assumes: we can do this defining an observer function. Add the following lines to hello-cells.lisp:

(defobserver num ((self hello-cells))
  (format t "new value of num is: ~a~%" new-value))

Now reload the file and try running

(hello)

again:

> (load "hello-cells.lisp")
T
> (hello)
new value of num is: 0
new value of num is: 10
num is 10 and square-num is 100
new value of num is: 20
num is 20 and square-num is 400
new value of num is: 30
num is 30 and square-num is 900
new value of num is: 40
num is 40 and square-num is 1600
new value of num is: 50
num is 50 and square-num is 2500
new value of num is: 60
num is 60 and square-num is 3600
num is 60 and square-num is 3600
NIL

As you can see from the output, every time we set (num h) with a different value, the action previously defined is called. This also happens when (num h) is initialized for the first time at object creation time. You may have noted that when we set (num h) to 60 for the second time, the observer function isn't called: this is because when you set a slot to a new value that is the same (according to the function eql) as its old one, the change isn't propagated because there is no need to propagate it: it didn't change! Now look at the following piece of code:

(defmodel str-model ()
  ((str :accessor str :initform (c-in "") :initarg :str)
   (rev-str :accessor rev-str :initform (c? (reverse (str self))))))

(defobserver str ()
  (format t "changed!~%"))

(defun try-str-model ()
  (let ((s (make-instance 'str-model)))
    (dolist (l `("Hello!" "Bye"
                 ,(concatenate 'string "By" "e") "!olleH"))
      (setf (str s) l)
      (format t "str is \"~a\", rev-str is \"~a\"~%"
              (str s) (rev-str s)))))

It does nothing new: it constrains rev-str to be the reverse of str, creates an instance of str-model and prints some strings together with their reverse. It also logs every time it needs to compute the reversed string. Note that the second and the third strings of the list are actually equal. Lets try to run the code (supposing you wrote it in hello-cells.lisp):

> (load "hello-cells.lisp")
T
> (try-str-model)
changed!
changed!
str is "Hello!", rev-str is "!olleH"
changed!
str is "Bye", rev-str is "eyB"
changed!
str is "Bye", rev-str is "eyB"
changed!
str is "!olleH", rev-str is "Hello!"
NIL

The reversed string is calculated every time we set (str s), even when we're changing it from "Bye" to "Bye". But "Bye" and "Bye" are equal! Why do we need to waste time reversing it twice? Because cells by default uses eql to test for equality and if two strings aren't the same string (i.e. they don't have the same memory address) eql considers them to be different. The following piece of code shows us another problem: suppose we change

`("Hello!" "Bye" ,(concatenate 'string "By" "e") "!olleH")

to

`("Hello!" "Bye" "Bye" "!olleH")

depending on the Common Lisp implementation you run the program on you'll have a different output! Solving the problem is easy, we just need to use equal instead of eql as the equality function. To supply your own equality function pass it to the :unchanged-if argument in the slot definition:

(str :accessor str :initform (c-in "") :initarg :str
     :unchanged-if #'equal)

Now we get the same expected result on any implementation:

changed!
changed!
str is "Hello!", rev-str is "!olleH"
changed!
str is "Bye", rev-str is "eyB"
str is "Bye", rev-str is "eyB"
changed!
str is "!olleH", rev-str is "Hello!"
NIL

The equality function must accept two values: the new value of the slot and the old one.

Lazy cells

Ruled cells are evaluated, as we have already seen, at instance creation time and after dependent cells change. However, you may want to not evaluate a ruled cell until it is really needed, i.e. when the program asks for its value. To achieve such a behavior, you can use lazy cells. There are three types of them, depending on their laziness:

  1. :once-asked this will get evaluated/observed on initialization, but won't be reevaluated immediately if dependencies change, rather only when read by application code.
  2. :until-asked this does not get evaluated/observed until read by application code, but then it becomes un-lazy, eagerly re-evaluated as soon as any dependency changes (not waiting until asked).
  3. :always this isn't evaluated/observed until read, and not reevaluated until read after a dependency changes.
There are two ways in which a cell can be lazy: by not being evaluated immediately after its creation and by not responding to dependencies change. In both cases, when the program asks for its value, the lazy cell is evaluated (if needed). The first type embodies only the second way, the second type only the first way and the third type is lazy in both ways. The following example shows the behavior of lazy cells:

(defmodel lazy-test ()
  ((lazy-1 :accessor lazy-1 :initform (c-formula (:lazy :once-asked)
                                        (append (val self) (list '!!))))
   (lazy-2 :accessor lazy-2 :initform (c_? (val self)))
   (lazy-3 :accessor lazy-3 :initform (c?_ (reverse (val self))))
   (val :accessor val :initarg :val :initform (c-in nil))))

(defobserver lazy-1 ()
  (format t "evaluating lazy-1!~%"))

(defobserver lazy-2 ()
  (format t "evaluating lazy-2!~%"))

(defobserver lazy-3 ()
  (format t "evaluating lazy-3!~%"))

(defun print-lazies (l)
  (format t "Printing all the values:~%")
  (format t "lazy-3: ~a~%" (lazy-3 l))
  (format t "lazy-2: ~a~%" (lazy-2 l))
  (format t "lazy-1: ~a~%" (lazy-1 l)))

(defun try-lazies ()
  (let ((l (make-instance 'lazy-test :val (c-in '(I am very lazy!)))))
    (format t "Initialization finished~%")
    (print-lazies l)
    (format t "Changing val~%")
    (setf (val l) '(who will be evaluated?))
    (print-lazies l)))

As usual, load it and run it:

> (load "hello-cells.lisp")
T
> (try-lazies)
evaluating lazy-1!
Initialization finished
Printing all the values:
evaluating lazy-3!
lazy-3: (LAZY! VERY AM I)
evaluating lazy-2!
lazy-2: (I AM VERY LAZY!)
lazy-1: (I AM VERY LAZY! !!)
Changing val
evaluating lazy-2!
Printing all the values:
evaluating lazy-3!
lazy-3: (EVALUATED? BE WILL WHO)
lazy-2: (WHO WILL BE EVALUATED?)
evaluating lazy-1!
lazy-1: (WHO WILL BE EVALUATED? !!)
NIL

As you can see from the code, to declare a ruled cell to be lazy you just need to use the three constructs (c-formula (:lazy :one-asked) ...), (c_? ...) and (c?_ ...) for :once-asked, :until-asked and :always lazy cells, respectively. lazy-1 is evaluated immediately, lazy-2 and lazy-3 only when they are needed by format. After setting (val l), on which all the lazy cells depend, lazy-2 is re-evaluated immediately because it is of type :until-asked, while lazy-1 becomes lazy and lazy-3 remains lazy, so these two postpone evaluation until we ask for their values in the call to format. As a side note, such short names may not be very easy to remember and to read, but those constructs are so common that you'll find yourself using them a lot, and you'll appreciate their conciseness. If you still prefer long descriptive names, though, you can use the c-formula construct instead of c?/c_?/c?_ and c-input instead of c-in.

Drifters

Another type of cells are drifter cells. A drifter cell acts like a ruled cell, but the value returned by its body is interpreted as an increment, so after it has been re-evaluated its value becomes its previous one plus the one returned by the body. The following example shows drifter cells in action:

(defmodel counter ()
  ((how-many :accessor how-many
             :initform (c... (0)
                         (length (^current-elems))))
   (current-elems :accessor current-elems
                  :initform (c-in nil))))

(defun try-counter ()
  (let ((m (make-instance 'counter)))
    (dolist (l '((1 2 3) (4 5) (1 2 3 4)))
      (setf (current-elems m) l)
      (format t "current elements: ~{~a ~}~%" (current-elems m))
      (format t "~a elements seen so far~%" (how-many m)))))

try-counter iterates other a list setting current-elems to a list of values, and after each iteration how-many will hold the total number of the elements within the lists seen so far. The output will be:

> (load "hello-cells.lisp")
T
> (try-counter)
elements: 1 2 3
3 elements seen so far
elements: 4 5
5 elements seen so far
elements: 1 2 3 4
9 elements seen so far
NIL

The important passage in the code is the initialization of how-many:

(c... (0)
  (length (^current-elems)))

(^current-elems) is just a shortcut for (current-elems self). The construct (c... (<initial-value>) <body>) creates a drifter cell whose initial value will be <initial-value>, in this case 0. When current-elems changes, (length (^current-elems)) is re-evaluated, and its value is summed to how-many, so how-many will hold the total number of elements that current-elems has held so far.

Cyclic dependencies

It is possible to write code with cyclic dependencies: when A changes you need to take some action that changes B, which in turn sets A, but A has still to complete running the code needed to keep it in a consistent state. The following code shows how this situation could arise:

(defmodel cycle ()
  ((cycle-a :accessor cycle-a :initform (c-in nil))
   (cycle-b :accessor cycle-b :initform (c-in nil))))

(defobserver cycle-a ()
  (setf (cycle-b self) new-value))

(defobserver cycle-b ()
  (setf (cycle-a self) new-value))

(defun try-cycle ()
  (let ((m (make-instance 'cycle)))
    (setf (cycle-a m) '(? !))
    (format t "~a and ~a" (cycle-a m) (cycle-b m))))

When try-cycle sets cycle-a, its observer gets called, which sets cycle-b which in turn sets cycle-a. This is not an infinite cycle as it may seem, because the second time we set cycle-a we give it the same value we gave it the first time, so the cells engine should stop the propagation. Lets see if this does actually work:

> (load "hello-cells.lisp")
T
> (try-cycle)
SETF of <2:A CYCLE-B/NIL = NIL> must be deferred by
wrapping code in WITH-INTEGRITY

   [Condition of type SIMPLE-ERROR]

The message could vary depending on your Common Lisp implementation, but one thing is clear: the code doesn't work. This happens because when we set cycle-a for the second time, its observer is still running, so cycle-a could be in an inconsistent state. The error message tells us the solution: wrap the problematic code inside the with-integrity construct, which makes sure that cycle-a is consistent when that piece of code is run. The same problem exists for cycle-b and the solution is the same. We need then to change

(defobserver cycle-a ()
  (setf (cycle-b self) new-value))

to

(defobserver cycle-a ()
  (with-integrity (:change)
    (setf (cycle-b self) new-value)))

and

(defobserver cycle-b ()
  (setf (cycle-a self) new-value))

to

(defobserver cycle-b ()
  (with-integrity (:change)
    (setf (cycle-a self) new-value)))

Now if we reload the code and run it we'll get the correct result. Make sure to call (cells-reset) after an error has occurred.

> (cells-reset)
NIL
> (load "hello-cells.lisp")
T
> (try-cycle)
(? !) and (? !)
NIL

Synapses

Built-in synapses

Suppose that you have a cell A that depends on another cell B, but you want A to change only when B changes by an amount over a given threshold, maybe because B receives data from an external probe and you don't want A to over-react to small fluctuations. Synapses let you do this, and they give you more control over the constraint propagation system. Basically, using synapses you can tell the system if a change should be propagated or not. The following example shows a "clock" that changes only after a minimal amount of time:

(defmodel syn-time ()
  ((current-time :accessor current-time :initarg :current-time
                 :initform (c-in 0))
   (wait-time :accessor wait-time :initarg :wait-time :initform (c-in 0))
   (time-elapsed :accessor time-elapsed
                 :initform
                 (c?
                   (f-sensitivity :syn ((wait-time self))
                     (current-time self))))))

(defun try-syn-time ()
  (let ((tm (make-instance 'syn-time :wait-time (c-in 2))))
    (dotimes (n 10)
      (format t "time +1~%")
      (incf (current-time tm))
      (format t "time-elapsed is ~a~%" (time-elapsed tm)))))

time-elapsed holds the same value of current-time, but it changes only when current-time changes by at least wait-time units. In the main function we simulate time with a loop that increments current-time by one unit and then shows elapsed-time. The most important part of the program is

(f-sensitivity :syn ((wait-time self))
  (current-time self))

Here we create a synapse named :syn. It is of type f-sensitivity: (current-time self) is evaluated always, but if the difference between the previously propagated value (if there is one) and the value it returns is lesser than (wait-time self), then the slot elapsed-time won't change and, consequently, nothing will be propagated. The expected result then will be:

> (load "hello-cells.lisp")
T
> (try-syn-time)
time +1
time-elapsed is 0
time +1
time-elapsed is 2
time +1
time-elapsed is 2
time +1
time-elapsed is 4
time +1
time-elapsed is 4
time +1
time-elapsed is 6
time +1
time-elapsed is 6
time +1
time-elapsed is 8
time +1
time-elapsed is 8
time +1
time-elapsed is 10
NIL

time-elapsed changes only when the accumulated difference is at least wait-time (2 in this case). Other synapses available are f-delta, f-plusp, f-zerop.

Defining your own

As it frequently happens, you may need a type of synapse that is not available. In this case, you can define your own synapses using the construct with-synapse.

(with-synapse <id> (&rest <vars>)
  <body>)

<vars> is a valid variable declaration list such as that of the let form. These variables are created and initialized the first time <body> is executed, and they retain their value from call to call, so that you can use them to carry state between different re-evaluations of <body>. <body> should return two values: the value to return and one keyword out of :propagate and :no-propagate to indicate if the value should be propagated or not. For example, we could have a ruled cell that propagates only when another cell is odd:

(defmodel my-syn-test ()
  ((num :accessor num :initform (c-in 0))
   (odd-num :reader odd-num
            :initform (c?
                        (with-synapse :odd-syn ()
                          (if (oddp (^num))
                              (values (^num) :propagate))
                              (values nil :no-propagate)))))))

(defobserver odd-num ()
  (when old-value-boundp
    (format t "Propagated!~%")))

(defun try-my-syn ()
  (let ((m (make-instance 'my-syn-test)))
    (dolist (n '(1 2 4 5 7 11 12 14 16 15))
      (format t "Setting num to ~a~%" n)
      (setf (num m) n)
      (format t "odd-num is ~a~%" (odd-num m)))))

The crucial part is the values returned by with-synapse's body. When num is odd, we return it together with :propagate, otherwise we return a value that will be ignored (because it won't be propagated) and :no-propagate. Here is the output:

> (load "hello-cells.lisp")
T
> (try-my-syn)
Setting num to 1
Propagated!
odd-num is 1
Setting num to 2
odd-num is 1
Setting num to 4
odd-num is 1
Setting num to 5
Propagated!
odd-num is 5
Setting num to 7
Propagated!
odd-num is 7
Setting num to 11
Propagated!
odd-num is 11
Setting num to 12
odd-num is 11
Setting num to 14
odd-num is 11
Setting num to 16
odd-num is 11
Setting num to 15
Propagated!
odd-num is 15
NIL

You can see that odd-num changes only when we return :propagate (we could have returned any other value. The only requirement to propagate is to return something different from :no-propagate). When we return :no-propagate odd-num doesn't change. We didn't need to carry some state between different executions of the body, so we left the <vars> list empty.

Example: playing sudoku

We have seen a few example of using cells, but none of them actually did something beside showing cells behavior. Now we will see how to use cells to aid us resolving a sudoku puzzle. First of all, some constants:

(defparameter *all-values* '(1 2 3 4 5 6 7 8 9))
(defparameter *row-len* 9)
(defparameter *sq-size* 3)
(defparameter *col-len* 9)

The input board is a vector of vectors: every position contains either a number from 1 to 9 or a '? telling the program that it must find a value to fill in that position. The following is an empty board:

(defparameter *board*
  #(#(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)
    #(? ? ? ? ? ? ? ? ?)))

We will represent the playing board with the model board, which has two slots: complete is a boolean that tells if every position on the board has been filled with a value, and squares is a vector of vectors representing the actual board. The slot complete is a lazy cell because it is needed rarely and it would be a waste of time to recompute it whenever a single square changes. Every square in the board is represented by the model square, which has three slots: exact-val holds the actual value of the square and it is NIL if the square is empty, possible-vals holds a list of the values that the square could assume without conflicting with the exact-val of the squares in the same group, and group is a reference to an object of type square-group: squares in the same group cannot have the same exact-val.

(defmodel square-group ()
  ((constraining :initform (c-in nil) :initarg :constraining
                 :accessor constraining)))

(defmodel square ()
  ((group :accessor group :initform (c-in nil))
   (exact-val :accessor exact-val :initform (c-in nil) :initarg :exact-val)
   (possible-vals
    :accessor possible-vals
    :initform
    (c?
      (when (and (^group) (not (^exact-val)))
        (let ((c (constraining (^group))))
          ;; a value must not be the same of the constraining
          (remove-if-not
           #'(lambda (v)
               (every
                #'(lambda (x)
                    (not (eql v (exact-val x))))
                c))
           *all-values*)))))))

(defun make-square (x)
  (make-instance 'square :exact-val (c-in (if (eql x
'?) nil x))))

(defmodel board ()
  ((complete :accessor complete
             :initform
             (c?_
               (every #'(lambda (x) (every #'exact-val x)) (^squares))))
   (squares :accessor squares :initarg :squares)))

(defmethod print-object ((self board) out)
  (dotimes (r *col-len*)
    (dotimes (c *row-len*)
      (format out "~a " (exact-val (at (^squares) r c))))
      (format out "~%")))

Some helper functions to get a value from the board and to find the next position without a value. A position is a list of two numbers: the row and the column.

(defun at (board r c)
  (elt (elt board r) c))

(defun next-pos (pos)
  "next position in the board. search only forward.
return NIL if the board is finished"
  (destructuring-bind (r c) pos
    (if (= c (1- *row-len*))
        (if (= r (1- *col-len*))
            nil
            (list (1+ r) 0))
        (list r (1+ c)))))

(defun next-to-try (board pos)
  "find next position without a value searching forward.
return NIL if there is none"
  (let ((pos (next-pos pos)))
    (when pos
      (let ((s (at board (first pos) (second pos))))
        (if (exact-val s)
            (next-to-try board pos)
            pos)))))

We create a group for every square. The same square belongs to more than one group. We put in the same group of a certain square all the squares in the same line, in the same column or in the same block.

(defun make-groups (squares)
  (dotimes (r *col-len*)
    (dotimes (c *row-len*)
      (setf (group (at squares r c))
            (make-instance 'square-group
                           :constraining
                           (c-in
                            (delete-duplicates
                             (nconc
                              (nth-col squares c)
                              (nth-row squares r)
                              (nth-block squares r c)))))))))

(defun nth-row (board n)
  "return row n of board"
  (coerce (elt board n) 'list))

(defun nth-col (board n)
  "return column n of board"
  (map 'list #'(lambda (x) (elt x n)) board))

(defun nth-block (board r c)
  "return list of element in the same block of (at
board r c)"
  (let ((upper-left-r (* *sq-size* (floor (/ r *sq-size*))))
        (upper-left-c (* *sq-size* (floor (/ c *sq-size*)))))
    (apply #'concatenate 'list
           (map 'list #'(lambda (x)
                          (subseq x upper-left-c
                                  (+ upper-left-c *sq-size*)))
                (subseq board upper-left-r
                        (+ upper-left-r *sq-size*))))))

To create the board we map the input board and for every position we create a square. Then we build all the groups.

(defun make-board (b)
  (let ((b (make-instance
            'board
            :squares
            (c-in
             (map 'vector #'(lambda (x) (map 'vector #'make-square x))  b)))))
    (make-groups (squares b))
    b))

The following code looks for a solution, trying all the possible combinations. Thanks to how we defined possible-vals, impossible combinations are never tried.

(defun search-solution (b &optional (next
                                     (next-to-try (squares b) (list 0 -1))))
  (if next
      (let ((s (at (squares b) (first next) (second next))))
        (or (some ; find the first of the possible values that yields a solution
             #'(lambda (x)
                 (setf (exact-val s) x) ; try it
                 (search-solution b (next-to-try (squares b) next)))
             (possible-vals s))
            ;; couldn't find any solution: reset the square and return
            ;; NIL to indicate failure
            (setf (exact-val s) nil)))
      ;; tried all the positions: have we completed the board?
      (complete b)))

Finally the main function: it accepts an input board and prints a solution.

(defun sudoku (the-board)
  (let ((b (make-board the-board)))
    (search-solution b)
    (format t "Solution:~%~a~%" b)))

Save it in a file named "sudoku.lisp" and try it on the empty board:

> (load "sudoku.lisp")
T
> (sudoku *board*)
Solution:
1 2 3 4 5 6 7 8 9
4 5 6 7 8 9 1 2 3
7 8 9 1 2 3 4 5 6
2 1 4 3 6 5 8 9 7
3 6 5 8 9 7 2 1 4
8 9 7 2 1 4 3 6 5
5 3 1 6 4 2 9 7 8
6 4 2 9 7 8 5 3 1
9 7 8 5 3 1 6 4 2
NIL

It does find a solution, but it takes quite a while to print it:

> (time (sudoku *board*))
Solution:
1 2 3 4 5 6 7 8 9
4 5 6 7 8 9 1 2 3
7 8 9 1 2 3 4 5 6
2 1 4 3 6 5 8 9 7
3 6 5 8 9 7 2 1 4
8 9 7 2 1 4 3 6 5
5 3 1 6 4 2 9 7 8
6 4 2 9 7 8 5 3 1
9 7 8 5 3 1 6 4 2
Evaluation took:
  2.476 seconds of real time
  2.388149 seconds of user run time
  0.076004 seconds of system run time
  [Run times include 0.176 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  155,622,072 bytes consed.
NIL

It takes 2.4 seconds and it allocates more than 155 MB of memory! We can do better by noticing that when we set exact-val in search-solution the slot possible-vals of every cell in the same group are recomputed, but we don't need all those values immediately, and a lot of them will change again before we will need them. The solution is to use a lazy cell and to do that we change the initform of possible-vals to use c?_ instead of c?. Change it and run the program again:

> (load "sudoku.lisp")
T
> (time (sudoku *board*))
Solution:
1 2 3 4 5 6 7 8 9
4 5 6 7 8 9 1 2 3
7 8 9 1 2 3 4 5 6
2 1 4 3 6 5 8 9 7
3 6 5 8 9 7 2 1 4
8 9 7 2 1 4 3 6 5
5 3 1 6 4 2 9 7 8
6 4 2 9 7 8 5 3 1
9 7 8 5 3 1 6 4 2
Evaluation took:
  0.181 seconds of real time
  0.16001 seconds of user run time
  0.020001 seconds of system run time
  [Run times include 0.012 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  9,517,528 bytes consed.
NIL

Now the speed is much better (more than ten times faster), it allocates only 9.5 MB of memory, and we achieved this result with a really small change. One important thing to note about this example is that we had to write the function search-solution to solve the puzzle, because cells has no constraints resolution engine. What it does is to propagate change to dependent slots. We used this feature to keep the board in a consistent state and to roll out impossible combinations while searching for a solution, without having to worry about dependencies. This way the searching function has been quite simple to write, because all the relations between different squares were managed automatically by the models we defined earlier.