home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
simlib.zip
/
SIMLIB.SC
< prev
Wrap
Text File
|
1990-02-24
|
50KB
|
1,015 lines
;╔════════════════════════════════════════════════════════════════════════════╗
;║ This PARADOX code is placed in the public domain ║
;╠════════════════════════════════════════════════════════════════════════════╣
;║ SIMLIB is a queueing simulation language first presented by Averill ║
;║ M. Law and W. David Kelton in their book "Simulation Modeling And ║
;║ Analyis" (McGraw-Hill (c) 1982 ISBM 0-07-036696-9) ║
;╟────────────────────────────────────────────────────────────────────────────╢
;║ SIMLIB is a toolbox of utilities consisting of: ║
;║ INITIAL,FILE,REMOVE,CANCEL,SAMPST,TIMEST, ║
;║ TIMING,UNIFORM,RANDI,EXPON, ERLANG, and NORMAL ║
;║ The author intended the user to write the main routine, the arrival ║
;║ procedure, the departure procedure, and any other supporting routines. ║
;║ A generic set of routines is given in section two of the file. These ║
;║ routines can build simple queuing simulations or can serve as a template ║
;║ for building more complicated queuing simulations. ║
;║ ║
;║ Originally written in fortran, it is re-written in PARADOX PAL with ║
;║ a few modifications (and possibly even improvements). First, SIMLIB ║
;║ originally used only arrays. I have replaced many of the arrays with ║
;║ PARADOX tables: ║
;║ MASTER - replaces MASTER array. Stores queue information ║
;║ SAMPST - replaces a series of different arrays (Avg, Max, etc.) ║
;║ - Stores sampling statistics. ║
;║ TIMEST - replaces a series of different arrays ║
;║ - Stores time related statistics. ║
;║ RESULTS - Stores a variety of simulation results ║
;║ Furthermore, the file MASTER2.DB stores a backup copy of every element ║
;║ ever queued. This data can be used to calculate results "after-the-fact." ║
;║ See the procedure PISSOFF in section 3. ║
;║ ║
;║ Other minor changes include moving the event list from #25 to #1, the ║
;║ addition of a new few variables, and the elimination of most size ║
;║ constraints. ║
;╚════════════════════════════════════════════════════════════════════════════╝
;╔════════════════════════════════════════════════════════════════════════════╗
;║ SECTION ONE - SIMLIB routines ║
;╚════════════════════════════════════════════════════════════════════════════╝
libname="simlib"
CREATELIB libname
PROC initial() ;Initialize system variables
PRIVATE I
clock=0 ;Set clock to zero
IF NOT(ISASSIGNED(maxatr)) THEN
maxatr=10 ;<---- Maximum # of tracked attributes
ENDIF
IF ISTABLE("master2") THEN ;Retain one generation
RENAME "master2" "M2bak"
MESSAGE "Existing MASTER2.DB renamed TO M2BAK.DB"
SLEEP 1000
ENDIF
IF ISTABLE("master") THEN ;Retain one generation
RENAME "master" "Mbak"
MESSAGE "Existing MASTER.DB renamed TO MBAK.DB"
SLEEP 1000
ENDIF
{Create} {master} ;Create main queue file
"List" Enter "N" Enter
FOR I FROM 1 TO maxatr
TYPEIN "Attribute #"+STRVAL(I)
Enter "N" ENTER
ENDFOR
Do_It!
CREATE "master2" LIKE "master" ;Create history file
IF NOT(ISASSIGNED(blowout)) THEN
blowout=1000 ;<--- Maximum Queue Size
ENDIF
IF NOT(ISASSIGNED(maxlist)) THEN
maxlist=25 ;<--- Maximum number of queues kept
ENDIF
SAMPST(0,0) ;Initialize SAMPST.DB
TIMEST(0,0) ;Initialize TIMEST.DB
ARRAY transfer[max(maxatr,5)] ;Build & initialize the...
FOR I FROM 1 TO MAX(maxatr,5) ;transfer variables
transfer[I]=0 ;
ENDFOR
ARRAY lrank[maxlist] ;Stores attribute used for sorting
ARRAY lsize[maxlist] ;Queue size of a particular list
FOR I FROM 1 TO maxlist
lrank[I]=0 ;Initialize variable
lsize[I]=0 ;
ENDFOR
lrank[1]=1 ;Rank main queue on time (attribute #1)
CLEARALL
VIEW "Master" ;
VIEW "Master2" ;
VIEW "Results" ;Place files on workspace
IF ISTABLE("Sampst") THEN VIEW "Sampst" ENDIF ;
IF ISTABLE("Timest") THEN VIEW "Timest" ENDIF ;
MOVETO "Master"
COEDITKEY
ENDPROC
WRITELIB libname initial
RELEASE PROCS initial
PROC file(option,list) ;File records in queue
PRIVATE x,bigger,item
;╔════════════════════════════════════════════════════════════════════════════╗
;║ FILE options: ║
;║ 1) File transfer variables before first record in list ║
;║ 2) File transfer variables after last record in list ║
;║ 3) File transfer variables in increasing order based upon ║
;║ the attribute stored in LRANK[list] ║
;║ 4) File transfer variables in decreasing order based upon ║
;║ the attribute stored in LRANK[list] ║
;╚════════════════════════════════════════════════════════════════════════════╝
IF nrecords("master")>blowout THEN ;Protect against runaway queues
MESSAGE "Queue reached maximum size of "+STRVAL(blowout)+
" at time "+STRVAL(clock)
x=getchar()
QUIT
ENDIF
IF ((list>=1) AND (list<=maxlist)) THEN ;Make sure list exists
MOVETO [Master->List]
SWITCH
CASE option=1 : ;Insert new record before first record
HOME
INS
CASE option=2 : ;Insert new record after the last record
LOCATE list ;
WHILE retval ;
SKIP 1 ;Locate records until no more
IF NOT EOT() THEN ;...are found or EndOfTable.
LOCATE NEXT list ;
ELSE ;
retval=FALSE ;
ENDIF
ENDWHILE
IF ATLAST() THEN ;Increase the last record meets criteria
DOWN
ELSE
INS
ENDIF
CASE option=3 : ;Insert in ranked order list (increasing order)
item=STRVAL(lrank[list]) ;Attribute used in ranking
bigger=FALSE
LOCATE list ;Find first record
IF RETVAL THEN
EXECUTE "bigger=transfer["+item+"]>[Attribute #"+item+"]" ;Check size
WHILE retval and bigger ;While records exist and sort location hasn't been found
SKIP 1
IF NOT EOT() THEN ;Are we at the end of the file
LOCATE NEXT list ;Locate next record
IF retval THEN
EXECUTE "bigger=transfer["+item+"]>[Attribute #"+item+"]"
ENDIF
ELSE
retval=FALSE
ENDIF
ENDWHILE
ENDIF
IF ATLAST() AND bigger ;If on last record in file
THEN DOWN
ELSE
INS
ENDIF
CASE option=4 : ;Insert in ranked order list (descending order)
item=STRVAL(lrank[list])
LOCATE list ;find first record
IF RETVAL THEN
EXECUTE "retval=transfer["+item+"]<[Attribute #"+item+"]"
WHILE retval ;While we haven't found our spot
SKIP 1
IF NOT EOT() THEN ;Are we at the last record
LOCATE NEXT list ;Locate next record
IF retval THEN
EXECUTE "retval=transfer["+item+"]<[Attribute #"+item+"]"
ENDIF
ELSE
retval=FALSE
ENDIF
ENDWHILE
ENDIF
IF ATLAST() THEN ;If on last record
DOWN
ELSE
INS
ENDIF
OTHERWISE :
MESSAGE "An improper option was passed TO FILE"
SLEEP 2000
RETURN
ENDSWITCH
[List]=list ;
FOR I FROM 1 TO maxatr ;Plug variables
EXECUTE "[Attribute #"+STRVAL(I)+"]=transfer["+STRVAL(I)+"]"
ENDFOR
lsize[list]=lsize[list]+1 ;Increment queue size
TIMEST(lsize[list],list) ;Calculate time related variables
ELSE
MESSAGE "An improper value for file list was passed TO FILE"
SLEEP 2000
ENDIF
ENDPROC
WRITELIB libname file
RELEASE PROCS file
PROC remove(option,list) ;Remove a particular record
PRIVATE x,i,a
;╔════════════════════════════════════════════════════════════════════════════╗
;║ REMOVE options: ║
;║ 1) Remove the first record for a particular list ║
;║ 2) Remove the last record for a particular list ║
;║ ║
;║ Values are placed in the transfer array ║
;╚════════════════════════════════════════════════════════════════════════════╝
IF ((list>=1) AND (list<=maxlist)) THEN ;Check for valid list
IF lsize[list]=0 THEN ;Check queue size
MESSAGE "Underflow of list "+strval(list)+" at time "+strval(clock)
x=getchar()
QUIT
ENDIF
MOVETO [Master->List]
SWITCH
CASE option=1 : ;Remove the first record
LOCATE list
CASE option=2 : ;Remove the last record
LOCATE list ;
WHILE retval ;Locate until the last...
SKIP 1 ;...record is found or
IF NOT EOT() THEN ;...EndOfTable
LOCATE NEXT list ;
ELSE
retval=FALSE
ENDIF
ENDWHILE
IF LIST<>[] THEN ;In case the last record...
UP ;...meets the criteria
ENDIF ;
OTHERWISE :
MESSAGE "An improper option was passed TO REMOVE"
SLEEP 2000
RETURN
ENDSWITCH
IF list=[] THEN ;If the record was found
FOR I FROM 1 TO maxatr ;Record variables
EXECUTE "transfer["+strval(I)+"]=[Attribute #"+STRVAL(I)+"]"
ENDFOR
COPYTOARRAY a ;
MOVETO "master2" ;Make a backup copy
END DOWN ;
COPYFROMARRAY a ;
MOVETO "master" ;
DEL
lsize[list]=lsize[list]-1 ;Decrement queue size
TIMEST(lsize[list],list) ;Record time related statistics
ELSE
MESSAGE "REMOVE did not find the record"
x=getchar()
QUIT
ENDIF
ELSE
MESSAGE "An improper value for file list was passed TO REMOVE"
SLEEP 2000
ENDIF
ENDPROC
WRITELIB libname remove
RELEASE PROCS remove
PROC cancel(etype) ;Only removes from the event list #1
PRIVATE i,a,found
MOVETO [Master->List]
LOCATE 1 ;Locate main queue records
IF retval THEN
found=etype=[Attribute #2] ;Is this the type we're looking for?
WHILE NOT(found) AND retval
SKIP 1 ;
IF NOT EOT() THEN ;Locate until the last...
LOCATE NEXT 1 ;...record is found or
IF retval THEN ;...EndOfTable
found=etype=[Attribute #2] ;
ENDIF
ELSE
retval=FALSE
ENDIF
ENDWHILE
IF found THEN
FOR I FROM 1 TO maxatr ;Record variables
EXECUTE "transfer["+strval(I)+"]=[Attribute #"+STRVAL(I)+"]"
ENDFOR
COPYTOARRAY a ;
MOVETO "master2" ;Make a backup copy
END DOWN ;
COPYFROMARRAY a ;
MOVETO "master" ;
DEL
lsize[1]=lsize[1]-1 ;Decrement queue size
TIMEST(lsize[1],1) ;Record time related statistics
ELSE
MESSAGE "CANCEL did not find the correct record"
ENDIF
ENDIF
ENDPROC
WRITELIB libname cancel
RELEASE PROCS cancel
PROC sampst(value,var) ;Statistic collection routine
PRIVATE i
;╔════════════════════════════════════════════════════════════════════════════╗
;║ TRANSFER variables for SAMPST: ║
;║ 1) Sample mean ║
;║ 2) Number of observations ║
;║ 3) Maximum value recorded ║
;║ 4) Minimum value recorded ║
;║ 5) Sum of all variables recorded ║
;╚════════════════════════════════════════════════════════════════════════════╝
IF ((var>=-sample_vars) and (var<=sample_vars)) THEN
SWITCH
CASE var=0: ;Build the SAMPST.DB table
IF ISTABLE("sampst") THEN ;Maintain one generation
RENAME "sampst" "ssbak"
MESSAGE "Existing SAMPST.DB renamed TO SSBAK.DB"
ENDIF
CREATE "sampst"
"Sum" : "N",
"Maximum" : "N",
"Minimum" : "N",
"Number of Obs" : "N"
View "sampst"
COEDITKEY
For I from 1 TO sample_vars
[Sum]=0 ;
[Maximum]=-1.E+20 ;Set to initial value
[Minimum]= 1.E+20 ;
[Number of Obs]=0 ;
DOWN
ENDFOR
DO_IT!
CLEARIMAGE
CASE var>0 : ;Add new values to file
MOVETO "sampst"
MOVETO RECORD var
[Sum]=[Sum]+value
[Maximum]=MAX([Maximum],value)
[Minimum]=MIN([Minimum],value)
[Number of Obs]=[Number of Obs]+1
MOVETO "master"
CASE var<0 : ;Place results in transfer array
ivar=-var
MOVETO "sampst"
MOVETO RECORD ivar
transfer[2]=[Number of Obs]
transfer[3]=[Maximum]
transfer[4]=[Minimum]
transfer[5]=[Sum]
IF transfer[2]=0 THEN
transfer[1]=0
ELSE
transfer[1]=transfer[5]/transfer[2] ;Calc average
ENDIF
MOVETO "master"
ENDSWITCH
ELSE
MESSAGE "An invalid variable has been passed TO SAMPST"
sleep 2000
ENDIF
ENDPROC
WRITELIB libname sampst
RELEASE PROCS sampst
PROC timest(value,var) ;Collect time weighted statistics
PRIVATE i,ivar
;╔════════════════════════════════════════════════════════════════════════════╗
;║ TRANSFER variables for TIMEST: ║
;║ 1) Time average (mean) of the variables recorded ║
;║ 2) Maximum value recorded ║
;║ 3) Minimum value recorded ║
;╚════════════════════════════════════════════════════════════════════════════╝
IF ((var>=-maxlist) and (var<=maxlist)) THEN ;Check variable range
SWITCH
CASE var=0: ;Build TIMEST.DB table
IF ISTABLE("timest") THEN ;Maintain one generation
RENAME "timest" "tsbak"
MESSAGE "Existing TIMEST.DB renamed TO TSBAK.DB"
ENDIF
CREATE "timest"
"Area" : "N",
"Maximum" : "N",
"Minimum" : "N",
"Previous Value" : "N",
"Last Time Change" : "N"
View "timest"
COEDITKEY
For I from 1 TO maxlist ;
[Area]=0 ;
[Maximum]=-1.E+20 ;Set to initial value
[Minimum]= 1.E+20 ;
[Previous Value]=0 ;
[Last Time Change]=clock ;
DOWN
ENDFOR
DO_IT!
treset=clock
CLEARIMAGE
CASE var>0 : ;Add new values to file
MOVETO "timest"
MOVETO RECORD var
[Area]=[Area]+((clock-[Last Time Change])*[Previous Value])
[Maximum]=MAX([Maximum],value)
[Minimum]=MIN([Minimum],value)
[Previous Value]=value
[Last Time Change]=clock
MOVETO "master"
CASE var<0 : ;Place results in transfer array
ivar=-var
MOVETO "timest"
MOVETO RECORD ivar
[Area]=[Area]+((clock-[Last Time Change])*[Previous Value])
[Last Time Change]=clock
transfer[1]=[Area]/(clock-treset) ;Calc average
transfer[2]=[Maximum]
transfer[3]=[Minimum]
MOVETO "master"
ENDSWITCH
ELSE
MESSAGE "An invalid variable has been passed TO TIMEST"
sleep 2000
ENDIF
ENDPROC
WRITELIB libname timest
RELEASE PROCS timest
PROC filest(list) ;Generate TIMEST results
PRIVATE ilist
;╔════════════════════════════════════════════════════════════════════════════╗
;║ TRANSFER variables for FILEST: ║
;║ 1) Time average (mean) of the variables recorded ║
;║ 2) Maximum value recorded ║
;║ 3) Minimum value recorded ║
;╚════════════════════════════════════════════════════════════════════════════╝
ilist=-list
TIMEST(0,ilist)
ENDPROC
WRITELIB libname filest
RELEASE PROCS filest
PROC timing() ;Remove the next event from the event queue
PRIVATE x
REMOVE(1,1) ;Remove event
IF transfer[1]>=clock THEN ;Don't let the clock go backwards
clock=transfer[1] ;Update clock
next=transfer[2] ;Set "next" event flag
ELSE
MESSAGE "Attempt TO schedule event type "+STRVAL(transfer[2])+
" at time "+STRVAL(transfer[1])+" when clock is "+STRVAL(clock)
SLEEP 5000
x=getchar()
QUIT
ENDIF
ENDPROC
WRITELIB libname timing
RELEASE PROCS timing
PROC uniform(A,B) ;Generate a random number uniformly between two values
PRIVATE u,uniform
u=RAND() ;Get random number
uniform=A+(u*(B-A)) ;Calc value
RETURN uniform
ENDPROC
WRITELIB libname uniform
RELEASE PROCS uniform
PROC randi() ;Generate a discrete value based upon PROBD distribution
PRIVATE u,n1,i
u=RAND() ;Get random number
n1=ARRAYSIZE(probd)-1
FOR I FROM 1 TO n1
IF u<probd[I] THEN ;PROBD is cumulative (PROBD[1]=.50 PROBD[2]=.90 PROBD[3]=.95 etc.)
RETURN I ;Return discrete value
ENDIF
ENDFOR
RETURN n1+1 ;Otherwise its largest value
ENDPROC
WRITELIB libname randi
RELEASE PROCS randi
PROC expon(rmean) ;Generate an exponentially distributed value
PRIVATE u,expon
u=RAND()
expon=-RMEAN*LN(u) ;Excellent distribution for arrival and departure rates
RETURN expon
ENDPROC
WRITELIB libname expon
RELEASE PROCS expon
PROC erlang(k,rmean) ;Generate an m-ERLANG distribution
PRIVATE mexp,erl
mexp=rmean/k
erl=0 ;Initialize value
FOR I FROM 1 TO K
erl=erl+EXPON(mexp) ;get exponential value
ENDFOR
RETURN erl
ENDPROC
WRITELIB libname erlang
RELEASE PROCS erlang
PROC normal(mean,sd) ;Generate a normal distribution (negative numbers may generate)
PRIVATE v1,v2,w,y
w=9999
WHILE w>1
v1=2*RAND()-1
v2=2*RAND()-1
w=(v1*v1)+(v2*v2)
ENDWHILE
y=SQRT((-2*LN(w))/w) ;Generates normal dist. mean=0 st=1
norm=v1*y ;Calc distribution for given range
RETURN norm ;Alternatively "norm=v2*y"
ENDPROC
WRITELIB libname normal
RELEASE PROCS normal
;
;╔════════════════════════════════════════════════════════════════════════════╗
;║ SECTION TWO - Generic routines ║
;╟────────────────────────────────────────────────────────────────────────────╢
;║ MAIN - Query user for run parameters and initialize variables. ║
;║ MAINLOOP - Determine event type and call relevant procedure. ║
;║ ARRIVE - Process the current arrival and schedule next arrival. ║
;║ DEPART - Record the current departure & pull next item from queue. ║
;║ OUTPUT - Calculate output for current run. ║
;║ SETUP_REPORT - Setup the report display screen. ║
;║ UPDATE_REPORT - Print current status to screen. ║
;╚════════════════════════════════════════════════════════════════════════════╝
;
PROC CLOSED main() ;Query the user for settings
USEVARS autolib
PRIVATE mexp,erl
CLEAR
@1,0
SHOWMENU
"MSSQ" : "Multiple Server/Single Queue",
"MSMQ" : "Multiple Server/Multiple Queue",
"SSSQ" : "Single Server/Single Queue"
TO system
IF system="Esc" THEN
RETURN
ENDIF
SHOWMENU
"Time" : "End the process at a preset time",
"Create" : "End the process after a certain count created",
"Serve" : "End the process after a certain count served",
"Queue" : "End the process at a certain queue size"
DEFAULT "Time"
TO eoj
SWITCH
CASE eoj="Esc" :
RETURN
CASE eoj="Create" :
? "=> Enter total number of jobs created " CLEAR EOL
ACCEPT "N" TO eojval
CASE eoj="Serve" :
? "=> Enter total number of jobs served " CLEAR EOL
ACCEPT "N" TO eojval
CASE eoj="Time" :
? "=> Enter end of job time " CLEAR EOL
ACCEPT "N" TO eojval
;*** Immediately stop the run or should the system simulate closing
;*** the doors and waiting for the queue to empty?
? "===> Should the queue be completed? (Y/N) "
ACCEPT "a1" picture "{Y,N}" TO eojqueue
CASE eoj="Queue" :
? "=> Enter the maximum queue size " CLEAR EOL
ACCEPT "N" TO eojval
ENDSWITCH
? "=> Enter mean arrival rate "
ACCEPT "N" TO marrive
? "=> Enter service rate "
ACCEPT "N" TO mservice
minserv=1 ;Minimum number of servers
maxserv=1 ;Maximum number of servers
increm=1 ;Incremental unit to step number of servers
IF system="MSSQ" OR system="MSMQ" THEN
? "=> Enter the minimum number of servers to test "
ACCEPT "S" TO minserv
? "=> Enter the maximum number of servers to test "
ACCEPT "S" TO maxserv
? "=> Enter incremental unit "
ACCEPT "S" default 1 TO increm
ENDIF
? "=> Enter how many repetitive runs to execute? "
ACCEPT "S" DEFAULT 1 TO number_of_runs
;*** An initialproc can be added which adds new events, initializes new
;*** variables, etc.
? "=> Enter INITIAL Proc name "
ACCEPT "A20" TO initialproc
;*** An arrivalproc can be added which tests the length of the queue and
;*** removes the last arrival if too long...or it could be used to collect
;*** particular statistics.
? "=> Enter ARRIVAL Proc name "
ACCEPT "A20" TO arriveproc
;*** A departproc can be added which jockeys the queues after every
;*** departure. An example jockey proc is given.
? "=> Enter DEPART Proc name "
ACCEPT "A20" TO departproc
IF ISTABLE("results") THEN
RENAME "results" "Rbak"
MESSAGE "Existing RESULTS.DB renamed TO RBAK.DB"
ENDIF
CREATE "results"
"Run Number" : "N",
"Number of Servers" : "N",
"Average Number in Queue" : "N",
"Maximum Number in a Queue" : "N",
"Maximum Number in Queue" : "N",
"Average Delay" : "N",
"Maximum Delay" : "N",
"Server Number" : "N",
"Server Utilization" : "N"
setup_report()
mainloop() ;Main execution loop
CLEAR CLEARALL
STYLE
VIEW "results"
ENDPROC
WRITELIB libname main
RELEASE PROCS main
PROC mainloop() ;Main execution loop
FOR run_number FROM 1 TO number_of_runs ;Execute a certain number of times
FOR numtel FROM minserv TO maxserv STEP increm ;Execute for a range of servers
;*** Initialize variables
IF system="MSMQ" THEN
numque=numtel ;Number of queues
ELSE
numque=1 ;Only one queue is used
ENDIF
maxlist=1+numque+numtel ;maxlist is used to set most array sizes
sample_vars=2 ;Number of sample statistics kept
maxatr=5 ;Number of attributes kept (default=5)
nojobs=0 ;Counter for number of jobs created or served
total_que=0 ;Total queue size
INITIAL() ;Initialize other variables
;*** Schedule first arrival
transfer[1]=EXPON(marrive) ;arrival time
transfer[2]=1 ;Arrival code
FILE(3,1) ;File in increasing order
IF eoj="Create" THEN
nojobs=nojobs+1 ;increment number of jobs
ENDIF
;*** Schedule end of job if available
IF eoj="Time" THEN
transfer[1]=eojval ;Ending time
transfer[2]=3 ;End of run code
FILE(3,1) ;File in increasing order
ENDIF
;
;*** An initialproc can be added which adds new events, initializes new
;*** variables, etc.
;
IF initialproc<>"" THEN
EXECPROC initialproc
ENDIF
WHILE TRUE
TIMING() ;Remove next event
update_report() ;Print current status
SWITCH
CASE next=1 : ;Process an arrival
ARRIVE()
CASE next=2 : ;Process a departure
DEPART(transfer[3]) ;Departure from a particular teller
IF lsize[1]=0 THEN ;If CASE 3 has been run and queue is empty
OUTPUT() ;Built RESULTS table
QUITLOOP ;Exit system
ENDIF
CASE next=3 : ;End the run
IF ISASSIGNED(eojqueue) and eojqueue="Y" THEN ;Quit or just close the doors
CANCEL(1) ;Cancel the next arrival
IF lsize[1]=0 THEN ;IF the system is empty
OUTPUT() ;Built RESULTS table
QUITLOOP ;Exit system
ENDIF
ELSE
OUTPUT() ;Built RESULTS table
QUITLOOP ;Exit system
ENDIF
;╔════════════════════════════════════════════════════════════════════════════╗
;║ Additional CASEs could exist. For example, to accurately portray the ║
;║ arrival rate of a McDonalds's a new arrival rate must change at least ║
;║ once an hour, also new servers must be frequently added or removed. In ║
;║ this example the user initialize the event queue with rate changes: ║
;║ transfer(1)=60 ║
;║ transfer(2)=4 ║
;║ transfer(3)=.50 ║
;║ FILE(3,1) ║
;║ and write a CASE four routine to set marrive=transfer(3). To change the ║
;║ number of servers the same process would be used for CASE next=5: ║
;║ transfer(1)=60 ║
;║ transfer(2)=5 ║
;║ transfer(3)=-1 ║
;║ FILE(3,1) ║
;║ with a CASE five routine to empty the servers queue and set the number of ║
;║ of servers...numtel=numtel+transfer(3) ║
;╚════════════════════════════════════════════════════════════════════════════╝
ENDSWITCH
ENDWHILE
ENDFOR
ENDFOR
ENDPROC
WRITELIB libname mainloop
RELEASE PROCS mainloop
;*** Arrival procs must perform two processes. It must handle the current
;*** arrival (by sending to a server, queuing, or exiting the system) and
;*** schedule the next arrival.
PROC arrive()
PRIVATE i,delay,shortest_q
IF eoj="Create" THEN ;Are we tracking arrivals
nojobs=nojobs+1 ;Increment counter
IF nojobs >= eojval THEN ;Should an immediate exit be scheduled
transfer[1]=clock
transfer[2]=3 ;Exit code
FILE(1,1) ;File in front
ENDIF
ENDIF
; Check server status
FOR teller FROM 1 TO numtel
IF LSIZE[numque+teller+1]=0 THEN ;Is server available?
QUITLOOP
ENDIF
ENDFOR
teller=MIN(teller,numtel)
IF LSIZE[numque+teller+1]=0 THEN ;See if server is busy
delay=0
SAMPST(delay,1)
FILE(1,numque+teller+1) ;Make server busy
transfer[1]=clock+EXPON(mservice) ;Schedule departure
transfer[2]=2 ;Depart code
transfer[3]=teller ;Teller number
transfer[5]=transfer[1]-transfer[4] ;Calc entire time in system
FILE(3,1)
ELSE
IF eoj="Queue" THEN ;If monitoring queue size
IF total_que >= eojval THEN ;Schedule an immediate exit
transfer[1]=clock
transfer[2]=3 ;Exit code
FILE(1,1) ;File in front
ENDIF
ENDIF
shortest_q = 1.E+20 ;Determine shortest Queue
FOR I from 1 TO numque ;
IF LSIZE[I+1] < shortest_q THEN ;
shortest_q=LSIZE[I+1] ;
choice=I+1 ;
ENDIF ;
ENDFOR
transfer[1]=clock ;Used to calculate delay
FILE(2,choice) ;File in back of queue
total_que=total_que+1
SAMPST(total_que,2)
ENDIF
;*** Schedule next arrival
;*** Contrary to the style given in the book, schedule the next arrival
;*** as the last step in the arrival procedure; otherwise, the transfer
;*** variables may be overwritten.
transfer[1]=clock+EXPON(marrive) ;When the arrival
transfer[2]=1 ;Arrival code
transfer[4]=transfer[1] ;Stamp the original arrival time
FILE(3,1)
;*** An arrivalproc can be added which tests the length of the queue and
;*** removes the last arrival if too long...or it could be used to collect
;*** particular statistics.
IF arriveproc<>"" THEN
EXECPROC arriveproc
ENDIF
ENDPROC
WRITELIB libname arrive
RELEASE PROCS arrive
;*** Depart procs must perform two processes. It must handle the current
;*** departure and pull the next customer from the queue (or set the server's
;*** availability flag).
PROC depart(teller) ;Manage next departure
PRIVATE delay,queue
queue=MIN(numque,teller) ;Which queue is used
IF LSIZE[queue+1]=0 THEN ;If queue is empty
REMOVE(1,numque+teller+1) ;Remove "in use" queue
ELSE
REMOVE(1,queue+1) ;Remove first member in queue
total_que=total_que-1 ;Decrement total queue size
SAMPST(total_que,2) ;Calculate total queue size
delay=clock-transfer[1] ;DELAY = time in queue
SAMPST(delay,1) ;Calculate delay statistics
transfer[1]=clock+EXPON(mservice) ;Schedule service
transfer[2]=2
transfer[3]=teller ;Teller number
transfer[5]=transfer[1]-transfer[4] ;Calculate time in system
FILE(3,1) ;File in time order sequence
ENDIF
IF eoj="Serve" THEN ;If track number of members through system
nojobs=nojobs+1 ;Increment counter
IF nojobs >= eojval THEN ;Should an immediate exit be scheduled
transfer[1]=clock
transfer[2]=3 ;Exit code
FILE(1,1) ;File in front
ENDIF
ENDIF
;*** A departproc can be added which jockies the queues after every
;*** departure. An example proc is given in section three
IF departproc<>"" THEN
EXECPROC departproc
ENDIF
ENDPROC
WRITELIB libname depart
RELEASE PROCS depart
;*** The output proc builds a record in the RESULTS.DB table for each
;*** teller tested.
PROC output() ;Build RESULTS table
PRIVATE avgquesize,maxaque,i,avgdelay,maxdelay,maxque
avgquesize=0 ;
maxaque=-1.E+20 ;Initialize variables
FOR I FROM 1 TO numque
FILEST(I+1) ;Get each queue's statistics
avgquesize=avgquesize+transfer[1]
IF transfer[2]>maxaque THEN maxaque=transfer[2] ENDIF
ENDFOR
SAMPST(0,-1) ;Get DELAY statistics
AvgDelay=transfer[1]
MaxDelay=transfer[3]
SAMPST(0,-2) ;Get statistics for total queue size
MaxQue=transfer[3]
MOVETO "results"
END DOWN
FOR I FROM 1 TO numtel ;For each teller
[Run Number]=run_number ;Enter run number
[Number of Servers]=numtel ;Enter total number of tellers is test
[Average Number in Queue]=avgquesize ;Average size of total queue
[Maximum Number in a Queue]=maxaque ;Max in one of the multiple queues
[Maximum Number in Queue]=maxque ;Max in all queues
[Average Delay]=AvgDelay ;Delay equals time standing in queue
[Maximum Delay]=MaxDelay ;
[Server Number]=I ;Stats for this teller
FILEST(numque+I+1) ;Get teller stats
MOVETO "results"
[Server Utilization]=transfer[1]
DOWN
ENDFOR
DO_IT!
ENDPROC
WRITELIB libname output
RELEASE PROCS output
PROC setup_report() ;Sets up a "percent done" scale
STYLE ATTRIBUTE 78
oldpercentdone=0
newposition=0
oldposition=0
@13,12 ?? "╔═════════════════╤════════════════╤═══════════════════╗"
@14,12 ?? "║ RUN NUMBER │ SERVER NUMBER │ PERCENT COMPLETED ║"
@15,12 ?? "║ │ │ % ║"
@16,12 ?? "╟─────────────────┼────────────────┼───────────────────╢"
@17,12 ?? "║ CLOCK │ QUEUE SIZE │ JOB COUNTER ║"
@18,12 ?? "║ │ │ ║"
@19,12 ?? "╟─────────────────┴────────────────┴───────────────────╢"
@20,12 ?? "║ PERCENT COMPLETED ║"
@21,12 ?? "║ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ ║"
@22,12 ?? "║ 0% 25% 50% 75% 100% ║"
@23,12 ?? "╚══════════════════════════════════════════════════════╝"
passes=number_of_runs*(INT((maxserv-minserv+1)/increm)) ;How many passes will be made
STYLE ATTRIBUTE 79
ENDPROC
WRITELIB libname setup_report
RELEASE PROCS setup_report
PROC update_report() ;Update the scale
pass=run_number*(INT((numtel-minserv+1)/increm))
SWITCH
CASE eoj="Create" :
percentpass=MIN(1,nojobs/eojval) ;
CASE eoj="Serve" : ;Calculate percent completed for this pass
percentpass=MIN(1,nojobs/eojval) ;
CASE eoj="Time" : ;
percentpass=MIN(1,clock/eojval) ;
CASE eoj="Queue" : ;<--- Can't be computed
percentpass=0 ;
ENDSWITCH
completed=((percentpass*100/passes)+(100*(pass-1)/passes)) ;What percent is completed?
percentdone=INT(completed) ;Used to display bar
IF percentdone>=(oldpercentdone+2) THEN ;If the percent is large enough
newposition=INT((percentdone)/2) ;Calc the number of places to print
STYLE ATTRIBUTE 79
@21,15+oldposition ?? FILL("█",newposition-oldposition) ;Print bar
oldposition=newposition
oldpercentdone=percentdone
ENDIF
@15,16 ?? FORMAT("W6",run_number) ;
@15,35 ?? FORMAT("W6",numtel) ;Print results
@15,53 ?? FORMAT("W7.2",completed) ;
@18,16 ?? FORMAT("W10.4",clock) ;
@18,35 ?? FORMAT("W6",total_que) ;
IF nojobs>0 THEN ;<--- Are we keeping track?
@18,51 ?? FORMAT("W10",nojobs) ;
ENDIF
ENDPROC
WRITELIB libname update_report
RELEASE PROCS update_report
;
;╔════════════════════════════════════════════════════════════════════════════╗
;║ SECTION THREE - Supporting script(s) ║
;╚════════════════════════════════════════════════════════════════════════════╝
;
;*** JOCKEY checks the queue and bounces one customer around based upon current
;*** server status and queue lengths.
;*** To test this procedure select a multiple server/multiple queue system
;*** and define the departure proc as "JOCKEY" (omit quotes)
PROC jockey()
PRIVATE I,savail
IF total_que=0 THEN
RETURN
ENDIF
savail=FALSE
FOR teller FROM 1 TO numtel
IF LSIZE[numque+teller+1]=0 THEN ;Is server available?
savail=TRUE
QUITLOOP
ENDIF
ENDFOR
;*** If a server is available and another queue has records then bounce
;*** from another queue.
IF savail THEN
FOR queue FROM 1 TO numque
IF lsize[queue+1]<>0 THEN
REMOVE(1,queue+1) ;Remove first member in queue
total_que=total_que-1 ;Decrement total queue size
SAMPST(total_que,2) ;Calculate total queue size
delay=clock-transfer[1] ;DELAY = time in queue
SAMPST(delay,1) ;Calculate delay statistics
transfer[1]=clock+EXPON(mservice) ;Schedule service
transfer[2]=2
transfer[3]=teller ;Teller number
transfer[5]=transfer[1]-transfer[4] ;Calculate time in system
FILE(3,1) ;File in time order sequence
FILE(1,numque+teller+1) ;Make server busy
RETURN
ENDIF
ENDFOR
;*** Otherwise, just play with the queue lenghts.
ELSE
shortest_q = 1.E+20 ;Determine shortest Queue
FOR I from 1 TO numque ;
IF LSIZE[I+1] < shortest_q THEN ;
shortest_q=LSIZE[I+1] ;
choice1=I+1 ;
ENDIF ;
ENDFOR
longest_q =-1.E+20 ;Determine longest Queue
FOR I from 1 TO numque ;
IF LSIZE[I+1] > longest_q THEN ;
longest_q=LSIZE[I+1] ;
choice2=I+1 ;
ENDIF ;
ENDFOR
IF longest_q>(shortest_Q+2) THEN
REMOVE(2,choice2) ;Remove last member in longest queue
FILE(2,choice1) ;File as last member in shortest queue
;*** Theoretically, this member could be stuck in the system all day.
;*** Then again...this has happened to me a few times.
ENDIF
ENDIF
ENDPROC
WRITELIB libname jockey
RELEASE PROCS jockey
;*** The PISSOFF proc is just a little post-processing procedure which
;*** utilizes history (MASTER2.DB) to due a little further analysis.
;*** It not meant to be used for every simulation run...its only an example.
PROC pissoff()
CLEAR RESET
Query
Master2 | List | Attribute #1 | Attribute #2 | Attribute #3 |
| Check 1 | Check | Check 2 | Check |
Master2 | Attribute #4 | Attribute #5 |
| Check | Check |
Endquery
DO_IT!
;*** Where [List]=1 and [Attribute #2]=2 the record represents the last
;*** exit of a customer. Furthermore [Attribute #5] on these records
;*** represents the total time in the system
ARRAY peeved[6]
FOR I FROM 1 TO 6
peeved[I]=0
ENDFOR
VIEW "answer"
MOVETO [Attribute #5]
SCAN
SWITCH
CASE [] > 30 :
peeved[6]=peeved[6]+1
CASE [] > 25 :
peeved[5]=peeved[5]+1
CASE [] > 20 :
peeved[4]=peeved[4]+1
CASE [] > 15 :
peeved[3]=peeved[3]+1
CASE [] > 10 :
peeved[2]=peeved[2]+1
OTHERWISE :
peeved[1]=peeved[1]+1
ENDSWITCH
ENDSCAN
@0,0 ?? "Annoyance Ratio"
@1,0 ?? "---------------"
FOR I FROM 1 TO 6
@I+2,0 ?? "Customers annoyed at "+strval(FORMAT("W4",(I-1)*20))+"% "+strval(FORMAT("w5",peeved[I]))
ENDFOR
MESSAGE "Press any key to continue"
x=getchar()
RESET
ENDPROC
WRITELIB libname pissoff
RELEASE PROCS pissoff
