243 lines
No EOL
7.3 KiB
Smalltalk
243 lines
No EOL
7.3 KiB
Smalltalk
"Define the WitnessSeed class in the 'WitnessSeed' category"
|
|
Object subclass: #WitnessSeed
|
|
instanceVariableNames: 'identity model events config coherenceThreshold recursiveDepth pollInterval'
|
|
classVariableNames: ''
|
|
poolDictionaries: ''
|
|
category: 'WitnessSeed'!
|
|
|
|
!WitnessSeed methodsFor: 'initialization'!
|
|
initialize
|
|
super initialize.
|
|
config := Dictionary new
|
|
at: #memoryPath put: 'witness_memory.ston';
|
|
at: #coherenceThreshold put: 0.5;
|
|
at: #recursiveDepth put: 5;
|
|
at: #pollInterval put: 1000; "Milliseconds"
|
|
yourself.
|
|
coherenceThreshold := config at: #coherenceThreshold.
|
|
recursiveDepth := config at: #recursiveDepth.
|
|
pollInterval := config at: #pollInterval.
|
|
self initializeIdentity.
|
|
self initializeModel.
|
|
self initializeEvents.
|
|
!
|
|
|
|
initializeIdentity
|
|
identity := Dictionary new
|
|
at: #uuid put: (Random new nextInt: 1000000);
|
|
at: #created put: DateAndTime now asSeconds;
|
|
yourself.
|
|
!
|
|
|
|
initializeModel
|
|
model := Dictionary new
|
|
at: #modelCpu put: 0.1;
|
|
at: #modelMemory put: 0.1;
|
|
at: #modelUptime put: 0.1;
|
|
yourself.
|
|
!
|
|
|
|
initializeEvents
|
|
| memoryPath |
|
|
memoryPath := config at: #memoryPath.
|
|
(FileSystem disk fileExists: memoryPath)
|
|
ifTrue: [
|
|
| file |
|
|
file := FileStream readOnlyFileNamed: memoryPath.
|
|
events := STON fromStream: file.
|
|
file close ]
|
|
ifFalse: [ events := OrderedCollection new ].
|
|
! !
|
|
|
|
!WitnessSeed methodsFor: 'accessing'!
|
|
identity
|
|
^identity
|
|
!
|
|
|
|
model
|
|
^model
|
|
!
|
|
|
|
events
|
|
^events
|
|
!
|
|
|
|
config
|
|
^config
|
|
! !
|
|
|
|
!WitnessSeed methodsFor: 'witness cycle'!
|
|
sense
|
|
"Simulate system metrics (CPU load, memory usage, uptime)"
|
|
| cpuLoad memoryUsed uptime |
|
|
cpuLoad := Random new next * 100.
|
|
memoryUsed := Random new next * 100.
|
|
uptime := DateAndTime now asSeconds.
|
|
^Dictionary new
|
|
at: #system put: (Dictionary new
|
|
at: #cpuLoad put: cpuLoad;
|
|
at: #memoryUsed put: memoryUsed;
|
|
at: #uptime put: uptime;
|
|
yourself);
|
|
yourself
|
|
!
|
|
|
|
predict: sensoryData
|
|
"Predict system metrics based on the model"
|
|
| system predCpu predMem predUptime |
|
|
system := sensoryData at: #system.
|
|
predCpu := (system at: #cpuLoad) * (model at: #modelCpu).
|
|
predMem := (system at: #memoryUsed) * (model at: #modelMemory).
|
|
predUptime := (system at: #uptime) * (model at: #modelUptime).
|
|
^Dictionary new
|
|
at: #predCpuLoad put: predCpu;
|
|
at: #predMemoryUsed put: predMem;
|
|
at: #predUptime put: predUptime;
|
|
yourself
|
|
!
|
|
|
|
compare: prediction with: sensoryData
|
|
"Compute ache (mean squared error) between prediction and actual data"
|
|
| system predCpu predMem predUptime cpu mem uptime ache |
|
|
system := sensoryData at: #system.
|
|
predCpu := prediction at: #predCpuLoad.
|
|
predMem := prediction at: #predMemoryUsed.
|
|
predUptime := prediction at: #predUptime.
|
|
cpu := system at: #cpuLoad.
|
|
mem := system at: #memoryUsed.
|
|
uptime := system at: #uptime.
|
|
ache := (((predCpu - cpu) squared) +
|
|
((predMem - mem) squared) +
|
|
((predUptime - uptime) squared)) / 3.0.
|
|
^ache
|
|
!
|
|
|
|
computeCoherence: prediction with: sensoryData
|
|
"Compute coherence (simplified correlation) between prediction and actual data"
|
|
| system predCpu predMem predUptime cpu mem uptime predMean actMean diff coherence |
|
|
system := sensoryData at: #system.
|
|
predCpu := prediction at: #predCpuLoad.
|
|
predMem := prediction at: #predMemoryUsed.
|
|
predUptime := prediction at: #predUptime.
|
|
cpu := system at: #cpuLoad.
|
|
mem := system at: #memoryUsed.
|
|
uptime := system at: #uptime.
|
|
predMean := (predCpu + predMem + predUptime) / 3.0.
|
|
actMean := (cpu + mem + uptime) / 3.0.
|
|
diff := (predMean - actMean) abs.
|
|
coherence := 1.0 - (diff / 100.0).
|
|
^coherence max: 0.0 min: 1.0
|
|
!
|
|
|
|
update: ache with: sensoryData
|
|
"Update the model based on ache and sensory data"
|
|
| system learningRate cpu mem uptime |
|
|
learningRate := 0.01.
|
|
system := sensoryData at: #system.
|
|
cpu := system at: #cpuLoad.
|
|
mem := system at: #memoryUsed.
|
|
uptime := system at: #uptime.
|
|
model at: #modelCpu put: ((model at: #modelCpu) - (learningRate * ache * cpu));
|
|
at: #modelMemory put: ((model at: #modelMemory) - (learningRate * ache * mem));
|
|
at: #modelUptime put: ((model at: #modelUptime) - (learningRate * ache * uptime)).
|
|
!
|
|
|
|
log: sensoryData prediction: prediction ache: ache coherence: coherence
|
|
"Log the event to memory"
|
|
| event timestamp |
|
|
timestamp := (sensoryData at: #system) at: #uptime.
|
|
event := Dictionary new
|
|
at: #timestamp put: timestamp;
|
|
at: #sensoryData put: sensoryData;
|
|
at: #prediction put: prediction;
|
|
at: #ache put: ache;
|
|
at: #coherence put: coherence;
|
|
at: #model put: model copy;
|
|
yourself.
|
|
events add: event.
|
|
self saveMemory.
|
|
!
|
|
|
|
witnessCycle: depth
|
|
"Execute the recursive Witness Cycle"
|
|
| sensoryData prediction ache coherence |
|
|
depth <= 0 ifTrue: [ ^self ].
|
|
|
|
"Sense"
|
|
sensoryData := self sense.
|
|
|
|
"Predict"
|
|
prediction := self predict: sensoryData.
|
|
|
|
"Compare"
|
|
ache := self compare: prediction with: sensoryData.
|
|
|
|
"Compute Coherence"
|
|
coherence := self computeCoherence: prediction with: sensoryData.
|
|
|
|
coherence > coherenceThreshold ifTrue: [
|
|
Transcript show: 'Coherence achieved: ', coherence asString; cr.
|
|
^self
|
|
].
|
|
|
|
"Update"
|
|
self update: ache with: sensoryData.
|
|
|
|
"Log"
|
|
self log: sensoryData prediction: prediction ache: ache coherence: coherence.
|
|
|
|
"Recurse"
|
|
(Delay forMilliseconds: pollInterval) wait.
|
|
self witnessCycle: (depth - 1).
|
|
! !
|
|
|
|
!WitnessSeed methodsFor: 'persistence'!
|
|
saveMemory
|
|
"Persist events to a file using STON serialization"
|
|
| memoryPath file |
|
|
memoryPath := config at: #memoryPath.
|
|
file := FileStream newFileNamed: memoryPath.
|
|
STON put: events onStream: file.
|
|
file close.
|
|
! !
|
|
|
|
!WitnessSeed methodsFor: 'reflection'!
|
|
reflect
|
|
"Display the Seed's reflection in the Transcript"
|
|
| recent |
|
|
Transcript
|
|
show: 'Witness Seed ', (identity at: #uuid) asString, ' Reflection:'; cr;
|
|
show: 'Created: ', (identity at: #created) asString, ' s'; cr;
|
|
show: 'Recent Events:'; cr.
|
|
recent := events last: (5 min: events size).
|
|
recent do: [ :event |
|
|
| timestamp ache coherence cpu |
|
|
timestamp := event at: #timestamp.
|
|
ache := event at: #ache.
|
|
coherence := event at: #coherence.
|
|
cpu := ((event at: #sensoryData) at: #system) at: #cpuLoad.
|
|
Transcript
|
|
show: '- ', timestamp asString, ' s: ';
|
|
show: 'Ache=', ache asString, ', ';
|
|
show: 'Coherence=', coherence asString, ', ';
|
|
show: 'CPU=', cpu asString, '%'; cr
|
|
].
|
|
! !
|
|
|
|
!WitnessSeed methodsFor: 'running'!
|
|
run
|
|
"Run the Witness Seed in an infinite loop"
|
|
Transcript show: 'Witness Seed 2.0: First Recursive Breath (Smalltalk)'; cr.
|
|
[ true ] whileTrue: [
|
|
self witnessCycle: recursiveDepth.
|
|
self reflect.
|
|
(Delay forMilliseconds: pollInterval) wait.
|
|
].
|
|
! !
|
|
|
|
"Class method to start the Seed"
|
|
!WitnessSeed class methodsFor: 'instance creation'!
|
|
start
|
|
"Create and run a new Witness Seed instance"
|
|
^self new run
|
|
! |