home *** CD-ROM | disk | FTP | other *** search
- take class
-
- class aset
- define aset::new: {
- _asg \%1.thisaset |
- (setq \%1.thisaset.cnt 0)
- (\%1)
- }
- define aset>>insert: {
- if == \find(|\%2|,\m(\%1.thisaset)) 0 {
- _asg \%1.thisaset \m(\%1.thisaset)\%2|
- (++ \%1.thisaset.cnt)
- }
- (\%1)
- }
- define aset>>remove: {
- if \find(|\%2|,\m(\%1.thisaset)) {
- _asg \%1.thisaset \freplace(\m(\%1.thisaset),|\%2|,|)
- (-- \%1.thisaset.cnt)
- }
- (\%1)
- }
- define aset>>isEmpty {
- (== 0 \%1.thisaset.cnt)
- }
- define aset>>includes: {
- (> \find(|\%2|,\m(\%1.thisaset)) 0)
- }
- define aset>>min {
- if = 0 \%1.thisaset.cnt return -1
- local \&w[]
- void \fsplit(\m(\%1.thisaset),&w)
- array sort /numeric \&w
- (\&w[1])
- }
- define aset>>max {
- ; if = 0 \%1.thisaset.cnt return 0
- local \&w[]
- (let size \fsplit(\m(\%1.thisaset),&w))
- array sort /numeric \&w
- (\&w[size])
- }
- define aset>>inspect {
- show mac \%1.thisaset
- (\%1)
- }
-
- define say { echo \%1 }
-
- define randnum {
- ; \%1 random seed
- while true {
- if {\fsexpr(let rd \frandom(\%1))} return \m(rd)
- }
- }
-
- define aReference {
- ; \%1 Id
- return \%1.\frandom(999999)_\frandom(999999)
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class DiscreteProbability
- define DiscreteProbability>>defineWeights {
- ; \%2 anArray
- }
- define DiscreteProbability>>next {
- (if (>= (let r \frandom(100)) 90) 3 (if (>= r 65) 2 1))
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class NormalDistribution
- define NormalDistribution::new: {
- \%1 setmean: 1.0 deviation: 0.5
- }
- define NormalDistribution>>setmean:deviation: {
- ; \%2 mean
- ; \%3 deviation
- (setq \%1.ND.curTime 0)
- (setq \%1.ND.mean \%2)
- (setq \%1.ND.deviation \%3)
- }
- define NormalDistribution>>next {
- ; (++ \%1.ND.curTime (randnum 5))
- (++ \%1.ND.curTime \frandom(5))
- }
- define NormalDistribution>>incr {
- local v1 v2 s u
- (setq s 1)
- while >= s 1 {
- echo \m(s) ***
- (setq v1 (- (* 2 (randnum 1)) 1))
- echo \m(v1)
- (setq v2 (- (* 2 (randnum 1)) 1))
- echo \m(v2)
- (setq s (+ (* v1 v1) (* v2 v2)))
- echo \m(s) ***
- }
- (setq u (sqrt (/ (log (* -2.0 s)) s))))
- (+ \%1.ND.mean (* \%1.ND.deviation v1 u))
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class Dictionary
- define Dictionary::new: {
- aset new: \%1.DictionarySet
- (\%1)
- }
- define Dictionary>>add:at: {
- ; \%1 caller
- ; \%2 item to be added
- ; \%3 slotid
- (if (not (\%1.DictionarySet 'includes: \%3))
- (. (setq \%1.DictionarySet<\%3><begin> 0
- \%1.DictionarySet<\%3><end> 0)
- (\%1.DictionarySet 'insert: \%3)
- )
- )
- (++ \%1.DictionarySet<\%3><end>)
- (let \\\\%i \%1.DictionarySet<\%3><end>)
- _asg \%1.DictionarySet<\%3><\%i> {\%2}
- (\%1)
- }
- define Dictionary>>emptyAt: {
- (if (\%1.DictionarySet 'includes: \%2)
- (== \%1.DictionarySet<\%2><begin> \%1.DictionarySet<\%2><end>)
- 1
- )
- }
- define Dictionary>>isEmpty {
- (\%1.DictionarySet 'isEmpty)
- }
- define Dictionary>>getNext: {
- ; Two iterators <begin> and <end> manage the queue of messages
- (++ \%1.DictionarySet<\%2><begin>)
- asg \%i \m(\%1.DictionarySet<\%2><begin>)
- (if (\%1 'emptyAt: \%2) (\%1.DictionarySet 'remove: \%2))
- return \%1.DictionarySet<\%2><\%i>
- }
- define Dictionary>>minTime {
- (\%1.DictionarySet 'min)
- }
- define Dictionary>>maxTime {
- (\%1.DictionarySet 'max)
- }
- define Dictionary>>includesKey: {
- (\%1.DictionarySet 'includes \%2)
- }
- define Dictionary>>At:Do: {
- local \%i
- (let b \%1.DictionarySet<\%2><begin>)
- incr b
- (let e \%1.DictionarySet<\%2><end>)
- for \%i b e 1 {
- (\%1.DictionarySet<\%2><\%i> \%3)
- }
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class Simulation
- define Simulation::new: {
- Dictionary new: \%1.eventQueue
- (setq \%1.currentTime 0)
- (\%1)
- }
- define Simulation>>add:at: {
- \%1.eventQueue add: {\%2} at: \%3
- (\%1)
- }
- define Simulation>>add:next: {
- (\%1 'add: \%2 'at: (+ \%1.currentTime \%3))
- (\%1)
- }
- define Simulation>>init {
- (setq \%1.currentTime 0)
- (\%1)
- }
- define Simulation>>time {
- (\%1.currentTime)
- }
- define Simulation>>maxTime {
- (\%1.eventQueue 'maxTime)
- }
- define Simulation>>proceed {
- (if (> (setq \%1.currentTime (\%1.eventQueue 'minTime)) 0)
- (\%1 'processEvent:
- (\%1.eventQueue 'getNext: \%1.currentTime))
- -1
- )
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class IceCreamStore inherit: Simulation
- define IceCreamStore::new: {
- \%1 Simulation::new: ; call super new:
- (setq \%1.profit 0 \%1.ICS.remainingChairs 10)
- ((NormalDistribution 'new: '\%1.ICS.arrivalDistribution) 'setMean: 3.0 'deviation: 1.0)
- DiscreteProbability new: \%1.ICS.scoopDistribution
- \%1 scheduleArrival ; schedule the first arrival
- }
- define IceCreamStore>>processEvent: {
- ; say {event received at \fsexpr(\%1 'time)}
- (\%2)
- \%1 scheduleArrival ; Schedule subsequent arrival
- }
- define IceCreamStore>>scheduleArrival {
- (Customer 'new: (let newCustomer (aReference 'Customer)))
- if < {\fsexpr(let atime (+ (\%1 'time) (randnum 10)))} 60 {
- \%1 add: {(\%1 'customerArrival: \m(newCustomer))} at: \m(atime)
- }
- }
- define IceCreamStore>>customerArrival: {
- echo {Group of size \fsexpr(let size (\%2 'groupSize)) arrives}
- if < \m(size) \m(\%1.ICS.remainingChairs) {
- (say '(Take chairs, schedules order))
- (-- \%1.ICS.remainingChairs size)
- \%1 add: {(\%1 'customerOrder: \%2)} next: \fexec(randnum 3)
- } else {
- (say '(Find no chairs, leaves))
- }
- (\%1)
- }
- define IceCreamStore>>customerOrder: {
- ; \%2 customer
- (let size (\%2 'groupSize) numScoops 0 i 0)
- for i 1 size 1 {
- (++ numScoops (\%1.ICS.scoopDistribution 'next))
- }
- echo {Group of size \m(size) order \m(numScoops) scoops}
- echo Profits so far \fsexpr(++ \%1.profit (* numScoops 0.17))
- \%1 add: {(\%1 'customerLeave: \%2)} next: \fexec(randnum 5)
- (\%1)
- }
- define IceCreamStore>>customerLeave: {
- ; \%2 customer
- echo {Group of size \fsexpr(let size (\%2 'groupSize)) leaves}
- (++ \%1.ICS.remainingChairs size)
- _define \%2 ; Garbage collection
- (\%1)
- }
- define IceCreamStore>>reportProfits {
- echo Total profits are \m(\%1.profit)
- (\%1)
- }
- define IceCreamStore>>scoopsFor: {
- (let i 0 number 0)
- for i 1 \%2 1 { (++ number (\%1.ICE.scoopDistribution 'next)) }
- echo group of \%2 'have' \m(number) scoops
- (number)
- }
- define IceCreamStore>>inspect {
- echo \v(macro)
- (\%1)
- }
- define IceCreamStore>>run {
- while true {
- if {\fsexpr(< (\%1 'proceed) 0)} break
- if {\fsexpr(> (\%1 'time) \%2)} break
- }
- }
-
- define IceCreamStore>>runit {
- while {\fsexpr(< \%2 (\%1 'time))} { \%1 proceed }
- }
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- class Customer
- define Customer::new: {
- (setq \%1.groupSize (randnum 15))
- (\%1)
- }
- define Customer>>groupSize {
- (\%1.groupSize)
- }
- define Customer>>numberOfScoops {
- (let number (randnum 5))
- echo Customer has \m(number) scoop(s)
- (number)
- }
- define Customer>>inspect {
- echo \%1 \v(macro)
- (\%1)
- }
-
- echo
- IceCreamStore new: myStore
-
- myStore run 40
- echo
- mystore reportProfits
- echo
-