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.
+]