home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
ckscripts
/
simulation
< prev
next >
Wrap
Lisp/Scheme
|
2020-01-01
|
7KB
|
298 lines
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