Arquivo do mês: abril 2012

Recursive Polymorphic List


Polimorfismo em listas geralmente é aplicado aos elementos de uma lista. Neste post mostramos duas alternativas para a implementação, usando polimorfismo, de uma lista ligada, mas o polimorfismo será aplicado à estrutura da lista. Duas funcionalidades serão abordadas: a impressão do conteúdo da lista e a adição de um elemento no final da lista. (Veja no final do post os file outs).

Na primeira implementação a adição de um elemento no final da lista envolve a passagem de um parâmetro extra para permitir a manipulação das referências na inserção do elemento.

No nosso exemplo inserimos 3 elementos para depois imprimí-los a partir da lista. Os métodos #add: e #print são implementados nas várias classes respeitando a Lei de Demeter. A técnica usada também é chamada de “waving” (Introducing Demeter and its Laws).

O método #print é trivial. As classes colaboram respondendo à mensagem #print polimorficamente.

Client>>#print

NonEmpty>>#print

Empty>>#print

Element>>#print

O método #add:to: também é implementado com a técnica de “waving”.

Client>>#add:to:

NonEmpty>>#add:to:

Empty>>#add:to:

Com a necessidade de passar um parâmetro adicional e de “acertar os ponteiros” o código se tornou pouco elegante. Para “become” o código mais elegante nada melhor que o método #become, jóia unicamente encontrada em Smalltalk (The Miracle of become:).

ProtoObject>>#become:

O código abaixo ilustra o efeito de #become.

Usando #become o código fica mais elegante como pode ser observado abaixo:

Client>>#add:

NonEmpty>>#add:

Empty>>#add:

O gráfico abaixo mostra como as referências foram afetadas pelo #become.

Digite Client example3 no Workspace e DoIt para ver o gráfico no Mondrian. O menu popup permite explorar cada nó.

Para carregar o Mondrian no Pharo use o script abaixo:

Veja Painting models with Mondrian no MOOSE Book.

Mondrian também pode ser usado para desenhar diagramas UML como abaixo:

A versão anterior do método #add apesar de algum grau de elegância obtido é mais “error prone” do que uma solução no estilo funcional, onde a correção do código é mais evidente. A solução funcional evita a manipulação direta de referências (ponteiros). A seguir será delineada uma implementação mais elegante obtida usando um estilo copiado das linguagens funcionais. Seja (x | y) uma representação da lista onde x corresponde ao primeiro elemento (first) da lista e y o resto da lista (rest). Podemos definir uma função append para adicionar um elemento a o final da lista da seguinte forma:


append x (y | z) = (y | append x z)
append x nil = (x | nil)

Convertendo para Smalltalk temos:

NonEmpty>>append: aElement

Empty>>append: aElement

Concatenação de listas pode ser implementada de forma similar:


concat (x | y) z = (x | concat y z)
concat x nil = x

Em Smalltalk:

NonEmpty>>concat: aNonEmpty

Empty>>concat: aNonEmpty

Inversão da ordem da lista pode ser implementada usando append ou concat.

Usando append:


reverse (x | y) = (reverse y) append x
reverse nil = nil

Em Smalltalk:

NonEmpty>>reverse

Empty>>reverse

Ou usando concat:


reverse (x | y) = concat (reverse y) (x | nil)
reverse nil = nil

Em Smalltalk:

NonEmpty>>reverse

Empty>>reverse

Abaixo seguem os file outs prometidos no início do post:

RecursivePolymorphicList-Core

Object subclass: #List
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RecursivePolymorphicList-Core'!

!List methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 17:22'!
add: aElement
	self subclassResponsibility! !

!List methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:45'!
add: aElement to: predecessor
	self subclassResponsibility! !

!List methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/28/2012 20:06'!
drawOn: aStandardWindow
	self subclassResponsibility .! !

!List methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 12:53'!
print
	self subclassResponsibility! !

List subclass: #Empty
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RecursivePolymorphicList-Core'!

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:35'!
add: aElement
	| nonEmpty |
	nonEmpty := NonEmpty new first: aElement.
	nonEmpty rest: nonEmpty.
	self become: nonEmpty.
	^ aElement! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 22:24'!
add: aElement to: last
	| empty new|
	.empty := self.
	new := NonEmpty first: aElement rest: empty.
	last = empty ifTrue: [^ new].
	last rest: new.
	^ last! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 14:13'!
