مرحبا اصدقاء! في هذه المقالة ، أود أن أتحدث عن خوارزمية مثيرة للاهتمام من تخصص "البحث التشغيلي" ، وهي بالتحديد حول الطريقة المجرية وكيفية حل مشاكل المهمة بمساعدتها. سوف أتطرق إلى النظرية حول الحالات والمهام التي تنطبق عليها هذه الخوارزمية ، سأقوم بتحليلها خطوة بخطوة على المثال الذي اخترعته ، ومشاركة مخططي المتواضع للكود لتطبيقه باللغة R. دعنا نبدأ!
بضع كلمات حول الطريقة
لكي لا نرسم الكثير من النظرية بمصطلحات وتعاريف رياضية ، أقترح النظر في خيارين لتكوين مشكلة المهمة ، وأعتقد أنك ستفهم على الفور في الحالات التي سنستخدم فيها الطريقة المجرية:
- مهمة تعيين الموظفين في المناصب. من الضروري توزيع العمال على المناصب حتى يتم تحقيق أقصى قدر من الكفاءة ، أو أن هناك تكلفة عمل ضئيلة.
- تعيين ماكينات لأقسام الإنتاج. توزيع الآلات بحيث يكون إنتاجها مربحًا قدر الإمكان أثناء تشغيلها ، أو تكون تكلفة صيانتها ضئيلة.
- ويقدر اختيار المرشحين لشواغر مختلفة. سنقوم بتحليل هذا المثال أدناه.
كما ترى ، هناك العديد من الخيارات التي تنطبق عليها الطريقة المجرية ، وتنشأ مهام مماثلة في العديد من مجالات النشاط.
ونتيجة لذلك ، يجب حل المهمة حتى يتمكن مؤدٍ واحد (شخص ، آلة ، أداة ، ...) من أداء عمل واحد فقط ، ويتم تنفيذ كل عمل بواسطة مؤدي واحد فقط.
الشرط الضروري والكافي لحل المشكلة هو نوعه المغلق. على سبيل المثال عندما يكون عدد المؤدين = عدد الأعمال (N = M). إذا لم يتم استيفاء هذا الشرط ، فيمكنك إضافة فنانين خياليين ، أو عمل خيالي ، حيث ستكون القيم في المصفوفة صفرًا. لن يؤثر هذا على حل المشكلة ، بل سيعطيها فقط النوع المغلق الضروري.
خوارزمية خطوة بخطوة بالقدوة
بيان المشكلة: دعنا نخطط لمؤتمر علمي مهم. لإجراء ذلك ، تحتاج إلى إعداد الصوت والضوء والصور وتسجيل الضيوف والتحضير للاستراحات بين العروض. يوجد 5 منظمين لهذه المهمة. لكل منهم تقديرات معينة لأداء عمل معين (افترض أنه تم تعيين هذه التقديرات كمتوسط حسابي لمراجعات موظفيهم). من الضروري توزيع المنظمين بحيث يكون مجموع درجاتهم كحد أقصى. تتضمن المهمة الشكل التالي:
إذا تم حل المشكلة في الحد الأقصى (كما في حالتنا) ، فمن الضروري في كل صف من المصفوفة العثور على العنصر الأقصى ، وطرحه من كل عنصر من الصف المقابل وضرب المصفوفة بأكملها في -1. إذا تم حل المشكلة إلى الحد الأدنى ، فيجب تخطي هذه الخطوة.
في كل صف وفي كل عمود يجب تحديد صفر واحد فقط محدد. (على سبيل المثال ، عند اختيار صفر ، لن يتم أخذ الأصفار المتبقية في هذا الصف أو في هذا العمود في الاعتبار). في هذه الحالة ، لا يمكن القيام بذلك:
(
إذا تم حل المشكلة إلى الحد الأدنى ، فأنت بحاجة إلى البدء بهذه الخطوة ). نواصل الحل أكثر. تخفيض المصفوفة حسب الصفوف (ابحث عن الحد الأدنى للعنصر في كل صف واطرحه من كل عنصر على التوالي):
لأن نظرًا لأن جميع العناصر الدنيا صفر ، لم تتغير المصفوفة. نقوم بتخفيض الأعمدة:
مرة أخرى ، ننظر بحيث لا يوجد سوى صف واحد محدد في كل عمود وفي كل صف. كما هو موضح أدناه ، في هذه الحالة من المستحيل القيام بذلك. لقد قدمت خيارين لكيفية اختيار الأصفار ، ولكن لم يعط أي منها النتيجة المرجوة:
نواصل القرار كذلك. شطب الصفوف والأعمدة التي تحتوي على عناصر صفرية (
هام! يجب أن يكون عدد المعابر ضئيلاً ). من بين العناصر المتبقية ، نبحث عن الحد الأدنى ، ونطرحه من العناصر المتبقية (التي لم يتم شطبها) ونضيفها إلى العناصر الموجودة عند تقاطع الصفوف والأعمدة المشطوفة (ما يتم تمييزه باللون الأخضر يتم طرحه هناك ؛ وما تم تمييزه باللون الذهبي يتم تلخيصه هناك ؛ ثم ، ما لم يتم رسمه - لا تلمس):
كما ترى الآن ، في كل عمود وصف لا يوجد سوى صف واحد محدد. نكمل حل المشكلة!
استبدل موقع الأصفار المحددة في الجدول الأولي. وبالتالي ، نحصل على الخطة المثلى أو المثلى ، حيث يتم توزيع المنظمين بين العمل وتبين أن مجموع التقديرات هو الحد الأقصى:
إذا قمت بحل المشكلة وما زال من المستحيل بالنسبة لك اختيار الأصفار بحيث لا يوجد سوى صف واحد في كل عمود وصف ، فإننا نكرر الخوارزمية من المكان الذي تم فيه التخفيض حسب الصفوف (الحد الأدنى للعنصر في كل صف).
تنفيذ لغة البرمجة R
يتم تنفيذ الخوارزمية المجرية باستخدام العودية. آمل ألا يتسبب رمزي في صعوبات. تحتاج أولاً إلى تجميع ثلاث وظائف ، ثم بدء الحسابات.
يتم أخذ بيانات حل المشكلة من ملف example.csv الذي يحتوي على النموذج:
تمت إضافة الرمز إلى المفسد للمقال سيكون كبيرًا جدًا بسببه# library(dplyr) # csv ( - ; - ) table <- read.csv("example.csv",header=TRUE,row.names=1,sep=";") # unique_index <- hungarian_algorithm(table,T) # cat(paste(row.names(table[as.vector(unique_index$row),])," - ",names(table[as.vector(unique_index$col)])),sep = "\n") # cat(" -",sum(mapply(function(i, j) table[i, j], unique_index$row, unique_index$col, SIMPLIFY = TRUE))) #____________________ __________________________________ hungarian_algorithm <- function(data,optim=F){ # optim = T, if(optim==T) { data <- data %>% apply(1,function(x) (x-max(x))*(-1)) %>% t() %>% as.data.frame() optim <- F } # data <- data %>% apply(1,function(x) x-min(x)) %>% t() %>% as.data.frame() # zero_index <- which(data==0, arr.ind = T) # "" - unique_index <- from_the_beginning(zero_index) # "" , .. if(nrow(unique_index)!=nrow(data)) #.. "" - unique_index <- from_the_end(zero_index) # , if(nrow(unique_index)!=nrow(data)) { # data <- data %>% apply(2,function(x) x-min(x)) %>% as.data.frame() zero_index <- which(data==0, arr.ind = T) unique_index <- from_the_beginning(zero_index) if(nrow(unique_index)!=nrow(data)) unique_index <- from_the_end(zero_index) if(nrow(unique_index)!=nrow(data)) { #"" (! ) index <- which(apply(data,1,function(x) length(x[x==0])>1)) index2 <- which(apply(data[-index,],2,function(x) length(x[x==0])>0)) # min_from_table <- min(data[-index,-index2]) # data[-index,-index2] <- data[-index,-index2]-min_from_table # , data[index,index2] <- data[index,index2]+min_from_table zero_index <- which(data==0, arr.ind = T) unique_index <- from_the_beginning(zero_index) if(nrow(unique_index)!=nrow(data)) unique_index <- from_the_end(zero_index) # "" , .. if(nrow(unique_index)!=nrow(data)) #.. hungarian_algorithm(data,optim) else # "" unique_index } else # "" unique_index } else # "" unique_index } #_________________________________________________________________________________ #__________ "" -___________ from_the_beginning <- function(x,i=0,j=0,index = data.frame(row=numeric(),col=numeric())){ # , i, j find_zero <- x[(!x[,1] %in% i) & (!x[,2] %in% j),] if(length(find_zero)>2){ # i <- c(i,as.vector(find_zero[1,1])) # j <- c(j,as.vector(find_zero[1,2])) # data frame ( ) index <- rbind(index,setNames(as.list(find_zero[1,]), names(index))) # from_the_beginning(find_zero,i,j,index)} else rbind(index,find_zero) } #_________________________________________________________________________________ #__________ "" -___________ from_the_end <- function(x,i=0,j=0,index = data.frame(row=numeric(),col=numeric())){ find_zero <- x[(!x[,1] %in% i) & (!x[,2] %in% j),] if(length(find_zero)>2){ i <- c(i,as.vector(find_zero[nrow(find_zero),1])) j <- c(j,as.vector(find_zero[nrow(find_zero),2])) index <- rbind(index,setNames(as.list(find_zero[nrow(find_zero),]), names(index))) from_the_end(find_zero,i,j,index)} else rbind(index,find_zero) } #_________________________________________________________________________________
نتيجة البرنامج:
في الختام
شكرا جزيلا لأخذ الوقت لقراءة مقالتي. سأقدم جميع الروابط المستخدمة أدناه. آمل أن تكون قد تعلمت شيئًا جديدًا لنفسك أو قمت بتحديث معرفتك القديمة. كل النجاح ، وحظا سعيدا وحظا سعيدا!
الموارد المستخدمة
1.
ويكيبيديا العاصفة2.
ومواقع أخرى جيدة3.
أكدت لنفسي بعض المعلومات من هذه المقالة.