نموذج محاكاة انتشار فيروس كورونا covid19 بواسطة الحاسوب

نموذج محاكاة انتشار فيروس كورونا.. بواسطة الحاسوب

------------------------------------------------------------------------------------------ 

إذا كنت تعيش في هذا العالم ، فهناك احتمال ضئيل للغاية انك لم تسمع بعد عن

فيروس كورونا Covid-19 والوباء الذي تسبب فيه حرفياً في جميع أنحاء العالم. في الواقع ، إنها فرصة جيدة أن تقرأ هذا أثناء وجودك في الحجر الصحي في منزلك ، وأن يكون لديك الكثير من الوقت الإضافي للتعامل مع الابتعاد الاجتماعي عن الجمهور ومثل الكثيرين. لذا ، إذا كنت معتادًا على البحث ، فلماذا لا تجرب هذا: قم ببناء نموذج الوباء الخاص بك في المنزل. مما يساعدك على تعزيز قدراتك ، ويساعدك على فهم المفاهيم والديناميكيات الأساسية للأوبئة. لكن أولاً وقبل كل شيء ، يرجى ملاحظة أنه مجرد مقال لإظهار كيفية استخدام vba مع اكسل لإعداد نموذج أساسي لوباء Covid-19. وهو ما يعني من ناحية أخرى: إنه ليس نموذجًا يمكنك استخدامه للتنبؤ بما سيأتي. ليس نموذج الذي يمنحك القدرة على تجاهل ما توصي به السلطات الرسمية بفعله. اذا كنت موافق على ما سبق دعنا نكمل....
في شهر ايلول الماضي من عام 2021 شهدت البلاد موجة كورونا جديدة اودت بحياة عدد من الناس ومن جميع الفئات اطفال و شباب وكبار بالسن وفي هذه الحالة تضطر بعض الحكومات الى تطبيق حظر تجوال كلي للحد من عدد الاصابات وفرض لبس الكمامات والكفوف والتباعد الاجتماعي واتخاذ اجراءات الوقاية المناسبة مما يقلل احتمالية الاصابة بالفيروس ولاسيما ان اللقاح غير متوفر في اغلب البلدان نموذج المحاكاة: تستخدم نماذج المحاكاة لتوعية الناس بالمخاطر كشكل من اشكال محاكاة الواقع..

وتستخدم كاداة للتوقع المستقبلي لعدة شهور وتفيد النماذج ايضا بتطبيق بعض الفرضيات التي قد تطبق على الواقع الحقيقي ودراسة النتائج التي من خلالها يؤخذ القرار الصحيح 

النموذج الرياضي:

 يعتمد في تطبيقه على معادلات رياضية تفاضلية..تقيس مقدار التغير مع الزمن مع عدد الاصابات المرافقة لعدة ايام وهنا تكون البيانات حقيقة وتجمع على عدة شهور وتطبق على النموذج لتخاذ القرار المناسب لشهور قادمة ياخذ التابع الرياضي المتغير مع الزمن شكل تابع اسي متزايد في حالة انتشار الوباء وعدم الحد من عدد الاصابات وهنا لابد من محاكاة الواقع بواسطة برامج الحاسوب للحد من تزايد التابع الاسي وجعله ياخذ شكل انحناء افقي او متناقص نحو الاسفل..

 نموذج المحاكاة البسيط:

 اقدم لكم نموذج محاكاة بسيط يتألف من مدينة صغيرة تحوي عدد من السكان (الاشخاص) والموزعين بشكل عشوائي ضمن المدينة يوجد لدينا افتراضيا ثلاث حالات للشخص 

 1-سليم يأخذ لون اخظر

 2-معافى يأخذ لون البنفسجي 

 3-مصاب ياخذ لون احمر 

 الية الحركةونقل المرض بين السكان في النموذج: 

تنتقل العدى بين السكان نتيجة لمس او تجاور شخص مصاب رقم 3 لشخص غير مصاب رقم (1 او 2) ينتقل السكان من المنزل الى العمل او المركز التجاري ...الخ او الى اي مكان ضمن المدينة بشكل عشوائي اثناء الحركة اذا تصادم شخص مصاب مع شخص غير مصاب اثناء الحركة او السكون يتم تحول الشخص السليم الى شخص مصاب وبدوره اثناء حركته وتصادمه مع اشخاص سليمين اخرين يتم نقل العدوى لهم وهنا لدينا عدة حالات افتراضية
الحالة1: يوجد عدة فرضيات
1-تفرض هذه الحالة وجود عدد قليل من المصابين بالمقارنة مع عدد السكان الكلي 

2-تفرض هذه الحالة نقل العدوى للشخص 1 السليم والشخص 2 المعافى اثناء التلامس (التجاور) مع شخص رقم3(مصاب)

 3-نفرض وجود مشفى يملك اللقاح والرعاية الصحية وتوفر الاوكسحين في هذه الحالة الشخص المصاب رقم 3 في حال دخوله المشفى سيتم شفاءه ولا يوجد احتمال لموته بشكل افتراضي
الحالة2 :
هنا نفرض حظر تجوال او حجر كلي للاشخاص المصابة نفصل فيه بين المصابين وغير المصابين بوضع حد افتراضي لا يسمح بولوج الاشخاص المصابين المخطط البياني يوجد في النموذج مخطط بياني لفحص التغيرات من اليوم الاول الى عدد من الايام التالية وتطبيق النتائج ورسمها على المخطط في كل من الحالات السابقة

