मोंटे कार्लो सिमुलेशन में आर


11

मैं निम्नलिखित अभ्यास को हल करने की कोशिश कर रहा हूं लेकिन वास्तव में मुझे इस बात का कोई सुराग नहीं है कि यह कैसे करना शुरू करना है। मैंने अपनी पुस्तक में कुछ कोड पाया है जो ऐसा दिखता है, लेकिन यह पूरी तरह से अलग अभ्यास है और मुझे नहीं पता कि उन्हें प्रत्येक अभिभावक से कैसे संबंधित किया जाए। मैं आगमन का अनुकरण कैसे शुरू कर सकता हूं और जब वे समाप्त हो जाते हैं तो मुझे कैसे पता चलेगा? मुझे पता है कि उन्हें कैसे स्टोर करना है और उसी के अनुसार बी, सी, डी की गणना करनी है। लेकिन मुझे नहीं पता कि मुझे वास्तव में मोंटे कार्लो सिमुलेशन का अनुकरण करने की आवश्यकता है। क्या कोई मुझे शुरू करने में मदद कर सकता है? मुझे पता है कि यह एक ऐसी जगह नहीं है जहाँ आपके सवालों का जवाब आपके लिए मिलता है, बल्कि केवल हल किया जाता है। लेकिन समस्या यह है कि मुझे नहीं पता कि कैसे शुरू किया जाए।

एक आईटी सपोर्ट हेल्प डेस्क ग्राहकों से कॉल लेने वाले पांच सहायकों के साथ एक कतार प्रणाली का प्रतिनिधित्व करता है। कॉल प्रत्येक 45 सेकंड में एक कॉल की औसत दर के साथ एक पॉइसन प्रक्रिया के अनुसार होती हैं। 1, 2, 3, 4, और 5 वें सहायकों के लिए सेवा समय सभी घातीय यादृच्छिक चर हैं जिनमें λ1 = 0.1, λ2 = 0.2, λ3 = 0.3, λ4 = 0.4, और λ5 / 0.5 मिनट − 1, क्रमशः हैं ( jth help desk असिस्टेंट में λk = k / 10 min। 1) है। जिन ग्राहकों को सहायता दी जा रही है, उनके अलावा दस अन्य ग्राहकों को होल्ड पर रखा जा सकता है। कई बार जब यह क्षमता हो जाती है, तो नए कॉल करने वालों को एक व्यस्त संकेत प्राप्त होता है। निम्नलिखित प्रदर्शन विशेषताओं का अनुमान लगाने के लिए मोंटे कार्लो विधियों का उपयोग करें,

(ए) व्यस्त संकेत प्राप्त करने वाले ग्राहकों का अंश;

(बी) अपेक्षित प्रतिक्रिया समय;

(ग) औसत प्रतीक्षा समय;

(डी) प्रत्येक हेल्प डेस्क सहायक द्वारा ग्राहकों का हिस्सा;

संपादित करें: मेरे पास अब तक क्या है (ज्यादा नहीं):

pa = 1/45sec-1

jobs = rep(1,5); onHold = rep(1,10);

jobsIndex = 0;

onHoldIndex = 0;

u = runif(1)
for (i in 1:1000) {

    if(u  <= pa){ # new arrival

        if(jobsIndex < 5) # assistant is free, #give job to assistant

            jobsIndex++;

        else #add to onHold array

            onHoldIndex++;
    }
}

यह "MC कैसे करें" के बारे में बिल्कुल नहीं है, लेकिन क्या आप इस पैकेज से परिचित हैं: r-bloggers.com/… ? यह आपके द्वारा वर्णित विभिन्न प्रकार की समस्याओं के लिए पूरी तरह से फिट बैठता है (हालांकि विभिन्न मॉडल का उपयोग करके)।
टिम

मैं वास्तव में बाहरी पुस्तकालयों के बिना इसे हल करने की कोशिश कर रहा हूं, लेकिन अगर मैं ऐसा नहीं कर सकता तो मैं तुम्हारा उपयोग सुनिश्चित
करूंगा

आपने अब तक क्या किया है, यह दिखाएं। आप बस यहाँ नहीं आ सकते हैं और एक घर के काम का समाधान पूछ सकते हैं।
अक्कल

जवाबों:


22