addNodesTo: aNodeList
	aNodeList add: self! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 20:09'!
addNodesTo: aNodeList andElementsTo: aElementList
	aNodeList add: self! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/2/2012 21:44'!
append: aElement
	^ NonEmpty first: aElement rest: self.
	! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/2/2012 21:26'!
concat: aNonEmpty
	^ aNonEmpty ! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:07'!
do: aBlockClosure
	"empty"! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 12:57'!
print
	"empty"! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/2/2012 21:57'!
printOn: aStream
	aStream nextPutAll: '{}'! !

!Empty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/2/2012 21:24'!
reverse
	^ self! !

List subclass: #NonEmpty
	instanceVariableNames: 'first rest'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RecursivePolymorphicList-Core'!

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 17:23'!
add: aElement
	^ rest add: aElement ! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 22:25'!
add: aElement to: last
	rest add: aElement to: self.
	^ last! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 19:47'!
addNodesTo: nodeList
	nodeList add: self.
	nodeList add: first.
	rest addNodesTo: nodeList ! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 20:07'!
addNodesTo: nodeList andElementsTo: elementList
	nodeList add: self.
	elementList add: first.
	rest addNodesTo: nodeList andElementsTo: elementList! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/3/2012 20:54'!
append: aElement
	 ^ NonEmpty first: first rest: (rest append: aElement)! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:54'!
collect: aBlockClosure
	| list |
	list := Empty new.
	self do: [:each | list add: (aBlockClosure value: each)].
	^ list! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/2/2012 21:31'!
concat: aNonEmpty
	^ NonEmpty first: first rest: (rest concat: aNonEmpty)! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:13'!
detect: aBlockClosure
	^ self detect: aBlockClosure ifNone: [self errorNotFound: aBlockClosure]! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:15'!
detect: aBlockClosure ifNone: exceptionBlock
	self do: [:each | (aBlockClosure value: each) ifTrue: [^ each]].
	^ exceptionBlock value! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:06'!
do: aBlockClosure
	aBlockClosure value: first.
	rest do: aBlockClosure ! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/28/2012 20:08'!
drawOn: aWindow
	first drawOn: aWindow.
	rest drawOn: aWindow! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:17'!
errorNotFound: anObject
	"Raise a NotFound exception."

	NotFound signalFor: anObject! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 17:23'!
first: aElement
	first := aElement! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 12:57'!
print
	first print.
	rest print! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:59'!
printOn: aStream
	aStream nextPut: ${.
	first printOn: aStream.
	rest printOn: aStream.
	aStream nextPut: $}! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 17:24'!
rest: aList
	rest := aList! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/3/2012 21:06'!
reverse
"	^ rest reverse concat: (NonEmpty first: first rest: Empty new) "
	^ rest reverse append: first! !

!NonEmpty methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:06'!
select: aBlockClosure
	| list |
	list := Empty new.
	self do: [:each | (aBlockClosure value: each) ifTrue: [list add: each]].
	^list! !

!NonEmpty methodsFor: 'accessing' stamp: 'FranciscoAryMartins 4/29/2012 19:43'!
first
	^ first! !

!NonEmpty methodsFor: 'accessing' stamp: 'FranciscoAryMartins 4/29/2012 14:23'!
rest
	^ rest! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

NonEmpty class
	instanceVariableNames: ''!

!NonEmpty class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 13:26'!
first: aElement rest: aList
	^ self new
		first: aElement;
		rest: aList! !

RecursivePolymorphicList-Example

Object subclass: #Client
	instanceVariableNames: 'list window view'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RecursivePolymorphicList-Examples'!

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/28/2012 10:00'!
add2: aElement
	^ self add: aElement to: list! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:20'!
add: aElement
	^ list add: aElement ! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/28/2012 10:00'!
add: aElement to: predecessor
	^ list := list add: aElement to: predecessor! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:31'!
collect: aBlockClosure
	^ list collect: aBlockClosure ! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:12'!
detect: aBlockClosure
	^ list detect: aBlockClosure ! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:05'!
do: aBlockClosure
	list do: aBlockClosure ! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 13:34'!
draw
	self drawOn: view.
	view open! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 20:01'!