تم استخدام برنامج الاكسل وذلك من خلال الاستفادة من لغة vba  

التنسيق الشرطي:

يتم الاستفادة من التنسيق الشرطي حيث يتم وضع 

رقم 1 لدلالة على ان الشخص سليم 

ورقم 2 لدلالة على ان تم اصابته وشفائه وياخذ اللون البنفسجي 

ورقم 3 لدلالة على الاصابة 

المخططات البيانية :

 الاستفادة من امكانيات اكسيل في رسم المخططات البيانية حيث يتم تحديث المحطط البياني تلقائيا من خلال زيادة عدد المصابين 

عامل الحركة :

يتم من خلال الكود البرمجي حيث عند التصادم يتم نقل العدوى وعند دخول المشفى يتم الشفاء واخذ اللقاح

تطبيق حالة وضع الجدار (حظر تجوال )

الكود البرمجي بلغة vba:

'Dim grid(1 To 50, 1 To 51) As Integer
Dim next1(0 To 51, 0 To 51) As Integer
Dim counti As Integer

Sub life()
DoEvents
Dim i, j, d, f As Integer
For a = 1 To 5
For i = 1 To 50
For j = 1 To 50
 next1(i, j) = Cells(i, j).Value

Next j

Next i
If corona.CheckBox1.Value = True Then
For d = 1 To 50
next1(22, d) = 4
Next d
End If
'If corona.CheckBox1.Value = True Then MsgBox ("ok")
For i = 1 To 50
For j = 1 To 50

If next1(i, j) <> 0 Then Call lmted(i, j)

If ((next1(i - 1, j - 1) = 3 Or next1(i - 1, j) = 3 Or next1(i - 1, j + 1) = 3 Or next1(i, j - 1) = 3 Or next1(i, j + 1) = 3 Or next1(i + 1, j - 1) = 3 Or next1(i + 1, j) = 3 Or next1(i + 1, j + 1) = 3)) And ((next1(i, j) = 1) Or (next1(i, j) = 2)) Then

next1(i, j) = 3

End If

If i <= 20 And j >= 43 And (next1(i, j) = 3) Then

next1(i, j) = 2
End If
If next1(i, j) = 1 Or next1(i, j) = 2 Or next1(i, j) = 3 Then Call moves(i, j)





If corona.CheckBox1.Value = True Then Call wall1(i, j)



Next j
Next i

For i = 1 To 50
For j = 1 To 50
Cells(i, j).Value = next1(i, j)
Next j
Next i
 'corona.Shapes.Range(Array("fff")).ThreeD.RotationX = corona.Shapes.Range(Array("fff")).ThreeD.RotationX - 1

Next a
counti = counti + 1
Cells(25, 60 + counti).Value = counti
Cells(26, 60 + counti).Value = Cells(10, 57).Value
Cells(1, 51).Value = counti
End Sub
Private Sub moves(ByVal a As Integer, ByVal b As Integer) 'i,j
Dim s As Integer
s = Int(Rnd() * 4)
If s = 0 And (b + 3) < 50 Then 'left
If (next1(a, b) <> 0) And next1(a, b + 3) = 0 And b < 47 Then

next1(a, b + 3) = next1(a, b)


next1(a, b) = 0

End If
Else
If s = 1 And (b - 3) > 0 Then 'rght
If (next1(a, b) <> 0) And next1(a, b - 3) = 0 And b > 3 Then

next1(a, b - 3) = next1(a, b)

next1(a, b) = 0
End If
Else
If s = 2 And (a - 3) > 0 Then 'up
If (next1(a, b) <> 0) And next1(a - 3, b) = 0 And a > 3 Then

next1(a - 3, b) = next1(a, b)

next1(a, b) = 0
End If
Else
If s = 3 And (a + 3) < 50 Then 'up
If (next1(a, b) <> 0) And next1(a + 3, b) = 0 And a < 47 Then

next1(a + 3, b) = next1(a, b)

next1(a, b) = 0
End If
End If
End If
End If
End If
End Sub
Private Sub lmted(ByVal a As Integer, ByVal b As Integer) 'i,j
If a = 1 And next1(a + 1, b) = 0 Then
next1(a + 1, b) = next1(a, b)
next1(a, b) = 0
End If
If a = 50 And next1(a - 1, b) = 0 Then
next1(a - 1, b) = next1(a, b)
next1(a, b) = 0
End If
If b = 50 And next1(a, b - 1) = 0 Then
next1(a, b - 1) = next1(a, b)
next1(a, b) = 0
End If
If b = 1 And next1(a, b + 1) = 0 Then
next1(a, b + 1) = next1(a, b)
next1(a, b) = 0
End If
End Sub
Private Sub wall1(ByVal a As Integer, ByVal b As Integer) 'i,j



If a = 22 And next1(a - 1, b) = 0 Then
next1(a - 1, b) = next1(a, b)
next1(a, b) = 0
End If
If a = 22 And next1(a + 1, b) = 0 Then
next1(a + 1, b) = next1(a, b)
next1(a, b) = 0
End If
End Sub

 رابط تحميل ملف العمل 

 https://docs.google.com/spreadsheets/d/1-GXpOQa0VygrzvfD067Z0jdhBcm2hs7tYsR0KTL-rek/edit?usp=sharing

تابع الفيديو