यह प्रदर्शन करने के लिए सबसे अधिक शिक्षाप्रद और मजेदार प्रकार है: आप कंप्यूटर में स्वतंत्र एजेंट बनाते हैं, उन्हें बातचीत करने देते हैं, वे क्या करते हैं, इस पर नज़र रखते हैं और क्या होता है, इसका अध्ययन करते हैं। यह जटिल प्रणालियों के बारे में जानने का एक अद्भुत तरीका है, विशेष रूप से (लेकिन उन तक सीमित नहीं है) जिन्हें विशुद्ध रूप से गणितीय विश्लेषण के साथ नहीं समझा जा सकता है।

इस तरह के सिमुलेशन के निर्माण का सबसे अच्छा तरीका टॉप-डाउन डिज़ाइन के साथ है।

बहुत उच्चतम स्तर पर कोड को कुछ ऐसा दिखना चाहिए

initialize(...)
while (process(get.next.event())) {}

(यह और इसके बाद के सभी उदाहरण निष्पादन योग्य R कोड हैं, न कि केवल छद्म कोड।) लूप एक घटना-संचालित सिमुलेशन है: get.next.event()ब्याज की कोई भी "घटना" पाता है और इसके बारे में एक विवरण देता है process, जो इसके साथ कुछ करता है (किसी भी लॉगिंग सहित) इसके बारे में जानकारी)। यह तब तक लौटता TRUEहै जब तक चीजें अच्छी तरह से चल रही होती हैं; एक त्रुटि या सिमुलेशन के अंत की पहचान करने पर, यह FALSEलूप को समाप्त करता है।

यदि हम इस कतार के भौतिक कार्यान्वयन की कल्पना करते हैं, जैसे कि न्यूयॉर्क शहर में विवाह लाइसेंस की प्रतीक्षा कर रहे लोग या ड्राइवर के लाइसेंस या ट्रेन टिकट के लिए लगभग कहीं भी, हम दो प्रकार के एजेंटों के बारे में सोचते हैं: ग्राहक और "सहायक" (या सर्वर) । ग्राहक खुद को दिखाते हुए घोषणा करते हैं; सहायक एक प्रकाश या संकेत को चालू करके या एक खिड़की खोलकर अपनी उपलब्धता की घोषणा करते हैं। ये दो प्रकार की घटनाएँ हैं।

इस तरह के सिमुलेशन के लिए आदर्श वातावरण एक सच्चा ऑब्जेक्ट-ओरिएंटेड है जिसमें ऑब्जेक्ट परस्पर हैं : वे अपने आसपास की चीजों के लिए स्वतंत्र रूप से प्रतिक्रिया करने के लिए राज्य बदल सकते हैं। Rइस के लिए बिल्कुल भयानक है (यहां तक ​​कि फोरट्रान बेहतर होगा!)। हालाँकि, हम अभी भी इसका इस्तेमाल कर सकते हैं अगर हम कुछ ध्यान रखें। चाल डेटा संरचनाओं के एक सामान्य सेट में सभी जानकारी को बनाए रखने के लिए है जिसे कई अलग-अलग, इंटरेक्टिव प्रक्रियाओं द्वारा एक्सेस (और संशोधित) किया जा सकता है। मैं ऐसे डेटा के लिए सभी नामों में परिवर्तनशील नामों का उपयोग करने की परंपरा को अपनाऊंगा।

शीर्ष-डाउन डिज़ाइन का अगला स्तर कोड करना है process। यह एक एकल ईवेंट विवरणक का जवाब देता है e:

process <- function(e) {
  if (is.null(e)) return(FALSE)
  if (e$type == "Customer") {
    i <- find.assistant(e$time)
    if (is.null(i)) put.on.hold(e$x, e$time) else serve(i, e$x, e$time)
  } else {
    release.hold(e$time)
  }
  return(TRUE)
}

यह एक अशक्त घटना का जवाब देना है जब get.next.eventरिपोर्ट करने के लिए कोई घटना नहीं है। अन्यथा, processसिस्टम के "व्यावसायिक नियमों" को लागू करता है। यह व्यावहारिक रूप से प्रश्न में वर्णन से खुद को लिखता है। इसे कैसे काम करना चाहिए, इसके लिए छोटी टिप्पणी की आवश्यकता होती है, सिवाय इसके कि हमें अंत में सबरूटीन्स कोड करने की आवश्यकता होगी put.on.holdऔर release.hold(ग्राहक-होल्डिंग कतार को serveलागू करना) और (ग्राहक-सहायक इंटरैक्शन को लागू करना)।

