หนึ่งในโจทย์ความน่าจะเป็นที่ผมประทับใจที่สุดก็คือปริศนาที่ชื่อว่า Monty Hall Problem

ใครที่รู้เฉลยอยู่แล้วก็อย่าเพิ่ง Spoil นะครับ ผ่านไปเลย
ใครไม่รู้จัก อย่าเพิ่ง search Google อยากให้มาลองคิดกันดู

สมมติว่าเราไปเล่นเกมโชว์ ซึ่งพิธีกรจะมีกล่อง 3 ใบ มีตัวอักษร A B และ C จะมีกล่องแค่ใบเดียวเท่านั้นที่ภายในมีทองคำอยู่! และพิธีกรรู้ว่ามันคือใบไหน

Xmas-Gift-Box-4-by-Merlin2525.png   Xmas-Gift-Box-4-by-Merlin2525.png   Xmas-Gift-Box-4-by-Merlin2525.png
กติกานั้นเรียบง่ายมาก…ให้เราเลือกกล่องก่อน 1 ใบ แล้วพิธีกรซึ่งทราบดีว่ากล่องไหนมีทองคำ กล่องไหนไม่มี
จะเลือกกล่อง 1 ใบซึ่งไม่มีทองคำและไม่ใช่กล่องที่เราเลือก มาเปิดให้เราดู แล้วถามว่า เราจะเปลี่ยนกล่องไหม?
(สมมติเราเลือก A แล้วจริงๆทองอยู่ใน B พิธีกรก็จะเปิด C ให้ดูว่าว่างเปล่านะ แล้วเราจะมีสิทธิเลือกว่า เราจะยังคงเลือก A หรือจะเปลี่ยนมาเลือก B)

คำถามคือ
0) มีวิธีที่เราจะมีลุ้นได้ทองมากกว่า 50:50 หรือ 1/3 หรือไม่?
1) ถ้ามี เราจะมียุทธวิธีอย่างไรเพื่อให้มีโอกาสได้ทองคำสูงที่สุด?
2) และโอกาสที่เราจะได้ทองคำจากยุทธวิธีนี้คือเท่าไร?




ทั้งๆที่รู้เฉลยแล้ว ลองพิสูจน์ด้วยความน่าจะเป็นก็แล้ว พิสูจน์ด้วยมือตัวเองแล้วโดยการเขียนโปรแกรม simulation ผมก็ยังต้องยอมรับว่ามันช่างฝืนสัญชาตญาณเหลือเกิน แต่มันก็เป็นความจริงครับ
//ผมพบว่าใครที่งงตอนแรก ก็จะงงและรู้สึกค้านต่อไปจนจบเหมือนผม แต่ใครที่มองออกเลย มันก็…ออกเลยนะ

A.) เฉลยแบบความน่าจะเป็น
> ในกรณีที่ใบแรกเลือกถูก แล้วเรา “เลือกกล่องเดิมเสมอ”  โอกาสได้ทอง = 100%
แต่ถ้า “เปลี่ยนกล่องเสมอ” โอกาสได้ทอง = 0%
> ในกรณีที่เลือกผิด แล้วเรา “เลือกกล่องเดิมเสมอ” โอกาสได้ทอง = 0%
แต่ถ้า “เปลี่ยนกล่องเสมอ” โอกาสได้ทอง = 100%
> แต่ในความเป็นจริง โอกาสที่กล่องใบแรกเราเลือกถูก = 1/3 เลือกผิด =2/3
ดังนั้นถ้าเราใช้แผน “เลือกกล่องใบเดิมเสมอ” โอกาสได้ทองของเราก็คือ 1/3*100% + 2/3*0% = 1/3
ทำนองเดียวกัน ถ้าเรา “เปลี่ยนกล่องเสมอ” โอกาสได้ทองของเราก็คือ 1/3*0% + 2/3*100% = 2/3

ดังนั้น ไม่ว่าตาแรกจะเลือกอะไร ขอให้เราเปลี่ยนกล่องเสมอ เราจะมีโอกาสได้ทองคำ 2/3

B.) วิธี simulation

SetBox <- function(){ #คำสั่งให้เริ่มตั้งกล่อง
  x <- runif(1,0,3)
  if(x<1)return(c(T,F,F));
  if(x<2)return(c(F,T,F));
  if(x<3)return(c(F,F,T));
}

GamePlay <- function(BoxPattern,Quess,Stay){
#แสดงผลลัพธ์จาก กล่อง, การเดาครั้งแรก, และยุทธวิธีของคนเล่น
#Quess คือการเดา จงใจสะกดผิด ให้ไม่ตรงกับตัวแปร Guess ในโปรแกรมหลัก
#Stay = T ; to always stay the same box
#Stay = F ; to always change box
#return(คะแนน)
  if(BoxPattern[Quess]&amp;Stay) #ถ้าเดาถูก + คงกล่องเดิม
    return(1);
  if(BoxPattern[Quess]&amp;!Stay) #ถ้าเดาถูก + เปลี่ยนกล่อง
    return(0);
  if(!BoxPattern[Quess]&amp;Stay) #ถ้าเดาผิด + คงกล่องเดิม
    return(0);
  return(1); #แบบสุดท้าย เดาผิด +เปลี่ยนกล่อง
}
#Program หลัก
N<-1000 #ลองเล่น 1000 รอบ
pointA<-0 #คะแนนกรณีไม่เปลี่ยนกล่อง
pointB<-0 #คะแนนกรณีเปลี่ยนกล่อง
for(i in 1:N){
  NewBox <- SetBox() #ตั้งกล่องรอบใหม่
  Guess <- ceiling(runif(1,0,3)) #เดากล่อง 1ใน 3 ใบ
  pointA <- pointA+GamePlay(NewBox,Guess,Stay=T)
  pointB <- pointB+GamePlay(NewBox,Guess,Stay=F)
}

print(pointA/N)
print(pointB/N)
#ผลออกมาได้ 0.33 กับ 0.66 ตลอด!

สรุป ข้อคิดจากเรื่องนี้ก็คือ … ไม่มีนะ 555 แค่เบื่ออ่านวิชาการ เลยเปลี่ยน mode บ้างครับ

Advertisements