VL-Repartitions2

VLGroupIndividu

Object subclass: #VLGroupIndividu
	instanceVariableNames: 'individus locaux '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VL-Repartitions2'
[initialization]
initialize
	
individus := IdentitySet new.
	locaux := OrderedCollection new
[individus]
ajoute: unIndividu
	
"pose les questions"
	| reponse |
	individus do: [:qqun |
		reponse := Dialog request: 'Est ce que ', unIndividu nom, ' aime ', qqun nom, ' ?'
			initialAnswer: 'oui / non / bof'.
		reponse = 'oui' ifTrue: [ unIndividu aime: qqun ].
		reponse = 'non' ifTrue: [ unIndividu nAimePas: qqun ] ].
	individus do: [:qqun |
		reponse := Dialog request: 'Est ce que ', qqun nom, ' aime ', unIndividu nom, ' ?'
			initialAnswer: 'oui / non / bof'.
		reponse = 'oui' ifTrue: [ qqun aime: unIndividu ].
		reponse = 'non' ifTrue: [ qqun nAimePas: unIndividu ] ].
	individus add: unIndividu.
	unIndividu groupe: self
satisfaction
	
"globale au groupe"
	| s |
	s := 0.
	individus do: [:each |
		individus do: [:unAutre |
			s := s + (each amitie: unAutre) ]].
	^ s
[accessing]
ajouteLocalNomme: unNom
	
| unLocal |
	locaux isEmpty ifTrue: [
		locaux add: (unLocal := VLLocal nom: unNom).
		individus do: [:each | unLocal ajoute: each ] ]
	ifFalse: [ locaux add: (unLocal := VLLocal nom: unNom) ]
individus
	
^ individus
locaux
	
^locaux
vadrouille
	
individus do: [:each | each vadrouille ]
VLGroupIndividu class
	instanceVariableNames: ''
[instance creation]
new
	
^super new initialize
[examples]
exemple03
	
| g |
	g := self new.
	g ajoute: (VLIndividu nom: 'Xavier').
	g ajoute: (VLIndividu nom: 'Yannis').
	g ajoute: (VLIndividu nom: 'Toto').
	^ g
exemple04
	
| g |
	g := self new.
	g ajoute: (VLIndividu nom: 'Xavier').
	g ajoute: (VLIndividu nom: 'Yannis').
	g ajoute: (VLIndividu nom: 'Toto').
	g ajouteLocalNomme: 'le salon'.
	g ajouteLocalNomme: 'la cuisine'.
	g inspect
exemple05
		
"VLHtmlReport on: 'repartition2.html' categorie: self category"

VLIndividu

Object subclass: #VLIndividu
	instanceVariableNames: 'nom amities groupe local '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VL-Repartitions2'
[printing]
printOn: aStream
	
aStream nextPutAll: '(individu ', nom, (local notNil ifTrue: [
		' dans ', local nom ] ifFalse: [ '' ] ),  ')'
[initialization]
nom: unNom amities: unDictionnaire
	
nom := unNom.
	amities := unDictionnaire
[amities]
aime: unIndividu
	
amities at: unIndividu put: 1
amitie: unIndividu
	
^amities at: unIndividu ifAbsent: [ 0 ]
nAimePas: unIndividu
	
amities at: unIndividu put: -1
[accessing]
groupe: unGroupe
	
groupe := unGroupe
local: unLocal
	
local := unLocal
nom
	
^nom
satisfactionParRapportA: unGroupeOuUnLocal
	
^ unGroupeOuUnLocal individus inject: 0 into: [:s :y |
		s + (self amitie: y) ]
vaDans: unLocal
	
local retire: self.
	unLocal ajoute: self.
vadrouille
	
"change de piece pour ameliorer sa satisfaction"
	| s unMeilleurEndroit |
	s := self satisfactionParRapportA: local.
	unMeilleurEndroit := groupe locaux detect: [:unLocal |
		(self satisfactionParRapportA: unLocal) > s ]
	ifNone: [ "pas de meilleur endroit que local " nil ].
	unMeilleurEndroit notNil ifTrue: [ self vaDans: unMeilleurEndroit ]
VLIndividu class
	instanceVariableNames: ''
[instance creation]
nom: unNom
	
^self new nom: unNom amities: (IdentityDictionary new)
[examples]
exemple01
	
| x y |
	x := VLIndividu nom: 'Xavier'.
	y := VLIndividu nom: 'Yannis'.
	^Array with: x with: y
exemple02
	
| x y |
	x := VLIndividu nom: 'Xavier'.
	y := VLIndividu nom: 'Yannis'.
	x aime: y.
	y nAimePas: x.
	^Array with: x with: y

VLLocal

VLGroupIndividu subclass: #VLLocal
	instanceVariableNames: 'nom '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VL-Repartitions2'
[accessing]
nom
	
^nom
nom: unNom
	
nom := unNom
[individus]
ajoute: unIndividu
	
"sans poser de questions"
	individus add: unIndividu.
	unIndividu local: self
retire: unIndividu
	
"sans poser de questions"
	individus remove: unIndividu.
	unIndividu local: nil
[printing]
printOn: aStream
	
aStream nextPutAll: '(local ', nom, ' ', (individus printString),  ')'
VLLocal class
	instanceVariableNames: ''
[instance creation]
nom: unNom
	
^self new nom: unNom