एक "घटना" क्या है? इसके बारे में जानकारी होना आवश्यक है , जो काम कर रहा है, क्या कार्रवाई की तरह वे ले जा रहे हैं, और जब यह हो रहा है। मेरा कोड इसलिए इन तीन प्रकार की जानकारी वाली सूची का उपयोग करता है। हालांकि, get.next.eventकेवल समय का निरीक्षण करने की जरूरत है। यह केवल घटनाओं की एक कतार बनाए रखने के लिए जिम्मेदार है जिसमें

  1. किसी भी घटना को प्राप्त होने पर कतार में लगाया जा सकता है और

  2. कतार में जल्द से जल्द घटना को आसानी से निकाला जा सकता है और कॉलर को पास किया जा सकता है।

इस प्राथमिकता कतार का सबसे अच्छा कार्यान्वयन एक ढेर होगा, लेकिन यह भी उधम मचाता है R। नॉर्मन मैटलॉफ़ की द आर्ट ऑफ़ आर प्रोग्रामिंग में एक सुझाव के बाद (जो एक अधिक लचीला, सार, लेकिन सीमित कतार सिम्युलेटर प्रदान करता है), मैंने घटनाओं को पकड़ने के लिए एक डेटा फ्रेम का उपयोग किया है और बस इसे रिकॉर्ड के बीच न्यूनतम समय के लिए खोजा है।

get.next.event <- function() {
  if (length(EVENTS$time) <= 0) new.customer()               # Wait for a customer$
  if (length(EVENTS$time) <= 0) return(NULL)                 # Nothing's going on!$
  if (min(EVENTS$time) > next.customer.time()) new.customer()# See text
  i <- which.min(EVENTS$time)
  e <- EVENTS[i, ]; EVENTS <<- EVENTS[-i, ]
  return (e)
}

ऐसे कई तरीके हैं जिनसे इसे कोड किया जा सकता था। यहाँ दिखाया गया अंतिम संस्करण एक पसंद को दर्शाता है जिसे मैंने कोडिंग में बनाया है कि process"असिस्टेंट" ईवेंट में कैसे प्रतिक्रिया होती है और कैसे new.customerकाम करता है: get.next.eventकेवल एक ग्राहक को होल्ड क्व्यू से बाहर ले जाता है, फिर वापस बैठता है और किसी अन्य ईवेंट का इंतजार करता है। कभी-कभी एक नए ग्राहक की दो तरह से तलाश करना आवश्यक होगा: पहला, यह देखने के लिए कि क्या कोई दरवाजे पर इंतजार कर रहा है (जैसा कि यह था) और दूसरा, क्या कोई तब आया है जब हम नहीं देख रहे थे।

स्पष्ट रूप से, new.customerऔर next.customer.timeमहत्वपूर्ण दिनचर्याएं हैं , तो चलिए आगे उनकी देखभाल करते हैं।

new.customer <- function() {  
  if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
    CUSTOMER.COUNT <<- CUSTOMER.COUNT + 1
    insert.event(CUSTOMER.COUNT, "Customer", 
                 CUSTOMERS["Arrived", CUSTOMER.COUNT])
  }
  return(CUSTOMER.COUNT)
}
next.customer.time <- function() {
  if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
    x <- CUSTOMERS["Arrived", CUSTOMER.COUNT]
  } else {x <- Inf}
  return(x) # Time when the next customer will arrive
}

