hacky correlation

packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st

@@ -0,0 +1,131 @@
+Class {
+	#name : #SBCorrelationCluster,
+	#superclass : #SBCluster,
+	#instVars : [
+		'multiverse',
+		'displayedExample',
+		'displayedWatch',
+		'opponentPermutations',
+		'basePermutation'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'instance creation' }
+SBCorrelationCluster class >> newForSize: aSBMorphResizer multiverse: aMultiverse example: anExample watch: aWatch basePermutation: base opponentPermutations: opponent [
+
+	^ self new 
+		morphResizer: aSBMorphResizer;
+		multiverse: aMultiverse;
+		displayedExample: anExample;
+		displayedWatch: aWatch;
+		basePermutation: base;
+		opponentPermutations: opponent;
+		visualize;
+		yourself 
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> basePermutation [
+
+	^ basePermutation
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> basePermutation: aSBPermutation [
+
+	basePermutation := aSBPermutation
+]
+
+{ #category : #building }
+SBCorrelationCluster >> buildDisplayMatrix [
+
+	| matrix |
+
+	matrix := Matrix 
+		rows: 2
+		columns: self opponentPermutations size + 1.
+
+	matrix atRow: 1 put: ({TextMorph new contents: self basePermutation asVariantString}, 
+	(self extractedTopHeadingsFrom: self opponentPermutations)).
+
+	matrix at: 2 at: 1 put: (SBPermutationLabel newDisplaying: self basePermutation).
+
+	self extractRow withIndexDo: [:aCellMorph :column | matrix at: 2 at: column+1 put: aCellMorph].
+
+	^ matrix
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedExample [
+
+	^ displayedExample
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedExample: aSBExample [
+
+	displayedExample := aSBExample
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedWatch [
+
+	^ displayedWatch
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedWatch: anSBExampleWatch [
+
+	displayedWatch := anSBExampleWatch
+]
+
+{ #category : #building }
+SBCorrelationCluster >> extractRow [
+
+	^ self multiverse universes 
+		select: [:aUniverse | (aUniverse activePermutation contains: self basePermutation)]
+		thenCollect: [: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 [
+
+	^ aCollectionOfPermutations collect: [:aPermutation | SBPermutationLabel newDisplaying: aPermutation]
+]
+
+{ #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
+]

packages/Sandblocks-Babylonian/SBCorrelationView.class.st

@@ -0,0 +1,99 @@
+Class {
+	#name : #SBCorrelationView,
+	#superclass : #SBResizableResultsView,
+	#instVars : [
+		'basePermutations'
+	],
+	#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}.
+
+	self multiverse activeExamples do: [:anExample |
+		self multiverse watches do: [:aWatch | 
+			self buildForExample: anExample watching: aWatch]]
+]
+
+{ #category : #building }
+SBCorrelationView >> buildForExample: anExample watching: aWatch [
+
+	gridContainer addMorphBack: (self containerRow cellPositioning: #center;
+		addAllMorphsBack: {
+			self containerRow listDirection: #topToBottom;
+				addAllMorphsBack: { 
+					SBOwnTextMorph new contents: (
+						'{1}, {2}' format: {anExample label.
+											 (aWatch cleanedExpression sourceString)}).
+					self buildGridsFor: anExample watching: aWatch} flatten})
+]
+
+{ #category : #building }
+SBCorrelationView >> buildGridsFor: anExample watching: aWatch [
+
+	^ (self basePermutations collect: [:aBasePermutation | | split |
+		split := self getAllUniversesContainingPermutation: 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
+
+]
+
+{ #category : #building }
+SBCorrelationView >> getAllUniversesContainingPermutation: aPermutation [
+
+	| containsBase rest |
+	containsBase := OrderedCollection new.
+	rest := OrderedCollection new.
+
+	 self multiverse universes do: [:aUniverse | 
+		((aUniverse activePermutation contains: aPermutation))
+			ifTrue: [containsBase add: (aUniverse activePermutation copyRemoving: {aPermutation}) ]
+			ifFalse: [rest add: aUniverse activePermutation]].
+
+	^ {containsBase reject: [:aContainingPermutation | aContainingPermutation = aPermutation].
+		rest ifEmpty: [{SBNilPermutation new referencedVariants: {}}]}
+]
+
+{ #category : #initialization }
+SBCorrelationView >> initialize [ 
+
+	super initialize.
+
+	self name: 'Correlation'.
+
+]

packages/Sandblocks-Babylonian/SBCustomView.class.st

@@ -73,6 +73,7 @@ SBCustomView >> viewClasses [
 
 	^ {SBPermutationGridsView. 
 		SBExampleGridsView. 
+		SBCorrelationView.
 		SBLiveView.}
 ]
 

packages/Sandblocks-Babylonian/SBExampleWatch.class.st

@@ -127,6 +127,7 @@ SBExampleWatch >> asInactiveCopy [
 	| copy |
 	copy := SBInactiveExampleWatch new 
 				newIdentifier;
+				originalIdentifier: self identifier;
 				expression: (SBTextBubble new contents: self cleanedExpression sourceString);
 				modifyExpression: self modifyExpression veryDeepCopy;
 				dimensionOptions: self dimensionOptions veryDeepCopy. 

packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st

@@ -4,6 +4,9 @@ Does not update its results anymore. Applying modification expressions is still
 Class {
 	#name : #SBInactiveExampleWatch,
 	#superclass : #SBExampleWatch,
+	#instVars : [
+		'originalIdentifier'
+	],
 	#category : #'Sandblocks-Babylonian'
 }
 
@@ -53,6 +56,18 @@ SBInactiveExampleWatch >> listensToExamples [
 	^ false
 ]
 
+{ #category : #accessing }
+SBInactiveExampleWatch >> originalIdentifier [
+
+	^ originalIdentifier
+]
+
+{ #category : #accessing }
+SBInactiveExampleWatch >> originalIdentifier: aNumber [
+
+	originalIdentifier := aNumber
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 SBInactiveExampleWatch >> saveObjectsActivePermutations [
 

packages/Sandblocks-Babylonian/SBResizableResultsView.class.st

@@ -0,0 +1,55 @@
+Class {
+	#name : #SBResizableResultsView,
+	#superclass : #SBGridResultsView,
+	#instVars : [
+		'dimensionOptions'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #actions }
+SBResizableResultsView >> applyResizer [
+
+	self visualize.
+	self multiverse sandblockEditor markSaved: SBExploriants uniqueInstance 
+]
+
+{ #category : #building }
+SBResizableResultsView >> buildDimensionOptions [
+
+	| options |
+	options := SBMorphResizer standardOptions.
+
+	^ SBComboBox new
+		prefix: 'Image Dimensions: ';
+		labels: (options collect: #label);
+		values: options;
+		object: options third;
+		when: #selectionChanged send: #applyResizer to: self
+]
+
+{ #category : #initialization }
+SBResizableResultsView >> initialize [ 
+
+	super initialize.
+
+	dimensionOptions := self buildDimensionOptions
+]
+
+{ #category : #accessing }
+SBResizableResultsView >> selectedResizer [
+
+	^ dimensionOptions object
+]
+
+{ #category : #'as yet unclassified' }
+SBResizableResultsView >> visualize [ 
+
+	self clean.
+
+	self block addMorph: dimensionOptions.
+	self buildButtonRow.
+
+	self buildAllPossibleResults .
+	self concludeContainerWidth.
+]