home *** CD-ROM | disk | FTP | other *** search
/ Really Useful CD 1 / ReallyUsefulCD1.iso / extras / languages / smalltalk / _smalltalk / tests / sim3 < prev    next >
Encoding:
Text File  |  1987-12-30  |  4.4 KB  |  150 lines
  1. "
  2.      Simple Minded simulation from Chapter 6 of book
  3.  
  4.      IceCream Store -
  5.           multiple event queue
  6. "
  7. Class Main
  8. [
  9.      main      | i |
  10.           i <- IceCreamStore new.
  11.           [i time < 60] whileTrue: [ i proceed ].
  12.           i reportProfits
  13. ]
  14.  
  15. Class Simulation
  16. | currentTime eventQueue |
  17. [
  18.      new
  19.           eventQueue <- Dictionary new.
  20.           currentTime <- 0
  21. |
  22.      time
  23.           ^ currentTime
  24. |
  25.      addEvent: event at: eventTime
  26.           (eventQueue includesKey: eventTime)
  27.                ifTrue: [(eventQueue at: eventTime) add: event]
  28.                ifFalse: [eventQueue at: eventTime
  29.                          put: (Set new ; add: event)]
  30. |    
  31.      addEvent: event next: timeIncrement
  32.           self addEvent: event at: currentTime + timeIncrement
  33. |
  34.      proceed        | minTime eventset event |
  35.           minTime <- 99999.
  36.           eventQueue keysDo:
  37.                [:x | (x < minTime) ifTrue: [minTime <- x]].
  38.           currentTime <- minTime.
  39.           eventset <- eventQueue at: minTime ifAbsent: [^nil].
  40.           event <- eventset first.
  41.           eventset remove: event.
  42.           (eventset isEmpty) ifTrue: [eventQueue removeKey: minTime].
  43.           self processEvent: event
  44. ]
  45.  
  46. Class IceCreamStore :Simulation
  47. | profit arrivalDistribution rand scoopDistribution remainingChairs |
  48. [
  49.      new
  50.           profit <- 0.
  51.           remainingChairs <- 15.
  52.           rand <- Random new.
  53.           (arrivalDistribution <- Normal new)
  54.                setMean: 3.0 deviation: 1.0.
  55.           (scoopDistribution <- DiscreteProbability new)
  56.                defineWeights: #(65 25 10).
  57.           self scheduleArrival
  58. |
  59.      scheduleArrival               | newcustomer  time |
  60.           newcustomer <- Customer new.
  61.           time <- self time + (arrivalDistribution next).
  62.           (time < 15) ifTrue: [
  63.                self addEvent: [self customerArrival: newcustomer]
  64.                     at: time ]
  65. |
  66.      processEvent: event
  67.           ('event received at ', self time printString) print.
  68.           event value.
  69.           self scheduleArrival
  70. |
  71.      customerArrival: customer     | size |
  72.           size <- customer groupSize.
  73.           ('group of size ', size printString , ' arrives') print.
  74.           (size < remainingChairs)
  75.                ifTrue: [remainingChairs <- remainingChairs - size.
  76.                      'take chairs, schedule order' print.
  77.                      self addEvent: 
  78.                          [self customerOrder: customer]
  79.                          next: (rand randInteger: 3).
  80.                     ]
  81.                ifFalse: ['finds no chairs, leave' print]
  82. |
  83.      customerOrder: customer       | size numScoops |
  84.           size <- customer groupSize.
  85.           numScoops <- 0.
  86.           size timesRepeat: 
  87.                [numScoops <- numScoops + scoopDistribution next].
  88.           ('group of size ', size printString, ' orders ' ,
  89.           numScoops printString, ' scoops') print.
  90.           profit <- profit + (numScoops * 0.17).
  91.           self addEvent:
  92.                [self customerLeave: customer]
  93.                next: (rand randInteger: 5)
  94. |
  95.      customerLeave: customer       | size |
  96.           size <- customer groupSize.
  97.           ('group of size ', size printString, ' leaves') print.
  98.           remainingChairs <- remainingChairs + customer groupSize
  99. |
  100.      reportProfits
  101.           ('profits are ', profit printString) print
  102. ]
  103.  
  104. Class Customer
  105. | groupSize |
  106. [
  107.      new
  108.           groupSize <- (Random new "randomize") randInteger: 8
  109. |
  110.      groupSize
  111.           ^ groupSize
  112. ]
  113.  
  114. Class DiscreteProbability
  115. | weights rand max |
  116. [
  117.      defineWeights: anArray
  118.           weights <- anArray.
  119.           (rand <- Random new) "randomize".
  120.           max <- anArray inject: 0 into: [:x :y | x + y]
  121. |
  122.      next | index value |
  123.           value <- rand randInteger: max.
  124.           index <- 1.
  125.           [value > (weights at: index)]
  126.                whileTrue: [value <- value - (weights at: index).
  127.                          index <- index + 1].
  128.           ^ index
  129. ]
  130.  
  131. Class Normal :Random
  132. | mean deviation |
  133. [
  134.      new
  135.           self setMean: 1.0 deviation: 0.5
  136. |
  137.      setMean: m deviation: s
  138.           mean <- m.
  139.           deviation <- s
  140. |
  141.      next      | v1 v2 s u |
  142.           s <- 1.
  143.           [s >= 1] whileTrue:
  144.                [v1 <- (2 * super next) - 1.
  145.                 v2 <- (2 * super next) - 1.
  146.                  s <- v1 squared + v2 squared ].
  147.           u <- (-2.0 * s ln / s) sqrt.
  148.           ^ mean + (deviation * v1 * u)
  149. ]
  150.