CUSTOMERSस्तंभों में प्रत्येक ग्राहक के डेटा के साथ एक 2D सरणी है। इसकी चार पंक्तियाँ हैं (फ़ील्ड के रूप में अभिनय), जो ग्राहकों का वर्णन करती हैं और सिमुलेशन के दौरान उनके अनुभवों को रिकॉर्ड करती हैं : "आगमन", "सेवा की", "अवधि", और "सहायक" (सहायक का एक सकारात्मक संख्यात्मक पहचानकर्ता, यदि कोई हो, जो सेवा की उन्हें, और -1व्यस्त संकेतों के लिए अन्यथा )। अत्यधिक लचीले सिमुलेशन में ये कॉलम गतिशील रूप से उत्पन्न होंगे, लेकिन Rकाम करने के लिए पसंद करने के कारण यह शुरू से ही सभी ग्राहकों को एक बड़े मैट्रिक्स में, उनके आगमन के समय के साथ यादृच्छिक पर उत्पन्न करने के लिए सुविधाजनक है। next.customer.timeइस मैट्रिक्स के अगले कॉलम पर देख सकते हैं कि आगे कौन आ रहा है। वैश्विक चरCUSTOMER.COUNTआने वाले अंतिम ग्राहक को इंगित करता है। ग्राहक इस पॉइंटर के माध्यम से बहुत आसानी से प्रबंधित होते हैं, यह एक नया ग्राहक प्राप्त करने के लिए आगे बढ़ते हैं और अगले ग्राहक को देखने के लिए इसे (आगे बढ़ाए बिना) देखते हैं।

serve सिमुलेशन में व्यावसायिक नियमों को लागू करता है।

serve <- function(i, x, time.now) {
  #
  # Serve customer `x` with assistant `i`.
  #
  a <- ASSISTANTS[i, ]
  r <- rexp(1, a$rate)                       # Simulate the duration of service
  r <- round(r, 2)                           # (Make simple numbers)
  ASSISTANTS[i, ]$available <<- time.now + r # Update availability
  #
  # Log this successful service event for later analysis.
  #
  CUSTOMERS["Assistant", x] <<- i
  CUSTOMERS["Served", x] <<- time.now
  CUSTOMERS["Duration", x] <<- r
  #
  # Queue the moment the assistant becomes free, so they can check for
  # any customers on hold.
  #
  insert.event(i, "Assistant", time.now + r)
  if (VERBOSE) cat(time.now, ": Assistant", i, "is now serving customer", 
                   x, "until", time.now + r, "\n")
  return (TRUE)
}

यह सीधा है। ASSISTANTSदो क्षेत्रों के साथ एक डेटाफ़्रेम है: capabilities(उनकी सेवा दर देते हुए) और available, जो अगली बार फ़्लैग करता है जिस पर सहायक मुक्त होगा। एक ग्राहक को सहायक की क्षमताओं के अनुसार एक यादृच्छिक सेवा अवधि उत्पन्न करके सेवा दी जाती है, उस समय को अपडेट करना जब सहायक अगला उपलब्ध हो जाता है, और CUSTOMERSडेटा संरचना में सेवा अंतराल लॉग करना । VERBOSEजब सच है, यह अंग्रेजी कुंजी प्रसंस्करण अंक का वर्णन वाक्य की एक धारा का उत्सर्जन करता है: झंडा परीक्षण और डीबगिंग के लिए उपयोगी है।

ग्राहकों को सहायक कैसे सौंपे जाते हैं यह महत्वपूर्ण और दिलचस्प है। कोई भी कई प्रक्रियाओं की कल्पना कर सकता है: यादृच्छिक पर असाइनमेंट, कुछ निश्चित क्रम द्वारा, या जो सबसे लंबे समय तक (या सबसे कम) समय से मुक्त हो गया है। इनमें से कई को टिप्पणी-आउट कोड में चित्रित किया गया है:

find.assistant <- function(time.now) {
  j <- which(ASSISTANTS$available <= time.now)
  #if (length(j) > 0) {
  #  i <- j[ceiling(runif(1) * length(j))]
  #} else i <- NULL                                    # Random selection
  #if (length(j) > 0) i <- j[1] else i <- NULL         # Pick first assistant
  #if (length(j) > 0) i <- j[length(j)] else i <- NULL # Pick last assistant
  if (length(j) > 0) {
    i <- j[which.min(ASSISTANTS[j, ]$available)]
  } else i <- NULL                                     # Pick most-rested assistant
  return (i)
}

