Shareware Overload

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload / ShartewareOverload.cdr / database / simlib.zip / SIMLIB.SC < prev

Wrap

Text File | 1990-02-24 | 48.7 KB | 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