home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d524 / kamin.lha / Kamin / P-Distr.lzh / code.smt < prev    next >
Text File  |  1990-04-07  |  23KB  |  678 lines
  1. ; Code from previous chapters
  2. (define +1 (x) (+ x 1))
  3. (define or (x y) (if x x y))
  4. (define and (x y) (if x y x))
  5. (define not (x) (if x false true))
  6. (define <> (x y) (not (= x y)))
  7. (define <= (x y) (or (< x y) (= x y)))
  8. (define divides (n x) (= (* n (/ x n)) x))
  9. (define mod (n m) (- n (* m (/ n m))))
  10. (define gcd (i j)
  11.    (if (> i j) (gcd j i)
  12.      (if (divides i j) i (gcd (mod j i) i))))
  13. (define abs (x) (if (< x 0) (- 0 x) x))
  14. ; Section 7.1.1
  15. (class FinancialHistory Object
  16.     (cashOnHand incomes expenditures)
  17.     (define initFinancialHistory (amount)
  18.          (begin
  19.               (set cashOnHand amount)
  20.               (set incomes (mkDictionary))
  21.               (set expenditures (mkDictionary))
  22.               self))
  23.     (define receive:from: (amount source)
  24.          (begin
  25.             (at:put: incomes source (+ (totalReceivedFrom: self source) amount))
  26.             (set cashOnHand (+ cashOnHand amount))))
  27.     (define spend:for: (amount reason)
  28.          (begin
  29.            (at:put: expenditures reason (+ (totalSpentFor: self reason) amount))
  30.            (set cashOnHand (- cashOnHand amount))))
  31.     (define cashOnHand () cashOnHand)
  32.     (define totalReceivedFrom: (source)
  33.          (if (includesKey: incomes source)
  34.               (at: incomes source)
  35.               0))
  36.     (define totalSpentFor: (reason)
  37.          (if (includesKey: expenditures reason)
  38.               (at: expenditures reason)
  39.               0))
  40. )
  41. (define mkFinancialHistory (amount)
  42.      (initFinancialHistory (new FinancialHistory) amount))
  43. ; Test cases for FinancialHistory moved to after Collection hierarchy
  44. (class DeductibleHistory FinancialHistory
  45.     (deductible)
  46.     (define initDeductibleHistory (amount)
  47.          (begin
  48.               (initFinancialHistory self amount)
  49.               (set deductible 0)
  50.               self))
  51.     (define spend:Deduct: (amount reason)
  52.          (begin
  53.               (spend:for: self amount reason)
  54.               (set deductible (+ deductible amount))))
  55.     (define spend:for:deduct: (amount reason deduction)
  56.          (begin
  57.               (spend:for: self amount reason)
  58.               (set deductible (+ deductible deduction))))
  59.     (define totalDeductions () deductible))
  60. (define mkDeductibleHistory (amount)
  61.      (initDeductibleHistory (new DeductibleHistory) amount))
  62. ; Test cases for DeductibleHistory moved to after Collection hierarchy
  63. ; Section 7.1.5
  64. (set false 0)
  65. (set true 1)
  66. (define isNil (x) (= x #nil))
  67. (define notNil (x) (<> x #nil))
  68. (class Collection Object
  69.     ()  ; abstract class
  70.     (define first () #subclassResponsibility)
  71.     (define next () #subclassResponsibility)
  72.     (define add: (item) #subclassResponsibility)
  73.     (define size ()
  74.          (begin
  75.               (set tempitem (first self))
  76.               (set tempsize 0)
  77.               (while (notNil tempitem)
  78.                    (begin
  79.                         (set tempsize (+1 tempsize))
  80.                         (set tempitem (next self))))
  81.               tempsize))
  82.     (define isEmpty () (isNil (first self)))
  83.     (define includes: (item)
  84.          (begin
  85.               (set tempitem (first self))
  86.               (set found false)
  87.               (while (and (notNil tempitem) (not found))
  88.                    (if (= tempitem item)
  89.                         (set found true)
  90.                         (set tempitem (next self))))
  91.               found))
  92. )
  93. (class Set Collection
  94.     (members)  ; list of elements
  95.     (define initSet () (begin (set members (mkList)) self))
  96.     (define first () (first members))
  97.     (define next () (next members))
  98.     (define add: (item)
  99.          (if (includes: members item) self (add: members item)))
  100. )
  101. (define mkSet () (initSet (new Set)))
  102. ;
  103. (class KeyedCollection Collection
  104.     ()  ; abstract class
  105.     (define at:put: (key value) #subclassResponsibility)
  106.     (define currentKey () #subclassResponsibility)
  107.     (define at: (key)
  108.          (begin
  109.               (set tempvalue (first self))
  110.               (set found false)
  111.               (while (and (notNil tempvalue) (not found))
  112.                    (if (= key (currentKey self))
  113.                         (set found true)
  114.                         (set tempvalue (next self))))
  115.               tempvalue))  ; note: nil if key out of range
  116.     (define includesKey: (key)
  117.          (notNil (at: self key)))
  118.     (define indexOf: (value)
  119.          (begin
  120.               (set tempvalue (first self))
  121.               (set found false)
  122.               (while (and (notNil tempvalue) (not found))
  123.                    (if (= value tempvalue)
  124.                         (set found true)
  125.                         (set tempvalue (next self))))
  126.               (if (isNil tempvalue) #nil (currentKey self))))
  127. )
  128. ;
  129. (class Association Object 
  130.    (fst snd)
  131.      (define initAssociation (x y) (begin (set fst x) (set snd y) self))
  132.      (define fst () fst)
  133.      (define snd () snd)
  134.      (define fst:  (x) (set fst x))
  135.      (define snd:  (y) (set snd y))
  136. )
  137. ;
  138. (define mkAssociation (a b) (initAssociation (new Association) a b))
  139. (class Dictionary KeyedCollection
  140.     (table currentKey)
  141.     (define initDictionary ()
  142.          (begin (set table (mkList)) self))
  143.     (define currentKey () currentKey)
  144.     (define first ()
  145.          (if (isEmpty table) #nil
  146.               (begin
  147.                    (set tempassoc (first table))
  148.                    (set currentKey (fst tempassoc))
  149.                    (snd tempassoc))))
  150.     (define next ()
  151.          (begin
  152.               (set tempassoc (next table))
  153.               (if (isNil tempassoc) #nil
  154.                    (begin
  155.                         (set currentKey (fst tempassoc))
  156.                         (snd tempassoc)))))
  157.     (define at:put: (key value)
  158.          (begin
  159.               (set tempassoc (associationAt: self key))
  160.               (if (isNil tempassoc)
  161.                    (add: table (mkAssociation key value))
  162.                    (snd: tempassoc value))))
  163.     (define associationAt: (key)
  164.          (begin
  165.               (set temptable table)
  166.               (set found false)
  167.               (while (not (or (isEmpty temptable) found))
  168.                    (if (= (fst (car temptable)) key)
  169.                        (set found true)
  170.                        (set temptable (cdr temptable))))
  171.               (if found (car temptable) #nil)))
  172. )
  173. (define mkDictionary () (initDictionary (new Dictionary)))
  174. ;
  175. (class SequenceableCollection KeyedCollection
  176.     () ; abstract class
  177.     (define firstKey () #subclassResponsibility)
  178.     (define lastKey () #subclassResponsibility)
  179.     (define last () (at:  self (lastKey self)))
  180.    (define at: (index)
  181.          (begin
  182.                (set iterations (- index (firstKey self)))
  183.                (set result (first self))
  184.                (while (> iterations 0)
  185.                      (begin
  186.                            (set result (next self))
  187.                            (set iterations (- iterations 1))))
  188.                result))
  189. )
  190. (class List SequenceableCollection
  191.     (car cdr currentKey currentCell)
  192.     (define car () car)
  193.     (define cdr () cdr)
  194.     (define initList ()
  195.          (begin (set car #nil) self))
  196.     (define add: (item)
  197.          (begin
  198.               (set temp (new List))
  199.               (car: temp car)
  200.               (cdr: temp cdr)
  201.               (set cdr temp)
  202.               (set car item)))
  203.     (define car: (x) (set car x))
  204.     (define cdr: (x) (set cdr x))
  205.     (define first ()
  206.          (begin
  207.               (set currentKey 1)
  208.               (set currentCell self)
  209.               car))
  210.     (define next ()
  211.          (if (isNil (car currentCell)) #nil
  212.               (begin
  213.                    (set currentKey (+1 currentKey))
  214.                    (set currentCell (cdr currentCell))
  215.                    (car currentCell))))
  216.     (define firstKey () 1)
  217.     (define lastKey () (size self))
  218.     (define currentKey () currentKey)
  219.     (define at:put: (n value)
  220.          (if (= n 1) (set car value)
  221.              (at:put: cdr (- n 1) value)))
  222.     (define removeFirst ()
  223.          (if (isEmpty self) self ; do nothing
  224.               (begin
  225.                     (set car (car cdr))
  226.                     (set cdr (cdr cdr)))))
  227.     (define zerolist (size)
  228.             (while (> size 0)
  229.                  (begin
  230.                       (add: self 0)
  231.                       (set size (- size 1)))))
  232. )
  233. (define mkList () (initList (new List)))
  234. ;
  235. (class Array SequenceableCollection
  236.     (elements lobound hibound currentKey)
  237.     (define initArray (lo size)
  238.          (begin
  239.               (set lobound lo)
  240.               (set hibound (- (+ lo size) 1))
  241.               (set elements (new List))
  242.               (zerolist elements size)
  243.               self))
  244.     (define size () (+1 (- hibound lobound)))
  245.     (define firstKey () lobound)
  246.     (define lastKey () hibound)
  247.     (define currentKey () currentKey)
  248.     (define first ()
  249.          (begin
  250.               (set currentKey lobound)
  251.               (first elements)))
  252.     (define next ()
  253.          (if (= currentKey hibound) #nil
  254.               (begin
  255.                    (set currentKey (+1 currentKey))
  256.                 (next elements))))
  257.     (define at:put: (n value)
  258.          (if (> n hibound) #nil
  259.              (if (< n lobound) #nil
  260.                   (at:put: elements (+1 (- n lobound)) value))))
  261. )
  262. (define mkArray (l s) (initArray (new Array) l s))
  263. ; Test cases for FinancialHistory and DeductibleHistory
  264. (set myaccount (mkFinancialHistory 1000))
  265. (spend:for: myaccount 50 #insurance)
  266. (receive:from: myaccount 200 #salary)
  267. (cashOnHand myaccount)
  268. 1150
  269. (spend:for: myaccount 100 #books)
  270. (cashOnHand myaccount)
  271. 1050
  272. (set myaccount (mkDeductibleHistory 1000))
  273. (spend:for: myaccount 50 #insurance)
  274. (receive:from: myaccount 200 #salary)
  275. (cashOnHand myaccount)
  276. 1150
  277. (totalDeductions myaccount)
  278. 0
  279. (spend:Deduct: myaccount 100 #mortgage)
  280. (cashOnHand myaccount)
  281. 1050
  282. (totalDeductions myaccount)
  283. 100
  284. (spend:for:deduct: myaccount 100 #3-martini-lunch 50)
  285. (cashOnHand myaccount)
  286. 950
  287. (totalDeductions myaccount)
  288. 150
  289. ; Section 7.3
  290. (class Number Object
  291.     ()  ; abstract class
  292.     (define + (x) #subclassResponsibility)
  293.     (define negate () #subclassResponsibility)
  294.     (define * (x) #subclassResponsibility)
  295.     (define recip () #subclassResponsibility)
  296.     (define = (x) #subclassResponsibility)
  297.     (define < (x) #subclassResponsibility)
  298.     (define zero () #subclassResponsibility)
  299.     (define one () #subclassResponsibility)
  300.     (define print () #subclassResponsibility)
  301.     (define - (y) (+ self (negate y)))
  302.     (define / (y) (* self (recip y)))
  303.     (define > (y) (< y self))
  304.     (define +1 () (+ self (one self)))
  305.     (define sub1 () (- self (one self)))
  306.     (define isZero () (= self (zero self)))
  307.     (define isNegative () (< self (zero self)))
  308.     (define abs () (if (isNegative self) (negate self) self))
  309.     (define sqr () (* self self))
  310.     (define sqrt (epsilon) ; find square root of receiver within epsilon
  311.          (begin
  312.               (set this-step (+1 (zero self)))
  313.               (set two (+1 this-step))
  314.               (set next-step (/ (+ this-step (/ self this-step)) two))
  315.               (while (> (abs (- this-step next-step)) epsilon)
  316.                    (begin
  317.                         (set this-step next-step)
  318.                         (set next-step (/
  319.                             (+ this-step (/ self this-step)) two))))
  320.               next-step))
  321. )
  322. (class Fraction Number
  323.     (x y)
  324.     (define initFraction (a b)
  325.          (begin
  326.                (setFraction self a b)
  327.                (sign-reduce self)
  328.                (div-reduce self)))
  329.     (define setFraction (a b) (begin (set x a) (set y b) self))
  330.     (define x () x)
  331.     (define y () y)
  332.     (define + (f)
  333.          (div-reduce
  334.             (setFraction (new Fraction)
  335.                             (+ (* x (y f)) (* (x f) y))
  336.                             (* y (y f)))))
  337.     (define negate () (setFraction (new Fraction) (- 0 x) y))
  338.     (define * (f)
  339.          (div-reduce
  340.               (setFraction (new Fraction)
  341.                             (* x (x f))
  342.                             (* y (y f)))))
  343.     (define recip ()
  344.      (sign-reduce (setFraction (new Fraction) y x)))
  345.     (define = (f)
  346.      (and (= x (x f)) (= y (y f))))
  347.     (define < (f)
  348.      (< (* x (y f)) (* (x f) y)))
  349.     (define zero () (setFraction (new Fraction) 0 1))
  350.     (define one () (setFraction (new Fraction) 1 1))
  351.     (define print () (begin (print x) (print y)))
  352.     ; div-reduce and sign-reduce should not be exported
  353.     (define div-reduce ()
  354.          (begin
  355.               (if (= x 0)
  356.                    (set y 1)
  357.                    (begin
  358.                          (set temp (gcd (abs x) y))
  359.                          (set x (/ x temp))
  360.                          (set y (/ y temp))))
  361.               self))
  362.     (define sign-reduce ()
  363.          (begin
  364.               (if (< y 0)
  365.                    (begin (set x (- 0 x))(set y (- 0 y)))
  366.                    0)
  367.               self))
  368. )
  369. (define mkFraction (a b) (initFraction (new Fraction) a b))
  370. (set eps (mkFraction 1 2))
  371. (set f1 (mkFraction 17 1))
  372. (set f2 (sqrt f1 eps))
  373. (print f2)
  374.  3437249
  375.  833049
  376. ;
  377. (class Float Number
  378.     (mant exp)
  379.     (define initFloat (m e)
  380.      (begin (set mant m) (set exp e) self))
  381.     (define mant () mant)
  382.     (define exp () exp)
  383.     (define + (x)
  384.          (begin
  385.               (if (< exp (exp x))
  386.                   (begin
  387.                        (set min self)
  388.                        (set max x))
  389.                   (begin
  390.                        (set min x)
  391.                        (set max self)))
  392.               (set delta (- (exp max) (exp min)))
  393.               (set temp (+ (* (mant max) (powerof10 self delta)) (mant min)))
  394.               (normalize
  395.                   (initFloat (new Float) temp (if (= temp 0) 0 (exp min))))))
  396.     (define negate ()  (initFloat (new Float) (- 0 mant) exp))
  397.     (define * (x)
  398.          (normalize (initFloat (new Float)
  399.               (* mant (mant x))
  400.               (+ exp (exp x)))))
  401.     (define recip ()
  402.          (if (isZero self) self
  403.              (normalize (initFloat (new Float)
  404.                   (/ 100000000 mant)
  405.                   (- (- 0 8) exp)))))
  406.     (define zero () (initFloat (new Float) 0 0))
  407.     (define one () (initFloat (new Float) 1 0))
  408.     (define = (x) (isZero (- self x)))
  409.     (define < (x) (isNegative (- self x)))
  410.     (define print () (begin (print mant) (print exp)))
  411.     (define isZero () (= mant 0))
  412.     (define isNegative () (< mant 0))
  413.     ; normalize and powerof10 should not be exported
  414.     (define powerof10 (d)
  415.      (if (= d 0) 1 (* 10 (powerof10 self (- d 1)))))
  416.     (define normalize ()
  417.            (begin
  418.                 (while (> (abs mant) 10000)
  419.                      (begin
  420.                           (set mant (/ mant 10))
  421.                           (set exp (+ exp 1))))
  422.                 self))
  423. )
  424. (define mkFloat (m e) (initFloat (new Float) m e))
  425. (set eps (mkFloat 5 -1))
  426. (set x1 (mkFloat 17 0))
  427. (print (sqrt x1 eps))
  428. 4125
  429. -3
  430. ; Section 7.4
  431. (class Simulation Object
  432.      () ; abstract class
  433.      (define initialize () #subclassResponsibility)
  434.      (define report () #subclassResponsibility)
  435.      (define run (timelimit)
  436.           (begin
  437.                 (set CLOCK 0)
  438.                 (set EVQUEUE (mkEventQueue))
  439.                 (initialize self)
  440.                 (while (<= CLOCK timelimit) (doNextEvent EVQUEUE))
  441.                 (report self)))
  442. )
  443. (class LabSimulation Simulation
  444.      (termlimit)
  445.      (define initLabSimulation (t)
  446.            (begin (set termlimit t) self))
  447.      (define initialize ()
  448.           (begin
  449.                 (set TERMINALLIMIT termlimit)
  450.                 (set THELAB (mkLab))
  451.                 (set STUDENTNO 0)
  452.                 (set STUDENTSFINISHING 0)
  453.                 (set TOTALTIMEWASTED 0)
  454.                 (set TERMINALQUEUE (mkQueue))
  455.                 (set WAITTIMES (mkWaitTimeList))
  456.                 (set SERVICETIMES (mkServiceTimeList))
  457.                 (scheduleNewArrival (new Student))))
  458.      (define report ()
  459.           (begin
  460.                 (print #simulation-done)
  461.                 (print #students-finishing)
  462.                 (print STUDENTSFINISHING)
  463.                 (print #left-on-queue)
  464.                 (print (size TERMINALQUEUE))
  465.                 (print #Total-time-wasted:)
  466.                 (print TOTALTIMEWASTED)
  467.                 (print #Average-time-wasted:)
  468.                 (print (/ TOTALTIMEWASTED STUDENTSFINISHING))))
  469. )
  470. (define mkLabSimulation (tl) (initLabSimulation (new LabSimulation) tl))
  471. (class Lab Object
  472.     (term1free term2free)
  473.     (define initLab ()
  474.            (begin (set term1free true) (set term2free true) self))
  475.     (define terminals-free? () (or term1free term2free))
  476.     (define pick-terminal ()
  477.          (if term1free
  478.               (begin (set term1free false) 1)
  479.               (begin (set term2free false) 2)))
  480.     (define release-terminal (t)
  481.          (if (= t 1) (set term1free true) (set term2free true)))
  482. )
  483. (define mkLab () (initLab (new Lab)))
  484. ;
  485. (class List SequenceableCollection
  486.   (car cdr currentKey currentCell)
  487.   (define car () car)
  488.   (define cdr () cdr)
  489.   (define initList ()
  490.      (begin (set car #nil) self))
  491.   (define newEmptyCollection () (initList (new List)))
  492.   (define add: (item)
  493.      (begin
  494.         (set temp (newEmptyCollection self))
  495.         (car: temp car)
  496.         (cdr: temp cdr)
  497.         (set cdr temp)
  498.         (set car item)))
  499.   (define car: (x) (set car x))
  500.   (define cdr: (x) (set cdr x))
  501.   (define first ()
  502.      (begin
  503.         (set currentKey 1)
  504.         (set currentCell self)
  505.         car))
  506.   (define next ()
  507.      (if (isNil (car currentCell)) #nil
  508.         (begin
  509.            (set currentKey (+1 currentKey))
  510.            (set currentCell (cdr currentCell))
  511.            (car currentCell))))
  512.   (define firstKey () 1)
  513.   (define lastKey () (size self))
  514.   (define currentKey () currentKey)
  515.   (define at:put: (n value)
  516.      (if (= n 1) (set car value)
  517.        (at:put: cdr (- n 1) value)))
  518.   (define removeFirst ()
  519.      (if (isEmpty self) self ; do nothing
  520.         (begin
  521.             (set car (car cdr))
  522.             (set cdr (cdr cdr)))))
  523.   (define zerolist (size)
  524.         (while (> size 0)
  525.            (begin
  526.               (add: self 0)
  527.               (set size (- size 1)))))
  528. )
  529. ;
  530. (class Queue List
  531.      ()
  532.     (define initQueue () (initList self))
  533.     (define newEmptyCollection () (initList (new Queue)))
  534.     (define enqueue: (item)
  535.          (if (isEmpty self) (add: self item) (enqueue: cdr item)))
  536. )
  537. (define mkQueue () (initQueue (new Queue)))
  538. (class EventQueue Object
  539.     (pqueue) ; a PriorityQueue
  540.     (define initEventQueue ()
  541.          (begin (set pqueue (mkPriorityQueue)) self))
  542.     (define scheduleEvent (event time)
  543.          (insert: pqueue (mkAssociation time event)))
  544.     (define doNextEvent ()
  545.          (begin
  546.                (set pair (car pqueue))
  547.                (removeFirst pqueue)
  548.                (set CLOCK (fst pair))
  549.                (takeAction (snd pair))))
  550. )
  551. (define mkEventQueue () (initEventQueue (new EventQueue)))
  552. (class PriorityQueue List
  553.     ()
  554.     (define initPriorityQueue () (initList self))
  555.     (define newEmptyCollection () (initList (new PriorityQueue)))
  556.     (define insert: (pair)
  557.         (if (isEmpty self) (add: self pair)
  558.              (if (< (fst pair) (fst car)) (add: self pair)
  559.                   (insert: cdr pair))))
  560. )
  561. (define mkPriorityQueue () (initPriorityQueue (new PriorityQueue)))
  562. (class Student Object
  563.     (status number timeNeeded timeStillNeeded arrivalTime)
  564.     (define initStudent (n t a)
  565.          (begin
  566.                (set status -1)
  567.                (set number n)
  568.                (set timeNeeded t)
  569.                (set timeStillNeeded t)
  570.                (set arrivalTime a)
  571.                self))
  572.     (define takeAction ()
  573.          (if (= status -1) (arrive self) (leaveTerminal self)))
  574.     (define arrive ()
  575.          (begin
  576.                (if (terminals-free? THELAB)
  577.                     (grabTerminal self)
  578.                     (begin
  579.                           (set status 0)
  580.                           (enqueue: TERMINALQUEUE self)))
  581.                (scheduleNewArrival (new Student))))
  582.     (define leaveTerminal ()
  583.          (if (= timeStillNeeded 0)
  584.               (begin
  585.                     (release-terminal THELAB status)
  586.                     (set status 3)
  587.             (set wasted (- (- CLOCK arrivalTime) timeNeeded))
  588.                  (set STUDENTSFINISHING (+1 STUDENTSFINISHING))
  589.                  (set TOTALTIMEWASTED (+ TOTALTIMEWASTED wasted))
  590.                     (if (not (isEmpty TERMINALQUEUE))
  591.                          (grabTerminal (car TERMINALQUEUE)) 0))
  592.               (if (isEmpty TERMINALQUEUE)
  593.                    (scheduleLeaveTerminal self)
  594.                    (begin
  595.                          (release-terminal THELAB status) ; bug in book
  596.                          (set status 0)
  597.                          (enqueue: TERMINALQUEUE self)
  598.                          (grabTerminal (car TERMINALQUEUE))))))
  599.     (define grabTerminal ()
  600.          (begin
  601.                (if (= status 0) ; was on terminal queue
  602.                     (removeFirst TERMINALQUEUE)
  603.                      0) ; else do nothing
  604.                (set status (pick-terminal THELAB))
  605.                (scheduleLeaveTerminal self)))
  606.     (define scheduleLeaveTerminal ()
  607.          (if (<= timeStillNeeded TERMINALLIMIT)
  608.               (begin
  609.                     (scheduleEvent EVQUEUE self (+ CLOCK timeStillNeeded))
  610.                     (set timeStillNeeded 0))
  611.               (begin
  612.                   (scheduleEvent EVQUEUE self (+ CLOCK TERMINALLIMIT))
  613.                   (set timeStillNeeded (- timeStillNeeded TERMINALLIMIT)))))
  614.     (define scheduleNewArrival ()
  615.          (begin
  616.                (set wait (next WAITTIMES))
  617.                (set service (next SERVICETIMES))
  618.                (set STUDENTNO (+1 STUDENTNO))
  619.                (set arrival (+ CLOCK wait))
  620.                (initStudent self STUDENTNO service arrival)
  621.                (scheduleEvent EVQUEUE self arrival)))
  622. )
  623. ; Twenty arrivals at time zero
  624. (class WaitTimeList Object
  625.     (which)
  626.     (define initWaitTimeList () (begin (set which 0) self))
  627.     (define next ()
  628.          (if (= which 20) 2000 (begin (set which (+1 which)) 0)))
  629. )
  630. (define mkWaitTimeList () (initWaitTimeList (new WaitTimeList)))
  631. ; All students need 120 minutes of terminal time
  632. (class ServiceTimeList Object
  633.     ()
  634.     (define initServiceTimeList () self)
  635.     (define next () 120)
  636. )
  637. (define mkServiceTimeList () (initServiceTimeList (new ServiceTimeList)))
  638. (set sim30 (mkLabSimulation 30))
  639. (run sim30 1200)
  640. #simulation-done
  641. #students-finishing
  642. 20
  643. #left-on-queue
  644. 0
  645. #Total-time-wasted:
  646. 18900
  647. #Average-time-wasted:
  648. 945
  649. ; Arrivals every 30 minutes
  650. (class WaitTimeList Object
  651.     ()
  652.     (define initWaitTimeList () self)
  653.     (define next () 30)
  654. )
  655. (define mkWaitTimeList () (initWaitTimeList (new WaitTimeList)))
  656. ; Service times alternating: 120, 30, 120, 30, ...
  657. (class ServiceTimeList Object
  658.     (which)
  659.     (define initServiceTimeList () (begin (set which 1) self))
  660.     (define next ()
  661.           (begin
  662.                 (set which (- 1 which))
  663.                 (if (= which 0) 120 30)))
  664. )
  665. (define mkServiceTimeList () (initServiceTimeList (new ServiceTimeList)))
  666. (set sim30 (mkLabSimulation 30))
  667. (run sim30 1200)
  668. #simulation-done
  669. #students-finishing
  670. 30
  671. #left-on-queue
  672. 8
  673. #Total-time-wasted:
  674. 3090
  675. #Average-time-wasted:
  676. 103
  677. quit
  678.