अनुकार के बाकी वास्तव में Rमानक डेटा संरचनाओं को लागू करने के लिए राजी करने में केवल एक नियमित अभ्यास है , मुख्य रूप से ऑन-होल्ड कतार के लिए एक परिपत्र बफर। क्योंकि आप ग्लोबल्स के साथ एमोक नहीं चलाना चाहते हैं, मैंने इन सभी को एक ही प्रक्रिया में रखा है sim। इसके तर्क समस्या का वर्णन करते हैं: ग्राहकों की संख्या अनुकरण करने के लिए ( n.events), ग्राहक की आगमन दर, सहायक की क्षमताएं, और पकड़ कतार का आकार (जो पूरी तरह से कतार को समाप्त करने के लिए शून्य पर सेट किया जा सकता है)।

r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)

CUSTOMERSR50250

आकृति 1

प्रत्येक ग्राहक के अनुभव को एक क्षैतिज समय रेखा के रूप में प्लॉट किया जाता है, आगमन के समय एक गोल प्रतीक के साथ, पकड़ पर किसी भी प्रतीक्षा के लिए एक ठोस काली रेखा और सहायक के साथ उनकी बातचीत की अवधि के लिए एक रंगीन रेखा (रंग और रेखा प्रकार) सहायकों के बीच अंतर)। इस ग्राहक के कथानक में से एक सहायक के अनुभवों को दिखा रहा है, उस समय को चिह्नित करता है जब वे ग्राहक नहीं थे। गतिविधि के प्रत्येक अंतराल के समापन बिंदु को ऊर्ध्वाधर सलाखों द्वारा सीमांकित किया जाता है।

जब साथ चलाया जाता है verbose=TRUE, तो सिमुलेशन का टेक्स्ट आउटपुट इस तरह दिखता है:

...
160.71 : Customer 211 put on hold at position 1 
161.88 : Customer 212 put on hold at position 2 
161.91 : Assistant 3 is now serving customer 213 until 163.24 
161.91 : Customer 211 put on hold at position 2 
162.68 : Assistant 4 is now serving customer 212 until 164.79 
162.71 : Assistant 5 is now serving customer 211 until 162.9 
163.51 : Assistant 5 is now serving customer 214 until 164.05 
...

160165

हम ग्राहकों को एक व्यस्त संकेत प्राप्त करने के लिए एक विशेष (लाल) प्रतीक का उपयोग करके ग्राहक पहचानकर्ता द्वारा ऑन-होल्ड अवधि की साजिश रचकर ग्राहकों के अनुभव का अध्ययन कर सकते हैं।

चित्र 2

(इन सभी भूखंडों में इस सेवा कतार का प्रबंधन करने वाले किसी भी व्यक्ति के लिए एक अद्भुत वास्तविक समय का डैशबोर्ड नहीं होगा!)

यह उन भूखंडों और आँकड़ों की तुलना करने के लिए आकर्षक है जो आपको दिए गए मापदंडों को अलग-अलग करने पर मिलते हैं sim। क्या होता है जब ग्राहक बहुत तेजी से संसाधित होने के लिए पहुंचते हैं? क्या होता है जब पकड़ कतार छोटी या समाप्त हो जाती है? जब विभिन्न शिष्टाचार में सहायकों का चयन किया जाता है तो क्या बदलाव आते हैं? सहायकों की संख्या और क्षमताएं ग्राहक के अनुभव को कैसे प्रभावित करती हैं? वे कौन से महत्वपूर्ण बिंदु हैं जहां कुछ ग्राहक दूर होने लगते हैं या लंबे समय के लिए रोकना शुरू कर देते हैं?


सामान्य तौर पर, इस तरह के स्व-अध्ययन के स्पष्ट प्रश्नों के लिए, हम यहां रुकेंगे और शेष विवरणों को एक अभ्यास के रूप में छोड़ देंगे। हालाँकि, मैं उन पाठकों को निराश नहीं करना चाहता, जिन्होंने इसे बहुत दूर तक पा लिया है और वे इसे अपने लिए आजमाने में रुचि रखते हैं (और शायद इसे संशोधित करके और अन्य उद्देश्यों के लिए इस पर निर्माण कर रहे हैं), इसलिए नीचे दिया गया पूर्ण कार्य कोड है।

TEX$

