home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ckscripts / simulation < prev    next >
Lisp/Scheme  |  2020-01-01  |  7KB  |  298 lines
  1. take class
  2.  
  3. class aset
  4. define aset::new: {
  5.     _asg \%1.thisaset |
  6.     (setq \%1.thisaset.cnt 0)
  7.     (\%1)
  8. }
  9. define aset>>insert: {
  10.     if == \find(|\%2|,\m(\%1.thisaset)) 0 {
  11.         _asg \%1.thisaset \m(\%1.thisaset)\%2|
  12.         (++ \%1.thisaset.cnt)
  13.     }
  14.     (\%1)
  15. }
  16. define aset>>remove: {
  17.     if \find(|\%2|,\m(\%1.thisaset)) {
  18.         _asg \%1.thisaset \freplace(\m(\%1.thisaset),|\%2|,|)
  19.         (-- \%1.thisaset.cnt)
  20.     }
  21.     (\%1)
  22. }
  23. define aset>>isEmpty {
  24.     (== 0 \%1.thisaset.cnt)
  25. }
  26. define aset>>includes: {
  27.     (> \find(|\%2|,\m(\%1.thisaset)) 0)
  28. }
  29. define aset>>min {
  30.     if = 0 \%1.thisaset.cnt return -1
  31.     local \&w[]
  32.     void \fsplit(\m(\%1.thisaset),&w)
  33.     array sort /numeric \&w
  34.     (\&w[1])
  35. }
  36. define aset>>max {
  37. ;    if = 0 \%1.thisaset.cnt return 0
  38.     local \&w[]
  39.     (let size \fsplit(\m(\%1.thisaset),&w))
  40.     array sort /numeric \&w
  41.     (\&w[size])
  42. }
  43. define aset>>inspect {
  44.     show mac \%1.thisaset
  45.     (\%1)
  46. }
  47.  
  48. define say { echo \%1 }
  49.  
  50. define randnum {
  51. ; \%1 random seed
  52.     while true {
  53.         if {\fsexpr(let rd \frandom(\%1))} return \m(rd)
  54.     }
  55. }
  56.  
  57. define aReference {
  58. ; \%1 Id
  59.     return \%1.\frandom(999999)_\frandom(999999)
  60. }
  61.  
  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63.  
  64. class DiscreteProbability
  65. define DiscreteProbability>>defineWeights {
  66. ; \%2 anArray
  67. }
  68. define DiscreteProbability>>next {
  69.     (if (>= (let r \frandom(100)) 90) 3 (if (>= r 65) 2 1))
  70. }
  71.  
  72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73.  
  74. class NormalDistribution
  75. define NormalDistribution::new: {
  76.     \%1 setmean: 1.0 deviation: 0.5
  77. }
  78. define NormalDistribution>>setmean:deviation: {
  79. ; \%2 mean
  80. ; \%3 deviation
  81.     (setq \%1.ND.curTime 0)
  82.     (setq \%1.ND.mean \%2)
  83.     (setq \%1.ND.deviation \%3)
  84. }
  85. define NormalDistribution>>next {
  86. ;    (++ \%1.ND.curTime (randnum 5))
  87.     (++ \%1.ND.curTime \frandom(5))
  88. }
  89. define NormalDistribution>>incr {
  90.     local v1 v2 s u
  91.     (setq s 1)
  92.     while >= s 1 {
  93.         echo \m(s) ***
  94.         (setq v1 (- (* 2 (randnum 1)) 1))
  95.         echo \m(v1)
  96.         (setq v2 (- (* 2 (randnum 1)) 1))
  97.         echo \m(v2)
  98.         (setq s (+ (* v1 v1) (* v2 v2)))
  99.         echo \m(s) ***
  100.     }
  101.     (setq u (sqrt (/ (log (* -2.0 s)) s))))
  102.     (+ \%1.ND.mean (* \%1.ND.deviation v1 u))
  103. }
  104.  
  105. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.  
  107. class Dictionary
  108. define Dictionary::new: {
  109.     aset new: \%1.DictionarySet
  110.     (\%1)
  111. }
  112. define Dictionary>>add:at: {
  113. ; \%1 caller
  114. ; \%2 item to be added
  115. ; \%3 slotid
  116.     (if (not (\%1.DictionarySet 'includes: \%3))
  117.         (.    (setq \%1.DictionarySet<\%3><begin> 0
  118.                   \%1.DictionarySet<\%3><end>   0)
  119.             (\%1.DictionarySet 'insert: \%3)
  120.         )
  121.     )
  122.     (++ \%1.DictionarySet<\%3><end>)
  123.     (let \\\\%i \%1.DictionarySet<\%3><end>)
  124.     _asg \%1.DictionarySet<\%3><\%i> {\%2}
  125.     (\%1)
  126. }
  127. define Dictionary>>emptyAt: {
  128.     (if (\%1.DictionarySet 'includes: \%2)
  129.         (== \%1.DictionarySet<\%2><begin> \%1.DictionarySet<\%2><end>)
  130.         1
  131.     )
  132. }
  133. define Dictionary>>isEmpty {
  134.     (\%1.DictionarySet 'isEmpty)
  135. }
  136. define Dictionary>>getNext: {
  137. ; Two iterators <begin> and <end> manage the queue of messages
  138.     (++ \%1.DictionarySet<\%2><begin>)
  139.     asg \%i \m(\%1.DictionarySet<\%2><begin>)
  140.     (if (\%1 'emptyAt: \%2) (\%1.DictionarySet 'remove: \%2))
  141.     return \%1.DictionarySet<\%2><\%i>
  142. }
  143. define Dictionary>>minTime {
  144.     (\%1.DictionarySet 'min)
  145. }
  146. define Dictionary>>maxTime {
  147.     (\%1.DictionarySet 'max)
  148. }
  149. define Dictionary>>includesKey: {
  150.     (\%1.DictionarySet 'includes \%2)
  151. }
  152. define Dictionary>>At:Do: {
  153.     local \%i
  154.     (let b \%1.DictionarySet<\%2><begin>)
  155.     incr b
  156.     (let e \%1.DictionarySet<\%2><end>)
  157.     for \%i b e 1 {
  158.         (\%1.DictionarySet<\%2><\%i> \%3)
  159.     }
  160. }
  161.  
  162. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  163.  
  164. class Simulation
  165. define Simulation::new: {
  166.     Dictionary new: \%1.eventQueue
  167.     (setq \%1.currentTime 0)
  168.     (\%1)
  169. }
  170. define Simulation>>add:at: {
  171.     \%1.eventQueue add: {\%2} at: \%3
  172.     (\%1)
  173. }
  174. define Simulation>>add:next: {
  175.     (\%1 'add: \%2 'at: (+ \%1.currentTime \%3))
  176.     (\%1)
  177. }
  178. define Simulation>>init {
  179.     (setq \%1.currentTime 0)
  180.     (\%1)
  181. }
  182. define Simulation>>time {
  183.     (\%1.currentTime)
  184. }
  185. define Simulation>>maxTime {
  186.     (\%1.eventQueue 'maxTime)
  187. }
  188. define Simulation>>proceed {
  189.     (if (> (setq \%1.currentTime (\%1.eventQueue 'minTime)) 0)
  190.         (\%1 'processEvent:
  191.             (\%1.eventQueue 'getNext: \%1.currentTime))
  192.         -1
  193.     )
  194. }
  195.  
  196. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  197.  
  198. class IceCreamStore inherit: Simulation
  199. define IceCreamStore::new: {
  200.     \%1 Simulation::new:    ; call super new:
  201.     (setq \%1.profit 0 \%1.ICS.remainingChairs 10)
  202.     ((NormalDistribution 'new: '\%1.ICS.arrivalDistribution) 'setMean: 3.0 'deviation: 1.0)
  203.     DiscreteProbability new: \%1.ICS.scoopDistribution
  204.     \%1 scheduleArrival    ; schedule the first arrival
  205. }
  206. define IceCreamStore>>processEvent: {
  207. ;    say {event received at \fsexpr(\%1 'time)}
  208.     (\%2)
  209.     \%1 scheduleArrival    ; Schedule subsequent arrival
  210. }
  211. define IceCreamStore>>scheduleArrival {
  212.     (Customer 'new: (let newCustomer (aReference 'Customer)))
  213.     if < {\fsexpr(let atime (+ (\%1 'time) (randnum 10)))} 60 {
  214.         \%1 add: {(\%1 'customerArrival: \m(newCustomer))} at: \m(atime)
  215.     }
  216. }
  217. define IceCreamStore>>customerArrival: {
  218.     echo {Group of size \fsexpr(let size (\%2 'groupSize)) arrives}
  219.     if < \m(size) \m(\%1.ICS.remainingChairs) {
  220.         (say '(Take chairs, schedules order))
  221.         (-- \%1.ICS.remainingChairs size)
  222.         \%1 add: {(\%1 'customerOrder: \%2)} next: \fexec(randnum 3)
  223.     } else {
  224.         (say '(Find no chairs, leaves))
  225.     }
  226.     (\%1)
  227. }
  228. define IceCreamStore>>customerOrder: {
  229. ; \%2 customer
  230.     (let size (\%2 'groupSize) numScoops 0 i 0)
  231.     for i 1 size 1 {
  232.         (++ numScoops (\%1.ICS.scoopDistribution 'next))
  233.     }
  234.     echo {Group of size \m(size) order \m(numScoops) scoops}
  235.     echo Profits so far \fsexpr(++ \%1.profit (* numScoops 0.17))
  236.     \%1 add: {(\%1 'customerLeave: \%2)} next: \fexec(randnum 5)
  237.     (\%1)
  238. }
  239. define IceCreamStore>>customerLeave: {
  240. ; \%2 customer
  241.     echo {Group of size \fsexpr(let size (\%2 'groupSize)) leaves}
  242.     (++ \%1.ICS.remainingChairs size)
  243.     _define \%2    ; Garbage collection
  244.     (\%1)
  245. }
  246. define IceCreamStore>>reportProfits {
  247.     echo Total profits are \m(\%1.profit)
  248.     (\%1)
  249. }
  250. define IceCreamStore>>scoopsFor: {
  251.     (let i 0 number 0)
  252.     for i 1 \%2 1 { (++ number (\%1.ICE.scoopDistribution 'next)) }
  253.     echo group of \%2 'have' \m(number) scoops
  254.     (number)
  255. }
  256. define IceCreamStore>>inspect {
  257.     echo \v(macro)
  258.     (\%1)
  259. }
  260. define IceCreamStore>>run {
  261.     while true {
  262.         if {\fsexpr(< (\%1 'proceed) 0)} break
  263.         if {\fsexpr(> (\%1 'time) \%2)} break
  264.     }
  265. }
  266.  
  267. define IceCreamStore>>runit {
  268.     while {\fsexpr(< \%2 (\%1 'time))} { \%1 proceed }
  269. }
  270.  
  271. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  272.  
  273. class Customer
  274. define Customer::new: {
  275.     (setq \%1.groupSize (randnum 15))
  276.     (\%1)
  277. }
  278. define Customer>>groupSize {
  279.     (\%1.groupSize)
  280. }
  281. define Customer>>numberOfScoops {
  282.     (let number (randnum 5))
  283.     echo Customer has \m(number) scoop(s)
  284.     (number)
  285. }
  286. define Customer>>inspect {
  287.     echo \%1 \v(macro)
  288.     (\%1)
  289. }
  290.  
  291. echo
  292. IceCreamStore new: myStore
  293.  
  294. myStore run 40
  295. echo
  296. mystore reportProfits
  297. echo
  298.