Dictionary variableSubclass: #AccessableDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Accessable-Objects'! !AccessableDictionary methodsFor: 'accessing'! items "Say that we are one big item list..." ^self! ! !AccessableDictionary methodsFor: 'accessing'! items: itemList "Say that we are one big item list..." ^self error: 'AccessableDictionaries should not reset their item lists...'! ! !AccessableDictionary methodsFor: 'accessing'! valueAt: key "Just send this to ourself..." ^self at: key! ! !AccessableDictionary methodsFor: 'accessing'! valueAt: key ifAbsent: aBlock "Just send this to ourself..." ^self at: key ifAbsent: aBlock! ! !AccessableDictionary methodsFor: 'accessing'! valueAt: key put: value "Just send this to ourself..." ^self at: key put: value! ! !AccessableDictionary methodsFor: 'error interception'! doesNotUnderstand: aMessage "Convert accessing messages to dictionary accesses..." | selector args | selector := aMessage selector. args := aMessage arguments. selector isKeyword ifTrue: [selector := (selector copyWithout: $:) asSymbol. ^self at: selector put: (args at: 1)] ifFalse: [^self at: selector ifAbsent: [^super doesNotUnderstand: aMessage]]! ! Object subclass: #AccessableObject instanceVariableNames: 'items ' classVariableNames: '' poolDictionaries: '' category: 'Accessable-Objects'! !AccessableObject methodsFor: 'instance initialization'! initialize "As a default, do nothing..." ^self! ! !AccessableObject methodsFor: 'accessing'! at: key "Return the object associated with the given key..." ^self valueAt: key! ! !AccessableObject methodsFor: 'accessing'! at: key ifAbsent: aBlock "Allow graceful recovery if an item is not defined..." ^self valueAt: key ifAbsent: aBlock! ! !AccessableObject methodsFor: 'accessing'! at: key put: value "Store the indicated value at the designated place in our item dictionary... " ^self valueAt: key put: value! ! !AccessableObject methodsFor: 'accessing'! items "Return our item list..." ^items! ! !AccessableObject methodsFor: 'accessing'! items: itemList "Set our item list..." ^items := itemList! ! !AccessableObject methodsFor: 'accessing'! size "Let's say our size is the size of our item dictionary plus our number of instance variables..." ^self items size + self instVarNames size! ! !AccessableObject methodsFor: 'accessing'! valueAt: key "Return the object associated with the given key..." ^self valueAt: key ifAbsent: [self errorKeyNotFound]! ! !AccessableObject methodsFor: 'accessing'! valueAt: key ifAbsent: aBlock "Allow graceful recovery if an item is not defined..." ^self variableAt: key ifAbsent: [^self items at: key ifAbsent: aBlock]! ! !AccessableObject methodsFor: 'accessing'! valueAt: key put: value "Store the indicated value at the designated place in our item dictionary, unless there is an instance var by that name..." items isNil ifTrue: [items := IdentityDictionary new: 16]. (self hasVariableNamed: key) ifTrue: [^self variableAt: key put: value] ifFalse: [^items at: key put: value]! ! !AccessableObject methodsFor: 'instance variable access'! allInstVarNames "Define a shorthand for this class method..." ^self class allInstVarNames! ! !AccessableObject methodsFor: 'instance variable access'! hasVariableNamed: name "Say whether we have a variable by the given name..." ^(self variableIndex: name) ~= 0! ! !AccessableObject methodsFor: 'instance variable access'! instVarNames "Define a shorthand for this class method..." ^self class instVarNames! ! !AccessableObject methodsFor: 'instance variable access'! variableAt: name "Return the named value..." | index | index := self variableIndex: name. index = 0 ifTrue: [self error: 'Bad instance variable name...']. ^self instVarAt: index! ! !AccessableObject methodsFor: 'instance variable access'! variableAt: name ifAbsent: aBlock "Return the named value..." | index | index := self variableIndex: name. index = 0 ifTrue: [^aBlock value]. ^self instVarAt: index! ! !AccessableObject methodsFor: 'instance variable access'! variableAt: name put: value "Set the named instance variable to the indicated value..." | index | index := self variableIndex: name. index = 0 ifTrue: [self error: 'Bad instance variable name...']. ^self instVarAt: index put: value! ! !AccessableObject methodsFor: 'instance variable access'! variableIndex: name "Return the instance variable index for this name, or zero..." ^self class allInstVarNames indexOf: name asString! ! !AccessableObject methodsFor: 'error interception'! doesNotUnderstand: aMessage "Refer messages we don't understand to our item dictionary..." | selector name args | selector := aMessage selector. name := (selector copyWithout: $:) asSymbol. args := aMessage arguments. (self hasVariableNamed: name) ifTrue: [args size = 1 ifTrue: [^self variableAt: name] ifFalse: [self variableAt: name put: (args at: 1)]]. (items respondsTo: selector) ifTrue: [^items perform: selector withArguments: args]. args size = 1 ifTrue: [^self valueAt: name put: (args at: 1)] ifFalse: [^self valueAt: name ifAbsent: [^super doesNotUnderstand: aMessage]]! ! !AccessableObject methodsFor: 'conversion'! asAccessableDictionary "Return an AccessableDictionary with the same contents as us..." | dict | dict := AccessableDictionary new: self size + 10. self items~~ nil ifTrue:[self items keysDo: [:key | dict at: key put: (self at: key)]]. self allInstVarNames do: [:name | dict at: name asSymbol put: (self at: name asSymbol)]. ^dict! ! !AccessableObject methodsFor: 'private'! errorKeyNotFound "Make the obvious complaint..." self error: 'key not found'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AccessableObject class instanceVariableNames: ''! !AccessableObject class methodsFor: 'instance creation'! new "Slip in a default instance initialization message..." | anObject | anObject := super new. anObject initialize. ^anObject! ! !AccessableObject class methodsFor: 'examples'! example "AccessableObject example" | temp | temp := AccessableObject new. temp dog: 'Fido'. temp cat: 'Tabby'. Transcript print: temp dog; cr. Transcript print: temp items; cr. temp keysDo: [:key | Transcript print: key; cr]. Transcript print: (temp variableAt: #items); cr. Transcript endEntry! ! Object subclass: #BatteryBlock instanceVariableNames: 'parameters singleTrials tallies averages ' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! !BatteryBlock methodsFor: 'accessing'! averages ^averages! ! !BatteryBlock methodsFor: 'accessing'! averages: argument averages := argument. ^argument! ! !BatteryBlock methodsFor: 'accessing'! parameters ^parameters! ! !BatteryBlock methodsFor: 'accessing'! parameters: argument parameters := argument. ^argument! ! !BatteryBlock methodsFor: 'accessing'! singleTrials ^singleTrials! ! !BatteryBlock methodsFor: 'accessing'! singleTrials: argument singleTrials := argument. ^argument! ! !BatteryBlock methodsFor: 'accessing'! tallies ^tallies! ! !BatteryBlock methodsFor: 'accessing'! tallies: argument tallies := argument. ^argument! ! Object subclass: #BatteryTrial instanceVariableNames: 'trialNumber stimulus responseType responseTime data ' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! !BatteryTrial methodsFor: 'accessing'! data ^data! ! !BatteryTrial methodsFor: 'accessing'! data: argument data := argument. ^argument! ! !BatteryTrial methodsFor: 'accessing'! responseTime ^responseTime! ! !BatteryTrial methodsFor: 'accessing'! responseTime: argument responseTime := argument. ^argument! ! !BatteryTrial methodsFor: 'accessing'! responseType ^responseType! ! !BatteryTrial methodsFor: 'accessing'! responseType: argument responseType := argument. ^argument! ! !BatteryTrial methodsFor: 'accessing'! stimulus ^stimulus! ! !BatteryTrial methodsFor: 'accessing'! stimulus: argument stimulus := argument. ^argument! ! !BatteryTrial methodsFor: 'accessing'! trialNumber ^trialNumber! ! !BatteryTrial methodsFor: 'accessing'! trialNumber: argument trialNumber := argument. ^argument! ! AccessableDictionary variableSubclass: #DataDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! Object subclass: #DataDictionaryEntry instanceVariableNames: 'name type label date time data ' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! !DataDictionaryEntry methodsFor: 'accessing'! data ^data! ! !DataDictionaryEntry methodsFor: 'accessing'! data: argument data := argument. ^argument! ! !DataDictionaryEntry methodsFor: 'accessing'! date ^date! ! !DataDictionaryEntry methodsFor: 'accessing'! date: argument date := argument. ^argument! ! !DataDictionaryEntry methodsFor: 'accessing'! label ^label! ! !DataDictionaryEntry methodsFor: 'accessing'! label: argument label := argument. ^argument! ! !DataDictionaryEntry methodsFor: 'accessing'! name ^name! ! !DataDictionaryEntry methodsFor: 'accessing'! name: argument name := argument. ^argument! ! !DataDictionaryEntry methodsFor: 'accessing'! time ^time! ! !DataDictionaryEntry methodsFor: 'accessing'! time: argument time := argument. ^argument! ! !DataDictionaryEntry methodsFor: 'accessing'! type ^type! ! !DataDictionaryEntry methodsFor: 'accessing'! type: argument type := argument. ^argument! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DataDictionaryEntry class instanceVariableNames: ''! !DataDictionaryEntry class methodsFor: 'instance creation'! entryNamed: aString withLabel: aLabel andData: anObject "Create and entry and fill it in as indicated, together with the current date and time..." | entry date | entry := super new. entry name: aString. entry label: aLabel. entry data: anObject. date := Date dateAndTimeNow. entry date: (date at: 1). entry time: (date at: 2). ^entry! ! AccessableDictionary variableSubclass: #ParameterDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! Object subclass: #ParameterDictionaryEntry instanceVariableNames: 'key name access default category constraints ' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! !ParameterDictionaryEntry methodsFor: 'accessing'! access ^access! ! !ParameterDictionaryEntry methodsFor: 'accessing'! access: argument access := argument. ^argument! ! !ParameterDictionaryEntry methodsFor: 'accessing'! category ^category! ! !ParameterDictionaryEntry methodsFor: 'accessing'! category: argument category := argument. ^argument! ! !ParameterDictionaryEntry methodsFor: 'accessing'! constraints ^constraints! ! !ParameterDictionaryEntry methodsFor: 'accessing'! constraints: argument constraints := argument. ^argument! ! !ParameterDictionaryEntry methodsFor: 'accessing'! default ^default! ! !ParameterDictionaryEntry methodsFor: 'accessing'! default: argument default := argument. ^argument! ! !ParameterDictionaryEntry methodsFor: 'accessing'! key ^key! ! !ParameterDictionaryEntry methodsFor: 'accessing'! key: argument key := argument. ^argument! ! !ParameterDictionaryEntry methodsFor: 'accessing'! name ^name! ! !ParameterDictionaryEntry methodsFor: 'accessing'! name: argument name := argument. ^argument! ! Object subclass: #ParameterManager instanceVariableNames: 'parameters parameterList parameterListIndex ' classVariableNames: '' poolDictionaries: '' category: 'Data-Management'! Random subclass: #IntegerGenerator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Random-Support'! !IntegerGenerator commentStamp: 'BF 1/25/98 17:20' prior: 0! IntegerGenerators return random integers within given ranges...! !IntegerGenerator methodsFor: 'accessing'! from: start to: stop "Return a random integer in the range from start to stop inclusive." | x range | range := stop - start + 1. x := super next. ^(x * range) truncated + start! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerGenerator class instanceVariableNames: ''! IntegerGenerator subclass: #IntegerStream instanceVariableNames: 'start stop ' classVariableNames: '' poolDictionaries: '' category: 'Random-Support'! !IntegerStream commentStamp: 'BF 1/25/98 17:20' prior: 0! This Random subclass adds random integer generation...! !IntegerStream methodsFor: 'accessing'! next "Return a random integer in the range from start to stop inclusive." ^self from: start to: stop! ! !IntegerStream methodsFor: 'accessing'! start "Return our starting (lower) bounding value." ^start! ! !IntegerStream methodsFor: 'accessing'! start: anInteger "Set our start bound." ^start := anInteger! ! !IntegerStream methodsFor: 'accessing'! stop "Return our stop bound." ^stop! ! !IntegerStream methodsFor: 'accessing'! stop: anInteger "Set our stop bound." ^stop := anInteger! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerStream class instanceVariableNames: ''! !IntegerStream class methodsFor: 'instance creation'! from: startInteger to: stopInteger "Create a new IntegerStream with the specified bounds." | temp | temp := self new. temp start: startInteger. temp stop: stopInteger. ^temp! ! Stream subclass: #RandomStream instanceVariableNames: 'collection rand ' classVariableNames: '' poolDictionaries: '' category: 'Random-Support'! !RandomStream commentStamp: 'BF 1/25/98 17:20' prior: 0! RandomStreams return randomly chosen elements (with replacement) from the collection given them. They never run out. (That is, atEnd will always be false.)! !RandomStream methodsFor: 'accessing'! atEnd "We'll allow random elements to be chosen forever." ^false! ! !RandomStream methodsFor: 'accessing'! collection "Return our collection." ^collection! ! !RandomStream methodsFor: 'accessing'! collection: aCollection "Set our collection." ^collection := aCollection! ! !RandomStream methodsFor: 'accessing'! contents "Return elements of the base collection in a random order. Note that the resulting collection will be of the same size as the base collection, and that some elements may appear multiple times, while others do not appear at all. Note that a scrambled stream containing all elements of the base collection can be had by defining a SampledStream over it..." | temp | temp := collection copy. ^temp collect: [:each | self next]! ! !RandomStream methodsFor: 'accessing'! nextPut: anObject "We can't do this." self shouldNotImplement! ! !RandomStream methodsFor: 'accessing'! rand "Return our IntegerGenerator." ^rand! ! !RandomStream methodsFor: 'accessing'! rand: anIntegerGenerator "Set our IntegerGenerator." ^rand := anIntegerGenerator! ! !RandomStream methodsFor: 'accessing'! size "Size is whatever the size of our collection is." ^collection size! ! !RandomStream methodsFor: 'As yet unclassified'! next "Pick an element at random and return it." ^collection at: (rand from: 1 to: self size)! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RandomStream class instanceVariableNames: ''! !RandomStream class methodsFor: 'instance creation'! on: aCollection "Create ourself, and set up a IntegerGenerator..." | temp | temp := self basicNew. temp collection: aCollection copy asOrderedCollection. temp rand: IntegerGenerator new. ^temp "Brian Foote 6/8/87 Does asOrderedCollection return a copy if it is sent to an OrderedCollection?" "Brian Foote 6/8/87 Added the copy above anyway..."! ! !RandomStream class methodsFor: 'instance creation'! on: aCollection from: firstIndex to: lastIndex "Answer an instance of me, streaming over the elements of aCollection starting with the element at firstIndex and ending with the one at lastIndex." ^self on: (aCollection copyFrom: firstIndex to: lastIndex) "Brian Foote 6/8/87 Removed the basicNew above (which could not have worked)..."! ! !RandomStream class methodsFor: 'examples'! example1 "RandomStream example1" | temp | temp := RandomStream on: (Interval from: 1 to: 100). ^(1 to: 10) collect: [:n | temp next]! ! RandomStream subclass: #SampledStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Random-Support'! !SampledStream commentStamp: 'BF 1/25/98 17:20' prior: 0! SampledStreams stream randomly over a copy of the collection given them without replacement...! !SampledStream methodsFor: 'accessing'! atEnd "Anything left?" ^self size ~~ 0! ! !SampledStream methodsFor: 'accessing'! next "Return the next element, but remove it from our collection first." ^collection remove: super next! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SampledStream class instanceVariableNames: ''! !SampledStream class methodsFor: 'examples'! example1 "SampledStream example1" ^(SampledStream on: #(dog cat mouse gerbil)) contents! ! !SampledStream class methodsFor: 'examples'! lotto7 "SampledStream lotto7" | lotto | lotto := SampledStream on: (1 to: 39). ^((1 to: 7) collect: [:i | lotto next]) asSortedCollection asArray! ! !SampledStream class methodsFor: 'examples'! quickPick "SampledStream quickPick" | lotto | lotto := SampledStream on: (1 to: 44). ^((1 to: 6) collect: [:i | lotto next]) asSortedCollection asArray! ! AccessableObject subclass: #BatteryParameters instanceVariableNames: 'baseline channels points digitizingRate responseMax stimulusDuration trialDuration trials writeDataFlag probabilities stimuli inputBitA inputBitB name label ' classVariableNames: '' poolDictionaries: '' category: 'Battery-Parameters'! !BatteryParameters methodsFor: 'instance initialization' stamp: 'BF 1/24/98 22:13'! establishDefaults "Set out our defaults..." baseline := 10. channels := 1. points := 100. digitizingRate := 1. responseMax := 90. stimulusDuration := 20. trialDuration := 150. trials := 10. writeDataFlag := True. probabilities := #(0.5 0.5). stimuli := #(catA catB). "BF 1/24/98 22:13" inputBitA := 0. inputBitB := 1! ! !BatteryParameters methodsFor: 'instance initialization'! initialize "Set defaults and return ourself..." self establishDefaults. ^self! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:47'! baseline ^ baseline ! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:48'! baseline: argument baseline _ argument. ^ argument ! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:48'! channels ^ channels! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:48'! channels: argument channels _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:48'! digitizingRate ^ digitizingRate ! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! digitizingRate: argument digitizingRate _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! inputBitA ^ inputBitA! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! inputBitA: argument inputBitA _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! inputBitB ^ inputBitB! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! inputBitB: argument inputBitB _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:49'! label ^ label! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:50'! label: argument label _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:50'! name ^ name! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:50'! name: argument name _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:50'! points ^ points! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:50'! points: argument points _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! probabilities ^ probabilities! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! probabilities: argument probabilities _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! responseMax ^ responseMax! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! responseMax: argument responseMax _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! stimuli ^ stimuli! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:51'! stimuli: argument stimuli _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:52'! stimulusDuration ^ stimulusDuration! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:52'! stimulusDuration: argument stimulusDuration _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:52'! trialDuration ^ trialDuration! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:52'! trialDuration: argument trialDuration _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:52'! trials ^ trials! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:53'! trials: argument trials _ argument. ^ argument! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:53'! writeDataFlag ^ writeDataFlag! ! !BatteryParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:53'! writeDataFlag: argument writeDataFlag _ argument. ^ argument! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BatteryParameters class instanceVariableNames: ''! !BatteryParameters class methodsFor: 'instance creation'! new "Create a new parameter object and initialize it..." ^super new initialize! ! BatteryParameters subclass: #SternbergTaskParameters instanceVariableNames: 'memorySetBaseline memorySetDuration probeBaseline probeDuration memorySetSize vocabulary ' classVariableNames: '' poolDictionaries: '' category: 'Battery-Parameters'! !SternbergTaskParameters methodsFor: 'instance initialization' stamp: 'BF 1/24/98 17:48'! establishDefaults "Do Sternberg defaults... " | positive negative | super establishDefaults. memorySetBaseline := 10. memorySetDuration := 10. memorySetSize := 3. vocabulary := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. probeBaseline := 40. probeDuration := 10. positive := SternbergStimulus new. positive category: #positive. negative := SternbergStimulus new. negative category: #negative. stimuli := Array with: positive with: negative. name := 'Sternberg/ERP Task'. label := 'Sternberg/ERP Experiment'! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:53'! memorySetBaseline ^ memorySetBaseline! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:53'! memorySetBaseline: argument memorySetBaseline _ argument. ^ argument! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! memorySetDuration ^ memorySetDuration! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! memorySetDuration: argument memorySetDuration _ argument. ^ argument! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! memorySetSize ^ memorySetSize! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! memorySetSize: argument memorySetSize _ argument. ^ argument! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! probeBaseline ^ probeBaseline! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! probeBaseline: argument probeBaseline _ argument. ^ argument! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:54'! probeDuration ^ probeDuration! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! probeDuration: argument probeDuration _ argument. ^ argument! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! vocabulary ^ vocabulary! ! !SternbergTaskParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! vocabulary: argument vocabulary _ argument. ^ argument! ! BatteryParameters subclass: #ToneOddballParameters instanceVariableNames: 'outputBitA outputBitB ' classVariableNames: '' poolDictionaries: '' category: 'Battery-Parameters'! !ToneOddballParameters methodsFor: 'instance initialization'! establishDefaults "Do ToneOddball defaults... " | toneA toneB | super establishDefaults. toneA := ToneStimulus new. toneA primary: #toneA ; category: #catA. toneB := ToneStimulus new. toneB primary: #toneB ; category: #catB. stimuli := Array with: toneA with: toneB. outputBitA := 0. outputBitB := 1. name := 'Tone Oddball'. label := 'Auditory Oddball Experiment'! ! !ToneOddballParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! outputBitA ^ outputBitA! ! !ToneOddballParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! outputBitA: argument outputBitA _ argument. ^ argument! ! !ToneOddballParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:55'! outputBitB ^ outputBitB! ! !ToneOddballParameters methodsFor: 'accessing' stamp: 'BF 1/24/98 22:56'! outputBitB: argument outputBitB _ argument. ^ argument! ! BatteryParameters subclass: #WordOddballParameters instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Battery-Parameters'! !WordOddballParameters methodsFor: 'instance initialization'! establishDefaults "Do WordOddball defaults... " | animal vegitable | super establishDefaults. animal := WordStimulus new. animal primary: #animal ; category: #catA. vegitable := WordStimulus new. vegitable primary: #vegitable ; category: #catB. stimuli := Array with: animal with: vegitable. name := 'Word Oddball'. label := 'Animal/Vegitable Oddball Experiment'! ! Object subclass: #StimulusGenerator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Generators'! !StimulusGenerator methodsFor: 'instance initialization'! initialize "Provide nothing as our default behavior..." ^self! ! !StimulusGenerator methodsFor: 'stimulus control'! finishBlock "Default shall be to do nothing..."! ! !StimulusGenerator methodsFor: 'stimulus control'! prepare: aStimulus "Default shall be to do nothing..."! ! !StimulusGenerator methodsFor: 'stimulus control'! startBlock "Default shall be to do nothing..."! ! !StimulusGenerator methodsFor: 'stimulus control'! turnOff: aStimulus "Default shall be to do nothing..."! ! !StimulusGenerator methodsFor: 'stimulus control'! turnOn: aStimulus "Default shall be to do nothing..."! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! StimulusGenerator class instanceVariableNames: ''! !StimulusGenerator class methodsFor: 'instance creation'! new "Return an intialized instance..." ^super new initialize! ! StimulusGenerator subclass: #SternbergDisplayGenerator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Generators'! !SternbergDisplayGenerator methodsFor: 'stimulus control'! prepare: aStimulus "We distinguish between probes and memory sets, so we don't do this..." self shouldNotImplement! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! prepareMemorySet: aStimulus "Do nothing here for now..."! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! prepareProbe: aStimulus "Do nothing here for now..."! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOff: aStimulus "We distinguish between probes and memory sets, so we don't do this..." self shouldNotImplement! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOffMemorySet: aStimulus "Do nothing here for now..."! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOffProbe: aStimulus "Do nothing here for now..."! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOn: aStimulus "We distinguish between probes and memory sets, so we don't do this..." self shouldNotImplement! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOnMemorySet: aStimulus "Just write the memory set to the transcript for now..." Transcript show: '--> Memory Set: ' , aStimulus memorySet; cr; endEntry! ! !SternbergDisplayGenerator methodsFor: 'stimulus control'! turnOnProbe: aStimulus "Just write the probe to the transcript for now..." Transcript show: '--> Probe: ' , aStimulus probe; cr; endEntry! ! StimulusGenerator subclass: #ToneGenerator instanceVariableNames: 'bitA bitB ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Generators'! !ToneGenerator methodsFor: 'accessing'! bitA "Return the output bit for the first tone..." ^bitA! ! !ToneGenerator methodsFor: 'accessing'! bitA: aBit "Set the output bit for the first tone..." ^bitA := aBit! ! !ToneGenerator methodsFor: 'accessing'! bitB "Return the output bit for the second tone..." ^bitB! ! !ToneGenerator methodsFor: 'accessing'! bitB: aBit "Set the output bit for the second tone..." ^bitB := aBit! ! !ToneGenerator methodsFor: 'stimulus control'! finishBlock "Make sure both our bits are off..." bitA clear. bitB clear! ! !ToneGenerator methodsFor: 'stimulus control'! startBlock "Make sure both our bits are off..." bitA clear. bitB clear! ! !ToneGenerator methodsFor: 'stimulus control'! turnOff: aStimulus "Turn off the bit indicated as the primary stimulus by the Stimulus object that was passed to us..." | primary | primary := aStimulus primary. primary == #toneA ifTrue: [bitA clear. ^self]. primary == #toneB ifTrue: [bitB clear. ^self]. self error: 'Bad stimulus...'! ! !ToneGenerator methodsFor: 'stimulus control'! turnOn: aStimulus "Turn on the bit indicated as the primary stimulus by the Stimulus object that was passed to us..." | primary | primary := aStimulus primary. primary == #toneA ifTrue: [bitA set. ^self]. primary == #toneB ifTrue: [bitB set. ^self]. self error: 'Bad stimulus...'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ToneGenerator class instanceVariableNames: ''! !ToneGenerator class methodsFor: 'instance creation'! bitA: a bitB: b "Create a tone generator, and set up the given bits..." | gen | gen := super new. gen initialize. gen bitA: (OutputBit onBit: a). gen bitB: (OutputBit onBit: b). ^gen! ! StimulusGenerator subclass: #WordGenerator instanceVariableNames: 'streamDictionary ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Generators'! !WordGenerator methodsFor: 'stimulus control'! prepare: aStimulus "Load a word into the stimulus object..." | word stream | stream := streamDictionary at: aStimulus primary. word := stream next. aStimulus word: word! ! !WordGenerator methodsFor: 'stimulus control'! turnOn: aStimulus "For now, send the word to the transcript..." Transcript show: aStimulus word ; cr ; endEntry! ! !WordGenerator methodsFor: 'accessing'! streamDictionary ^streamDictionary! ! !WordGenerator methodsFor: 'accessing'! streamDictionary: argument streamDictionary := argument. ^argument! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WordGenerator class instanceVariableNames: ''! !WordGenerator class methodsFor: 'instance creation'! on: aStreamDictionary "Create a WordGenerator, and tell it to remember the stream dictionary we were given..." | generator | generator := super new. generator initialize. generator streamDictionary: aStreamDictionary. ^generator! ! Object subclass: #Stimulus instanceVariableNames: 'category ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Support'! !Stimulus methodsFor: 'accessing'! category "Return the stimulus category..." ^category! ! !Stimulus methodsFor: 'accessing'! category: aCategory "Set the stimulus category..." ^category := aCategory! ! Stimulus subclass: #SternbergStimulus instanceVariableNames: 'memorySet probe ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Support'! !SternbergStimulus methodsFor: 'accessing'! memorySet ^memorySet! ! !SternbergStimulus methodsFor: 'accessing'! memorySet: argument memorySet := argument. ^argument! ! !SternbergStimulus methodsFor: 'accessing'! probe ^probe! ! !SternbergStimulus methodsFor: 'accessing'! probe: argument probe := argument. ^argument! ! Stimulus subclass: #ToneStimulus instanceVariableNames: 'primary ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Support'! !ToneStimulus methodsFor: 'accessing'! primary ^primary! ! !ToneStimulus methodsFor: 'accessing'! primary: argument primary := argument. ^argument! ! Stimulus subclass: #WordStimulus instanceVariableNames: 'primary word ' classVariableNames: '' poolDictionaries: '' category: 'Stimulus-Support'! !WordStimulus methodsFor: 'accessing'! primary ^primary! ! !WordStimulus methodsFor: 'accessing'! primary: argument primary := argument. ^argument! ! !WordStimulus methodsFor: 'accessing'! word ^word! ! !WordStimulus methodsFor: 'accessing'! word: argument word := argument. ^argument! ! Object subclass: #SequenceGenerator instanceVariableNames: 'length probabilities stimuli ' classVariableNames: '' poolDictionaries: '' category: 'Sequence-Support'! !SequenceGenerator methodsFor: 'sequence construction'! generateSequenceOn: stims withSize: size andProbabilities: probs "Save our parameters, contstrain the probability set, and build a sequence..." length := size. probabilities := probs. stimuli := stims. self constrainProbabilities. ^self constructSequence! ! !SequenceGenerator methodsFor: 'private'! constrainProbabilities "Make sure the probabilities add up to 1.0..." | sum last | sum := (1 to: probabilities size - 1) inject: 0 into: [:s :i | s + (probabilities at: i)]. (sum < 0 or: [sum > 1]) ifTrue: [self error: 'Bad probability sum...']. probabilities at: probabilities size put: (1.0-sum)! ! !SequenceGenerator methodsFor: 'private'! constructSequence "Build a weighted collection given our current size and probabilities... " ^WeightedCollection on: stimuli withSize: length andWeights: probabilities "Notes 6/23/86: Hope they allow zero length runs..." "Notes 7/24/86: They do...." "Notes 8/25/86: Changed over to WeightedCollections..."! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SequenceGenerator class instanceVariableNames: ''! !SequenceGenerator class methodsFor: 'examples'! example1 "SequenceGenerator example1 inspect" | s stims probs | s := SequenceGenerator new. stims := #(catA catB ). probs := Array with: 0.5 with: 0.5. ^s generateSequenceOn: stims withSize: 100 andProbabilities: probs! ! RunArray subclass: #WeightedCollection instanceVariableNames: 'weights ' classVariableNames: '' poolDictionaries: '' category: 'Sequence-Support'! !WeightedCollection methodsFor: 'growing'! grow: size "Transform ourself into a new weighted collection..." | new | new := WeightedCollection on: self values withSize: size andWeights: self weights. ^self become: new! ! !WeightedCollection methodsFor: 'private'! weights "Return the weights collection..." ^weights! ! !WeightedCollection methodsFor: 'private'! weights: aCollection "Save the weights collection..." ^weights := aCollection! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WeightedCollection class instanceVariableNames: ''! !WeightedCollection class methodsFor: 'instance creation'! on: aCollection withSize: size andWeights: weights "Create a new weighted collection..." | counts total error adjust increment new | counts := weights collect: [:weight | (weight * size) rounded asInteger]. total := counts inject: 0 into: [:sum :count | sum + count]. error := size - total. error > 0 ifTrue: [adjust := error. increment := 1] ifFalse: [adjust := error negated. increment := -1]. (1 to: adjust) do: [:i | counts at: i put: (counts at: i) + 1]. new := super runs: counts values: aCollection. new weights: weights. ^new! ! !WeightedCollection class methodsFor: 'examples'! example "WeightedCollection example inspect" ^WeightedCollection on: #(dog cat mouse ) withSize: 10 andWeights: #(0.3 0.3 0.3 )! ! Object subclass: #ButtonBox instanceVariableNames: 'bitA bitB clock ' classVariableNames: '' poolDictionaries: '' category: 'Response-Support'! !ButtonBox methodsFor: 'accessing'! bitA ^bitA! ! !ButtonBox methodsFor: 'accessing'! bitA: argument bitA := argument. ^argument! ! !ButtonBox methodsFor: 'accessing'! bitB ^bitB! ! !ButtonBox methodsFor: 'accessing'! bitB: argument bitB := argument. ^argument! ! !ButtonBox methodsFor: 'accessing'! clock ^clock! ! !ButtonBox methodsFor: 'accessing'! clock: argument clock := argument. ^argument! ! !ButtonBox methodsFor: 'accessing'! enable "Enable both our input bits using our clock..." self bitA enableUsingClock: self clock. self bitB enableUsingClock: self clock! ! !ButtonBox methodsFor: 'accessing'! response "Return a response object with the bit for which we recorded a response (if any) and the response time for it..." | resp | resp := ButtonBoxResponse new. (self bitA flag) ifTrue: [ resp responseButton: #buttonA. resp responseTime: self bitA time. ^resp]. (self bitB flag) ifTrue: [ resp responseButton: #buttonB. resp responseTime: self bitB time. ^resp]. ^resp! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ButtonBox class instanceVariableNames: ''! !ButtonBox class methodsFor: 'instance creation'! bitA: a bitB: b usingClock: aClock "Create a new button box..." | box | box := super new. box bitA: (InputBit onBit: a). box bitB: (InputBit onBit: b). box clock: aClock. ^box! ! Object subclass: #ButtonBoxResponse instanceVariableNames: 'responseButton responseTime ' classVariableNames: '' poolDictionaries: '' category: 'Response-Support'! !ButtonBoxResponse methodsFor: 'accessing'! responseButton ^responseButton! ! !ButtonBoxResponse methodsFor: 'accessing'! responseButton: argument responseButton := argument. ^argument! ! !ButtonBoxResponse methodsFor: 'accessing'! responseTime ^responseTime! ! !ButtonBoxResponse methodsFor: 'accessing'! responseTime: argument responseTime := argument. ^argument! ! Object subclass: #Timebase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Support'! !Timebase commentStamp: 'BF 1/25/98 17:20' prior: 0! Timebase objects generate a simulated timebase for clocked realtime device objects.! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Timebase class instanceVariableNames: 'tick process '! !Timebase class methodsFor: 'class initialization'! initialize "Initialize our instance variables, and rid ourself of old dependents." "Timebase initialize" tick := 0. self breakDependents! ! !Timebase class methodsFor: 'instance creation'! new "Do not permit this." self error: 'Timebase should have no instances...'! ! !Timebase class methodsFor: 'accessing'! tick "Return the number of ticks we've counted since we were last initialized." ^tick! ! !Timebase class methodsFor: 'accessing'! tick: anInteger "Explicitly set the tick counter." ^tick := anInteger! ! !Timebase class methodsFor: 'timebase process'! doTick "A tick has occured. Up our tick count, and say we changed." tick := tick + 1. self changed! ! !Timebase class methodsFor: 'timebase process'! waitForEvent "Declare a clock tick. This will in turn update any timebase dependent dependents." self doTick! ! Timebase initialize! Object subclass: #Device instanceVariableNames: '' classVariableNames: 'DeviceAccess DeviceIntegerGenerator ' poolDictionaries: '' category: 'Realtime-Devices'! !Device commentStamp: 'BF 1/25/98 17:20' prior: 0! This abstract class provides common realtime device behavior...! !Device methodsFor: 'instance initialization'! initialize "Default for Devices is to do nothing." ^self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Device class instanceVariableNames: ''! !Device class methodsFor: 'instance creation'! new "Create a new device, and initialize it. (This ensures that any instance of device is initialized upon creation (as per usual practice).)" | device | device := super new. device initialize. ^device! ! !Device class methodsFor: 'class initialization'! initialize "Device initialize" "Create a shared random number generator and a semaphore. (The semaphore is not used by the current synchronous realtime device implementation.)" DeviceAccess := Semaphore forMutualExclusion. DeviceIntegerGenerator := IntegerGenerator new! ! Device initialize! Device subclass: #ClockedDevice instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !ClockedDevice commentStamp: 'BF 1/25/98 17:20' prior: 0! ClockedDevice is an abstract class that adds protocol for setting up Timebase dependencies to Device. ! !ClockedDevice methodsFor: 'instance initialization'! initialize "All ClockedDevice instances should be made Timebase dependents." super initialize. Timebase addDependent: self! ! !ClockedDevice methodsFor: 'timebase access'! update: anObject "Our timebase must have issued an update request. Do what we need to do when a tick occurs. (We keep this method in reserve in case additional update protocol needs to be added somewhere.)" self doTick! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ClockedDevice class instanceVariableNames: ''! ClockedDevice subclass: #Clock instanceVariableNames: 'interval active count flag cycle recycle scheduledBlocks startTick ' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !Clock commentStamp: 'BF 1/25/98 17:20' prior: 0! Clock is a realtime programmable clock simulation. It provides protocol for starting and stopping timers in a number of different modes...! !Clock methodsFor: 'instance initialization'! initialize "Make sure the active flag has a value, then let super make the dependent list connections." active := false. flag := false. super initialize! ! !Clock methodsFor: 'clock control'! atTime: tick do: aBlock "Add this block to the OrderedCollection for the given time point. If there is no collection in the Dictionary for this time point, make one." (scheduledBlocks at: tick ifAbsent: [scheduledBlocks at: tick put: (OrderedCollection new: 4)]) add: aBlock! ! !Clock methodsFor: 'clock control'! startEvery: ticks "Run us in repeat mode." self startInterval: ticks recycle: true thenDo: nil! ! !Clock methodsFor: 'clock control'! startEvery: ticks thenDo: aBlock "Run the indicated block at the indicated interval." self startInterval: ticks recycle: false thenDo: aBlock! ! !Clock methodsFor: 'clock control'! startFor: ticks "Start us for the indicated interval." self startInterval: ticks recycle: false thenDo: nil! ! !Clock methodsFor: 'clock control'! startFor: ticks thenDo: aBlock "Start a clock for the indicated interval, and schedule the indicated block when it is done." self startInterval: ticks recycle: false thenDo: aBlock! ! !Clock methodsFor: 'clock control'! stop "Just mark the clock as inactive." active := false! ! !Clock methodsFor: 'public access'! elapsed "Return how many ticks we've counted." ^count! ! !Clock methodsFor: 'public access'! flag "Allow the user to test the done flag." ^flag! ! !Clock methodsFor: 'public access'! flag: aBoolean "Allow the user to set the done flag." ^flag := aBoolean! ! !Clock methodsFor: 'public access'! left "Return the amount of time left until the clock times out." ^interval - count! ! !Clock methodsFor: 'public access'! wait "Just wait for the done flag." [flag] whileFalse: [Timebase waitForEvent]! ! !Clock methodsFor: 'public access'! waitUntil: tick "Just wait 'til we've counted up to tick." [count ~= tick] whileTrue: [Timebase waitForEvent]! ! !Clock methodsFor: 'timebase access'! doBlocks: blocks "Run all the blocks in the collection given us. (Note that we may want to think about forking these instead of running them here and now.)" blocks do: [:aBlock | aBlock value]! ! !Clock methodsFor: 'timebase access'! doTick "A timebase tick occured. If we are active, up our count, check for scheduled blocks, and see if we timed out." active ifTrue: [count := count + 1. (scheduledBlocks includesKey: count) ifTrue: [self doBlocks: (scheduledBlocks at: count)]. count = interval ifTrue: [self doTimeout]]! ! !Clock methodsFor: 'timebase access'! doTimeout "If this is repeat mode, start over, otherwise just stop." recycle ifTrue: [count := 0] ifFalse: [active := false]. cycle := cycle + 1. flag := true! ! !Clock methodsFor: 'private'! startInterval: ticks recycle: aBoolean thenDo: aBlock "Initialize the clock variables, and start us up." count := 0. interval := ticks. active := true. cycle := 0. recycle := aBoolean. flag := false. startTick := Timebase tick. scheduledBlocks := (Dictionary new: 4). (aBlock~~nil) ifTrue: [self atTime: ticks do: aBlock]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Clock class instanceVariableNames: ''! !Clock class methodsFor: 'examples'! example "Clock example" "MessageTally spyOn: [Clock example]" "Time millisecondsToRun: [Clock example]" | aClock | "Set up the timebase..." Timebase initialize. "Create a clock, and schedule a bunch of completion blocks..." aClock := Clock new. aClock startFor: 5 thenDo: [Transcript show: 'All done...'; cr]. aClock atTime: 5 do: [Transcript show: 'Time: ' , aClock elapsed printString; cr]. aClock atTime: 4 do: [Transcript show: 'Time: ' , aClock elapsed printString; cr]. "This should make things interesting (and demonstrate a classic critical section problem)..." Transcript show: 'During set up: ' , aClock elapsed printString; cr. aClock atTime: 3 do: [Transcript show: 'Time: ' , aClock elapsed printString; cr]. aClock atTime: 2 do: [Transcript show: 'Time: ' , aClock elapsed printString; cr]. aClock atTime: 1 do: [Transcript show: 'Time: ' , aClock elapsed printString; cr]. aClock wait. Transcript show: 'After wait...'; cr.! ! ClockedDevice subclass: #Digitizer instanceVariableNames: 'interval active count flag channels points block point ' classVariableNames: 'MaxValue MinValue ' poolDictionaries: '' category: 'Realtime-Devices'! !Digitizer commentStamp: 'BF 1/25/98 17:20' prior: 0! This abstract class simulates clocked, multichannel A/D converter systems. Subclasses demonstrate different approaches to handling digitizer output data...! !Digitizer methodsFor: 'instance initialization'! initialize "Make sure the active flag has a value, then let super make the dependent list connections." active := false. flag := false. super initialize! ! !Digitizer methodsFor: 'data collection'! stop "Just mark the clock as inactive." active := false! ! !Digitizer methodsFor: 'public access '! flag "Allow the user to test the done flag." ^flag! ! !Digitizer methodsFor: 'public access '! wait "Just wait for the done flag." [flag] whileFalse: [Timebase waitForEvent]! ! !Digitizer methodsFor: 'As yet unclassified'! flag: aBoolean "Allow the user to set the done flag." ^flag := aBoolean! ! !Digitizer methodsFor: 'timebase access'! doTimeout "We are done. Execute our block, turn off the active flag, and say we are done." block ~~ nil ifTrue: [block value]. active := false. flag := true! ! !Digitizer methodsFor: 'timebase access' stamp: 'BF 1/24/98 19:41'! simulatePoint "Fabricate a point. We might want to make this more interesting later." ^DeviceIntegerGenerator from: MinValue to: MaxValue! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Digitizer class instanceVariableNames: ''! !Digitizer class methodsFor: 'class initialization'! initialize "Digitizer initialize" "Define constants for our minimum and maximum values. The values chosen here are consistent with what a real 12 bit signed A/D system would report." MinValue := -2048. MaxValue := 2047! ! Digitizer initialize! Digitizer subclass: #BufferedDigitizer instanceVariableNames: 'buffer ' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !BufferedDigitizer methodsFor: 'data collection'! collectChannels: chans points: pnts in: buf every: ticks thenDo: aBlock "Collect data from the indicated number of channels at the indicated interval until the given number of time points have been sampled. The data will be stored in a caller supplied buffer. This buffer must be an ArrayedCollection with (at least) 'chans' elements. Each of these elements must be an ArrayedCollection large enough to accomodated at least 'pnts' data points." interval := ticks. count := 0. active := true. flag := false. channels := chans. point := 0. points := pnts. buffer := buf. block := aBlock! ! !BufferedDigitizer methodsFor: 'timebase access'! doTick "Fake some data." active ifTrue: [count := count + 1. count = interval ifTrue: [count := 0. point := point + 1. buffer do: [:waveform | waveform at: point put: self simulatePoint]. point = points ifTrue: [self doTimeout]]] "Brian Foote 7/21/87 (?!!) Repaired to fix missing interval timeout code..."! ! ClockedDevice subclass: #InputBit instanceVariableNames: 'active count flag bit clock time block fakeTime low high ' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !InputBit commentStamp: 'BF 1/25/98 17:21' prior: 0! This class simulates a single line parallel input device.! !InputBit methodsFor: 'instance initialization'! initialize "Set out reasonable defaults." active := false. flag := false. super initialize.! ! !InputBit methodsFor: 'input reporting'! disable "Mark us as off." active := false! ! !InputBit methodsFor: 'input reporting'! enable "Turn us on with no clock or block." self enableUsingClock: nil onInputDo: nil! ! !InputBit methodsFor: 'input reporting'! enableUsingClock: aClock "Turn us on, saving the given clock." self enableUsingClock: aClock onInputDo: nil! ! !InputBit methodsFor: 'input reporting'! enableUsingClock: aClock onInputDo: aBlock "Turn us on, saving the given clock and block." clock := aClock. block := aBlock. flag := false. count := 0. active := true! ! !InputBit methodsFor: 'accessing'! bit "Return the bit that I watch." ^bit! ! !InputBit methodsFor: 'accessing'! bit: bitNumber "Set the bit number." ^bit := bitNumber! ! !InputBit methodsFor: 'accessing'! fakeTimeLow: lowLimit high: highLimit "Turn on faking." low := lowLimit. high := highLimit. fakeTime:=DeviceIntegerGenerator integerBetween: low and: high! ! !InputBit methodsFor: 'accessing'! time "Return the saved time or nil." ^time! ! !InputBit methodsFor: 'timebase access'! doEvent "An input event for this bit has been generated (somehow). Set the event flag to true and the active flag to false. Then, record the event time relative to the given clock, if any. Then, run the completion block, if need be. Note that all this has the effect of latching the first event time after a bit is enabled. Subsequent events will be ignored until the bit is reenabled." flag := true. active := false. clock ~~ nil ifTrue: [time := clock elapsed]. block ~~ nil ifTrue: [block value] "Notes 4/29/86: It might be a good idea to make the order in which these tasks are done consistent across devices. As long as we use a synchronous event base this won't matter that much..." "Brian Foote 7/21/87 Changed the order of these actions so that completion blocks could reenable the bits, if desired.."! ! !InputBit methodsFor: 'timebase access'! doTick "Count ticks, and check for mouse buttons and faked events" active ifTrue: [count := count + 1. Sensor anyButtonPressed | (fakeTime ~~ nil and: [count = fakeTime]) ifTrue: [self doEvent]]! ! !InputBit methodsFor: 'public access'! flag "Allow the user to test the done flag." ^flag! ! !InputBit methodsFor: 'public access'! flag: aBoolean "Allow the user to set the done flag." ^flag := aBoolean! ! !InputBit methodsFor: 'public access'! wait "Just wait for the done flag." [flag] whileFalse: [Timebase waitForEvent]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! InputBit class instanceVariableNames: ''! !InputBit class methodsFor: 'instance creation'! new "Force a bit number..." self shouldNotImplement! ! !InputBit class methodsFor: 'instance creation'! onBit: anInteger "Save the bit number..." | newBit | newBit := super new. newBit bit: anInteger. ^newBit! ! !InputBit class methodsFor: 'examples'! example "InputBit example" "MessageTally spyOn: [InputBit example]" "Time millisecondsToRun: [InputBit example]" | aBit aClock | "Start the timebase..." Device initialize. Timebase initialize. "Set up a bit and a clock..." aClock := Clock new. aClock startFor: 1000. aBit := InputBit newOnBit: 0. aBit fakeTimeLow: 200 high: 800. aBit enableUsingClock: aClock. "Wait for the bit event, and print the time..." aBit wait. Transcript show: 'Time was: ' , aBit time printString ; cr.! ! Device subclass: #OutputBit instanceVariableNames: 'bit ' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !OutputBit commentStamp: 'BF 1/25/98 17:21' prior: 0! This class simulates a single line parallel output device.! !OutputBit methodsFor: 'accessing'! bit "Return the bit number..." ^bit! ! !OutputBit methodsFor: 'accessing'! bit: bitNumber "Set the bit number..." ^bit := bitNumber! ! !OutputBit methodsFor: 'set/clear' stamp: 'BF 1/24/98 19:04'! clear "This is only a simulation..." SoundPlayer shutDown. ^self! ! !OutputBit methodsFor: 'set/clear' stamp: 'BF 1/24/98 19:01'! set "The buck stops here..." | s | SoundPlayer startPlayerProcessBufferSize: 11025 rate: 11025 stereo: true. s _ FMSound pitch: 440.0+(100.0*bit) dur: 50.0 loudness: 0.2. SoundPlayer playSound: s. ^self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OutputBit class instanceVariableNames: ''! !OutputBit class methodsFor: 'instance creation'! new "Force a bit number..." self shouldNotImplement! ! !OutputBit class methodsFor: 'instance creation'! onBit: anInteger "Save the bit number..." | newBit | newBit := super new. newBit bit: anInteger. ^newBit! ! Digitizer subclass: #StreamedDigitizer instanceVariableNames: 'stream ' classVariableNames: '' poolDictionaries: '' category: 'Realtime-Devices'! !StreamedDigitizer methodsFor: 'data collection'! collectChannels: chans points: pnts on: aStream every: ticks thenDo: aBlock "Collect data from the indicated number of channels at the indicated interval until the given number of time points have been sampled. The data will be written to a caller supplied stream..." interval := ticks. count := 0. active := true. flag := false. channels := chans. point := 0. points := pnts. stream := aStream. block := aBlock! ! !StreamedDigitizer methodsFor: 'timebase access'! doTick "Fake some data..." active ifTrue: [count := count + 1. count = interval ifTrue: [count := 0. point := point + 1. (1 to: channels) do: [stream nextPut: self fakePoint]. point = points ifTrue: [self doTimeout]]] "Brian Foote 7/21/87 Added some missing interval timeout code..."! ! Object subclass: #Averager instanceVariableNames: 'count sum ' classVariableNames: '' poolDictionaries: '' category: 'Waveform-Support'! !Averager methodsFor: 'instance initialization'! initialize "Make sure new averages start with their counters at zero..." self count: 0! ! !Averager methodsFor: 'accessing'! count "Return the number of objects incorporated into our sum buffer so far..." ^count! ! !Averager methodsFor: 'accessing'! count: n "Set the counter as indicated. This might be useful were one to want to add new data into a saved pair of sum and count objects..." ^count := n! ! !Averager methodsFor: 'accessing'! sum "Return the current sum object. (This can be any object that responds to '+=', '/=', and 'zero'.)" ^sum! ! !Averager methodsFor: 'accessing'! sum: anObject "Set the current sum object. (This can be any object that responds to '+=', '/=', and 'zero'.)" ^sum := anObject! ! !Averager methodsFor: 'averaging'! average ^self sum /= self count! ! !Averager methodsFor: 'averaging'! nextPut: anObject "Tell our sum object to add this object into to itself. Then update our count... " self sum += anObject. self count: self count + 1! ! !Averager methodsFor: 'averaging'! zero "Forward this to our sum object, if any..." self count: 0. sum isNil ifFalse: [sum zero]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Averager class instanceVariableNames: ''! !Averager class methodsFor: 'instance creation'! new "Create a new averager..." | avg | avg := super new. avg initialize. ^avg! ! !Averager class methodsFor: 'instance creation'! on: anObject "Create a new averager and set its initial sum buffer as indicated. (This can be any object that responds to '+=', '/=', and 'zero'.)" | avg | avg := self new. avg sum: anObject. avg zero. ^avg! ! Object subclass: #Tally instanceVariableNames: 'sum sumSquared count ' classVariableNames: '' poolDictionaries: '' category: 'Waveform-Support'! !Tally methodsFor: 'instance initialization'! initialize "Tell ourself to zero our accumulators..." self zero! ! !Tally methodsFor: 'instance initialization'! zero "Zero our counter, and our two sums..." count := 0. sum := 0. sumSquared := 0! ! !Tally methodsFor: 'statistics'! average "Return the average value across all the values we've seen..." count == 0 ifTrue: [^0] ifFalse: [^sum / count]! ! !Tally methodsFor: 'statistics'! standardDeviation "Return the accumulated standard deviation..." | t | count == 0 ifTrue: [^0]. t := count * sumSquared - (sum * sum). ^t sqrt / count! ! !Tally methodsFor: 'statistics'! variance "There are certainly more efficient ways to do this one..." ^self standardDeviation * self standardDeviation! ! !Tally methodsFor: 'accessing'! count "Return our current counter value..." ^count! ! !Tally methodsFor: 'accessing'! count: n "Set the counter value..." ^count := n! ! !Tally methodsFor: 'accessing'! sum "Return the current running sum..." ^sum! ! !Tally methodsFor: 'accessing'! sum: n "Set the sum accumulator..." ^sum := n! ! !Tally methodsFor: 'accessing'! sumSquared "Return the squares sum..." ^sumSquared! ! !Tally methodsFor: 'accessing'! sumSquared: n "Set the squares sum..." ^sumSquared := n! ! !Tally methodsFor: 'updating'! nextPut: value "Sum the given value into our accumulators. (We used to call this addIn: and +=)..." sum := sum + value. sumSquared := sumSquared + (value * value). count := count + 1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tally class instanceVariableNames: ''! !Tally class methodsFor: 'instance creation'! new "Create a tally, and initialize it..." | aTally | aTally := super new. aTally initialize. ^aTally! ! Array variableSubclass: #Waveform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Waveform-Support'! !Waveform commentStamp: 'BF 1/25/98 17:21' prior: 0! Waveforms represent single channels time series records...! !Waveform methodsFor: 'instance initialization'! initialize "Let's zero new waveforms..." self zero! ! !Waveform methodsFor: 'element initialization'! simulateData "Put a random number in the range that one would expect from an A/D converter into each or our elements..." | r | r := IntegerGenerator new. (1 to: self size) do: [:p | self at: p put: (r from: -2048 to: 2047)] "Notes 4/30/86: We might want to consider creating a pool with A/D ranges and the like in it..."! ! !Waveform methodsFor: 'element initialization'! zero "Filling a collection with zeros is easy..." self atAllPut: 0! ! !Waveform methodsFor: 'averaging'! += aWaveform (1 to: self size) do: [:p | self at: p put: (self at: p) + (aWaveform at: p)]! ! !Waveform methodsFor: 'averaging'! /= count | w | w := self collect: [:pnt | pnt / count rounded]. ^w! ! !Waveform methodsFor: 'extrema'! highX ^self size! ! !Waveform methodsFor: 'extrema'! highY ^2047! ! !Waveform methodsFor: 'extrema'! lowX ^1! ! !Waveform methodsFor: 'extrema'! lowY ^-2048! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Waveform class instanceVariableNames: ''! !Waveform class methodsFor: 'instance creation'! points: size "Create a waveform of the given size..." "Create a Waveform..." | w | w := super new: size. w initialize. ^w! ! Array variableSubclass: #WaveformCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Waveform-Support'! !WaveformCollection methodsFor: 'element initalization'! simulateData "Tell all our elements to fill themselves with bogus data..." self do: [:chan | self at: chan simulateData]! ! !WaveformCollection methodsFor: 'element initalization'! zero "Tell all our elements to zero themselves..." self do: [:chan | chan zero]! ! !WaveformCollection methodsFor: 'averaging'! += aWaveformCollection "Sum each of the elements of the given waveform collection into the respective element of us..." self with: aWaveformCollection do: [:selfElement :otherElement | selfElement += otherElement]! ! !WaveformCollection methodsFor: 'averaging'! /= count "Divide each of our elements by the given value..." self do: [:waveform | waveform /= count]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WaveformCollection class instanceVariableNames: ''! !WaveformCollection class methodsFor: 'instance creation'! channels: chans points: pnts "Create a waveform collection with 'size' elements, each of which is a waveform..." | w | w := super new: chans. (1 to: chans) do: [:elem | w at: elem put: (Waveform points: pnts)]. ^w! ! !WaveformCollection class methodsFor: 'instance creation'! new "We need to know dimensions to make a waveform collection..." self shouldNotImplement! ! Stream subclass: #Filter instanceVariableNames: 'sink ' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !Filter commentStamp: 'BF 1/25/98 17:21' prior: 0! Filters allow Stream-like objects and other Filters to be strung together. They allow nextPut: based plumbing fixtures to be constructed. Subclasses may add additional functionality so that they do more with the data they receive than merely pass it down the line.! !Filter methodsFor: 'accessing'! next "No reading allowed. Filters are WriteStream-like objects." self shouldNotImplement! ! !Filter methodsFor: 'accessing'! nextPut: anObject "Write the given object to our output sink. If no sink has been designated, eat the object." sink isNil ifTrue: [^anObject]. ^sink nextPut: anObject! ! !Filter methodsFor: 'accessing'! sink "Return our output sink." ^sink! ! !Filter methodsFor: 'accessing'! sink: aSink "Set our output sink, aand return this object as our result." ^sink := aSink! ! !Filter methodsFor: 'connecting'! >> aSink "Connect us to the indicated output sink. Note that we return the given sink so as to allow connect messages to be strung together." ^self sink: aSink! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Filter class instanceVariableNames: ''! !Filter class methodsFor: 'instance creation'! new "It's okay to use new to create these..." ^self basicNew! ! Filter subclass: #Pump instanceVariableNames: 'source ' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !Pump commentStamp: 'BF 1/25/98 17:21' prior: 0! Pumps draw data from ReadStream-like objects, and send them down WriteStream-like objects (such as Filters).! !Pump methodsFor: 'accessing'! nextPut "Send the next item down the pike, and return whatever it was as our result. We send a next to our source, and nextPut: the result down our sink. " ^sink nextPut: source next! ! !Pump methodsFor: 'accessing'! nextPutAll "Send all we can the pike. While our source is not atEnd, draw objects from it and shove them down our output pipeline." [self atEnd] whileFalse: [self nextPut]! ! !Pump methodsFor: 'accessing'! source "Return our current source object." ^source! ! !Pump methodsFor: 'accessing'! source: aSource "Set our current source object, and return it as our result." ^source := aSource! ! !Pump methodsFor: 'testing'! atEnd "Any source data left?" source isNil ifTrue: [^true]. ^source atEnd! ! !Pump methodsFor: 'connecting'! << aSource "Set our current source object. Note that we return the given source so as to allow connect messages to be strung together..." ^self source: aSource! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Pump class instanceVariableNames: ''! !Pump class methodsFor: 'examples'! example1 "Pump example1" | result fixture | "We'll dump our results on this array, to which we will fit a stream..." result := WriteStream on: (Array new: 100). "Build a fixture. Start with a pump. Hook a stream on an interval into it as a data source. Run its output into a ValueFilter, which will double each value, and a divisible by four Valve, then into the result stream..." fixture := Pump new. fixture << (ReadStream on: (Interval from: 1 to: 10)). fixture >> (ValueFilter using: [:value | value * 2]) >> (Valve using: [:value | value \\ 4 = 0]) >> result. "The fixture is all constructed, so now let's use it. Run all the data from our input stream through the pipeline constructed above into the result stream. Return the contents of the result stream..." fixture nextPutAll. ^result contents! ! Filter subclass: #Tee instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !Tee commentStamp: 'BF 1/25/98 17:21' prior: 0! Tees are output Filters that allow multiple output sinks. (If this facility proves really useful, it can be added to Filter.)! !Tee methodsFor: 'accessing'! >> aSink "Add this sink to our collection..." self sink isNil ifTrue: [self sink: (OrderedCollection new: 4)]. self sink addLast: aSink. ^aSink! ! !Tee methodsFor: 'accessing'! nextPut: anObject "Do writes to all our effluent ports..." self sink do: [:aSink | aSink nextPut: anObject]. ^anObject! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tee class instanceVariableNames: ''! Filter subclass: #ValueFilter instanceVariableNames: 'block ' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !ValueFilter commentStamp: 'BF 1/25/98 17:21' prior: 0! ValueFilters transform the input they receive using a designated block, and send the result to their output sinks...! !ValueFilter methodsFor: 'accessing'! block: aBlock "Set (or reset) our transformation..." ^block := aBlock! ! !ValueFilter methodsFor: 'accessing'! nextPut: anObject "Return the value of running the given object through our block..." block isNil ifTrue: [^super nextPut: anObject] ifFalse: [^super nextPut: (block value: anObject)]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ValueFilter class instanceVariableNames: ''! !ValueFilter class methodsFor: 'instance creation'! using: aBlock "Set our value transformation block..." | filter | filter := super new. filter block: aBlock. ^filter! ! Filter subclass: #ValueSink instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !ValueSink commentStamp: 'BF 1/25/98 17:21' prior: 0! This Filter subclass serves as a bit bucket. It actually adds no protocol to Filter...! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ValueSink class instanceVariableNames: ''! Object subclass: #ValueSupply instanceVariableNames: 'block ' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !ValueSupply commentStamp: 'BF 1/25/98 17:21' prior: 0! This ReadStream-like object evaluates a given block in response to next requests...! !ValueSupply methodsFor: 'accessing'! block: aBlock "Set (or reset) our transformation..." ^block := aBlock! ! !ValueSupply methodsFor: 'accessing'! next "Return the result of evaluating our block..." ^block value! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ValueSupply class instanceVariableNames: ''! !ValueSupply class methodsFor: 'instance creation'! using: aBlock "Set our value generating block..." | filter | filter := super new. filter block: aBlock. ^filter! ! Filter subclass: #Valve instanceVariableNames: 'block ' classVariableNames: '' poolDictionaries: '' category: 'Plumbing-Support'! !Valve commentStamp: 'BF 1/25/98 17:21' prior: 0! Valve objects pass data through to their output sinks only if a given block evaluates to true...! !Valve methodsFor: 'accessing'! block: aBlock "Set (or reset) our predicate block. This should be a one arguement block, which will receive the current output object..." ^block := aBlock! ! !Valve methodsFor: 'accessing'! nextPut: anObject "Return the value of running the given object down our sink only if we have a predicate block, and it is true. Otherwise return the object itself..." block isNil ifTrue: [^anObject]. (block value: anObject) ifTrue: [^super nextPut: anObject]. ^anObject! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Valve class instanceVariableNames: ''! !Valve class methodsFor: 'instance creation'! using: aBlock "Set our test block..." | filter | filter := super new. filter block: aBlock. ^filter! ! Number subclass: #Complex instanceVariableNames: 're im ' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !Complex methodsFor: 'accessing'! im "Return my imaginary part..." ^ im! ! !Complex methodsFor: 'accessing'! im: aNumber "Set my imaginary part." ^ im := aNumber! ! !Complex methodsFor: 'accessing'! re "Return my real part." ^re! ! !Complex methodsFor: 'accessing'! re: aNumber "Set the real part of this complex number." ^ re := aNumber! ! !Complex methodsFor: 'coercing'! coerce: argument (argument isKindOf: Polar) ifTrue: [^ argument asComplex]. (argument isKindOf: Number) ifTrue: [^ Complex re: argument im: 0]. (argument isKindOf: Collection) ifTrue: [^ Complex re: (argument at: 1) im: (argument at: 2)]. self error: 'Coercion failed...'! ! !Complex methodsFor: 'coercing'! generality "The generalities that come with the distributed system are: Float 80, Fraction 60, Integer 40, SmallInteger 20." ^ 100! ! !Complex methodsFor: 'converting'! asComplex ^ self! ! !Complex methodsFor: 'converting'! asPolar "Convert ourself to a polar complex (trigonometric notation)..." "(1 + 1 i) asPolar" | r theta | r := self abs. theta := (self re / r) arcCos. ^ Polar r: r theta: theta! ! !Complex methodsFor: 'binary operators'! * argument "(1 + 2 i) * (1 + 3 i)" "(1 + 2 i) * (1 - 3 i)" "(1 + 4 i) * 2 i" "2 i * (1 + 4 i)" | r i | (argument isKindOf: Complex) ifTrue: [r := self re * argument re - (self im * argument im). i := self re * argument im + (self im * argument re). ^ Complex re: r im: i] ifFalse: [^ self retry: #* coercing: argument]! ! !Complex methodsFor: 'binary operators'! + argument "(Complex re: 3 im: 4)+(Complex re: 3 im: 4)" "(3 + 4 i) + (3 + 4 i)" | r i | (argument isKindOf: Complex) ifTrue: [r := self re + argument re. i := self im + argument im. ^ Complex re: r im: i] ifFalse: [^ self retry: #+ coercing: argument]! ! !Complex methodsFor: 'binary operators'! - argument "(Complex re: 3 im: 4) + (Complex re: 3 im: 4)" "(3 + 4 i) - (3 + 4 i)" | r i | (argument isKindOf: Complex) ifTrue: [r := self re - argument re. i := self im - argument im. ^ Complex re: r im: i] ifFalse: [^ self retry: #- coercing: argument]! ! !Complex methodsFor: 'binary operators'! / argument "(4 + 5 i) / (1 + 4 i)" "1 / (2 - 3 i)" | r i c d n | (argument isKindOf: Complex) ifTrue: [c := argument conjugate. d := argument * c. n := self * c. r := n re / d re. i := n im / d re. ^ Complex re: r im: i] ifFalse: [^ self retry: #/ coercing: argument]! ! !Complex methodsFor: 'binary operators'! = aNumber "If we are both complex, see if both the real and imaginary parts match. If not, twist someone's arm..." (aNumber isKindOf: Complex) ifTrue: [^ self re = aNumber re and: [self im = aNumber im]] ifFalse: [^ self retry: #= coercing: aNumber]! ! !Complex methodsFor: 'unary operators'! abs "The absolute value of a complex number is the square root of the sum of the real part squared and the imaginary part squared..." ^ (self re * self re + (self im * self im)) sqrt! ! !Complex methodsFor: 'unary operators'! conjugate "To form the conjugate we negate our imaginary part..." ^ Complex re: self re im: self im negated! ! !Complex methodsFor: 'unary operators'! negated "To negate a complex number, negate both the real and the imaginary components... " ^ Complex re: self re negated im: self im negated! ! !Complex methodsFor: 'printing'! printOn: aStream aStream nextPut: $(. self re printOn: aStream. self im >= 0 ifTrue: [aStream nextPutAll: ' + '. self im printOn: aStream] ifFalse: [aStream nextPutAll: ' - '. self im negated printOn: aStream]. aStream nextPutAll: ' i)'! ! !Complex methodsFor: 'printing'! storeOn: aStream "Use our print string for this..." ^ self printOn: aStream! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Complex class instanceVariableNames: ''! !Complex class methodsFor: 'instance creation'! re: r im: i "Create a complex number with the given real and imaginary parts." | c | c := self new. c re: r; im: i. ^ c! ! !Complex class methodsFor: 'Number methods'! asComplex "Return a complex number with me as the real part and zero as the imaginary part." ^ Complex re: self im: 0! ! !Complex class methodsFor: 'Number methods'! cis: theta "Assume the we are r and we are constructing a polar complex number..." "2 cis: (120 degreesToRadians) (-1.0 + 1.73205 i)" ^ self * (theta cos + theta sin i)! ! !Complex class methodsFor: 'Number methods'! i "Return a complex number with zero as the real part and me as the imaginary part." ^ Complex re: 0 im: self! ! !Complex class methodsFor: 'Float methods'! sqrt "Answer the square root of the receiver." "Brian Foote 21 September 1987 Modified this method to allow the square root of a negative number to return a complex result..." "-4 sqrt (2.0 + 1 i)" | guess | self <= 0.0 ifTrue: [self = 0.0 ifTrue: [^ 0.0] ifFalse: [^ self negated sqrt + 1 i "self error: 'sqrt invalid for x < 0'"]]. "copy and halve the exponent for first guess" guess := self timesTwoPower: 0 - (self exponent // 2). 5 timesRepeat: [guess := self - (guess * guess) / (guess * 2.0) + guess]. ^ guess! ! !Complex class methodsFor: 'installation'! install "Complex install" Number copyCategory: 'Number methods' asSymbol from: Complex class classified: 'Complex methods'. Float copyCategory: 'Float methods' asSymbol from: Complex class classified: 'Complex methods'! ! !Complex class methodsFor: 'notes'! notes "The base conversion algorithm for logarithms: log(b) x = log(a) x / log(a) b" "100 ln / 10 ln 2.0" "The exponent base conversion algorithm: a**x = b**(x log(b) a" "2 raisedTo: (3 * (10 log: 2)) 999.99"! ! Object variableSubclass: #Eliminator instanceVariableNames: 'matrix inverse inverseDeterminant determinant steps rowEchelonForm reducedRowEchelonForm originalMatrix log lower ' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !Eliminator methodsFor: 'public access'! determinant "If there is a zero row in the matrix, the determinant of the matrix is zero. Otherwise, the determinant of the matrix is the inverse of the determinant of the inverse (which we know)..." reducedRowEchelonForm hasZeroRow ifTrue: [^ 0]. ^ 1 / inverseDeterminant! ! !Eliminator methodsFor: 'public access'! inverse "Return the inverse we calculated. Note that if our original matrix was not invertable the value returned will nonetheless transform the (non-identity) reduced row echelon form we produced into the original matrix (for all the good that does)..." ^ inverse! ! !Eliminator methodsFor: 'public access'! inverseDeterminant "This value is the determinant of the the inverse matrix we've constructed. If the original matrix was reduced all the way to an identity matrix, then that matrix is the inverse of the original matrix..." ^ inverseDeterminant! ! !Eliminator methodsFor: 'public access'! log "Return our elementary row operation log. It contains an entry for each move we made. Each entry is an Array with the move selector as the first argument, and the move arguments in the subsequent positions..." ^ log! ! !Eliminator methodsFor: 'public access'! lower "Return the L (as in LU) matrix we've calculated..." ^ lower! ! !Eliminator methodsFor: 'public access'! originalMatrix "We keep a copy of the original matrix in case anyone needs to see it..." ^ originalMatrix! ! !Eliminator methodsFor: 'public access'! reducedRowEchelonForm "Return the reduced row echelon form of the original matrix. If the original matrix was invertable, the coefficient part of this matrix will be an identity matrix. Recall that the reduced row echelon form of a matrix is unique..." ^ reducedRowEchelonForm! ! !Eliminator methodsFor: 'public access'! rowEchelonForm "Return a row echelon form of the original matrix. Row echelon forms are not unique..." ^ rowEchelonForm! ! !Eliminator methodsFor: 'public access'! steps "Return the number of elementary row operations we had to perform to reduce the original matrix to reduced row echelon form. (We could eliminate this counter and use log size if we wished.)" ^ steps! ! !Eliminator methodsFor: 'public access'! upper "Return the U (as in LU) matrix we've calculated..." ^ self rowEchelonForm! ! !Eliminator methodsFor: 'elementary row operations'! addRow: src multipliedBy: aNumber toRow: dst "Perform this operation both on our proto-inverse and on the matrix we are trying to reduce. (Note that this elementary row operation has no effect on the inverse determinant that we are trying to accumulate.)" steps := steps + 1. log addLast: (Array with: #addRow:multipliedBy:toRow: with: src with: aNumber with: dst). inverse addRow: src multipliedBy: aNumber toRow: dst. ^ matrix addRow: src multipliedBy: aNumber toRow: dst! ! !Eliminator methodsFor: 'elementary row operations'! interchangeRow: row1 andRow: row2 "Perform this exchange both on our proto-inverse and on the matrix we are trying to reduce. Interchanging two rows negates the determinant of a matrix..." steps := steps + 1. log addLast: (Array with: #interchangeRow:andRow: with: row1 with: row2). inverseDeterminant := inverseDeterminant negated. inverse interchangeRow: row1 andRow: row2. ^ matrix interchangeRow: row1 andRow: row2! ! !Eliminator methodsFor: 'elementary row operations'! multiplyRow: row by: aNumber "Apply this operation both to our proto-inverse and to the matrix we are attempting to reduce. Multiplying a row of a matrix by a constant k multiplies the determinant by k as well." steps := steps + 1. log addLast: (Array with: #multiplyRow:by: with: row with: aNumber). inverseDeterminant := inverseDeterminant * aNumber. inverse multiplyRow: row by: aNumber. ^ matrix multiplyRow: row by: aNumber! ! !Eliminator methodsFor: 'gauss-jordan elimination'! backSubstitute "Solve an augmented matrix in row echelon form using back substitution..." | m n p b | m := self rowEchelonForm copy. n := m rows. p := m cols. (m rows - 1 to: 1 by: -1) do: [:r | b := m row: r col: p. (r + 1 to: n) do: [:c | b := b - ((m row: r col: c) * (m row: c col: p)). m row: r col: c put: 0]. m row: r col: p put: b]. ^m! ! !Eliminator methodsFor: 'gauss-jordan elimination'! findLargestRowStartingAtRow: row inCol: col "Find the pivot row in the indicated column. This is the row with the element with the largest absolute value. (Ties will go to the lower numbered row.)" | max pivotRow e | max := matrix row: row col: col. pivotRow := row. (row to: matrix rows) do: [:r | e := (matrix row: r col: col) abs. e > max ifTrue: [max := e. pivotRow := r]]. ^ pivotRow! ! !Eliminator methodsFor: 'gauss-jordan elimination'! findNonZeroColStartingAtRow: row "Search the submatrix defined by row for a non-zero column, and return the column number for it. If no such column can be found, return nil..." (1 to: matrix cols) do: [:c | (row to: matrix rows) do: [:r | (matrix row: r col: c) ~= 0 ifTrue: [^ c]]]. ^ nil! ! !Eliminator methodsFor: 'gauss-jordan elimination'! findNonZeroRowStartingAtRow: row inCol: col "Return the row number of the first non-zero row in the indicated column at or below the given starting row..." (row to: matrix rows) do: [:r | (matrix row: r col: col) ~= 0 ifTrue: [^ r]]. self error: 'No non-zero row? Impossible...'! ! !Eliminator methodsFor: 'gauss-jordan elimination'! initializeWith: aMatrix "First, convert whatever we were passed to a matrix. Then copy this for posterity. Set the inverseDeterminant and inverse variables so that they start with identity matrix values. We will perform the same elementary row operations on these that we perform on the original matrix in the process of trying to reduce it to reduced row echelon form. If the original matrix is reduced to an identity matrix, the values of these variables will be as advertized..." matrix := aMatrix asMatrix. originalMatrix := matrix copy. inverseDeterminant := 1. inverse := (Matrix order: matrix rows) zero; atDiagonalPut: 1. lower := (Matrix order: matrix rows) zero; atDiagonalPut: 1. steps := 0. log := OrderedCollection new: matrix rows * matrix rows! ! !Eliminator methodsFor: 'gauss-jordan elimination'! reduce: aMatrix "Attempt to reduce the given matrix using Gauss-Jordan elimination (with a pivotal condensation embelishment). The reduceRow pass creates leading one rows and eliminates the non-zeros below the diagonal. The reduceCol pass works up and attempts to eliminate non-zeros above the diagonal. We retain the intermediate row echelon form in case anyone should be interested in it for some reason..." self initializeWith: aMatrix. (1 to: matrix rows) do: [:r | self reduceRow: r]. rowEchelonForm := matrix copy. (matrix rows to: 2 by: -1) do: [:r | self reduceCol: r]. reducedRowEchelonForm := matrix copy. ^ reducedRowEchelonForm! ! !Eliminator methodsFor: 'gauss-jordan elimination'! reduceCol: row "We work up from the bottom row, and attempt to eliminate non-zeros above the diagonal by adding appropriate multiples of the ones that should lie along the diagonal. (This step is Jordan's embellishment to the Gaussian elimination technique...)" | col e | col := self findNonZeroColStartingAtRow: row. col isNil ifTrue: [^ self]. (row - 1 to: 1 by: -1) do: [:r | e := matrix row: r col: col. e ~= 0 ifTrue: [self addRow: row multipliedBy: e negated toRow: r]]! ! !Eliminator methodsFor: 'gauss-jordan elimination'! reduceRow: row "Perform Gaussian elimination on the submatrix defined by row. First, we locate a non-zero column in the current submatrix. Then find the row containing largest absolute value in this column (the pivot row). Next we scale this row so that it has a leading one. We then use this row to get rid of any non-zeros below us in the current column..." | r c e | c := self findNonZeroColStartingAtRow: row. c isNil ifTrue: [^self]. r := self findLargestRowStartingAtRow: row inCol: c. r = row ifFalse: [self interchangeRow: row andRow: r]. self multiplyRow: row by: 1 / (matrix row: row col: c). (row + 1 to: matrix rows) do: [:i | e := matrix row: i col: c. e ~= 0 ifTrue: [self addRow: row multipliedBy: e negated toRow: i. lower row: i col: c put: e negated]]! ! !Eliminator methodsFor: 'gauss-jordan elimination'! reduceRowWithoutCondensation: row "Perform Gaussian elimination on the submatrix defined by row. First, we locate a non-zero column in the current submatrix. Then find the row containing largest absolute value in this column (the pivot row). Next we scale this row so that it has a leading one. We then use this row to get rid of any non-zeros below us in the current column..." | r c e pivot | c := self findNonZeroColStartingAtRow: row. c isNil ifTrue: [^self]. r := self findLargestRowStartingAtRow: row inCol: c. r = row ifFalse: [self interchangeRow: row andRow: r]. pivot := matrix row: row col: c. (row + 1 to: matrix rows) do: [:i | e := matrix row: i col: c. e ~= 0 ifTrue: [self addRow: row multipliedBy: (e / pivot) negated toRow: i. lower row: i col: c put: e / pivot]]! ! !Eliminator methodsFor: 'gauss-jordan elimination'! reduceWithoutCondensation: aMatrix "Attempt to reduce the given matrix using Gauss-Jordan elimination (with a pivotal condensation embelishment). The reduceRow pass creates leading one rows and eliminates the non-zeros below the diagonal. The reduceCol pass works up and attempts to eliminate non-zeros above the diagonal. We retain the intermediate row echelon form in case anyone should be interested in it for some reason..." self initializeWith: aMatrix. (1 to: matrix rows) do: [:r | self reduceRowWithoutCondensation: r]. rowEchelonForm := matrix copy. (matrix rows to: 2 by: -1) do: [:r | self reduceCol: r]. reducedRowEchelonForm := matrix copy. ^ reducedRowEchelonForm! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Eliminator class instanceVariableNames: ''! !Eliminator class methodsFor: 'examples'! example1 "The correct inverse below is ((-40 16 9 )(13 -5 -3 )(5 -2 -1 ))." "Eliminator example1 #((-40 16 9 ) (13 -5 -3 ) (5 -2 -1 ) ) asMatrix" | e | e := Eliminator new. e reduce: #((1 2 3 ) (2 5 3 ) (1 0 8 ) ). ^e inverse! ! !Eliminator class methodsFor: 'examples'! example2 "Eliminator example2 #((1 2 0 3 0 7 ) (0 0 1 0 0 1 ) (0 0 0 0 1 2 ) ) asMatrix" ^Eliminator new reduce: #((0 0 -2 0 7 12) (2 4 -10 6 12 28) (2 4 -5 6 -5 -1))! ! !Eliminator class methodsFor: 'examples'! example3 "Eliminator example3 #((1.0 0.0 1.11759e-8 4.11957 ) (0.0 1.0 1.49012e-8 3.22389 ) (0.0 0.0 1.0 -18.2022 ) ) asMatrix" | e | e := Eliminator new. ^e reduce: #((4.4e-4 3.0e-4 -1.0e-4 0.0046 ) (4 1 1 1.5 ) (3 -9.2 -0.5 -8.2 ) )! ! !Eliminator class methodsFor: 'examples'! example4 "Eliminator example4 #((1 0 0 0 ) (0 0 1 -1 ) (0 0 0 0 ) (0 0 0 0 ) ) asMatrix" | e | e := Eliminator new. ^e reduce: #((2 0 1 -1 ) (1 0 1 -1 ) (1 0 0 0 ) (0 0 1 -1 ) )! ! !Eliminator class methodsFor: 'examples'! example5 "Eliminator example5 #((1 0 0 (-8/21) ) (0 1 0 (-1/21) ) (0 0 1 (1/21) ) ) asMatrix " | e | e := Eliminator new. ^e reduce: #((0 1 1 0 ) (1 -5 3 0 ) (2 1 -4 -1 ) )! ! !Eliminator class methodsFor: 'examples'! example6 "This example/test of LU decomposition is from Leon, page 228." "Eliminator example6 upper #((4 2 -2 ) (0 9 3 ) (0 0 3 ) ) asMatrix" "Eliminator example6 lower #((1 0 0 ) ((1/2) 1 0 ) ((-1/2) (1/3) 1 ) ) asMatrix" "Eliminator example6 lower * Eliminator example6 upper #((4 2 -2 ) (2 10 2 ) (-2 2 5 ) ) asMatrix" "Eliminator example6 backSubstitute" | e | e := Eliminator new. e reduceWithoutCondensation: #((4 2 -2 ) (2 10 2 ) (-2 2 5 ) ). ^e! ! !Eliminator class methodsFor: 'examples'! example7 "Eliminator example7 backSubstitute #((1 0 0 (-8/21) ) (0 1 0 (-1/21) ) (0 0 1 (1/21) ) ) asMatrix" | e | e := Eliminator new. e reduce: #((0 1 1 0 ) (1 -5 3 0 ) (2 1 -4 -1 ) ). ^e! ! Array variableSubclass: #Matrix instanceVariableNames: 'rows cols ' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !Matrix methodsFor: 'accessing'! cols ^cols! ! !Matrix methodsFor: 'accessing'! cols: n ^cols := n! ! !Matrix methodsFor: 'accessing'! copy ^self deepCopy! ! !Matrix methodsFor: 'accessing'! rows ^rows! ! !Matrix methodsFor: 'accessing'! rows: n ^rows := n! ! !Matrix methodsFor: 'coercing'! coerce: argument | matrix | "(argument isKindOf: Vector) ifTrue: [^ argument asMatrix]." (argument isKindOf: Matrix) ifTrue: [^ argument]. (argument isKindOf: Number) ifTrue: [matrix := Matrix order: self rows. matrix zero. matrix atDiagonalPut: argument. ^ matrix]. (argument isKindOf: Collection) ifTrue: [ ^Matrix with: argument]. self error: 'Coercion failed...'! ! !Matrix methodsFor: 'coercing'! generality "The generalities that come with the distributed system are: Float 80, Fraction 60, Integer 40, SmallInteger 20." ^ 140! ! !Matrix methodsFor: 'coercing'! retry: arith coercing: argument "Arithmetic represented by the message, arith, could not be performed between the receiver and the argument because of differences in representation. Coerce either the receiver or the argument to a more general representation, and try again." self generality < argument generality ifTrue: [^ (argument coerce: self) perform: arith with: argument] ifFalse: [^ self perform: arith with: (self coerce: argument)]! ! !Matrix methodsFor: 'converting '! asMatrix "We need do nothing to convert ourselves into a Matrix..." ^ self! ! !Matrix methodsFor: 'converting '! asVector "If both our number of columns or our number of rows is one, we can convert ourself to a Vector. Otherwise, we should already be one..." self cols = 1 & (self rows = 1) ifTrue: [^Vector with: (Array with: (self row: 1 col: 1))] ifFalse: [^self]! ! !Matrix methodsFor: 'element access'! atAllPut: value "Set all the elements or the matrix to the indicated value..." self doWithIndices: [:i :j | self row: i col: j put: value]! ! !Matrix methodsFor: 'element access'! atDiagonalPut: value "Set all the elements of the diagonal the matrix to the indicated value..." (1 to: (self rows min: self cols)) do: [:i | self row: i col: i put: value]! ! !Matrix methodsFor: 'element access'! col: n "Return a Matrix with just the indicated column..." | col | col := Matrix rows: self rows cols: 1. (1 to: self rows) do: [:row | col row: row col: 1 put: (self row: row col: n)]. ^col! ! !Matrix methodsFor: 'element access'! row: n "Return a matrix with just the indicated row..." | row | row := Matrix rows: 1 cols: self cols. (1 to: self cols) do: [:col | row row: 1 col: col put: (self row: n col: col)]. ^row! ! !Matrix methodsFor: 'element access'! row: row col: col "Return the value at the indicated row and column..." ^(self at: row) at: col! ! !Matrix methodsFor: 'element access'! row: row col: col put: value "Assign the given value to the matrix element at the given row/column address... " ^(self at: row) at: col put: value! ! !Matrix methodsFor: 'element access'! zero "Zap all the elements..." self atAllPut: 0! ! !Matrix methodsFor: 'elementary row operations'! addRow: src multipliedBy: n toRow: dst "#((1 2 3)(2 4 5)(3 2 1)) asMatrix addRow: 1 multipliedBy: -3 toRow: 3" | s d | s := self row: src. d := self row: dst. d := s * n + d. self replaceRow: dst with: d! ! !Matrix methodsFor: 'elementary row operations'! interchangeRow: row2 andRow: row1 "Clone the two rows in question, and reinsert them into ourself..." | r1 r2 | r1 := self row: row1. r2 := self row: row2. self replaceRow: row1 with: r2. self replaceRow: row2 with: r1! ! !Matrix methodsFor: 'elementary row operations'! multiplyRow: row by: n "Scale the indicated row by n..." self replaceRow: row with: (self row: row) * n! ! !Matrix methodsFor: 'enumeration'! collect: aBlock "Reimplement collect:..." "#(1 2 3) asMatrix collect: [:e | e+1]" ^self collectWithIndices: [:i :j | aBlock value: (self row: i col: j)]! ! !Matrix methodsFor: 'enumeration'! collectWithIndices: aBlock "Run through the indices..." | result | result := Matrix rows: self rows cols: self cols. self doWithIndices: [:i :j | result row: i col: j put: (aBlock value: i value: j)]. ^result! ! !Matrix methodsFor: 'enumeration'! do: aBlock "Reimplement do:..." "Brian Foote 6/18/89 The commented-out implementation breaks printOn:, so I've tried reverting to the default one (Array). I can't find any code that depends on this. I'm not sure why I didn't catch this back in 87..." "#(1 2 3) asMatrix do: [:e | Transcript print: e; cr; endEntry]" "^ self doWithIndices: [:i :j | aBlock value: (self row: i col: j)]" ^super do: aBlock! ! !Matrix methodsFor: 'enumeration'! doWithIndices: aBlock "Run through the indices..." (1 to: self rows) do: [:row | (1 to: self cols) do: [:col | aBlock value: row value: col]]! ! !Matrix methodsFor: 'binary operations'! * multiplier "Do the right thing for scalars and matrices..." (multiplier isKindOf: Matrix) ifTrue: [^self multiplyMatrix: multiplier]. (multiplier isKindOf: Number) ifTrue: [^self multiplyScalar: multiplier]. ^self retry: #* coercing: multiplier! ! !Matrix methodsFor: 'binary operations'! + addend "Do the right thing for scalars and matrices..." (addend isKindOf: Number) ifTrue: [^self addScalar: addend]. (addend isKindOf: Vector) ifTrue: [^self addMatrix: addend asMatrix]. (addend isKindOf: Matrix) ifTrue: [^self addMatrix: addend]. (addend isKindOf: Collection) ifTrue: [^self addMatrix: (Matrix with: addend)]. self error: 'Bad addend...'! ! !Matrix methodsFor: 'binary operations'! - arg "Add the negated argument..." ^self + arg negated! ! !Matrix methodsFor: 'binary operations'! / divisor "Do the right thing for scalars and matrices..." "#(4 2) asMatrix / 2 #(2 1 ) asVector" "#(4 2) asVector / 2 #(2 1 ) asVector" (divisor isKindOf: Matrix) ifTrue: [^ self multiplyMatrix: divisor inverse]. (divisor isKindOf: Number) ifTrue: [^ self multiplyScalar: 1 / divisor]. ^ self retry: #* coercing: divisor! ! !Matrix methodsFor: 'binary operations'! = aMatrix "Compare using the matrix accessing protocol..." (aMatrix isKindOf: Matrix) ifTrue: [self doWithIndices: [:i :j | (self row: i col: j) ~= (aMatrix row: i col: j) ifTrue: [^ false]]. ^ true]. ^ false! ! !Matrix methodsFor: 'binary operations'! addMatrix: addend "Add the corresponding elements of the two matrices together..." ^self collectWithIndices: [:i :j | ( self row: i col: j) + (addend row: i col: j)]! ! !Matrix methodsFor: 'binary operations'! addScalar: addend "Add the given value to all our elements..." ^self collectWithIndices: [:i :j | (self row: i col: j) + addend]! ! !Matrix methodsFor: 'binary operations'! multiplyMatrix: multiplier "Do a matrix multiplication..." | result sum | self cols = multiplier rows ifFalse: [self error: 'Matrices are not conformable...']. result := Matrix rows: self rows cols: multiplier cols. (1 to: self rows) do: [:row | (1 to: multiplier cols) do: [:col | sum := 0. (1 to: self cols) do: [:k | sum := sum + ((self row: row col: k) * (multiplier row: k col: col))]. result row: row col: col put: sum]]. ^result! ! !Matrix methodsFor: 'binary operations'! multiplyScalar: multiplier "Multiply all of our elements by the given scalar..." ^self collectWithIndices: [:i :j | (self row: i col: j) * multiplier]! ! !Matrix methodsFor: 'unary operations'! adjoint "Return the adjoint of this matrix. This is the transpose of the matrix of conjugates. Like the transpose, this operation is defined for general n x m matrices. This operation is not to be confused with the classical adjoint, which is called the adjoint by some authors..." "((Matrix identity: 3) * (0 +1 i)) adjoint" ^ self conjugate transpose! ! !Matrix methodsFor: 'unary operations'! conjugate "Return the conjugate of this matrix." "((Matrix identity: 3) * (0 +1 i)) conjugate" ^ self collectWithIndices: [:i :j | (self row: i col: j) asComplex conjugate]! ! !Matrix methodsFor: 'unary operations'! negated "Return me multiplied by -1..." ^self * -1! ! !Matrix methodsFor: 'unary operations'! pseudoInverse "Compute the pseudoinverse, or Moore-Penrose generalized inverse using an algorithm derived from Greville's theorem..." "From Kohonen, Self-Organization and Associative Memory, pp. 50-51." "#((1 2)(3 5)) asMatrix determinant -1" "#((1 2)(3 5)) asMatrix inverse #((-5 2 ) (3 -1 ) ) asMatrix" "#((1 2)(3 5)) asMatrix pseudoInverse" "#((1 2 3)(2 5 3 )(1 0 8)) asMatrix inverse" "#((1 2 3)(2 5 3 )(1 0 8)) asMatrix pseudoInverse" "| t | t := #((1 2 0 5 9)(-1 22 4 25 0)) asMatrix. t * t pseudoInverse * t" "| t | t := #((1 2 4 5 7)(1 2 4 5 7)) asMatrix. (t * t pseudoInverse) isHermitian" | a ap k ak i n d p top m | k := self cols. "Are we a single column? (If so we should have been a Vector...)" (self rows = 1 and: [self cols = 1]) ifTrue: [^ Vector with: (Array with: ((self row: 1 col: 1) = 0 ifTrue: [0] ifFalse: [1 / (self row: 1 col: 1)]))]. k = 1 ifTrue: [^ self error: 'We should not get other than 1 by 1 Vectors...']. "We are not a single column. If we were, we would be executing Vector's method for pseudoinverse. First, find the pseudoinverse of all but our last column..." a := self withoutCol: k. ak := self col: k. ap := a pseudoInverse. "Calculate p..." i := Matrix identity: self rows. n := i - (a * ap) * ak. "n isZero" n isAlmostZero ifTrue: [n := ap transpose * ap * ak. d := 1 + ((ap * ak) norm raisedToInteger: 2)] ifFalse: [d := (i - (a * ap) * ak) norm raisedToInteger: 2]. p := n / d. "We now have all we need to finish up..." top := ap * (i - (ak * p transpose)). m := Matrix rows: self cols cols: self rows. (1 to: k - 1) do: [:r | m replaceRow: r with: (top row: r)]. m replaceRow: k with: p transpose. "Transcript cr; show: 'self, pseudoinverse: '; cr; print: self; cr; print: m; cr; endEntry." ^ m! ! !Matrix methodsFor: 'unary operations'! rank "First, get the reduced row echelon form of this matrix. Then, count the non-zero rows..." "#((1 2)(2 4)) asMatrix rank" | m r | m := Eliminator new reduce: self. r := 0. (1 to: m rows) do: [:i | (m row: i) isZero ifFalse: [r := r + 1]]. ^ r! ! !Matrix methodsFor: 'unary operations'! transpose "Return the transpose of this matrix..." | result | result := Matrix rows: self cols cols: self rows. self doWithIndices: [:row :col | result row: col col: row put: (self row: row col: col)]. ^ result! ! !Matrix methodsFor: 'row/column manipulation'! replaceCol: col with: aCol "Replace the designated column of ourself with the given vector..." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix replaceCol: 2 with: #(10 11 12) asVector" | newCol | newCol := aCol asVector. (1 to: self rows) do: [:r | self row: r col: col put: (newCol at: r)]! ! !Matrix methodsFor: 'row/column manipulation'! replaceRow: row with: aRow "Replace the designated row of ourself with the given vector..." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix replaceRow: 2 with: #(10 11 12) asVector" | newRow | newRow := aRow asVector. (1 to: self cols) do: [:c | self row: row col: c put: (newRow row: c col: 1)]! ! !Matrix methodsFor: 'row/column manipulation'! with: aCol atCol: col "Replace the designated column of ourself with the given vector..." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix replaceCol: 2 with: #(10 11 12) asVector" | newCol clone | clone := self deepCopy. newCol := aCol asVector. (1 to: clone rows) do: [:r | clone row: r col: col put: (newCol at: r)]. ^clone! ! !Matrix methodsFor: 'row/column manipulation'! with: aRow atRow: row "Replace the designated row of ourself with the given vector..." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix with: #(10 11 12) asVector atRow: 2" | newRow clone | clone := self deepCopy. newRow := aRow asVector. (1 to: clone cols) do: [:c | clone row: row col: c put: (newRow at: c)]. ^ clone! ! !Matrix methodsFor: 'row/column manipulation'! withoutCol: col "Return the submatrix defined by deleting the given column." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix withoutCol: 2" | j matrix | matrix := Matrix rows: self rows cols: self cols-1. (1 to: self rows) do: [:r | j := 1. (1 to: self cols) do: [:c | c ~= col ifTrue: [matrix row: r col: j put: (self row: r col: c). j := j + 1]]]. ^ matrix! ! !Matrix methodsFor: 'row/column manipulation'! withoutRow: row "Return the submatrix defined by deleting the given row." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix withoutRow: 2" | i matrix | matrix := Matrix rows: self rows-1 cols: self cols. i := 1. (1 to: self rows) do: [:r | r ~= row ifTrue: [ (1 to: self cols) do: [:c | matrix row: i col: c put: (self row: r col: c)]. i := i + 1]]. ^ matrix! ! !Matrix methodsFor: 'row/column manipulation'! withoutRow: row andCol: col "Return the submatrix defined by deleting the row and column containing the given element." "#((1 2 3 )(4 5 6)(7 8 9)) asMatrix withoutRow: 2 andCol: 2." | i j submatrix | submatrix := Matrix order: self order - 1. i := 1. (1 to: self rows) do: [:r | r ~= row ifTrue: [j := 1. (1 to: self cols) do: [:c | c ~= col ifTrue: [submatrix row: i col: j put: (self row: r col: c). j := j + 1]]. i := i + 1]]. ^ submatrix! ! !Matrix methodsFor: 'predicates'! hasZeroColumn "Do we have a zero column?" (1 to: self cols) do: [:c | (self col: c) isZero ifTrue: [^ true]]. ^ false! ! !Matrix methodsFor: 'predicates'! hasZeroRow "Do we have a zero row?" (1 to: self rows) do: [:r | (self row: r) isZero ifTrue: [^ true]]. ^ false! ! !Matrix methodsFor: 'predicates'! isAlmostZero "We are a zero matrix if all our elements are almost zero." "Brian Foote 6/18/89 The tolerance (epsilon) below should probably be gotten from a Class variable or method..." self doWithIndices: [:i :j | (self row: i col: j) abs > 1.0e-7 ifTrue: [^ false]]. ^ true! ! !Matrix methodsFor: 'predicates'! isDiagonal "See if there are any non-zero elements off the diagonal..." self doWithIndices: [:i :j | (i ~= j and: [(self row: i col: j) ~= 0]) ifTrue: [^false]]. ^true! ! !Matrix methodsFor: 'predicates'! isHermitian "A Hermitian matrix is one that is equal to the transpose of its matrix of conjugates... " ^ self = self adjoint! ! !Matrix methodsFor: 'predicates'! isIdentity "See if this is an identity matrix..." self isSquare ifFalse: [^false]. ^self = (Matrix identity: self order)! ! !Matrix methodsFor: 'predicates'! isLowerTriangular "See if there are any non-zero elements above the diagonal. (Hence, the check is to see if we are an lower triangular matrix.)" self doWithIndices: [:i :j | (i < j and: [(self row: i col: j) ~= 0]) ifTrue: [^false]]. ^true! ! !Matrix methodsFor: 'predicates'! isNonNegative "Determine whether all the elements of this matrix are nonnegative..." self doWithIndices: [:i :j | (self row: i col: j) < 0 ifTrue: [^ false]]. ^ true! ! !Matrix methodsFor: 'predicates'! isSkewSymmetric "See if this matrox equals its transpose negated..." ^self = self transpose negated! ! !Matrix methodsFor: 'predicates'! isSquare "See if this is a square matrix..." ^self rows = self cols! ! !Matrix methodsFor: 'predicates'! isStochastic "A stochastic matrix has no negative elements, and all its columns sum to one. The third example below illustrates that the product of two stochastic matrices is a stochastic matrix." "#((0.1 0.5)(0.9 0.5)) asMatrix isStochastic" "#((0.2 0.5)(0.9 0.5)) asMatrix isStochastic" "#((0.1 0.5)(0.9 0.5)) asMatrix * #((0.3 0.4)(0.7 0.6)) asMatrix" self isNonNegative ifFalse: [^ false]. (1 to: self cols) do: [:c | (self col: c) asVector sum = 1 ifFalse: [^ false]]. ^ true! ! !Matrix methodsFor: 'predicates'! isSymmetric "See if this matrix equals its transpose..." ^self = self transpose! ! !Matrix methodsFor: 'predicates'! isTriangular "If we are either kind, return true..." ^self isUpperTriangular or: [self isLowerTriangular]! ! !Matrix methodsFor: 'predicates'! isUpperTriangular "See if there are any non-zero elements below the diagonal. (Hence, the check is to see if we are an upper triangular matrix.)" self doWithIndices: [:i :j | (i > j and: [(self row: i col: j) ~= 0]) ifTrue: [^false]]. ^true! ! !Matrix methodsFor: 'predicates'! isZero "We are a zero matrix if all our elements are zero..." self doWithIndices: [:i :j | (self row: i col: j) ~= 0 ifTrue: [^ false]]. ^ true! ! !Matrix methodsFor: 'printing'! printOn: aStream "Print our self in such a way as to make recreating ourself simple. We do both Vectors and Matrices here so that we don't lose our inherited array printing capability..." aStream nextPut: $#. super printOn: aStream. (self isKindOf: Vector) ifTrue: [aStream nextPutAll: ' asVector'. self cols ~= 1 ifTrue: [aStream nextPutAll: ' transpose']] ifFalse: [aStream nextPutAll: ' asMatrix']! ! !Matrix methodsFor: 'printing'! storeOn: aStream "Use our print string for this..." ^ self printOn: aStream! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Matrix class instanceVariableNames: ''! !Matrix class methodsFor: 'public creation'! cols: size "Return a row vector with the indicated number of columns..." ^ Vector rows: 1 cols: size! ! !Matrix class methodsFor: 'public creation'! identity: order "Return an identity matrix of the requested size. Let SquareMatrix decide how to accomplish this..." "Matrix identity: 3" ^ SquareMatrix identity: order! ! !Matrix class methodsFor: 'public creation'! order: size "Create a new square matrix..." ^ SquareMatrix rows: size cols: size! ! !Matrix class methodsFor: 'public creation'! rows: size "Return a (column) vector with the indicated number of rows..." ^ Vector rows: size cols: 1! ! !Matrix class methodsFor: 'public creation'! rows: rows cols: cols "Create a new matrix. We implement matrices as arrays of row vectors..." | matrix | rows = cols ifTrue: [^ SquareMatrix order: rows]. cols = 1 ifTrue: [^ Vector rows: rows cols: cols]. rows = 1 ifTrue: [^ Vector rows: rows cols: cols]. ^ self newRows: rows cols: cols! ! !Matrix class methodsFor: 'public creation'! rows: rows cols: cols from: aCollection "Create a new matrix using the elements of the given collection..." "Matrix rows: 2 cols: 2 from: #(1 2 3 4)" | matrix stream | matrix := Matrix rows: rows cols: cols. stream := ReadStream on: aCollection. matrix doWithIndices: [:i :j | matrix row: i col: j put: stream next]. ^ matrix! ! !Matrix class methodsFor: 'public creation'! with: aCollection "Build a matrix. (Note that a matrix is itself a kind of collection...)" "Matrix with: #(1 2 3) asMatrix" "Matrix with: #((1 2)(3 4)) asMatrix" | rows cols matrix | ((aCollection at: 1) isKindOf: Collection) ifFalse: [^ aCollection asVector asMatrix]. rows := aCollection size. cols := (aCollection at: 1) size. matrix := self rows: rows cols: cols. (1 to: rows) do: [:row | (1 to: cols) do: [:col | matrix row: row col: col put: ((aCollection at: row) at: col)]]. ^ matrix! ! !Matrix class methodsFor: 'instance creation'! newRows: rows cols: cols "Create a new matrix. We implement matrices as arrays of row vectors..." | matrix | matrix := self new: rows. (1 to: rows) do: [:row | matrix at: row put: (Array new: cols)]. matrix rows: rows. matrix cols: cols. ^ matrix! ! !Matrix class methodsFor: 'SequenceableCollection methods'! asMatrix "Convert this collection into a Matrix..." "Brian Foote 8/30/87" ^ Matrix with: self! ! !Matrix class methodsFor: 'SequenceableCollection methods'! with: aSequenceableCollection collect: aBlock "Evaluate aBlock with each of the receiver's elements along with the corresponding element from aSequencableCollection. Collect the results..." "Brian Foote 8/30/87" | otherCollection | self size ~= aSequenceableCollection size ifTrue: [^ self errorNoMatch]. otherCollection := ReadStream on: aSequenceableCollection. ^ self collect: [:each | aBlock value: each value: otherCollection next]! ! !Matrix class methodsFor: 'installation'! install "Matrix install" SequenceableCollection copyCategory: 'SequenceableCollection methods' asSymbol from: Matrix class classified: 'Matrix methods'! ! Number subclass: #Polar instanceVariableNames: 'r theta ' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !Polar methodsFor: 'coercing'! coerce: argument (argument isKindOf: Complex) ifTrue: [^ argument asPolar]. (argument isKindOf: Number) ifTrue: [^ argument asComplex asPolar]. (argument isKindOf: Collection) ifTrue: [^ (Complex re: (argument at: 1) im: (argument at: 2)) asPolar]. self error: 'Coercion failed...'! ! !Polar methodsFor: 'coercing'! generality "The generalities that come with the distributed system are: Float 80, Fraction 60, Integer 40, SmallInteger 20." ^ 100! ! !Polar methodsFor: 'accessing'! r ^ r! ! !Polar methodsFor: 'accessing'! r: aRadius ^ r := aRadius! ! !Polar methodsFor: 'accessing'! theta ^ theta! ! !Polar methodsFor: 'accessing'! theta: anAngle ^ theta := anAngle! ! !Polar methodsFor: 'converting'! asComplex "Convert from trigonometric to rectangular notation..." ^ self r * (self theta cos + self theta sin i)! ! !Polar methodsFor: 'converting'! asPolar "We are already in trigonomentric notation..." ^ self! ! !Polar methodsFor: 'binary operators'! * argument "(1 cis: 90 degreesToRadians) * (1 cis: 90 degreesToRadians)" (argument isKindOf: Polar) ifTrue: [^ self r * argument r cis: self theta + argument theta] ifFalse: [^ self retry: #* coercing: argument]! ! !Polar methodsFor: 'binary operators'! + argument "(1 cis: 90 degreesToRadians) + (1 cis: 90 degreesToRadians)" (argument isKindOf: Polar) ifTrue: [^ (self asComplex retry: #+ coercing: argument) asPolar] ifFalse: [^ self retry: #+ coercing: argument]! ! !Polar methodsFor: 'binary operators'! - argument "(1 cis: 90 degreesToRadians) - (1 cis: 90 degreesToRadians)" (argument isKindOf: Polar) ifTrue: [^ (self asComplex retry: #- coercing: argument) asPolar] ifFalse: [^ self retry: #- coercing: argument]! ! !Polar methodsFor: 'binary operators'! / argument "(1 cis: 90 degreesToRadians) / (1 cis: 90 degreesToRadians)" (argument isKindOf: Polar) ifTrue: [^ self r / argument r cis: self theta - argument theta] ifFalse: [^ self retry: #/ coercing: argument]! ! !Polar methodsFor: 'binary operators'! raisedToInteger: n "(1 cis: 90 degreesToRadians)*(1 cis: 90 degreesToRadians)" "(1 cis: 90 degreesToRadians) raisedToInteger: 2" ^ (self r raisedToInteger: n) cis: self theta * n! ! !Polar methodsFor: 'binary operators'! root: n "(4 cis: 0 degreesToRadians) root: 2" "k can go from 0 to n-1. There are n different roots..." | k | k := 0. ^ (self r raisedTo: 1 / n) cis: self theta / n + (k * (360 degreesToRadians / n))! ! !Polar methodsFor: 'binary operators'! roots: n "(4 cis: 0 degreesToRadians) roots: 2" "Return the n different nth roots of ourself..." ^ (0 to: n - 1) collect: [:k | (self r raisedTo: 1 / n) cis: self theta / n + (k * (360 degreesToRadians / n))]! ! !Polar methodsFor: 'unary operators'! abs "Return our radius as our absolute value..." ^ self r! ! !Polar methodsFor: 'printing'! printOn: aStream "Print us in a way that will allow us to be easily recreated..." aStream nextPut: $(. self r printOn: aStream. aStream nextPutAll: ' cis: '. self theta printOn: aStream. aStream nextPutAll: ')'! ! !Polar methodsFor: 'printing'! storeOn: aStream "Use our print string for this..." ^ self printOn: aStream! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Polar class instanceVariableNames: ''! !Polar class methodsFor: 'instance creation'! r: aRadius theta: anAngle "Create a polar complex number with the given radius and angle..." | p | p := self new. p r: aRadius; theta: anAngle. ^ p! ! !Polar class methodsFor: 'Number methods'! cis: theta "Assume the we are r and we are constructing a polar complex number..." "2 cis: (120 degreesToRadians)" ^ Polar r: self theta: theta! ! !Polar class methodsFor: 'installation'! install "Polar install" Number copyCategory: 'Number methods' asSymbol from: Polar class classified: 'Polar methods'! ! Array variableSubclass: #Polynomial instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !Polynomial methodsFor: 'coefficient access'! coefficient: i i+1 > self size ifTrue:[^0]. ^self at: i+1! ! !Polynomial methodsFor: 'coefficient access'! coefficient: i put: value ^self at: i+1 put: value! ! !Polynomial methodsFor: 'coefficient access'! degree "Perhaps we should return nil rather than zero to indicate no degree..." "Brian Foote 2 July 1989 Implemented the above..." "(Polynomial with: #(1)) degree" (self size to: 1 by: -1) do: [:i | (self at: i) ~= 0 ifTrue: [^i - 1]]. ^nil! ! !Polynomial methodsFor: 'coercing'! coerce: argument (argument isKindOf: Number) ifTrue: [^ Polynomial with: (Array with: argument)]. (argument isKindOf: Collection) ifTrue: [^ Polynomial with: argument]. self error: 'Coercion failed...'! ! !Polynomial methodsFor: 'coercing'! generality "The generalities that come with the distributed system are: Float 80, Fraction 60, Integer 40, SmallInteger 20." ^ 100! ! !Polynomial methodsFor: 'coercing'! retry: arith coercing: argument "Arithmetic represented by the message, arith, could not be performed between the receiver and the argument because of differences in representation. Coerce either the receiver or the argument to a more general representation, and try again." self generality < argument generality ifTrue: [^ (argument coerce: self) perform: arith with: argument] ifFalse: [^ self perform: arith with: (self coerce: argument)]! ! !Polynomial methodsFor: 'binary operators'! * argument "(Polynomial with: #(1 1 1)) * (Polynomial with: #(1 1 1))" | d p | (argument isKindOf: Polynomial) ifTrue: [d := self degree + argument degree. p := Polynomial degree: d. (0 to: self degree) do: [:i | (0 to: argument degree) do: [:j | p coefficient: i + j put: (p coefficient: i + j) + ((self coefficient: i) * (argument coefficient: j))]]. ^ p] ifFalse: [^ self retry: #* coercing: argument]! ! !Polynomial methodsFor: 'binary operators'! + argument "(Polynomial with: #(1 2 3)) + (Polynomial with: #(1 2 3))" | d p | (argument isKindOf: Polynomial) ifTrue: [d := self degree max: argument degree. p := Polynomial degree: d. (0 to: d) do: [:i | p coefficient: i put: (self coefficient: i) + (argument coefficient: i)]. ^ p] ifFalse: [^ self retry: #+ coercing: argument]! ! !Polynomial methodsFor: 'binary operators'! - argument "(Polynomial with: #(1 2 3)) - (Polynomial with: #(1 2 3))" | d p | (argument isKindOf: Polynomial) ifTrue: [d := self degree max: argument degree. p := Polynomial degree: d. (0 to: d) do: [:i | p coefficient: i put: (self coefficient: i) - (argument coefficient: i)]. ^ p] ifFalse: [^ self retry: #- coercing: argument]! ! !Polynomial methodsFor: 'binary operators'! / argument "(Polynomial with: #(1 1 1)) / (Polynomial with: #(1 1 1))" | d p | (argument isKindOf: Polynomial) ifTrue: [^self divideByPolynomial: argument] ifFalse: [^ self retry: #/ coercing: argument]! ! !Polynomial methodsFor: 'binary operators'! = argument "(Polynomial with: #(1 1 1)) = (Polynomial with: #(1 1 1))" | d p | (argument isKindOf: Polynomial) ifTrue: [self degree = argument degree ifTrue: [(self degree to: 0 by: -1) do: [:i | (self coefficient: i) ~= (argument coefficient: i) ifTrue: [^ false]]. ^ true] ifFalse: [^ false]] ifFalse: [^ self retry: #= coercing: argument]! ! !Polynomial methodsFor: 'binary operators'! divideByPolynomial: argument "A good old-fashioned seat-of-the-pants polynomial division algorithm..." "Brian Foote 13 September 1987" "(Polynomial coefficients: #(4 -3 1 7)) / (Polynomial coefficients: #(1 -2))" "(Polynomial coefficients: #(1 0 0 0 -81)) / (Polynomial coefficients: #(1 3 -1))" "These examples are from Keedy and Bittinger, College Algebra, Fourth Edition, pages 329-331..." | d ad a t td pd p v z | ad := argument degree. a := argument coefficient: ad. t := self copy. td := t degree. pd := td - ad. p := Polynomial degree: td - ad. [td >= ad] whileTrue: [v := (t coefficient: td) / a. p coefficient: pd put: v. z := Polynomial degree: pd. z coefficient: pd put: v. t := t - (argument * z). td := t degree. pd := td - ad]. "t contains the remainder at this point should it be need it..." ^p! ! !Polynomial methodsFor: 'binary operators'! rem: argument "(Polynomial coefficients: #(4 -3 1 7)) rem: (Polynomial coefficients: #(1 -2))" | d ad a t td pd p v z | ad := argument degree. a := argument coefficient: ad. t := self copy. td := t degree. pd := td - ad. p := Polynomial degree: td - ad. [td >= ad] whileTrue: [v := (t coefficient: td) / a. p coefficient: pd put: v. z := Polynomial degree: pd. z coefficient: pd put: v. t := t - (argument * z). td := t degree. pd := td - ad]. "t contains the remainder at this point should it be need it..." ^ t! ! !Polynomial methodsFor: 'evaluating'! eval: x "We provide this synonym for compatability with Tim Budd's protocol..." "(Polynomial coefficients: #(1 2 3)) eval: 2" ^ self evaluateWith: x! ! !Polynomial methodsFor: 'evaluating'! evaluateWith: x "(Polynomial coefficients: #(1 2 3)) evaluateWith: 2" | sum | sum := 0. (0 to: self degree) do: [:i | sum := sum + ((self coefficient: i) * (x raisedTo: i))]. ^ sum! ! !Polynomial methodsFor: 'printing'! printOn: aStream "Print our self in such a way as to make recreating ourself simple." "(Polynomial coefficients: #(1 2 3)) printString 'Polynomial coefficients: #(1 2 3)'" aStream nextPutAll: 'Polynomial coefficients: #('. (self degree to: 0 by: -1) do: [:i | (self coefficient: i) printOn: aStream. i > 0 ifTrue: [aStream nextPutAll: ' ']]. aStream nextPutAll: ')'! ! !Polynomial methodsFor: 'printing'! storeOn: aStream "Use our print string for this..." ^ self printOn: aStream! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Polynomial class instanceVariableNames: ''! !Polynomial class methodsFor: 'instance creation'! coefficients: aCollection "This creation message accepts the coefficient list in high to low order..." "(Polynomial coefficients: #(1 2 3 4))" | p d | d := aCollection size - 1. p := self degree: d. aCollection inject: d into: [:i :e | p coefficient: i put: e. i - 1]. ^ p! ! !Polynomial class methodsFor: 'instance creation'! degree: n "Create a zero polynomial with the indicated number of slots. (Note that by filling it with zeros we are acutely creating a polynomial with NO degree.)" "(Polynomial degree: 6) degree nil" | p | n < 0 ifTrue: [self error: 'Bad Polynomial degree: ' , n printString]. p := self new: n + 1. p atAllPut: 0. ^p! ! !Polynomial class methodsFor: 'instance creation'! with: aCollection "This creation message accepts the coefficient list in low to high order..." "(Polynomial with: #(1 2 3 4))" | p d | d := aCollection size - 1. p := self degree: d. aCollection inject: 0 into: [:i :e | p coefficient: i put: e. i + 1]. ^ p! ! Matrix variableSubclass: #SquareMatrix instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linear-Algebra'! !SquareMatrix methodsFor: 'element access'! atDiagonalPut: value "Set all the elements of the diagonal the matrix to the indicated value..." (1 to: (self rows min: self cols)) do: [:i | self row: i col: i put: value]! ! !SquareMatrix methodsFor: 'element access'! identity "Zap all the elements, and then put ones on the diagonal..." self zero. self atDiagonalPut: 1! ! !SquareMatrix methodsFor: 'binary operations'! raisedToInteger: n "The example below shows how to use this method to obtain an estimate of the dominant eigenvector..." "(#((3 2 )(-1 0)) asMatrix raisedToInteger: 7) * #(1 1) asVector" | m | n = 0 ifTrue: [^ Matrix identity: self order]. n < 0 ifTrue: [self inverse raisedToInteger: n negated]. m := 1. n timesRepeat: [m := m * self]. ^ m! ! !SquareMatrix methodsFor: 'unary operations'! classicalAdjoint "Return the classical adjoint of this matrix. This is the transpose of the matrix of cofactors. The classical adjoint is typically used only with square matrices, though this algorithm would operate using an n x m matrix as well..." "Answer below should be: ((12 4 12)(6 2 -10)(-16 16 16))" "#((3 2 -1)(1 6 3)(2 -4 0)) asMatrix classicalAdjoint" ^ (self collectWithIndices: [:i :j | self cofactorOfRow: i col: j]) transpose! ! !SquareMatrix methodsFor: 'unary operations'! cofactorOfRow: row col: col "Return the minor for row and col multiplied by +/- one as is appropriate... " ^ (self minorOfRow: row col: col) * (-1 raisedToInteger: row + col)! ! !SquareMatrix methodsFor: 'unary operations'! determinant "Calculate our determinant using Laplace's expansion rule. (Note that for now, we always expand along row one. (One can use any row or column.) " "The correct answer to the query below is -1." "#((3 1 0)(-2 -4 3)(5 4 -2)) asMatrix determinant" "The 4 by 4 answer is -18..." "#((3 5 -2 6)(1 2 -1 1)(2 4 1 5)(3 7 5 3)) asMatrix determinant" | sum r | self order = 1 ifTrue: [^ self row: 1 col: 1]. sum := 0. r := 1. (1 to: self order) do: [:c | sum := sum + ((self row: r col: c) * (self cofactorOfRow: r col: c))]. ^ sum! ! !SquareMatrix methodsFor: 'unary operations'! dominantEigenvector "We assume we are a matrix that has been raised to a desired power. We fudge up a vector, and use it in combination with ourself to come up with a dominant eigenvector estimate...." "(#((3 2 )(-1 0)) asMatrix raisedToInteger: 7) dominantEigenvector" | v | v := (Vector rows: self order) atAllPut: 1. ^ (self * v) asVector! ! !SquareMatrix methodsFor: 'unary operations'! dominantEigenvector: n "#((3 2)(-1 0)) asMatrix dominantEigenvector: 6" | v | v := (Vector rows: self order) atAllPut: 1. n timesRepeat: [v := (self * v) scale]. ^ v! ! !SquareMatrix methodsFor: 'unary operations'! inverse "#((1 2)(5 6)) asMatrix inverse" "#((3 2 -1)(1 6 3)(2 -4 0)) asMatrix * #((3 2 -1)(1 6 3)(2 -4 0)) asMatrix inverse" "#((2)) asMatrix inverse" ^ 1 / self determinant * self classicalAdjoint! ! !SquareMatrix methodsFor: 'unary operations'! minorOfRow: row col: col "The minor of entry a(i,j) is the determinant of the submatrix that remains after the i-th row and the j-th columns are deleted..." "Brian Foote 9/8/87 Unilaterally defined the minor of an order 1 matrix as 1..." self order = 1 ifTrue: [^ 1]. ^ (self withoutRow: row andCol: col) determinant! ! !SquareMatrix methodsFor: 'unary operations'! order "Just return the number of rows..." ^self rows! ! !SquareMatrix methodsFor: 'unary operations'! rayleighQuotient "We assume we are a matrix that has been raised to a desired power. First, we get a come up with a dominant eigenvector estimate. We then use this to estimate the dominant eigenvalue..." "(#((3 2 )(-1 0)) asMatrix raisedToInteger: 7) rayleighQuotient" | n d v | v := self dominantEigenvector. n := v innerProduct: self * v. d := v innerProduct: v. ^ n / d! ! !SquareMatrix methodsFor: 'unary operations'! rayleighQuotient: v "Use a given estimate of the dominant eigenvector to estimate the dominant eigenvalue..." "| m v | m := #((3 2 )(-1 0)) asMatrix. v := m dominantEigenvector: 6. m rayleighQuotient: v" | n d | n := v innerProduct: self * v. d := v innerProduct: v. ^ n / d! ! !SquareMatrix methodsFor: 'unary operations'! solution: j with: aMatrix "Solve a system of linear equations using Cramer's Rule..." "Solutions are: (-10/11), (18/11) and (38/11)..." "#((1 0 2)(-3 4 6)(-1 -2 3)) asMatrix solution: 1 with: #(6 30 8) asVector" | matrix | matrix := self deepCopy. matrix replaceCol: j with: aMatrix asMatrix. ^ matrix determinant / self determinant! ! !SquareMatrix methodsFor: 'unary operations'! trace "Return the sum of our main diagonal..." "#((1 2 3)(4 5 6)(0 1 0)) asMatrix trace" | sum | sum := 0. (1 to: self order) do: [:i | sum := sum + (self row: i col: i)]. ^ sum! ! !SquareMatrix methodsFor: 'predicates'! isSingular "Use the determinant to figure this out..." "#((1 2)(2 4)) asMatrix isSingular true" "#((1 2)(3 5)) asMatrix isSingular false" ^ self determinant = 0! ! !SquareMatrix methodsFor: 'predicates'! isSquare "We know we are a square matrix..." ^true! ! !SquareMatrix methodsFor: 'error interception'! doesNotUnderstand: aMessage "If we are a square matrix of order one, our inability to understand the message we've received may result from the fact that we we not created a Vector. So we find out whether this is the case by cobbling up a Vector and forwarding this message to it..." "(SquareMatrix order: 3) jumpInTheLake" self order = 1 ifTrue: [(Vector with: (Array with: (self row: 1 col: 1))) perform: aMessage selector withArguments: aMessage arguments] ifFalse: [^ super doesNotUnderstand: aMessage]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SquareMatrix class instanceVariableNames: ''! !SquareMatrix class methodsFor: 'instance creation'! identity: size "Return an identity matrix..." ^ (SquareMatrix order: size) identity! ! !SquareMatrix class methodsFor: 'instance creation'! rows: rows cols: cols "Create a new square matrix..." | matrix | rows = cols ifFalse: [^ self error: 'A SquareMatrix must be square...']. "rows = 1 ifTrue: [