draw: nodeList on: aView
	aView nodes: nodeList.
	view shape arrowedLine.
	aView edgesToAll: [:node| (node isKindOf: NonEmpty) ifTrue: [{node first. node rest.}]]! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 21:48'!
drawNodes: nodeList andElements: anElementList on: aView
	view shape ellipse
		width: [ :each | 30 ];
		height: [ :each | 30 ].
	view interaction action: #explore.
	aView nodes: nodeList.
	view shape rectangle
		width: [ :each | 20 ];
		height: [ :each | 20 ].
	view interaction action: #explore.
	aView nodes: anElementList.
	view shape arrowedLine.
	aView edgesToAll: [:node| (node isKindOf: NonEmpty) ifTrue: [{node first. node rest.}]]! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 20:10'!
drawOn: aView
	| nodes elements |
	nodes := OrderedCollection new.
	elements := OrderedCollection new.
	list addNodesTo: nodes andElementsTo: elements.
	self drawNodes: nodes andElements: elements on: view.! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 21:45'!
initialize
	list := Empty new.
	view := MOViewRenderer new.
	view horizontalTreeLayout! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:31'!
print
	Transcript show: ' {'.
	list print.
	Transcript show: '} '.! !

!Client methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:04'!
select: aBlockClosure
	^ list select: aBlockClosure ! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Client class
	instanceVariableNames: ''!

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:30'!
example
	| client |
	client := Client new.
	client
		add: (Element value: 1);
		add: (Element value: 2);
		add: (Element value: 3).
	client print! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/3/2012 21:03'!
example10
	"reverse (x | y) = append x (reverse y)"
	| list |
	list := Empty new.
	1 to: 6 do: [ 😡 |
		list := list append: x
	].
	^ list reverse       ! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 20:36'!
example2
	| client |
	client := Client new.
	client
		add2: (Element value: 1);
		add2: (Element value: 2);
		add2: (Element value: 3).
	client print! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 22:33'!
example3
	| client |
	client := Client new.
	(1 to: 10) do: [:n| client add: (Element value: n)].
	client draw! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:21'!
example4
	| client |
	client := Client new.
	(1 to: 10) do: [:n| client add: (Element value: n)].
	Transcript cr; show: '{'.
	client do: [ 😡 | Transcript show: ' ', x printString].
	Transcript show: ' }'! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:40'!
example5
	| client |
	client := Client new.
	(1 to: 10) do: [:n| client add: (Element value: n)].
	Transcript show: (client collect: [ :elem | elem value * elem value]) printString.
	! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:07'!
example6
	| client |
	client := Client new.
	(1 to: 10) do: [:n| client add: (Element value: n)].
	Transcript show: (client select: [ :elem | elem value > 5]) printString.
	! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 19:18'!
example7
	| client |
	client := Client new.
	(1 to: 10) do: [:n| client add: (Element value: n)].
	Transcript show: (client detect: [ :elem | elem value > 5]) printString.
	! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/3/2012 20:52'!
example8
	"append x (y | z) = (y | append x z)"
	| list |
	list := Empty new.
	1 to: 3 do: [ 😡 |
		list := list append: x
	].
	^ list       ! !

!Client class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 5/3/2012 21:00'!
example9
	"concat (x | y) z = (x | concat y z)"
	| list list2 |
	list := Empty new.
	1 to: 3 do: [ 😡 |
		list := list append: x
	].
	list2 := Empty new.
	4 to: 6 do: [ 😡 |
		list2 := list2 append: x
	].
	^ list concat: list2       ! !

Object subclass: #Element
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RecursivePolymorphicList-Examples'!

!Element methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/29/2012 13:29'!
drawOn: aRendererView
	 aRendererView addNode: self
	! !

!Element methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:19'!
print
	Transcript show: self printString! !

!Element methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:12'!
printOn: aStream
	aStream nextPut: $[.
	aStream nextPutAll: (value asString).
	aStream nextPut: $]! !

!Element methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/30/2012 18:46'!
value
	^ value! !

!Element methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 13:57'!
value: anObject
	value := anObject
	! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Element class
	instanceVariableNames: ''!

!Element class methodsFor: 'as yet unclassified' stamp: 'FranciscoAryMartins 4/27/2012 13:58'!
value: aSmallInteger
	^ self new value: aSmallInteger ! !