จากที่มีคนถามปัญหาที่ 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
ปล. อาจจะคำนวณนานหน่อยนะครับ 🙂