'From Squeak3.9 of 7 November 2006 [latest update: #7067] on 23 December 2006 at 11:35:55 pm'!

!SequenceableCollection methodsFor: 'converting' stamp: 'sumim 12/23/2006 23:35'!
flatten

	| array |
	array _ Array streamContents: [:ss |
		self do: [:each |
			(each isKindOf: self species)
				ifTrue: [ss nextPutAll: each flatten]
				ifFalse: [ss nextPut: each]]].
	^ array as: self species

"#(1 (2 3) (4 (5 6))) flatten"
! !

!SequenceableCollection methodsFor: 'converting' stamp: 'sumim 12/23/2006 23:35'!
generateGiftExchangePattern

	self generateGiftExchangePatternsDo: [:result | ^ result].
	^ self error: 'There is no pattern for such groups.'

"#((a1 a2) (b) (c) (d)) generateGiftExchangePattern"
! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sumim 12/23/2006 23:05'!
generateGiftExchangePatternsDo: aBlock

	| groups table |

	groups := self collect: [:group | group asOrderedCollection].
	groups := groups asOrderedCollection.
	
	table := groups flatten shuffled inject: #() into: [:tbl :mbr |
		tbl, {mbr. groups reject: [:group | group includes: mbr]}].
   
	table selectGiftTakersRestOf: #() thenDo: aBlock

"	World findATranscript: nil.
	#((a1 a2) (b) (c) (d)) generateGiftExchangePatternsDo: [:result |
		Transcript cr; show: result. false]
"
! !

!SequenceableCollection methodsFor: 'private' stamp: 'sumim 12/23/2006 23:04'!
selectGiftTakersRestOf: resultArray thenDo: aBlock

	| giver takerGroups takers allButFirstPair modifiedGroups taker shouldFail newResult |
   
	self size < 2 ifTrue: [^ aBlock value: resultArray sort].
	giver := self first.
	takerGroups := self second.
	takers := takerGroups flatten.
	allButFirstPair := self allButFirst: 2.
	modifiedGroups := OrderedCollection new.

	[takers notEmpty] whileTrue: [
		taker := takers remove: takers atRandom.
		takerGroups do: [:group |
			(group includes: taker) ifTrue: [
				modifiedGroups add: group.
				group remove: taker]].
		shouldFail := false.
		allButFirstPair pairsDo: [:memb :cands |
			cands flatten isEmpty ifTrue: [shouldFail := true]].
		(shouldFail not and: [
				newResult := resultArray copyWith: giver -> taker.
				allButFirstPair selectGiftTakersRestOf: newResult thenDo: aBlock])
			ifFalse: [
				modifiedGroups do: [:group | group add: taker].
				modifiedGroups := OrderedCollection new]].
	^ false
! !