Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 84 lines (69 sloc) 2.187 kb
baf83c93 »
2012-09-18 First commit
1 (in-package :common-lisp)
2
3 (defpackage :com.takeico.r.restroom
4 (:use :common-lisp)
5 (:export :*person-population*
6 :*duration*
7 :restroom
8 :facility
9 :person
10 :queue
11 :enter
12 :need-to-go-p
13 :tick))
14
15 (in-package :com.takeico.r.restroom)
16
17 (defparameter *person-population* nil)
18 (defparameter *duration* (* 9 60))
19
20 (defclass restroom ()
21 ((queue
22 :reader queue
23 :initform nil)
24 (facilities
25 :reader facilities)))
26
27 (defmethod initialize-instance :after ((restroom restroom) &key (facilities-per-room 3))
28 (with-slots (queue facilities) restroom
29 (setf facilities
30 (loop repeat facilities-per-room collect (make-instance 'facility)))))
31
32 (defmethod enter ((restroom restroom) person)
33 (let ((unoccupied-facility (find-if-not #'occupied-p (facilities restroom))))
34 (if unoccupied-facility
35 (occupy unoccupied-facility person)
36 (push person (slot-value restroom 'queue))))
37 (delete person *person-population*))
38
39
40 (defmethod tick ((restroom restroom))
41 (loop for facility in (facilities restroom) do (tick facility)))
42
43 (defclass facility ()
44 ((occupier
45 :initform nil)
46 duration))
47
48 (defmethod occupy ((facility facility) person)
49 (unless (occupied-p facility)
50 (with-slots (occupier duration) facility
51 (setf occupier person)
52 (setf duration 1))
53 (setf *person-population* (delete person *person-population*))
54 t))
55
56 (defmethod occupied-p ((facility facility))
57 (slot-value facility 'occupier))
58
59 (defmethod vacate ((facility facility))
60 (with-slots (occupier) facility
61 (push occupier *person-population*)
62 (setf occupier nil)))
63
64 (defmethod tick ((facility facility))
65 (when (occupied-p facility)
66 (with-slots (duration occupier) facility
67 (if (> duration (use-duration occupier))
68 (progn
69 (vacate facility)
70 (setf duration 0))
71 (incf duration)))))
72
73 (defclass person ()
74 ((use-duration
75 :initarg :use-duration
76 :initform 1
77 :reader use-duration)
78 (frequency
79 :initarg :frequency
80 :initform 4
81 :accessor frequency)))
82
83 (defmethod need-to-go-p ((person person))
84 (<= (1+ (random *duration*)) (frequency person)))
Something went wrong with that request. Please try again.