Previous Page Next Page

Chapter 7


Look at the class Pattern. Patterns are generalized and efficient pattern matchers. A Pattern object consists of a collection of objects to match, and a block of code to execute when the Pattern is successfully matched.

package require Itcl

itcl::class Pattern {
variable input
# contains the string to be used as the pattern
variable matchBlock
# contains a block of code to be executed when a match
# occurs
variable state
# contains a string denoting the current state of the pattern
# collection

constructor {aString} {
# "Answer a new pattern with aString
# as the pattern to match."
set input $aString
set matchBlock ""
set state ""}

method matchBlock: {aBlock} {
# "Set the match block of the receiver to
# aBlock. This block will be evaluated
# when the pattern is fully matched."
set matchBlock $aBlock}

method match: {anObject} {
# "Compare anObject against the pattern.
# If anObject completes the matching of
# the pattern, evaluate the match block."
append state " " $anObject
# puts "Pattern::match $input $state"
if {[regexp $input $state]} {
eval $matchBlock
set state ""

method reset {} {
# "Reset the receiver to start matching
# at the beginning of the pattern."
set state ""}

Animals Revisited

In Chapter 6, we built a simple hierarchy of animal classes. In this section, we will give those animals an environment (habitat) in which to live and a way to acquire knowledge and interact with their habitat.

The habitat will have a set of animals that inhabit it. Every animal will store knowledge as a collection of patterns, instances of class Pattern. In this case a Pattern is a sequence of words that, when recognized by the Pattern, evaluates a corresponding block of code. This causes the animal to react to a word sequence in some prescribed way. The global variable Script contains a Stream of words to send to all of the animals. Giving many different Patterns to a single animal provides that animal with a rich set of behaviors.

Animal Habitat

Create a new class AnimalHabitat.

The instance variable animals will contain the set of animals that inhabit the habitat. (The instance variables scriptString, script, and browser are used in a later tutorial.)

Now copy and paste the following class definition to the tkcon prompt:

package require Itcl

itcl::class AnimalHabitat {
variable animals ""
variable scriptString
variable script
variable browser

method add: {anAnimal}
method play {}
method script: {aString}

The methods are:

itcl::body AnimalHabitat::add: {anAnimal} {
# "Add anAnimal as an inhabitant of the receiver.
# Notify anAnimal of its new habitat."
if {[lsearch $animals $anAnimal] < 0} {
lappend animals $anAnimal}
$anAnimal habitat: $this}

itcl::body AnimalHabitat::play {} {
# "Play the Script to all of the animals."
foreach animal $animals {
$animal reset }
foreach word $script {
puts "$word"
set word [string tolower $word]
foreach animal $animals {
$animal reactTo: $word }}}

itcl::body AnimalHabitat::script: {aString} {
# "Change Script to a list on the
# words in aString."
set script [split $aString]}

Now evaluate the following expression to create a global variable, Habitat, containing an instance of the AnimalHabitat class:

AnimalHabitat Habitat

Animal Knowledge

To put animals inside of the habitat, you must first add some methods to the Animal class. The Animal class was created in Chapter 6.

The new methods in class are:

itcl::body Animal::habitat: {aHabitat} {
# "Change habitat to aHabitat"
set habitat $aHabitat}

itcl::body Animal::learn:action: {aString aBlock} {
# "Add a pattern of the words in aString to the
# receiver's knowledge. The action to perform
# when the pattern is matched is aBlock."
set words [string tolower $aString]
set pattern [Pattern #auto "[string tolower $name] $words"]
$pattern matchBlock: $aBlock
set knowledge($words) $pattern}

itcl::body Animal::reactTo: {aWord} {
# "Send a word to every pattern in knowledge."
foreach pattern [array names knowledge] {
$knowledge($pattern) match: $aWord}}

itcl::body Animal::reset {} {
# "Reset all patterns in knowledge"
foreach pattern [array names knowledge] {
$knowledge($pattern) reset}}

Using the Habitat

First, let's add some animals to the habitat. The following expressions use the animals that were created in Chapter 6:

Habitat add: Snoopy
Habitat add: Polly

Now, set up a script to work with:

Habitat script: \
"Snoopy is upset about the way that Polly is\
behaving. It is as if whenever anyone asks\
Polly to talk, Polly will be nasty. Maybe if\
instead of Snoopy barking at Polly when he\
wants Polly to talk, Snoopy quietly asks Polly\
to be pleasant for a change, things would go\
better. Now maybe Snoopy barking quietly will\
not make Polly nasty."

Before playing the script, we need to give the animals some knowledge:

Snoopy learn:action: "barking" {Snoopy talk}
Snoopy learn:action: "quietly" {Snoopy beQuiet; Snoopy talk}
Snoopy learn:action: "is upset" {Snoopy beNoisy; Snoopy talk}
Polly learn:action: "to be pleasant" \
{Polly vocabulary: "Have a nice day"; Polly talk}
Polly learn:action: ".* nasty" \
{Polly vocabulary: "Why are you bothering me"; \
Polly talk}

The dot-asterisk (.*) in '*nasty' stands for none or more arbitrary words. Let us test the actions:

Snoopy reactTo: "snoopy barking"
Snoopy reactTo: "snoopy quietly"
Snoopy reactTo: "snoopy is upset"
Polly reactTo: "polly to be pleasant"
Polly reactTo: "polly will be nasty"

To play the script to the animals, evaluate the following expression:

Habitat play

Look in the Transcript window to see the responses from the animals.

A Network of Nodes

As a final example of Streams and Collections, we will build a network of nodes, and determine paths through the network. Many problems can be described in terms of networks of nodes and paths through the network, such as route maps, pert charts, and many kinds of optimization problems.


A network is a collection of nodes that are connected to each other. Create the class Network.

The instance variable connections will hold an Array of connections between nodes. The key to the Array will be a node, and the value stored under that key will be a set of all of the nodes to which it is connected.

Evaluate the following class definition for class Network:

package require Itcl

itcl::class Network {
variable connections

method connections {}
method = {aNetwork}
method connect:to: {nodeA nodeB}
method initialize {}
method pathFrom:to:avoiding: {nodeA nodeB nodeSet}
method printOn: {aStream}

The methods are:

itcl::body Network::connections {} {
# answer connections as list
return [array get connections]}

itcl::body Network::= {aNetwork} {
# copy
catch {unset connections}
array set connections [$aNetwork connections]}

itcl::body Network::connect:to: {nodeA nodeB} {
# "Add a connection from nodeA to nodeB."
if {[info exists connections($nodeA)]} {
if {[lsearch $connections($nodeA) $nodeB] < 0} {
set connections($nodeA) \
[lappend connections($nodeA) $nodeB]
} else {
set connections($nodeA) $nodeB}
if {[info exists connections($nodeB)]} {
if {[lsearch $connections($nodeB) $nodeA] < 0} {
set connections($nodeB) \
[lappend connections($nodeB) $nodeA]
} else {
set connections($nodeB) $nodeA}}

itcl::body Network::initialize {} {
# "Initialize the connections to be empty."
catch {unset connections}}

itcl::body Network::pathFrom:to:avoiding: {nodeA nodeB nodeSet} {
# "Answer a path of connections that connect nodeA
# to nodeB without going through the nodes in
# nodeSet. This result is returned as a new
# network. Answer nil if there is no path."
if {[lsearch $nodeSet $nodeA] < 0} {
lappend nodeSet $nodeA}

foreach node $connections($nodeA) {
if {$node == $nodeB} {
set ret [Network #auto]
$ret initialize
$ret connect:to: $nodeA $node
return $ret}
if {[lsearch $nodeSet $node] < 0} {
set answer [$this pathFrom:to:avoiding: \
$node $nodeB $nodeSet]
if {$answer != ""} {
$answer connect:to: $nodeA $node
return $answer}}}
return ""}

itcl::body Network::printOn: {aStream} {
# "Print a description of the receiver on aStream."
foreach node [array names connections] {
$node printOn: $aStream
foreach neighbor $connections($node) {
puts -nonewline $aStream "\n>>"
$neighbor printOn: $aStream
puts $aStream ""}}

Notice the recursion in the pathFrom:to:avoiding: message. This is a simple solution; it does not find the optimal (shortest) path. If you want to find such an optimal solution, however, you need only change this one method. This is another of Smalltalk/V's characteristics. You can quickly build program fragments to start exploring the nature of the problem being solved. When you better understand the problem, the changes are quick and localized.

Network Nodes

Before using the Network class, define the class NetworkNode, with two instance variables, name and position.

itcl::class NetworkNode {
variable name
variable position

constructor {aString aPoint} {
set name $aString
set position $aPoint}

method name {}
method name:position: {aString aPoint}
method printOn: {aStream}

The methods are:

itcl::body NetworkNode::name {} {
# "Answer receiver's name."
return $name}

itcl::body NetworkNode::name:position: {aString aPoint} {
# "Set the receiver's name and position."
set name $aString
set position $aPoint}

itcl::body NetworkNode::printOn: {aStream} {
# "Print a description of the receiver on aStream."
puts -nonewline $aStream \
"Node($name [$position printString])"}

Building a Network

Now evaluate the following expression to create an empty Network object in the global variable Net:

Network Net
Net initialize

Then evaluate these expressions, to create six nodes and connect them together into a network:

NetworkNode N1 "one" [Point #auto 100 100]
NetworkNode N2 "two" [Point #auto 150 150]
NetworkNode N3 "three" [Point #auto 200 120]
NetworkNode N4 "four" [Point #auto 50 50]
NetworkNode N5 "five" [Point #auto 125 220]
NetworkNode N6 "six" [Point #auto 260 120]

Net connect:to: N1 N2
Net connect:to: N2 N3
Net connect:to: N4 N5
Net connect:to: N5 N1
Net connect:to: N3 N6
Net connect:to: N3 N5
Net connect:to: N3 N1

You can ask the network to print itself by evaluating the following expression:

Net printOn: stdout

Now evaluate the following expression and show the results, to find a path from N1 to N5:

Network ret     
ret = [Net pathFrom:to:avoiding: N1 N5 ""]
ret printOn: stdout

To see if there is a path that does not go through N3, evaluate the following expression:

ret = [Net pathFrom:to:avoiding: N1 N5 N3]           
ret printOn: stdout

What You've Now Learned

After having completed this tutorial, you should be familiar with:

As always, you can review any of these topics by repeating the corresponding section of the tutorial.

Previous Page Next Page