This chapter introduces you to two of Smalltalk¡s most widely used hierarchies: the Stream classes and the Collection classes. At the end of this chapter, you'll see four interesting examples using both of these hierarchies.
As always, the examples for this tutorial are stored in a disk file, chapter.7. You can use the File menu Open... item to retrieve these examples, if you do not want to type them.
You will also be altering the image during this tutorial, so be sure to save the image when you exit the environment.
Smalltalk supports many different kinds of stream objects. You already saw one of them when you accessed disk files using FileStream objects. Streams are also used for accessing internal collections of objects, such as strings and arrays using classes ReadStream, WriteStream, and ReadWriteStream. The stream classes are arranged in a hierarchy with the class Stream as the superclass. You can use the Class Hierarchy Browser (explained in Chapter 6) to explore this hierarchy.
This chapter will present a series of examples using streams, which should give you a good introduction. Part 3 of this manual gives a detailed description of streams and all of the messages that can be used with them.
Streams are frequently used for scanning input or producing edited output. For example, look at this method, which does both:
"Replace occurrences of % with the date today" | input output char dateStamp | dateStamp := Date today printString. input := ReadStream on: 'The date today is %'. output := WriteStream on: String new. [input atEnd] whileFalse: [ (char := input next) = $% ifTrue: [output nextPutAll: datestamp] ifFalse: [output nextput: char] ]. ^output Contents
This example creates two streams. The on: message is sent to the class ReadStream to create a stream on the argument string 'The date today is %'. The on: message is also used to create a WriteStream on an empty string, to hold the edited output.
As the names imply, ReadStream can only be read and WriteStream can only be written. As we have seen previously with the disk file examples, streams are read with the next message and written with the nextPut: message. The message atEnd tests if there is more input to be read. The message nextPutAll: writes several objects to a stream at once. In the above example, the argument is a string of characters containing today's date.
The above example streams over strings of characters. It uses an empty string for the WriteStream because streams automatically grow as necessary, to accommodate the objects written to them. The contents message returns a string containing all of the objects written to the stream.
To change the above example to use disk files instead of streams on strings, simply change the messages that create the streams input and output. This illustrates one of Smalltalk's most powerful features: you can write programs that are dependent on the behavior, rather than the structure, of data. This means that you can write and test a program using simple internal objects, such as streams on strings, and then easily extend it to use external files.
Streams are not restricted to reading and writing only characters. For example, this method reads and writes an Array of Number objects:
"Compute several factorials" | input output | input := ReadStream on: #( 1 5 10 20 ). output := WriteStream on: Array new. [input atEnd] whileFalse: [ output nextPut: input next factorial ]. ^output contents
Although these examples do not show it, streams can also be repositioned, much like a random access file, using the position: message. The argument is an Integer. You can also use the position message to access a stream's current position.
Collections are objects which contain a collection of other objects. You have already seen two kinds of collections: Array and String, Strings are fixed sized sequences of characters, while Arrays are fixed sized sequences of arbitrary objects. You have used the iterator messages do:, collect:, select:, and reject: with arrays and strings. These messages are understood by all of the collection classes, three of which are Dictionary, Bag, and Set.
Dictionaries store and retrieve objects by using a key. For example, let's create a simple phone book. First, create a global variable containing an empty Dictionary by evaluating the following:
PhoneBook:= Dictionary new
To add phone numbers to the phone book, use the at:put: message:
PhoneBook at: 'Marisa' put: '645-1082'; at: 'Francesca' put: '555-1212'; at: 'Jackie' put: '392-481-5000'; at: 'Rakesh' put: '645-1083'; at: 'Vijay' put: '645-1083'
In the above expressions, the strings 'Marisa' and 'Francesca' are the keys, and the strings '645-1082'and '555-1212' are the corresponding values. Notice that at:put: is also used to access the elements of Strings and Arrays. With Dictionary objects, however, the first argument is the key in the Dictionary, instead of the position in the Array or String.
To retrieve an object from a Dictionary, use the at: message with the key as the argument. For example, the following expression returns the string '645-1082':
PhoneBook at: 'Marisa'
To test if an object exists as a key in the Dictionary, use the includesKey: message, as in the following expression:
(PhoneBook includesKey: 'Aaron') ifTrue: [PhoneBook at: 'Aaron'] ifFalse: ['Not in phone book']
A simpler way to do this is to use the at:ifAbsent: message. The first argument is the key and the second argument is a block of code that will be executed if the key is not in the receiver Dictionary. For example:
PhoneBook at: 'Aaron' ifAbsent: ['Not in phone book']
The keys and the values stored in a Dictionary can be any kind of object.
Dictionaries are such useful objects that a special inspector window exists called the Dictionary Inspector. To open a Dictionary Inspector on the phone book, evaluate the following expression:
PhoneBook inspect
You can also double click on the word Phonebook and select Inspect It from the Smalltalk menu. The pane on the left of the window is a sorted list of all of the keys in the Dictionary, in our case the names of people in the phone book. When you select a key, the corresponding value is displayed in the pane on the right, in our case the person's phone number. By using the Edit and Inspect menus, entries can be edited, added, and removed.
Bags store an arbitrary number of objects of any kind. Unlike Arrays, there is no implied order or sequence to the elements (objects) inside the Bag. Elements are added to a Bag with the add: message. To test if an object is in a Bag, use the includes: message. For example, this expression reads a file and reports the frequency with which each letter occurs:
| input answer f c | input := File pathName: 'tutorial\chapter.7'. answer := WriteStream on: String new. f := Bag new. [input atEnd] whileFalse: [ (c := input next) isLetter ifTrue: [f add: c asLowerCase] ]. 0 to: 25 do: [:i | c := ($a asciiValue + i) asCharacter. answer cr; nextPut: c; space; nextPutAll: (f occurrencesOf: c) printString]. ^answer contents
A Set, like a Bag, stores arbitrary objects. The difference is that a Set does not store the same object more than once. For example, this expression computes the set of characters that occur in one file and not in another:
| set1 set2 | set1 := Set new. set2 := Set new. (File pathName: 'tutorial\chapter.7') do: [:c | set1 add: c]. (File pathName: 'tutorial\chapter.6') do: [:c | set2 add: c]. ^set1 reject: [ :c | set2 includes: c]
The message asSet creates a set out of the receiver collection object. This is a good way to eliminate duplicates from a Collection. For example, to compute the unique vowels in a string, evaluate the following:
'Now is the time' asSet select: [ :c | c isVowel ]
You've now seen the iterator messages select:, reject:, and collect: used with Strings, Arrays, Sets, and Bags. These messages can be used with all of the different kinds of Collections in Smalltalk/V. As such, they are excellent examples of generic code, code that is type and data independent. Smalltalk's ability to allow you to write generic code sets it apart from most other languages. Here is the code in class Collection for the select: message that is inherited by Bags, Sets, Dictionaries, Sorted Collections, Ordered Collections, and other Collection subclasses:
select: aBlock | answer | answer := self species new. self do: [:element | (aBlock value: element) ifTrue: [answer add: element] ]. ^answer
This method assumes nothing about the structure or type of the Collections with which it deals. It depends only on an object's behavior; the existence of the species, do:, and add: it sends to them. Smalltalk's polymorphism (discussed in Chapter 6) makes this possible.
By exploring the Collection classes using the Class Hierarchy Browser, you can see many more examples of the power of generic code.
The select: message above shows another interesting feature of Smalltalk: the use of blocks of code as objects. To illustrate this, look again at this invocation of the select: method:
'Now is the time' asSet select: [ :c | c isVowel ]
The receiver of the select: message is the set of all Characters in the String 'Now is the time'. The argument to the select: message is a block of code with one block argument, [:c | c isVowel]. This block of code is as much an object as the String 'Now is the time'. As such, we can use it as an argument for the select: method, which you saw previously. When the method is invoked, the block of code is assigned to the argument aBlock in the select: method.
A block of code executes when it is sent the message value, value:, or value:value:, depending on whether the block has zero, one, or two block arguments, respectively. Since it uses one argument, the select: message evaluates the block aBlock using the value: message.
As you now know, all messages return a result. The result of evaluating a block is the result of the last expression in the block. In the above example, the block [:c | c isVowel ] returns true or false, depending on whether or not the object passed to the block, c, is a vowel.
Block objects in turn let you build very powerful objects. For example, 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. For example, this expression computes the number of occurrences of a phrase in a file:
"Compute occurrences of a phrase in a file" | pattern count input word | count := 0. (pattern := Pattern new: #('now' 'is' 'the') ) matchBlock: [count := count + 1]. input := File pathName: 'tutorial\chapter.7'. [ (word := input nextWord) isNil ] whileFalse: [pattern match: word asLowerCase]. ^count
This example uses an Array of Strings as the Pattern. Any collection of objects can be used as the Pattern, as long as it can be indexed using the at: message.
The following example computes the frequency with which letter pairs occur in a file, and stores the result in the global variable, Pairs:
"Compute letter pair frequencies" | last pair | Pairs := Bag new. last := Space. (File pathName: 'tutorial\chapter.7') do: [ :c | (last isLetter and: [c isLetter] ) ifTrue: [ (pair := String new: 2) at: 1 put: last; at: 2 put: c. Pairs add: pair asLowerCase]. last := c]. Pairs elements inspect
The following expression, in turn, produces a report of the pair frequencies that occur more than 60 times in Pairs:
"Print letter pair frequencies greater than 60 in the Smalltalk/V (Transcript) window" | frequent | Transcript cr. frequent := Pairs asSet select: [ :pair | (Pairs occurrencesOf: pair > 60 ]. frequent asSortedCollection do: [:pair | Transcript nextPutAll: pair; tab; nextPutAll: (Pairs occurrencesOf: pair) printString; cr]
The message asSortedCollection creates a new kind of collection, a SortedCollection. SortedCollections are described in detail in Part 3 of this manual. Briefly, they are Collections in which all of the elements are stored in sorted order. As you can see from the above example, they are useful for sorting a collection of objects before outputting a report.
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.
Create a new class AnimalHabitat as a subclass of class Object, and assign to it five instance variables, animals, scriptString, script and browser. (Chapter 6 explains how to do this using the Class Hierarchy Browser.) When the new class is successfully created with the four instance variables, you should see the following class definition when it is selected in the Class Hierarchy Browser:
Object subclass: #AnimalHabitat instanceVariableNames: 'animals scriptString script browser' classVariableNames: ' ' poolDictionaries: ' '
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 evaluate the following expression to file in the methods for the AnimalHabitat:
(File pathName: 'tutorial\ habitat7.st') fileIn; close
Respond Yes to the prompt asking you if you want to create a global variable named Script during the process of filing in these new methods.
Click on the instance radio button to view the methods list. The new methods are:
add: anAnimal "Add anAnimal as an inhabitant of the receiver. Notify anAnimal of its new habitat." animals isNil ifTrue: [animals := Set new]. animals add: anAnimal. anAnimal habitat: self play "Play the Script to all of the animals" | word | Script reset animals do: [ :animal | animal reset ]. [Script atEnd] whileFalse: [ word := Script next asLowerCase. animals do: [ animal reactTo: word] ] script: aString "Change Script to the stream on the words in aString." | stream word | stream := ReadStream on: aString. Script := ReadWriteStream on: Array new. [(word := stream nextWord) isNil whileFalse: [ Script nextPut: word]
Now evaluate the following expression to create a global variable, Habitat, containing an instance of the AnimalHabitat class:
Habitat := AnimalHabitat new
To put animals inside of the habitat, you must first add some methods to the Animal class. Evaluate the following expression to add the required methods:
(File pathName:'tutorial:animal7.st') fileIn; close
The new methods in class are:
habitat: aHabitat "Change habitat to aHabitat" habitat := aHabitat learn: aString action: 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." | words pattern | knowledge isNil ifTrue: [knowledge := Dictionary new]. words := aString asLowerCase asArrayOfSubstrings. pattern := Pattern new: (Array with: name asLowerCase), words. pattern matchBlock: aBlock. knowledge at: words put: pattern reactTo: aWord "Send a word to every pattern in knowledge." knowledge isNil ifTrue: [^self]. knowledge do: [:pattern | pattern match: aWord] reset "Reset all patterns in knowledge" knowledge isNil ifTrue: [^self]. knowledge do: [:pattern | pattern reset]
First, let's add some animals to the habitat. The following expressions use the animals that were created in Chapter 6:
Habitat add: Snoopy; 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: 'barking' action: [Snoopy talk]; learn: 'quietly' action: [Snoopy beQuiet; talk]; learn: 'is upset' action: [Snoopy beNoisy; talk]. Pony learn: 'to be pleasant' action: [Polly vocabulary: 'Have a nice day'; talk]; learn: '* nasty' action: [Polly vocabulary: 'Why are you bothering me'; talk].
The asterisk (*) in '*nasty' stands for none or more arbitrary words. 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.
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 as a subclass of class Object, and define a single variable named connections. When you have created the class and the instance variable, the class specification in the Class Hierarchy Browser should be:
Object subclass: #Network instanceVariableNames: 'connections' classVariableNames: ' ' poolDictionaries: ' '
The instance variable connections will hold a Dictionary of connections between nodes. The key to the Dictionary 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 expression to file in the methods for class Network:
(File pathName: 'tutorial\network7.st') fileIn; close
The methods are:
connect: nodeA to: nodeB "Add a connection from nodeA to nodeB." (connections at: nodeA ifAbsent: [connections at: nodeA put: Set new] ) add: nodeB. (connections at: nodeB ifAbsent: [connections at: nodeB put: Set new] ) add: nodeA initialize "Initialize the connections to be empty." connections := Dictionary new pathFrom: nodeA to: nodeB avoiding: 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" | answer | nodeSet add: nodeA. (connections at: nodeA ifAbsent: [^nil] ) do: [ :node | node = nodeB ifTrue: [ ^Network new initialize connect: nodeA to: node]. (nodeSet includes: node) ifFalse: [ answer := self pathFrom: node to: nodeB avoiding: nodeSet. answer isNil ifFalse: [ ^answer connect: nodeA to: node] ] ]. ^nil printOn: aStream "print a description of the receiver on aStream." connections keys asSortedCollection do: [ :node | node printOn: aStream. (connections at: node) asSortedCollection do: [ :neighbor | aStream cr; nextPutAll: '>>'. neighbor print0n: aStream]. aStream cr]
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.
Before using the Network class, define the class NetworkNode as a subclass of class Object, with two instance variables, name and position. After you have created the class and its instance variables, the class specification should be:
Object subclass: #NetworkNode instanceVariableNames: 'name position' classVariableNames: ' ' poolDictionaries: 'WinConstants'
Then use the following expression to file in the methods for class NetworkNode:
(File pathName: 'tutorial\nodes7.st') fileIn; close
The methods are:
<= aNode "Answer true if the receiver name is less or equal to aNode name." ^name <= aNode name hash "Answer receiver's hash." ^name hash name "Answer receiver's name." ^name name: aString position: aPoint "Set the receiver's name and position." name := aString. position := aPoint printOn: aStream "Print a description of the receiver on aStream." aStream nextPutAll: 'Node(', name; space; nextPutAll: position printString; nextPut: $)
Now evaluate the following expression to create an empty Network object in the global variable Net:
Net := Network new initialize
Then evaluate these expressions, to create six nodes and connect them together into a network--you will have to answer Yes when asked to create a global variable for each of the nodes:
N1 := NetworkNode new name: 'one' position: 100 @ 100. N2 := NetworkNode new name: 'two' position: 150 @ 150. N3 := NetworkNode new name: 'three' position: 200 @ 120. N4 := NetworkNode new name: 'four' position: 50 @ 50. N5 := NetworkNode new name: 'five' position: 125 @ 220 N6 := NetworkNode new name: 'six' position: 260 @ 120. Net connect: N1 to: N2; connect: N2 to: N3; connect: N4 to: N5; connect: N5 to: N1; connect: N3 to: N6; connect: N3 to: N5; connect: N3 to: N1
You can ask the network to print itself by evaluating the following expression using Show It from the Smalltalk menu:
Net
Now evaluate the following expression and show the results, to find a path from N1 to N5:
Net pathFrom: N1 to: N5 avoiding: Set new
To see if there is a path that does not go through N3, evaluate the following expression:
Net pathFrom: N1 to: N5 avoiding: (Set with: N3)
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, or by referring to a detailed description in Part 3 of this manual.
If you exit the environment before beginning the next tutorial, be sure to save the image.