Prettier correlation

packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st

@@ -2,39 +2,48 @@ Class {
 	#name : #SBCorrelationCluster,
 	#superclass : #SBCluster,
 	#instVars : [
-		'multiverse',
 		'displayedExample',
 		'displayedWatch',
-		'opponentPermutations',
-		'basePermutation'
+		'baseUniverse',
+		'basePermutation',
+		'correlatingUniverses'
 	],
 	#category : #'Sandblocks-Babylonian'
 }
 
 { #category : #'instance creation' }
-SBCorrelationCluster class >> newForSize: aSBMorphResizer multiverse: aMultiverse example: anExample watch: aWatch basePermutation: base opponentPermutations: opponent [
+SBCorrelationCluster class >> newForSize: aSBMorphResizer example: anExample watch: aWatch basePermutation: aPermutation correlating: aCollectionOfUniverses [
 
 	^ self new 
 		morphResizer: aSBMorphResizer;
-		multiverse: aMultiverse;
 		displayedExample: anExample;
 		displayedWatch: aWatch;
-		basePermutation: base;
-		opponentPermutations: opponent;
+		basePermutation: aPermutation;
+		correlatingUniverses: aCollectionOfUniverses;
 		visualize;
 		yourself 
 ]
 
 { #category : #accessing }
 SBCorrelationCluster >> basePermutation [
-
 	^ basePermutation
 ]
 
 { #category : #accessing }
-SBCorrelationCluster >> basePermutation: aSBPermutation [
+SBCorrelationCluster >> basePermutation: anObject [
+	basePermutation := anObject
+]
 
-	basePermutation := aSBPermutation
+{ #category : #accessing }
+SBCorrelationCluster >> baseUniverse [
+
+	^ baseUniverse
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> baseUniverse: aUniverse [
+
+	baseUniverse := aUniverse
 ]
 
 { #category : #building }
@@ -44,10 +53,10 @@ SBCorrelationCluster >> buildDisplayMatrix [
 
 	matrix := Matrix 
 		rows: 2
-		columns: self opponentPermutations size + 1.
+		columns: self correlatingUniverses size + 1.
 
 	matrix atRow: 1 put: ({TextMorph new contents: self basePermutation asVariantString}, 
-	(self extractedTopHeadingsFrom: self opponentPermutations)).
+	(self extractedTopHeadingsFrom: self correlatingUniverses)).
 
 	matrix at: 2 at: 1 put: (SBPermutationLabel newDisplaying: self basePermutation).
 
@@ -56,6 +65,18 @@ SBCorrelationCluster >> buildDisplayMatrix [
 	^ matrix
 ]
 
+{ #category : #accessing }
+SBCorrelationCluster >> correlatingUniverses [
+
+	^ correlatingUniverses
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> correlatingUniverses: aCollectionOfUniverses [
+
+	correlatingUniverses := aCollectionOfUniverses
+]
+
 { #category : #accessing }
 SBCorrelationCluster >> displayedExample [
 
@@ -83,49 +104,37 @@ SBCorrelationCluster >> displayedWatch: anSBExampleWatch [
 { #category : #building }
 SBCorrelationCluster >> extractRow [
 
-	^ self multiverse universes 
-		select: [:aUniverse | (aUniverse activePermutation contains: self basePermutation)]
-		thenCollect: [:aUniverse | | display | 
+	^ self correlatingUniverses 
+		collect: [:aUniverse | | display | 
 		display := ((aUniverse watches detect: [:aWatch | aWatch originalIdentifier = self displayedWatch identifier]) 
 					exampleToDisplay at: self displayedExample) value display.
 		self compressedMorphsForDisplay: display]
 ]
 
 { #category : #building }
-SBCorrelationCluster >> extractedLeftHeadingsFrom: aCollectionOfPermutations [
+SBCorrelationCluster >> extractedTopHeadingsFrom: aCollectionOfCorrelatingUniverses [
 
-	^ aCollectionOfPermutations collect: [:aPermutation | SBPermutationLabel newDisplaying: aPermutation]
+	^ aCollectionOfCorrelatingUniverses collect: [:aCorrelatingUniverse |  
+		SBPartialPermutationLabel 
+			newDisplaying: (aCorrelatingUniverse activePermutation copyRemovingVariants: self basePermutation referencedVariants)
+			referingTo: aCorrelatingUniverse]
 ]
 
-{ #category : #building }
-SBCorrelationCluster >> extractedTopHeadingsFrom: aCollectionOfPermutations [
-
-	^ aCollectionOfPermutations collect: [:aPermutation | 
-		aPermutation isNilPermutation 
-			ifTrue: [StringMorph new contents: ' / '] 
-			ifFalse: [SBPermutationLabel newDisplaying: aPermutation]]
-]
-
-{ #category : #accessing }
-SBCorrelationCluster >> multiverse [
-
-	^ multiverse
-]
-
-{ #category : #accessing }
-SBCorrelationCluster >> multiverse: aSBMultiverse [
-
-	multiverse := aSBMultiverse
-]
-
-{ #category : #accessing }
-SBCorrelationCluster >> opponentPermutations [
-
-	^ opponentPermutations
-]
-
-{ #category : #accessing }
-SBCorrelationCluster >> opponentPermutations: aCollectionOfSBPermutations [
-
-	opponentPermutations := aCollectionOfSBPermutations
+{ #category : #visualisation }
+SBCorrelationCluster >> newTopRowFrom: aCollectionOfPermutationLabels [
+
+	"Width should be set, but height can vary"
+	^ self newContainerMorph 
+		listDirection: #leftToRight;
+		listCentering: #bottomRight;
+		cellPositioning: #topCenter;
+		hResizing: #spaceFill;
+		addAllMorphsBack: (aCollectionOfPermutationLabels collect: [:aLabel | 
+			self newContainerMorph 
+				addAllMorphsBack: {
+					(self 
+						wrapInCell: aLabel 
+						flexVertically: true 
+						flexHorizontally: false)  borderWidth: 0.
+					SBButton newApplyPermutationFor: (aLabel universe activePermutation).}])
 ]

packages/Sandblocks-Babylonian/SBCorrelationView.class.st

@@ -2,34 +2,23 @@ Class {
 	#name : #SBCorrelationView,
 	#superclass : #SBResizableResultsView,
 	#instVars : [
-		'basePermutations'
+		'variantSelection',
+		'selectedVariants',
+		'basePermutations',
+		'groupedUniverses'
 	],
 	#category : #'Sandblocks-Babylonian'
 }
 
-{ #category : #accessing }
-SBCorrelationView >> basePermutations [
-	^ basePermutations
-]
-
-{ #category : #accessing }
-SBCorrelationView >> basePermutations: anObject [
-	basePermutations := anObject
-]
-
 { #category : #building }
 SBCorrelationView >> buildAllPossibleResults [
 
-	| base thisVariant |
 	self multiverse activeExamples 
 		ifEmpty: [gridContainer addMorph: (TextMorph new contents: 'No examples active').
 				  gridContainer width: gridContainer firstSubmorph width + 5 "a bit of margin"].
 
-	thisVariant := self multiverse universes first activePermutation referencedVariants third.
-	base := SBPermutation new referencedVariants: (self multiverse universes first activePermutation referencedVariants select: [:var | var = thisVariant]).
-	self multiverse universes first activePermutation associationsDo: [:idToNum | idToNum key = thisVariant id ifTrue: [base add: idToNum]].
-	self halt.
-	self basePermutations: {base}.
+	groupedUniverses := self groupUniversesContainingAllVariantsIn: selectedVariants.
+	basePermutations := self collectAllPermutationsOfSelectedVariants asOrderedCollection.
 
 	self multiverse activeExamples do: [:anExample |
 		self multiverse watches do: [:aWatch | 
@@ -51,42 +40,142 @@ SBCorrelationView >> buildForExample: anExample watching: aWatch [
 
 { #category : #building }
 SBCorrelationView >> buildGridsFor: anExample watching: aWatch [
-
-	^ (self basePermutations collect: [:aBasePermutation | | split |
-		split := self getAllUniversesContainingPermutation: aBasePermutation.
-		{SBCorrelationCluster 
+
+	^ (basePermutations collect: [:aBasePermutation |
+		SBCorrelationCluster 
 			newForSize: self selectedResizer 
-			multiverse: self multiverse 
 			example: anExample 
 			watch: aWatch 
-			basePermutation: aBasePermutation 
-			opponentPermutations: split first },
-		(split second collect: [:nonContainingPermutation | 
-			SBCorrelationCluster 
-				newForSize: self selectedResizer 
-				multiverse: self multiverse 
-				example: anExample 
-				watch: aWatch 
-				basePermutation: nonContainingPermutation 
-				opponentPermutations: {SBNilPermutation new referencedVariants: {}}])	
-		]) flatten
+			basePermutation: aBasePermutation
+			correlating: (self getUniversesContainingPermutation: aBasePermutation)]),
+		 (groupedUniverses second collect: [:aNonCorrelatingUniverse | 
+				SBCorrelationCluster 
+					newForSize: self selectedResizer 
+					example: anExample 
+					watch: aWatch 
+					basePermutation: aNonCorrelatingUniverse activePermutation 
+					correlating: {aNonCorrelatingUniverse}]) 
+]
+
+{ #category : #building }
+SBCorrelationView >> buildSelectionRow [
+
+	| container selectedString |
+	container := self containerRow.
+	self ensureVariantSelectionIn: container.
+	selectedString := 'Selected: '.
+	selectedVariants 
+		ifEmpty: [ selectedString := selectedString, 'None' ]
+		ifNotEmpty: [ selectedString := selectedString, ((selectedVariants collect: #name) fold: [:a :b | a, ', ', Character cr, b ])]. 
+	container addMorphBack: selectedString asMorph.
+	self block addMorph: container.
 
 ]
 
 { #category : #building }
-SBCorrelationView >> getAllUniversesContainingPermutation: aPermutation [
+SBCorrelationView >> buildVariantSelection [
+
+	| options topLevelVariant |
+	options := self multiverse variants.
+	topLevelVariant := options detect: [:aVariant | aVariant parentVariant isNil] ifNone: [options first].
 
-	| containsBase rest |
-	containsBase := OrderedCollection new.
-	rest := OrderedCollection new.
+	^ SBComboBox new
+		prefix: 'Add or Remove';
+		labels: (options collect: #name);
+		values: options;
+		object: topLevelVariant;
+		when: #selectionChanged send: #changeVariants to: self;
+		displayPrefixOnly 
+]
+
+{ #category : #accessing }
+SBCorrelationView >> buttons [
+
+	^ {}
+]
+
+{ #category : #building }
+SBCorrelationView >> changeVariants [
+
+	(selectedVariants includes: variantSelection object)
+		ifTrue: [selectedVariants remove: variantSelection object] 
+		ifFalse: [selectedVariants add: variantSelection object].
+
+	self visualize
+]
+
+{ #category : #building }
+SBCorrelationView >> collectAllPermutationsOfSelectedVariants [
 
-	 self multiverse universes do: [:aUniverse | 
-		((aUniverse activePermutation contains: aPermutation))
-			ifTrue: [containsBase add: (aUniverse activePermutation copyRemoving: {aPermutation}) ]
-			ifFalse: [rest add: aUniverse activePermutation]].
+	| allPermutations |
+	selectedVariants ifEmpty: [^ {SBNilPermutation new referencedVariants: {}} asSet].
+	allPermutations := Set new.
+	groupedUniverses first do: [:aUniverseContainingSelected | | base |
+		base := SBPermutation new referencedVariants: selectedVariants.
+		selectedVariants do: [:aVariant | base at: aVariant id put: (aUniverseContainingSelected activePermutation at: aVariant id)].
+		allPermutations add: base].
+	^ allPermutations
+]
+
+{ #category : #building }
+SBCorrelationView >> ensureVariantSelection [ 
+
+	self multiverse variants ifEmpty: [selectedVariants := OrderedCollection new. ^ self].
+	variantSelection := self buildVariantSelection.
+	self block addMorph: variantSelection.
+
+	selectedVariants 
+		ifNil: [selectedVariants := {variantSelection object} asOrderedCollection]
+		ifNotNil: [selectedVariants := selectedVariants select: [:aVariant | self multiverse variants includes: aVariant]].
+
+]
+
+{ #category : #building }
+SBCorrelationView >> ensureVariantSelectionIn: aMorph [
+
+	self multiverse variants ifEmpty: [selectedVariants := OrderedCollection new. ^ self].
+	variantSelection := self buildVariantSelection.
+	aMorph addMorph: variantSelection.
+
+	selectedVariants 
+		ifNil: [selectedVariants := {variantSelection object} asOrderedCollection]
+		ifNotNil: [selectedVariants := selectedVariants select: [:aVariant | self multiverse variants includes: aVariant]].
+
+]
+
+{ #category : #building }
+SBCorrelationView >> getUniversesContainingPermutation: aPermutation [
+
+	^ groupedUniverses first select: [:aUniverse | 
+		aUniverse activePermutation contains: aPermutation]
+]
+
+{ #category : #building }
+SBCorrelationView >> groupUniversesContainingAllVariantsIn: aCollectionOfVariants [
+
+	| contains omits |
+	contains := OrderedCollection new.
+	omits := OrderedCollection new.
+	self multiverse universes do: [:aUniverse | 
+		(aCollectionOfVariants allSatisfy: [:aVariant | aUniverse activePermutation referencedVariants includes: aVariant])
+			ifTrue: [contains add: aUniverse] 
+			ifFalse: [omits add: aUniverse]].
+
+	^ {contains. omits.}
+]
+
+{ #category : #building }
+SBCorrelationView >> groupUniversesContainingPermutation: aPermutation [
+
+	| contains omits |
+	contains := OrderedCollection new.
+	omits := OrderedCollection new.
+	groupedUniverses first do: [:aUniverse | 
+		(aUniverse activePermutation contains: aPermutation)
+			ifTrue: [contains add: aUniverse] 
+			ifFalse: [omits add: aUniverse]].
 
-	^ {containsBase reject: [:aContainingPermutation | aContainingPermutation = aPermutation].
-		rest ifEmpty: [{SBNilPermutation new referencedVariants: {}}]}
+	^ {contains. omits.}
 ]
 
 { #category : #initialization }
@@ -97,3 +186,17 @@ SBCorrelationView >> initialize [
 	self name: 'Correlation'.
 
 ]
+
+{ #category : #actions }
+SBCorrelationView >> visualize [ 
+
+	self clean.
+
+	self buildSelectionRow.
+	self block addMorph: dimensionOptions.
+
+	self buildButtonRow.
+
+	self buildAllPossibleResults .
+	self concludeContainerWidth.
+]