วงกลมแห่งความตาย

จากที่มีคนถามปัญหาที่ http://www.pantip.com/cafe/wahkor/topic/X10570620/X10570620.html

มีชายหนึ่งล้านคนยืนกันเป็นวงกลม

ชายเหล่านี้ตั้งใจ จะฆ่าตัวตายหมู่ แต่เนื่องจากไม่มีใคร
กล้าฆ่าตัวตายจึงตกลงทำดังนี้ ให้ทุกคนล้อมเป็นวงกลม
จากนั้นให้เริ่มต้นที่คนแรก นำดาบฆ่าคนที่ 2
แล้วส่งดาบไปให้คนที่ 3 แล้วคนที่ 3 นำดาบนั้นฆ่าคนที่ 4
แล้วส่งดาบไปให้คนถัดไป ทำเช่นนี้ จนเหลือผู้รอดชีวิตอยู่คนเดียว
จึงค่อยฆ่าตัวตาย
ถ้าคุณบังเอิญอยู่ในกลุ่มคนพวกนี้ และเกิดไม่อยากถูกใครฆ่าขึ้นมา
คุณจึงพยายามไปยืนตำแหน่งที่จะเหลือรอดเป็นคนสุดท้าย
ถามว่าคุณจะไปยืนเป็นคนที่เท่าไหร่

 

เพื่อที่จะแก้ปัญหานี้แบบคนขี้เกียจผมก็ลองเขียนโปรแกรมโดยใช้ Mathematica ดูปรากฏว่าคำตอบที่ได้คือ

ต้องยืนที่ตำแหน่ง 951425

อันนี้โปรแกรมที่เขียนครับ

drp = Compile[{{ls, _Integer, 1}},
Select[ls, MemberQ[Drop[ls, {1, Length@ls, 2}], #] == False &]]

fn[ls_] :=
Module[{tmp}, tmp = drp[ls];(*Select[ls,MemberQ[Drop[ls,{1,Length@ls,
2}],#]==False&];*)
If[EvenQ[Length@ls], Developer`ToPackedArray@tmp,
Developer`ToPackedArray@RotateRight@tmp]
]

ls = Developer`ToPackedArray[Table[i, {i, 1, 10^6}]];

Nest[fn2, ls, 30]

{951425}

 

ซึ่งจริงๆแล้วปัญหานี้ก็คือรูปแบบหนึ่งของปัญหาที่เรียกว่า Josephus problem ครับ เราสามารถเขียนด้วย Mathematica

สั้นๆได้ตามนี้เลยครับ

Needs[“Combinatorica`”]
Last@InversePermutation[Josephus[10^6, 2]]
951425

 

ปล. อาจจะคำนวณนานหน่อยนะครับ 🙂