'From Squeak 2.2 of Sept 23, 1998 on 2 November 1998 at 11:48:57 am'! Object subclass: #DelayedEvent instanceVariableNames: 'resumptionSemaphore resumptionCondition ' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! Object subclass: #Histogram instanceVariableNames: 'tallyArray lowerBound upperBound step minValue maxValue totalValues extraEntries ' classVariableNames: '' poolDictionaries: '' category: 'Simulation statistics gathering'! Stream subclass: #ProbabilityDistribution instanceVariableNames: '' classVariableNames: 'U ' poolDictionaries: '' category: 'Statistics'! ProbabilityDistribution subclass: #ContinuousProbability instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! ProbabilityDistribution subclass: #DiscreteProbability instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! DiscreteProbability subclass: #Bernoulli instanceVariableNames: 'prob ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! Bernoulli subclass: #Binomial instanceVariableNames: 'N ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! ContinuousProbability subclass: #Exponential instanceVariableNames: 'mu ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! Exponential subclass: #Gamma instanceVariableNames: 'N ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! Bernoulli subclass: #Geometric instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! ContinuousProbability subclass: #Normal instanceVariableNames: 'mu sigma ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! DiscreteProbability subclass: #Poisson instanceVariableNames: 'mu ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! Object subclass: #Resource instanceVariableNames: 'pending resourceName ' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! Resource subclass: #ResourceCoordinator instanceVariableNames: 'whoIsWaiting ' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! Resource subclass: #ResourceProvider instanceVariableNames: 'amountAvailable ' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! DiscreteProbability subclass: #SampleSpace instanceVariableNames: 'data ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! Object subclass: #Simulation instanceVariableNames: 'resources currentTime eventQueue processCount ' classVariableNames: 'RunningSimulation ' poolDictionaries: '' category: 'Simulations'! Simulation subclass: #CarDealer instanceVariableNames: 'statistics ' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! Simulation subclass: #Museum instanceVariableNames: 'statistics ' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Museum'! Simulation subclass: #NothingAtAll instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! Object subclass: #SimulationObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! SimulationObject subclass: #Car instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! SimulationObject subclass: #CarBuyer instanceVariableNames: 'entryTime ' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! SimulationObject subclass: #CarDelivery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! SimulationObject subclass: #EventMonitor instanceVariableNames: 'label ' classVariableNames: 'Counter DataFile ' poolDictionaries: '' category: 'Simulation statistics gathering'! EventMonitor subclass: #DoNothing instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! Object subclass: #SimulationObjectRecord instanceVariableNames: 'entranceTime duration ' classVariableNames: '' poolDictionaries: '' category: 'Simulation statistics gathering'! Simulation subclass: #StatisticsWithSimulation instanceVariableNames: 'statistics ' classVariableNames: '' poolDictionaries: '' category: 'Simulation statistics gathering'! Simulation subclass: #Traffic instanceVariableNames: 'statistics ' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Demos'! ContinuousProbability subclass: #Uniform instanceVariableNames: 'startNumber stopNumber ' classVariableNames: '' poolDictionaries: '' category: 'Statistics'! SimulationObject subclass: #Visitor instanceVariableNames: 'entryTime ' classVariableNames: '' poolDictionaries: '' category: 'Simulation-Museum'! DelayedEvent subclass: #WaitingSimulationObject instanceVariableNames: 'amount resource ' classVariableNames: '' poolDictionaries: '' category: 'Simulations'! !DelayedEvent methodsFor: 'accessing'! condition "Answer a condition under which the event should be sequenced." ^resumptionCondition! ! !DelayedEvent methodsFor: 'accessing'! condition: anObject "The argument, anObject, is the condition under which the event should be sequenced." resumptionCondition := anObject! ! !DelayedEvent methodsFor: 'comparing'! <= aDelayedEvent "Answer whether the receiver should be sequenced before the argument." resumptionCondition isNil ifTrue: [^true] ifFalse: [^resumptionCondition <= aDelayedEvent condition]! ! !DelayedEvent methodsFor: 'scheduling'! pause "Suspend the current active process, that is, the current event that is running." Simulation active stopProcess. resumptionSemaphore wait! ! !DelayedEvent methodsFor: 'scheduling'! resume "Resume the suspended process." Simulation active startProcess. resumptionSemaphore signal. ^resumptionCondition! ! !DelayedEvent methodsFor: 'private'! initialize resumptionSemaphore := Semaphore new! ! !DelayedEvent methodsFor: 'private'! setCondition: anObject self initialize. resumptionCondition := anObject! ! !DelayedEvent class methodsFor: 'instance creation'! new ^super new initialize! ! !DelayedEvent class methodsFor: 'instance creation'! onCondition: anObject ^super new setCondition: anObject! ! !Histogram methodsFor: 'accessing'! contains: aValue ^lowerBound <= aValue and: [aValue < upperBound]! ! !Histogram methodsFor: 'accessing'! store: aValue | index | minValue isNil ifTrue: [minValue := maxValue := aValue] ifFalse: [minValue := minValue min: aValue. maxValue := maxValue max: aValue]. totalValues := totalValues + aValue. (self contains: aValue) ifTrue: [index := (aValue - lowerBound // step) + 1. tallyArray at: index put: (tallyArray at: index) + 1] ifFalse: [extraEntries := extraEntries + 1]! ! !Histogram methodsFor: 'printing'! firstHeader: aStream aStream cr; tab. aStream nextPutAll: 'Number of '. aStream tab. aStream nextPutAll: 'Minimum '. aStream tab. aStream nextPutAll: 'Maximum '. aStream tab. aStream nextPutAll: 'Average '. aStream cr; tab. aStream nextPutAll: 'Objects '. aStream tab. aStream nextPutAll: 'Value '. aStream tab. aStream nextPutAll: 'Value '. aStream tab. aStream nextPutAll: 'Value '.! ! !Histogram methodsFor: 'printing'! printStatisticsOn: aStream | totalObjs pos | self firstHeader: aStream. aStream cr; tab. totalObjs := extraEntries. tallyArray do: [:each | totalObjs := totalObjs + each]. totalObjs printOn: aStream. aStream tab. minValue printOn: aStream. aStream tab. maxValue printOn: aStream. aStream tab. (totalValues / totalObjs) asFloat printOn: aStream. aStream cr. self secondHeader: aStream. aStream cr. pos := lowerBound. tallyArray do: [:entry | pos printOn: aStream. aStream nextPut: $-. (pos := pos + step) printOn: aStream. aStream tab. entry printOn: aStream. aStream tab. (entry / totalObjs) asFloat printOn: aStream. aStream tab. aStream nextPut: $|. entry rounded timesRepeat: [aStream nextPut: $X]. aStream cr]! ! !Histogram methodsFor: 'printing'! secondHeader: aStream aStream cr; tab. aStream nextPutAll: 'Number of '. aStream cr. aStream nextPutAll: 'Entry '. aStream tab. aStream nextPutAll: 'Objects '. aStream tab. aStream nextPutAll: 'Frequency '.! ! !Histogram methodsFor: 'private'! newLower: lowerNum upper: upperNum by: stepAmount tallyArray := Array new: (upperNum - lowerNum // stepAmount). tallyArray atAllPut: 0. lowerBound := lowerNum. upperBound := upperNum. step := stepAmount. minValue := maxValue := nil. totalValues := 0. extraEntries := 0! ! !Histogram class methodsFor: 'class initialization'! from: lowerNum to: upperNum by: step ^self new newLower: lowerNum upper: upperNum by: step! ! !ProbabilityDistribution commentStamp: '' prior: 0! Initialization of the class is needed. Use ProbabilityDistribution initialize! !ProbabilityDistribution methodsFor: 'random sampling'! atEnd ^false! ! !ProbabilityDistribution methodsFor: 'random sampling'! next "This is a general random number generation method for any probability law; use the (0,1) uniformly distributed random varible U as the value of the law's distribution function. Obtain the next random value and then solve for the inverse. The inverse solution is defined by the subclass." ^self inverseDistribution: U next! ! !ProbabilityDistribution methodsFor: 'probability functions'! density: x self subclassResponsibility! ! !ProbabilityDistribution methodsFor: 'probability functions'! distribution: aCollection self subclassResponsibility! ! !ProbabilityDistribution methodsFor: 'private'! computeSample: m outOf: n m>n ifTrue: [^0.0]. ^n factorial / (n-m) factorial! ! !ProbabilityDistribution methodsFor: 'private'! inverseDistribution: x self subclassResponsibility! ! !ContinuousProbability methodsFor: 'probability functions'! distribution: aCollection "This is a slow and dirty trapezoidal integration to determine the area under the probability function curve y=density (x) for x in the specified collection. The method assumes that the collection contains numerically-ordered elements." | t aStream x1 x2 y1 y2 | t := 0.0. aStream := ReadStream on: aCollection. x2 := aStream next. y2 := self density: x2. [x1 := x2. x2 := aStream next] whileTrue: [y1 := y2. y2 := self density: x2. t := t + ((x2-x1)*(y2+y1))]. ^t*0.5! ! !DiscreteProbability methodsFor: 'probability functions'! distribution: aCollection "Answer the sum of the discrete values of the density function for each element in the collection." | t | t := 0.0. aCollection do: [:i | t := t + (self density: i)]. ^t! ! !Bernoulli commentStamp: '' prior: 0! Does an event occur? density function answers the probability of occurrence of one of two events! !Bernoulli methodsFor: 'accessing'! mean ^prob! ! !Bernoulli methodsFor: 'accessing'! variance ^prob * (1.0 - prob)! ! !Bernoulli methodsFor: 'probability functions'! density: x x=1 ifTrue: [^prob]. x=0 ifTrue: [^1.0-prob]. self error: ' outcomes of a Bernoulli can only be 1 or 0'! ! !Bernoulli methodsFor: 'private'! inverseDistribution: x x <= prob ifTrue: [^1] ifFalse: [^0]! ! !Bernoulli methodsFor: 'private'! setParameter: aNumber prob :=aNumber! ! !Binomial commentStamp: '' prior: 0! how many successes occurred in N trials? density funciton answers what is the probability that x successes will occur in the next N trials? i.e., N repeated Bernoulli trials! !Binomial methodsFor: 'random sampling'! next |t| t := 0. N timesRepeat: [t := t + super next]. ^t! ! !Binomial methodsFor: 'probability functions'! density: x (x between: 0 and: N) ifTrue: [^((self computeSample: x outOf: N) / (self computeSample: x outOf: x)) * (prob raisedTo: x)*((1.0 - prob) raisedTo: N-x)] ifFalse: [^0.0]! ! !Binomial methodsFor: 'private'! events: n mean: m N := n truncated. self setParameter: m/N! ! !Exponential methodsFor: 'accessing'! mean ^1.0/mu! ! !Exponential methodsFor: 'accessing'! variance ^1.0/(mu*mu)! ! !Exponential methodsFor: 'probability functions'! density: x x > 0.0 ifTrue: [^mu * (mu*x) negated exp] ifFalse: [^0.0]! ! !Exponential methodsFor: 'probability functions'! distribution: anInterval anInterval last <= 0.0 ifTrue: [^0.0] ifFalse: [^1.0 - (mu * anInterval last) negated exp - (anInterval first > 0.0 ifTrue: [self distribution: (0.0 to: anInterval first)] ifFalse: [0.0])]! ! !Exponential methodsFor: 'private'! inverseDistribution: x ^ x ln negated / mu! ! !Exponential methodsFor: 'private'! setParameter: p mu := p! ! !Gamma methodsFor: 'accessing'! mean ^super mean*N! ! !Gamma methodsFor: 'accessing'! variance ^super variance*N! ! !Gamma methodsFor: 'probability functions'! density: x | t | x > 0.0 ifTrue: [t := mu * x. ^(mu raisedTo: N) / (self gamma: N) *(x raisedTo: N-1) * t negated exp] ifFalse: [^0.0]! ! !Gamma methodsFor: 'private'! gamma: n | t | t := n - 1.0. ^self computeSample: t outOf: t! ! !Gamma methodsFor: 'private'! setEvents: events N := events! ! !Geometric commentStamp: '' prior: 0! How many repeated, independent Bernoulli trials are needed before the first success is obtained? e.g., how many seconds before the next car arrives (as versus how many cars arrive in the next 20 sec as in a binomial question)! !Geometric methodsFor: 'accessing'! mean ^ 1.0 / prob! ! !Geometric methodsFor: 'accessing'! variance ^ (1.0 - prob) / prob squared! ! !Geometric methodsFor: 'probability functions'! density: x x>0 ifTrue: [^prob * ((1.0 - prob) raisedTo: x-1)] ifFalse: [^0.0]! ! !Geometric methodsFor: 'private'! inverseDistribution: x ^(x ln / (1.0 - prob) ln) ceiling! ! !Normal commentStamp: '' prior: 0! How long before a success occurs or how many events occur in a certain time interval?! !Normal methodsFor: 'accessing'! mean ^mu! ! !Normal methodsFor: 'accessing'! variance ^sigma squared! ! !Normal methodsFor: 'random sampling'! next | v1 v2 s rand u | rand := Uniform from: -1.0 to: 1.0. [v1 := rand next. v2 := rand next. s := v1 squared + v2 squared. s >= 1] whileTrue. u := (-2.0 * s ln /s) sqrt. ^mu + (sigma * v1 *u)! ! !Normal methodsFor: 'probability functions'! density: x | twoPi t | twoPi := 2 * 3.1415926536. t := x - mu/sigma. ^(-0.5 * t squared) exp / (sigma * twoPi sqrt)! ! !Normal methodsFor: 'private'! setMean: m standardDeviation: s mu := m. sigma := s! ! !Poisson commentStamp: '' prior: 0! how many events occur in a unit time? used for sampling potential demands by customers for service The Poisson is typically the rate at which the service is provided. density function determines the probability that, in a unit interval, x events will occur. ! !Poisson methodsFor: 'accessing'! mean ^mu! ! !Poisson methodsFor: 'accessing'! variance ^mu! ! !Poisson methodsFor: 'random sampling'! next | p n q | p := mu negated exp. n := 0. q := 1.0. [q := q * U next. q >= p] whileTrue: [n := n + 1]. ^n! ! !Poisson methodsFor: 'probability functions'! density: x x >= 0 ifTrue: [^ ((mu raisedTo: x) * (mu negated exp)) / x factorial] ifFalse: [^0.0]! ! !Poisson methodsFor: 'private'! setMean: p mu := p! ! !ProbabilityDistribution class methodsFor: 'instance creation'! new ^self basicNew! ! !ProbabilityDistribution class methodsFor: 'class initialization'! initialize "Uniformly distributed random numbers in the range [o,1]." U := Random new! ! !Bernoulli class methodsFor: 'instance creation'! parameter: aNumber (aNumber between: 0.0 and: 1.0) ifTrue: [^self new setParameter: aNumber] ifFalse: [^self error: 'The probability must be between 0.0 and 1.0']! ! !Bernoulli class methodsFor: 'Examples'! Cardgame "is the first draw of a card an ace?" (Bernoulli parameter: 4/52) next "does a car arrive in the next second?" "will a machine break down today?"! ! !Binomial class methodsFor: 'instance creation'! events: n mean: m n truncated <= 0 ifTrue: [self error: 'number of events must be > 0']. ^self new events: n mean: m! ! !Binomial class methodsFor: 'Examples'! FlippingCoins | sampleA sampleB | sampleA := Bernoulli parameter: 0.5. "Did I get heads?" sampleA next. sampleB := Binomial events: 5 mean: 2.5. "How many heads did I get in 5 trials?" sampleB next! ! !Exponential class methodsFor: 'instance creation'! mean: p ^self parameter: 1.0/p! ! !Exponential class methodsFor: 'instance creation'! parameter: p p > 0.0 ifTrue: [^self new setParameter: p] ifFalse: [self error: 'The probability parameter must be greater than 0.0']! ! !Gamma class methodsFor: 'instance creation'! events: k mean: p | events | events := k truncated. events > 0 ifTrue: [^(self parameter: events/p) setEvents: events] ifFalse: [self error: 'the number of events must be greater than 0']! ! !Geometric class methodsFor: 'instance creation'! mean: m ^self parameter: m! ! !Geometric class methodsFor: 'Examples'! CarsArriving | sample | "two cars arrive every minute" sample := Geometric mean: 60/2. "what is the probability that it will take 30 sec before the next car arrives?" sample density: 30. "Did the next car arrive in 30 to 40 seconds?" sample distribution: (30 to: 40)! ! !Normal class methodsFor: 'instance creation'! mean: a deviation: b b > 0.0 ifTrue: [^self new setMean: a standardDeviation: b] ifFalse: [self error: 'standard deviation must be greater than 0.0']! ! !Poisson class methodsFor: 'instance creation'! mean: p p > 0.0 ifTrue: [^self new setMean: p] ifFalse: [self error: 'mean must be greater than 0.0']! ! !Resource methodsFor: 'accessing'! acquire ^self! ! !Resource methodsFor: 'accessing'! addRequest: aDelayedEvent pending add: aDelayedEvent. self provideResources. aDelayedEvent pause.! ! !Resource methodsFor: 'accessing'! name ^resourceName! ! !Resource methodsFor: 'private'! provideResources ^self! ! !Resource methodsFor: 'private'! setName: aString resourceName := aString. pending := SortedCollection new! ! !Resource class methodsFor: 'instance creation'! named: resourceName ^self new setName: resourceName! ! !ResourceCoordinator methodsFor: 'accessing'! customersWaiting ^whoIsWaiting == #customer! ! !ResourceCoordinator methodsFor: 'accessing'! queueLength ^pending size! ! !ResourceCoordinator methodsFor: 'accessing'! serversWaiting ^whoIsWaiting == #server! ! !ResourceCoordinator methodsFor: 'task language'! acquire |waiting| self customersWaiting ifTrue: [^self giveService]. "get here if there is no customer waiting for the server." waiting := WaitingSimulationObject for: 1 withPriority: 0. whoIsWaiting := #server. self addRequest: waiting. ^waiting resource! ! !ResourceCoordinator methodsFor: 'task language'! producedBy: aCustomer |waiting| waiting := WaitingSimulationObject for: 1 of: aCustomer withPriority: 0. self serversWaiting ifTrue: [^self getServiceFor: waiting]. whoIsWaiting := #customer. self addRequest: waiting! ! !ResourceCoordinator methodsFor: 'private'! getServiceFor: aCustomerRequest | aServerRequest | aServerRequest := pending removeFirst. pending isEmpty ifTrue: [whoIsWaiting := #none]. aServerRequest resource: aCustomerRequest. aServerRequest resume. aCustomerRequest pause! ! !ResourceCoordinator methodsFor: 'private'! giveService |aCustomerRequest| aCustomerRequest:= pending removeFirst. pending isEmpty ifTrue: [whoIsWaiting := #none]. ^aCustomerRequest! ! !ResourceCoordinator methodsFor: 'private'! setName: aString super setName: aString. whoIsWaiting := #none! ! !ResourceProvider methodsFor: 'accessing'! amountAvailable ^amountAvailable! ! !ResourceProvider methodsFor: 'task language'! acquire: amountNeeded withPriority: priorityNumber | waiting | waiting := WaitingSimulationObject for: amountNeeded of: self withPriority: priorityNumber. self addRequest: waiting. ^waiting! ! !ResourceProvider methodsFor: 'task language'! produce: amount amountAvailable := amountAvailable + amount. self provideResources! ! !ResourceProvider methodsFor: 'private'! provideResources | waiting | [pending isEmpty not and: [pending first amount <= amountAvailable]] whileTrue: [waiting := pending removeFirst. amountAvailable := amountAvailable - waiting amount. waiting resume]! ! !ResourceProvider methodsFor: 'private'! setName: aResourceName with: amount super setName: aResourceName. amountAvailable := amount! ! !ResourceProvider class methodsFor: 'instance creation'! named: aResourceName ^self new setName: aResourceName with: 0! ! !ResourceProvider class methodsFor: 'instance creation'! named: aResourceName with: amount ^self new setName: aResourceName with: amount! ! !SampleSpace methodsFor: 'probability functions'! density: x "x must be in the sample space; the probability must sum over all occurrences of x in the sample space." (data includes: x) ifTrue: [^(data occurrencesOf: x) / data size] ifFalse: [^0]! ! !SampleSpace methodsFor: 'private'! inverseDistribution: x ^data at: (x*data size) truncated + 1! ! !SampleSpace methodsFor: 'private'! setData: aCollection data := aCollection! ! !SampleSpace class methodsFor: 'instance creation'! data: aCollection ^self new setData: aCollection! ! !SampleSpace class methodsFor: 'Examples'! heights | heights | heights := SampleSpace data: #(60 60 60 62 62 64 64 64 64 66 66 66 68 68 68 68 68 70 70 70). "what is the probability of randomly selecting a student with height 64?" heights density: 64. "what is the probability of randomly selecting a student whose height is between 60 and 64?" heights distribution: (60 to: 64 by: 2)! ! !Simulation commentStamp: '' prior: 0! Expects to handle several kinds of resources, represented abstractly by class Resource, and concretely by subclasses of Resource: ResourceProvider, StaticResource, and ResourceCoordinator! !Simulation methodsFor: 'initialization'! activate "This instance is now the active simulation" RunningSimulation := self! ! !Simulation methodsFor: 'initialization'! defineArrivalSchedule "A subclass specifies the schedule by which simulation objects dynamically enter into the simulation." ^self! ! !Simulation methodsFor: 'initialization'! defineResources "A subclass specifies the schedule by which simulation objects that are initially entered into the simulation." ^self! ! !Simulation methodsFor: 'initialization'! initialize resources := Set new. currentTime := 0.0. processCount := 0. eventQueue := SortedCollection new! ! !Simulation methodsFor: 'task language'! coordinate: resourceName (self includesResourceFor: resourceName) ifFalse: [resources add: ( ResourceCoordinator named: resourceName)]! ! !Simulation methodsFor: 'task language'! produce: amount of: resourceName (self includesResourceFor: resourceName) ifTrue: [(self provideResourceFor: resourceName) produce: amount "sends produce: to a ResourceProvider"] ifFalse: [resources add: (ResourceProvider named: resourceName with: amount)]! ! !Simulation methodsFor: 'task language'! schedule: actionBlock after: timeDelay self schedule: actionBlock at: currentTime + timeDelay! ! !Simulation methodsFor: 'task language'! schedule: aBlock at: timeInteger "This is the mechanism for scheduling a single action." self newProcessFor: [self delayUntil: timeInteger. aBlock value]! ! !Simulation methodsFor: 'task language'! scheduleArrivalOf: aSimulationObjectClass accordingTo: aProbabilityDistribution "This means start now" self scheduleArrivalOf: aSimulationObjectClass accordingTo: aProbabilityDistribution startingAt: currentTime! ! !Simulation methodsFor: 'task language'! scheduleArrivalOf: aSimulationObjectClass accordingTo: aProbabilityDistribution startingAt: timeInteger "Note that aSimulationObjectClass is the class Simulation or one of its subclasses. The real work is done in the private message schedule:startingAt:andThenEvery:. " self schedule: [aSimulationObjectClass new startUp] startingAt: timeInteger andThenEvery: aProbabilityDistribution! ! !Simulation methodsFor: 'task language'! scheduleArrivalOf: aSimulationObject at: timeInteger self schedule: [aSimulationObject startUp] at: timeInteger! ! !Simulation methodsFor: 'scheduling'! delayFor: timeDelay self delayUntil: currentTime+timeDelay! ! !Simulation methodsFor: 'scheduling'! delayUntil: aTime | delayEvent | delayEvent := DelayedEvent onCondition: aTime. eventQueue add: delayEvent. "self stopProcess." delayEvent pause. "self startProcess"! ! !Simulation methodsFor: 'scheduling'! newProcessFor: aBlock self startProcess. [aBlock value. self stopProcess] fork! ! !Simulation methodsFor: 'scheduling'! startProcess processCount := processCount +1! ! !Simulation methodsFor: 'scheduling'! stopProcess processCount := processCount - 1! ! !Simulation methodsFor: 'simulation control'! enter: anObject ^self! ! !Simulation methodsFor: 'simulation control'! exit: anObject ^self! ! !Simulation methodsFor: 'simulation control'! finishUp "We need to empty out the event queue." eventQueue := SortedCollection new. ^nil! ! !Simulation methodsFor: 'simulation control'! proceed | eventProcess | [self readyToContinue] whileFalse: [Processor yield]. eventQueue isEmpty ifTrue: [^self finishUp] ifFalse: [eventProcess := eventQueue removeFirst. currentTime := eventProcess condition. eventProcess resume]! ! !Simulation methodsFor: 'simulation control'! startUp self activate. self defineResources. self defineArrivalSchedule! ! !Simulation methodsFor: 'accessing'! includesResourceFor: resourceName | test | test := resources detect: [:each | each name = resourceName] ifNone: [nil]. ^test notNil! ! !Simulation methodsFor: 'accessing'! provideResourceFor: resourceName ^resources detect: [ :each | each name = resourceName]! ! !Simulation methodsFor: 'accessing'! time ^currentTime! ! !Simulation methodsFor: 'private'! readyToContinue ^processCount = 0! ! !Simulation methodsFor: 'private'! schedule: aBlock startingAt: timeInteger andThenEvery: aProbabilityDistribution self newProcessFor: [self delayUntil: timeInteger. self newProcessFor: aBlock copy. aProbabilityDistribution do: [:nextTimeDelay | self delayFor: nextTimeDelay. self newProcessFor: aBlock copy]]! ! !Simulation methodsFor: 'reporting'! report: label Transcript show: label. Transcript tab. Transcript show: 'pc: ', processCount printString. Transcript space. Transcript show: 'procs: ', (Processor processesAt: Processor userSchedulingPriority) printString. Transcript space. Transcript show: 'events: ', eventQueue size printString. Transcript cr! ! !CarDealer methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:27'! exit: aSimulationObject super exit: aSimulationObject. "A CarDelivery could be exiting -- ignore it." (aSimulationObject isKindOf: CarBuyer) ifTrue: [statistics store: currentTime - aSimulationObject entryTime] ! ! !CarDealer methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:27'! printStatisticsOn: aStream statistics printStatisticsOn: aStream. ! ! !CarDealer methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:26'! defineArrivalSchedule self scheduleArrivalOf: CarBuyer accordingTo: (Uniform from: 2 to: 6) startingAt: 1.0. self scheduleArrivalOf: (CarDelivery new) at: 90.0. "Only one delivery is scheduled; the instance of CarDelivery will reschedule itself." ! ! !CarDealer methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:26'! defineResources self produce: 12 of: 'Car'. ! ! !CarDealer methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:24'! initialize super initialize. statistics := Histogram from: 1 to: 365 by: 7. ! ! !Museum methodsFor: 'class initialization'! defineArrivalSchedule self scheduleArrivalOf: Visitor accordingTo: (Uniform from: 5 to:10).! ! !Museum methodsFor: 'class initialization'! exit: aSimulationObject super exit: aSimulationObject. statistics store: currentTime - aSimulationObject entryTime! ! !Museum methodsFor: 'class initialization'! initialize super initialize. statistics := Histogram from: 5 to: 45 by: 5.! ! !Museum methodsFor: 'class initialization'! printStatisticsOn: aStream statistics printStatisticsOn: aStream! ! !NothingAtAll methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:18'! defineArrivalSchedule self scheduleArrivalOf: DoNothing accordingTo: (Uniform from:1 to:5).! ! !Simulation class methodsFor: 'instance creation'! new ^super new initialize! ! !Simulation class methodsFor: 'accessing'! active ^RunningSimulation! ! !CarDealer class reorganize! ('demo' demo) ! !CarDealer class methodsFor: 'demo' stamp: 'mjg 10/2/97 10:21'! demo | aSimulation aStream| aSimulation := self new startUp. [aSimulation time < 180] whileTrue: [aSimulation proceed]. aStream := FileStream fileNamed: 'dealer.events'. aSimulation printStatisticsOn: aStream. aStream close.! ! !Museum class reorganize! ('demo' demo) ! !Museum class methodsFor: 'demo' stamp: 'mjg 10/2/97 10:19'! demo | aSimulation aStream| aSimulation := self new startUp. [aSimulation time < 50] whileTrue: [aSimulation proceed]. aStream := FileStream fileNamed: 'museum.events'. aSimulation printStatisticsOn: aStream. aStream close.! ! !NothingAtAll class methodsFor: 'demos' stamp: 'mjg 10/2/97 10:22'! aDoNothingDemo | aSimulation aFile | aFile := (FileStream newFileNamed: 'demo.events3'). DoNothing file: aFile. aSimulation := self new startUp. [aSimulation time < 25] whileTrue: [aSimulation proceed]. aFile close! ! !SimulationObject commentStamp: '' prior: 0! A SimulationObject represents any object that can be given a sequence of tasks to do. The class specifies a general control sequence by which the object enters, carries out its tasks, and leaves the simulation. Resources can be produced, consumed, acquired, and tested by queries such as amountAvailable, serversWaiting, custoemrsWaiting?! !SimulationObject methodsFor: 'initialization'! initialize "Do nothing. Subclasses will initialize instance variables." ^self! ! !SimulationObject methodsFor: 'simulation control'! finishUp "Tell the simulation that the receiver is done with its tasks." Simulation active exit: self! ! !SimulationObject methodsFor: 'simulation control'! startUp Simulation active enter: self. "First tell the simulation that the receiver is beginning to do my tasks." self tasks. self finishUp! ! !SimulationObject methodsFor: 'simulation control'! tasks "Do nothing. Subclasses will schedule activities." ^self! ! !SimulationObject methodsFor: 'task language'! acquire: amount ofResource: resourceName "Get the resource and then tell it to acquire amount of it. Answers an instance of StaticResource." ^(Simulation active provideResourceFor: resourceName) acquire: amount withPriority: 0! ! !SimulationObject methodsFor: 'task language'! acquire: amount ofResource: resourceName withPriority: priority "Returns a StaticResource" ^(Simulation active provideResourceFor: resourceName) acquire: amount withPriority: priority! ! !SimulationObject methodsFor: 'task language'! acquireResource: resourceName "Returns a StaticResource" ^(Simulation active provideResourceFor: resourceName) acquire! ! !SimulationObject methodsFor: 'task language'! holdFor: aTimeDelay Simulation active delayFor: aTimeDelay! ! !SimulationObject methodsFor: 'task language'! inquireFor: amount ofResource: resourceName ^(Simulation active provideResourceFor: resourceName) amountAvailable >= amount! ! !SimulationObject methodsFor: 'task language'! numberOfProvidersOfResource: resourceName | resource | resource := Simulation active provideResourceFor: resourceName. resource serversWaiting ifTrue: [^resource queueLength] ifFalse: [^0]! ! !SimulationObject methodsFor: 'task language'! numberOfRequestersOfResource: resourceName | resource | resource := Simulation active provideResourceFor: resourceName. resource customersWaiting ifTrue: [^resource queueLength] ifFalse: [^0]! ! !SimulationObject methodsFor: 'task language'! produce: amount ofResource: resourceName Simulation active produce: amount of: resourceName! ! !SimulationObject methodsFor: 'task language'! produceResource: resourceName ^(Simulation active provideResourceFor: resourceName) producedBy: self! ! !SimulationObject methodsFor: 'task language'! release: aStaticResource ^aStaticResource release! ! !SimulationObject methodsFor: 'task language'! resourceAvailable: resourceName "Does the active simulaton have a resource with this attribute available?" ^Simulation active includesResourceFor: resourceName! ! !SimulationObject methodsFor: 'task language'! resume: anEvent ^anEvent resume! ! !SimulationObject methodsFor: 'task language'! stopSimulation Simulation active finishUp! ! !Car methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:20'! tasks "Sample, without replacement, the direction through the intersection that the car will travel" | sample | sample := SampleSpace data: #(left left right straight straight straight straight straight). (Simulation active) update: sample next.! ! !CarBuyer methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:28'! entryTime ^entryTime ! ! !CarBuyer methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:28'! tasks self acquire: 1 ofResource: 'Car'. ! ! !CarBuyer methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:28'! initialize super initialize. entryTime := (Simulation active) time. ! ! !CarDelivery methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:29'! tasks "Get access to the Car resource and produce 10, 11, or 12 cars." self produce: ((SampleSpace data: #(10 11 12)) next) ofResource: 'Car'. "Schedule a new delivery in 90 days" (Simulation active) scheduleArrivalOf: self at: (Simulation active) time + 90.! ! !EventMonitor methodsFor: 'scheduling'! finishUp super finishUp. self timeStamp. DataFile nextPutAll: ' exits '.! ! !EventMonitor methodsFor: 'scheduling'! startUp self timeStamp. DataFile nextPutAll: ' enters '. super startUp! ! !EventMonitor methodsFor: 'task language'! acquire: amount ofResource: resourceName | aStaticResource | self timeStamp. DataFile nextPutAll: ' requests '. amount printOn: DataFile. DataFile nextPutAll: ' of ', resourceName. aStaticResource := super acquire: amount ofResource: resourceName. self timeStamp. DataFile nextPutAll: ' obtained '. amount printOn: DataFile. DataFile nextPutAll: ' of ', resourceName. ^aStaticResource! ! !EventMonitor methodsFor: 'task language'! acquire: amount ofResource: resourceName withPriority: priorityNumber | aStaticResource | self timeStamp. DataFile nextPutAll: ' requests '. amount printOn: DataFile. DataFile nextPutAll: ' at priority '. priorityNumber printOn: DataFile. DataFile nextPutAll: ' of ', resourceName. aStaticResource := super acquire: amount ofResource: resourceName withPriority: priorityNumber. self timeStamp. DataFile nextPutAll: ' obtained '. amount printOn: DataFile. DataFile nextPutAll: ' of ', resourceName. ^aStaticResource! ! !EventMonitor methodsFor: 'task language'! acquireResource: resourceName | anEvent | self timeStamp. DataFile nextPutAll: ' wants to serve for '. DataFile nextPutAll: resourceName. anEvent := super acquireResource: resourceName. self timeStamp. DataFile nextPutAll: ' can serve '. anEvent resource printOn: DataFile. ^anEvent! ! !EventMonitor methodsFor: 'task language'! holdFor: aTimeDelay self timeStamp. DataFile nextPutAll: ' holds for '. aTimeDelay printOn: DataFile. super holdFor: aTimeDelay! ! !EventMonitor methodsFor: 'task language'! produce: amount ofResource: resourceName self timeStamp. DataFile nextPutAll: ' produces '. amount printOn: DataFile. DataFile nextPutAll: ' of ', resourceName. super produce: amount ofResource: resourceName! ! !EventMonitor methodsFor: 'task language'! produceResource: resourceName self timeStamp. DataFile nextPutAll: ' wants to get service as '. DataFile nextPutAll: resourceName. super produceResource: resourceName! ! !EventMonitor methodsFor: 'task language'! release: aStaticResource self timeStamp. DataFile nextPutAll: ' releases '. aStaticResource amount printOn: DataFile. DataFile nextPutAll: ' of ', aStaticResource name. super release: aStaticResource! ! !EventMonitor methodsFor: 'task language'! resume: anEvent self timeStamp. DataFile nextPutAll: ' resumes '. anEvent resource printOn: DataFile. super resume: anEvent! ! !EventMonitor methodsFor: 'private'! timeStamp DataFile cr. Simulation active time printOn: DataFile. DataFile tab. self printOn: DataFile! ! !EventMonitor methodsFor: 'initialization'! initialize super initialize. self setLabel! ! !EventMonitor methodsFor: 'accessing'! label ^label! ! !EventMonitor methodsFor: 'accessing'! setLabel Counter := Counter + 1. label := Counter printString.! ! !EventMonitor methodsFor: 'printing'! printOn: aStream self class name printOn: aStream. aStream space. aStream nextPutAll: self label! ! !SimulationObject class methodsFor: 'instance creation'! new ^super new initialize! ! !EventMonitor class methodsFor: 'class initialization'! file: aFile DataFile := aFile. Counter := 0! ! !SimulationObjectRecord methodsFor: 'accessing'! duration ^duration! ! !SimulationObjectRecord methodsFor: 'accessing'! entrance ^entranceTime! ! !SimulationObjectRecord methodsFor: 'accessing'! entrance: currentTime entranceTime := currentTime! ! !SimulationObjectRecord methodsFor: 'accessing'! exit ^entranceTime + duration! ! !SimulationObjectRecord methodsFor: 'accessing'! exit: currentTime duration := currentTime - entranceTime! ! !SimulationObjectRecord methodsFor: 'printing'! printOn: aStream entranceTime printOn: aStream. aStream tab. duration printOn: aStream! ! !StatisticsWithSimulation methodsFor: 'initialization'! initialize super initialize. statistics := Dictionary new.! ! !StatisticsWithSimulation methodsFor: 'simulation scheduling'! enter: anObject statistics at: anObject put: (SimulationObjectRecord new entrance: currentTime)! ! !StatisticsWithSimulation methodsFor: 'simulation scheduling'! exit: anObject (statistics at: anObject) exit: currentTime! ! !StatisticsWithSimulation methodsFor: 'statistics'! printStatisticsOn: aStream | stat | aStream cr. aStream nextPutAll: ' Object'. aStream tab. aStream nextPutAll: 'Entrance Time'. aStream tab. aStream nextPutAll: 'Duration'. aStream cr. stat := SortedCollection sortBlock: [:i :j | i value entrance <= j value entrance]. statistics associationsDo: [:each | stat add: each]. stat do: [:anAssociation | aStream cr. anAssociation key printOn: aStream. aStream tab. anAssociation value printOn: aStream]! ! !Traffic methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:19'! printStatisticsOn: aStream aStream cr. aStream nextPutAll: 'Car Direction Tally'. statistics associationsDo: [:assoc | aStream cr. assoc key printOn: aStream. aStream tab. assoc value printOn: aStream.] ! ! !Traffic methodsFor: 'simulation' stamp: 'MJG 7/28/97 11:19'! update: key statistics at: key put: (statistics at: key) + 1. ! ! !Traffic methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:18'! defineArrivalSchedule self scheduleArrivalOf: Car accordingTo: (Uniform from: 0.5 to: 2). self schedule: [self finishUp] at: 100. "MJG Note: DOESN'T WORK!!" ! ! !Traffic methodsFor: 'initialization' stamp: 'MJG 7/28/97 11:17'! initialize super initialize. statistics := Dictionary new. statistics at: #straight put: 0. statistics at: #right put: 0. statistics at: #left put: 0. ! ! !Uniform methodsFor: 'accessing'! mean ^ (startNumber + stopNumber)/2! ! !Uniform methodsFor: 'accessing'! variance ^ (stopNumber - stopNumber) squared / 12! ! !Uniform methodsFor: 'probability functions'! density: x (x between: startNumber and: stopNumber) ifTrue: [^1.0 / (stopNumber - startNumber)] ifFalse: [^0]! ! !Uniform methodsFor: 'private'! inverseDistribution: x "x is a random number between 0 and 1" ^startNumber + (x * (stopNumber - startNumber))! ! !Uniform methodsFor: 'private'! setStart: begin toEnd: end startNumber := begin. stopNumber := end! ! !Uniform class methodsFor: 'instance creation'! from: begin to: end begin > end ifTrue: [self error: 'illegal interval'] ifFalse: [^self new setStart: begin toEnd: end]! ! !Visitor methodsFor: 'access'! entryTime ^entryTime.! ! !Visitor methodsFor: 'access'! tasks self holdFor: (Normal mean: 20 deviation: 5) next.! ! !Visitor methodsFor: 'class initialization'! initialize super initialize. entryTime := Simulation active time.! ! !WaitingSimulationObject methodsFor: 'task language'! consume: aNumber amount := (amount - aNumber) max: 0! ! !WaitingSimulationObject methodsFor: 'task language'! release resource produce: amount. amount := 0! ! !WaitingSimulationObject methodsFor: 'task language'! release: anAmount resource produce: anAmount. amount := amount - anAmount! ! !WaitingSimulationObject methodsFor: 'accessing'! amount ^amount! ! !WaitingSimulationObject methodsFor: 'accessing'! name ^resource name! ! !WaitingSimulationObject methodsFor: 'accessing'! resource ^resource! ! !WaitingSimulationObject methodsFor: 'accessing'! resource: aResource resource := aResource! ! !WaitingSimulationObject methodsFor: 'private'! setAmount: aNumber resource: aResource amount := aNumber. resource := aResource! ! !WaitingSimulationObject class methodsFor: 'instance creation'! for: amount of: aResource withPriority: aNumber ^(self onCondition: aNumber) setAmount: amount resource: aResource! ! !WaitingSimulationObject class methodsFor: 'instance creation'! for: amount withPriority: aNumber ^(self onCondition: aNumber) setAmount: amount resource: nil! ! ProbabilityDistribution initialize!