sim <- function(n.events, verbose=FALSE, ...) {
  #
  # Simulate service for `n.events` customers.
  #
  # Variables global to this simulation (but local to the function):
  #
  VERBOSE <- verbose         # When TRUE, issues informative message
  ASSISTANTS <- list()       # List of assistant data structures
  CUSTOMERS <- numeric(0)    # Array of customers that arrived
  CUSTOMER.COUNT <- 0        # Number of customers processed
  EVENTS <- list()           # Dynamic event queue   
  HOLD <- list()             # Customer on-hold queue
  #............................................................................#
  #
  # Start.
  #
  initialize <- function(arrival.rate, capabilities, hold.queue.size) {
    #
    # Create common data structures.
    #
    ASSISTANTS <<- data.frame(rate=capabilities,     # Service rate
                              available=0            # Next available time
    )
    CUSTOMERS <<- matrix(NA, nrow=4, ncol=n.events, 
                         dimnames=list(c("Arrived",  # Time arrived
                                         "Served",   # Time served
                                         "Duration", # Duration of service
                                         "Assistant" # Assistant id
                         )))
    EVENTS <<- data.frame(x=integer(0),              # Assistant or customer id
                          type=character(0),         # Assistant or customer
                          time=numeric(0)            # Start of event
    )
    HOLD <<- list(first=1,                           # Index of first in queue
                  last=1,                            # Next available slot
                  customers=rep(NA, hold.queue.size+1))
    #
    # Generate all customer arrival times in advance.
    #
    CUSTOMERS["Arrived", ] <<- cumsum(round(rexp(n.events, arrival.rate), 2))
    CUSTOMER.COUNT <<- 0
    if (VERBOSE) cat("Started.\n")
    return(TRUE)
  }
  #............................................................................#
  #
  # Dispatching.
  #
  # Argument `e` represents an event, consisting of an assistant/customer 
  # identifier `x`, an event type `type`, and its time of occurrence `time`.
  #
  # Depending on the event, a customer is either served or an attempt is made
  # to put them on hold.
  #
  # Returns TRUE until no more events occur.
  #
  process <- function(e) {
    if (is.null(e)) return(FALSE)
    if (e$type == "Customer") {
      i <- find.assistant(e$time)
      if (is.null(i)) put.on.hold(e$x, e$time) else serve(i, e$x, e$time)
    } else {
      release.hold(e$time)
    }
    return(TRUE)
  }#$
  #............................................................................#
  #
  # Event queuing.
  #
  get.next.event <- function() {
    if (length(EVENTS$time) <= 0) new.customer()
    if (length(EVENTS$time) <= 0) return(NULL)
    if (min(EVENTS$time) > next.customer.time()) new.customer()
    i <- which.min(EVENTS$time)
    e <- EVENTS[i, ]; EVENTS <<- EVENTS[-i, ]
    return (e)
  }
  insert.event <- function(x, type, time.occurs) {
    EVENTS <<- rbind(EVENTS, data.frame(x=x, type=type, time=time.occurs))
    return (NULL)
  }
  # 
  # Customer arrivals (called by `get.next.event`).
  #
  # Updates the customers pointer `CUSTOMER.COUNT` and returns the customer
  # it newly points to.
  #
  new.customer <- function() {  
    if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
      CUSTOMER.COUNT <<- CUSTOMER.COUNT + 1
      insert.event(CUSTOMER.COUNT, "Customer", 
                   CUSTOMERS["Arrived", CUSTOMER.COUNT])
    }
    return(CUSTOMER.COUNT)
  }
  next.customer.time <- function() {
    if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
      x <- CUSTOMERS["Arrived", CUSTOMER.COUNT]
    } else {x <- Inf}
    return(x) # Time when the next customer will arrive
  }
  #............................................................................#
  #
  # Service.
  #
  find.assistant <- function(time.now) {
    #
    # Select among available assistants.
    #
    j <- which(ASSISTANTS$available <= time.now) 
    #if (length(j) > 0) {
    #  i <- j[ceiling(runif(1) * length(j))]
    #} else i <- NULL                                    # Random selection
    #if (length(j) > 0) i <- j[1] else i <- NULL         # Pick first assistant
    #if (length(j) > 0) i <- j[length(j)] else i <- NULL # Pick last assistant
    if (length(j) > 0) {
      i <- j[which.min(ASSISTANTS[j, ]$available)]
    } else i <- NULL # Pick most-rested assistant
    return (i)
  }#$
  serve <- function(i, x, time.now) {
    #
    # Serve customer `x` with assistant `i`.
    #
    a <- ASSISTANTS[i, ]
    r <- rexp(1, a$rate)                       # Simulate the duration of service
    r <- round(r, 2)                           # (Make simple numbers)
    ASSISTANTS[i, ]$available <<- time.now + r # Update availability
    #
    # Log this successful service event for later analysis.
    #
    CUSTOMERS["Assistant", x] <<- i
    CUSTOMERS["Served", x] <<- time.now
    CUSTOMERS["Duration", x] <<- r
    #
    # Queue the moment the assistant becomes free, so they can check for
    # any customers on hold.
    #
    insert.event(i, "Assistant", time.now + r)
    if (VERBOSE) cat(time.now, ": Assistant", i, "is now serving customer", 
                     x, "until", time.now + r, "\n")
    return (TRUE)
  }
  #............................................................................#
  #
  # The on-hold queue.
  #
  # This is a cicular buffer implemented by an array and two pointers,
  # one to its head and the other to the next available slot.
  #
  put.on.hold <- function(x, time.now) {
    #
    # Try to put customer `x` on hold.
    #
    if (length(HOLD$customers) < 1 || 
          (HOLD$first - HOLD$last %% length(HOLD$customers) == 1)) {
      # Hold queue is full, alas.  Log this occurrence for later analysis.
      CUSTOMERS["Assistant", x] <<- -1 # Busy signal
      if (VERBOSE) cat(time.now, ": Customer", x, "got a busy signal.\n")
      return(FALSE)
    }
    #
    # Add the customer to the hold queue.
    #
    HOLD$customers[HOLD$last] <<- x
    HOLD$last <<- HOLD$last %% length(HOLD$customers) + 1
    if (VERBOSE) cat(time.now, ": Customer", x, "put on hold at position", 
                 (HOLD$last - HOLD$first - 1) %% length(HOLD$customers) + 1, "\n")
    return (TRUE)
  }
  release.hold <- function(time.now) {
    #
    # Pick up the next customer from the hold queue and place them into
    # the event queue.
    #
    if (HOLD$first != HOLD$last) {
      x <- HOLD$customers[HOLD$first]   # Take the first customer
      HOLD$customers[HOLD$first] <<- NA # Update the hold queue
      HOLD$first <<- HOLD$first %% length(HOLD$customers) + 1
      insert.event(x, "Customer", time.now)
    }
  }$
  #............................................................................#
  #
  # Summaries.
  #
  # The CUSTOMERS array contains full information about the customer experiences:
  # when they arrived, when they were served, how long the service took, and
  # which assistant served them.
  #
  summarize <- function() return (list(c=CUSTOMERS, a=ASSISTANTS, e=EVENTS,
                                       h=HOLD))
  #............................................................................#
  #
  # The main event loop.
  #
  initialize(...)
  while (process(get.next.event())) {}
  #
  # Return the results.
  #
  return (summarize())
}
#------------------------------------------------------------------------------#
#
# Specify and run a simulation.
#
set.seed(17)
n.skip <- 200  # Number of initial events to skip in subsequent summaries
system.time({
  r <- sim(n.events=50+n.skip, verbose=TRUE, 
           arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
})
#------------------------------------------------------------------------------#
#
# Post processing.
#
# Skip the initial phase before equilibrium.
#
results <- r$c
ids <- (n.skip+1):(dim(results)[2])
arrived <- results["Arrived", ]
served <- results["Served", ]
duration <- results["Duration", ]
assistant <- results["Assistant", ]
assistant[is.na(assistant)] <- 0   # Was on hold forever
ended <- served + duration
#
# A detailed plot of customer experiences.
#
n.events <- length(ids)
n.assistants <- max(assistant, na.rm=TRUE) 
colors <- rainbow(n.assistants + 2)
assistant.color <- colors[assistant + 2]
x.max <- max(results["Served", ids] + results["Duration", ids], na.rm=TRUE)
x.min <- max(min(results["Arrived", ids], na.rm=TRUE) - 2, 0)
#
# Lay out the graphics.
#
layout(matrix(c(1,1,2,2), 2, 2, byrow=TRUE), heights=c(2,1))
#
# Set up the customers plot.
#
plot(c(x.min, x.max), range(ids), type="n",
     xlab="Time", ylab="Customer Id", main="Customers")
#
# Place points at customer arrival times.
#
points(arrived[ids], ids, pch=21, bg=assistant.color[ids], col="#00000070")
#
# Show wait times on hold.
#
invisible(sapply(ids, function(i) {
  if (!is.na(served[i])) lines(x=c(arrived[i], served[i]), y=c(i,i))
}))
#
# More clearly show customers getting a busy signal.
#
ids.not.served <- ids[is.na(served[ids])]
ids.served <- ids[!is.na(served[ids])]
points(arrived[ids.not.served], ids.not.served, pch=4, cex=1.2)
#
# Show times of service, colored by assistant id.
#
invisible(sapply(ids.served, function(i) {
  lines(x=c(served[i], ended[i]), y=c(i,i), col=assistant.color[i], lty=assistant[i])
}))
#
# Plot the histories of the assistants.
#
plot(c(x.min, x.max), c(1, n.assistants)+c(-1,1)/2, type="n", bty="n",
     xlab="", ylab="Assistant Id", main="Assistants")
abline(h=1:n.assistants, col="#808080", lwd=1)
invisible(sapply(1:(dim(results)[2]), function(i) {
  a <- assistant[i]
  if (a > 0) {
    lines(x=c(served[i], ended[i]), y=c(a, a), lwd=3, col=colors[a+2])
    points(x=c(served[i], ended[i]), y=c(a, a), pch="|", col=colors[a+2])
  }
}))
#
# Plot the customer waiting statistics.
#
par(mfrow=c(1,1))
i <- is.na(served)
plot(served - arrived, xlab="Customer Id", ylab="Minutes",
     main="Service Wait Durations")
lines(served - arrived, col="Gray")
points(which(i), rep(0, sum(i)), pch=16, col="Red")
#
# Summary statistics.
#
mean(!is.na(served)) # Proportion of customers served
table(assistant)

2
+1 अद्भुत! क्या आप उस स्तर की समझ और ध्यान के विस्तार के साथ सभी सवालों के जवाब दे सकते हैं? सपने, बस सपने ...
हांग्जो Blekh

+1 मैं क्या कह सकता हूं? आज मैंने बहुत सी दिलचस्प बातें सीखीं! कृपया आगे पढ़ने के लिए कोई पुस्तक जोड़ने के लिए, कृपया?
मुगें

1
@ मुगेन मैंने पाठ में मैटलॉफ पुस्तक का उल्लेख किया है। यह उन नए लोगों के लिए उपयुक्त हो सकता है Rजो कतार सिमुलेशन पर एक और (लेकिन काफी समान) परिप्रेक्ष्य चाहते हैं। इस छोटे से सिम्युलेटर को लिखते समय मैंने खुद को बहुत सोच-विचार किया कि मैंने एंड्रयू टेनबाम के टेक्स्ट ऑपरेटिंग सिस्टम / डिज़ाइन और कार्यान्वयन के कोड (पहले संस्करण) में अध्ययन करके कितना सीखा मैंने सीएसीएम में जॉन बेंटले के लेखों और किताबों की उनकी प्रोग्रामिंग पर्ल श्रृंखलाओं से व्यावहारिक डेटा संरचनाओं के बारे में भी सीखा । Tanenbaum और बेंटले महान लेखक हैं जिन्हें हर किसी को पढ़ना चाहिए।
whuber

1
@ मुगन, मोशे द्वारा यहां कतारबद्ध सिद्धांत पर एक मुफ्त ऑनलाइन पाठ्यपुस्तक है । इसके अलावा प्रो.गलेगर के असतत स्टोचस्टॉक प्रक्रिया पाठ्यक्रम में इन विषयों को एमआईटी ओसीडब्ल्यू पर शामिल किया गया है । वीडियो व्याख्यान वास्तविक अच्छे हैं।
अक्कल

@ शुभंकर, एक महान जवाब। हालाँकि मुझे नहीं लगता है कि आप इन दिनों बच्चों को तनानेबाम और बेंटले पढ़ने के लिए बना सकते हैं :)
अक्षकाल
हमारी साइट का प्रयोग करके, आप स्वीकार करते हैं कि आपने हमारी Cookie Policy और निजता नीति को पढ़ और समझा लिया है।
Licensed under cc by-sa 3.0 with attribution required.