Category Archives: math

ตัวอย่างการใช้ Mathematica ช่วยนับของให้ครับ

ที่หน้าคณิตศาสตร์นอกกะลา (https://www.facebook.com/mathsforlife32) มีคำถามว่า “มีช่องสี่เหลี่ยมจำนวน 6 ช่อง เรียงเป็นแนวเส้นตรง ถ้าต้องการทาสีช่องเหล่านี้ด้วยสีแดง สีขาว หรือสีดำ โดยจะทาสีแดงในช่องที่ติดกันไม่ได้ จงหาว่าจะมีวิธีทาสีได้ทั้งหมดกี่แบบ”

เนื่องจากผมขี้เกียจคิดผมเลยให้ Mathematica นับให้ดังนี้ครับ:

colors = {“R”, “W”, “B”} (*สีมีสามสี R, W, B*)
all = Tuples[colors, 6] (*ตอนนี้เอาสีมาทาเรียงกันหกตำแหน่ง*)
Length[all] (*จำนวนแบบของการทาสีทั้งหมด = 729*)
rr = Cases[all, {___, “R”, “R”, ___}] (*เลือกแบบที่มีสีแดงติดกัน*)
Length[rr] (*จำนวนแบบของการทาสีที่มีสีแดงติดกัน = 281 *)

ดังนั้นจำนวนการทาสีที่สีแดงไม่ติดกัน = 729 – 281 = 448

ถ้าจะดูว่าวิธีทาสีแบบสีแดงไม่ติดกันมีอย่างไรบ้างก็ใช้คำสั่งนี้ครับ:

Intersection[all, Complement[all, rr]] (*หาเซ็ท all – rr*)

ถ้าไม่มี Mathematica ก็เข้าไปใช้ Mathics (http://www.mathics.net/) ได้นะครับ Mathics เป็นโปรแกรมเสรี ฟรี ใช้คำสั่งเหมือนๆ Mathematica

1 กัป = กี่ปีเอ่ย (แก้ไขการคำนวณ)

ผมสงสัยว่าเวลาคนพูดว่าชั่วกัปชั่วกัลป์เขาหมายถึงเวลายาวแค่ไหนแน่เลยเคยคำนวณไว้ที่ https://witpoko.com/?p=448 เมื่อสี่ปีที่แล้ว วันนี้พึ่งมีคนมาทักว่าคำนวณผิด ผมเลยเข้ามาดูแล้วพบว่าผมคำนวณผิดจริงๆด้วย เลยมาคำนวณใหม่ครับ

ปล. พระไตรปิฎกถูกเขียนบันทึกหลังจากเวลาของพระพุทธเจ้าประมาณ 400-500 ปี ไม่แน่ใจว่าจำนวนศูนย์ในหลักตัวเลขต่างๆอาจจะหายหรืองอกในระหว่างเวลานั้นกี่ตัวเหมือนกันครับ พระอาจจำผิดพลาดก็ได้ ช่วงตัวเลขมันถึงห่างกันหลายเท่าเกินไป 🙂

จากวิธีนับกัป ใน Wikipedia:

(วิธีที่ 1) วิธีนับกัป กำหนดกาลว่านานกัปหนึ่งนั้น พึงรู้ด้วยอุปมาประมาณว่า มีขุนเขากว้างใหญ่สูงโยชน์หนึ่ง (16 กิโลเมตร) ถึง 100 ปีมีเทพยดาเอาผ้าทิพย์เนื้อละเอียดลงมาเช็ดถูบนยอดขุนเขานั้นหนหนึ่งแล้วก็ไป ถึงอีก 100 ปีจึงเอาผ้าลงมาเช็ดถูอีก นิยมอย่างนี้นานมาจนตราบเท่าขุนเขานั้นสึกเกรียนเหี้ยนลงมาราบเสมอพื้นพสุธาแล้ว กำหนดเป็น 1 กัป เมื่อนั้น

(วิธีที่ 2) อีกนัยหนึ่ง กำหนดด้วยประมาณว่า มีกำแพงเป็นสี่เหลี่ยมจตุรัสโดยกว้างลึกกำหนดหนึ่งโยชน์ ถึง 100 ปีมีเทพยดานำเมล็ดผักกาดมาหยอดลง 1 เม็ด เมล็ดผักกาดเต็มเสมอปากกำแพงนั้นนานเท่าใด จึงกำหนดว่าเป็น 1 กัป (ดูการประมาณความยาวนานใน อสงไขย)

จากวิธีที่ 1 เราต้องประมาณว่าการเอาผ้ามาเช็ดหินนั้น หินสึกลงไปเท่าไร สมมุติว่าหินสึกไปน้อยที่สุดเท่าที่จะสึกได้ ก็แสดงว่าหินสึกไปประมาณขนาดของอะตอม ตีว่าขนาดอะตอมประมาณ 1 อังสตรอม (หรือเท่ากับหนี่งส่วนสิบนาโนเมตร = 0.1/1,000,000,000 เมตร) แสดงว่าทุกร้อยปีหินจะสึกไปหนึ่งส่วนสิบนาโนเมตร ถ้าจะให้หินสึก 16 กิโลเมตร ( = 16,000 เมตร) ก็ต้องใช้เวลา = 100 ปี x 16,000 เมตร / (0.1/1,000,000,000) เมตร = 16,000,000,000,000,000 ปี หรือ 1.6 x 10^16 ปี หรืออ่านว่า หนึ่งหมื่นหกพัน ล้าน ล้านปี (หรือประมาณเท่ากับล้านเท่าอายุจักรวาล) เวลานี้จะเป็น upper boundคือ 1 กัป จะไม่เกิน หนึ่งหมื่นหกพันล้านล้านปี

ถ้าจะหา lower bound เราก็สมมุติว่าหินสึกเท่ากับยางรถยนต์สึกเมื่อหมุนไปบนถนน เราสังเกตว่ายางเส้นผ่าศูนย์กลาง 1/2 เมตร จะสึกประมาณ 1 เซ็นติเมตร เมื่อวิ่งไป 50,000 กิโลเมตร ถ้าทุกครั้งที่ยางกลิ้งไปบนพื้นแล้วยางสึกไป d เราจะได้ความสัมพันธ์ d x 50,000 ก.ม. = 1 ซ.ม. x (1/2) ม. x Pi (การคำนวณนี้เป็น lower bound เพราะหินไม่น่าจะสึกได้มากกว่ายางรถยนต์)

จะได้ว่า d = 3.14 อังสตรอม พอเราแทนค่าความสึกเข้าไปในการคำนวณ upper bound เราก็จะได้ lower bound = 5 พันล้านล้านปี = 5 x 10^15 ปี

หรือ 1 กัป อยู่ระหว่าง 0.5 ถึง 1.6 หมื่นล้านล้านปี จากวิธีที่ 1

จากวิธีที่ 2 ถ้าเราจะถมหลุมขนาด 16 ก.ม. x16 ก.ม. x 16 ก.ม. ด้วยเมล็ดผักกาด (ตีว่าขนาดประมาณ 0.5 ม.ม. x 0.5 ม.ม. x 0.5 ม.ม.) เราจะต้องใช้เมล็ดผักกาดประมาณ 3 x 10^22 เมล็ด  หรืออ่านว่า สามหมื่นล้านล้านล้านเมล็ด ถ้าแต่ละเมล็ดใช้เวลา 100 ปี ก็จะได้ว่า 1 กัป เท่ากับประมาณ 3 ล้าน ล้าน ล้าน ล้าน ปี

ปรากฎว่าวิธีที่ 1 และวิธีที่ 2 ต่างกัน 2 ร้อยล้านเท่า (ตาเหลือก)

— – —- – —– ———
ป.ล.

1. ถ้าจะให้วิธีที่ 2 ใกล้เคียงกับวิธีที่หนึ่ง เราต้องหาเมล็ดอะไรบางอย่างที่มีขนาดเส้นผ่าศูนย์กลางประมาณหนึ่งฟุต คงจะใช้มะพร้าวได้

2. ผมสงสัยมานานแล้วว่า คำว่ากัป นานเท่าไรกันแน่ วันนี้พึ่งทดลองหาใน Google เลยเห็นคำจำกัดความ ก็เลยลองคำนวณดู

สร้าง Bifurcation Diagram แบบง่ายๆ


พอดีมีนักเรียนตั้งกระทู้ถามเรื่องการวาดรูปเรื่อง Bifurcation Diagram เมื่อคืน ผมเลยทดลองวาดบน Mathematica เห็นว่าวิธีวาดง่ายดี เลยมาบันทึกไว้เผื่อมีใครค้นหาอีกในอนาคต ถ้าจะลองก็คัดลอกเอาไปลองได้เลย แล้วเปลี่ยนนู่นเปลี่ยนนี่เล่นดูเอง


(* กำหนด mapping ที่เราสนใจ อันนี้เรียกว่า logistic map *)
f[r_, x_] := r x (1 – x)

(* ทำการ iterate ด้วย ‘r’ ไป ‘iterations’ ครั้ง เริ่มด้วย ‘x0’ แล้วตัดมาดู ‘count’ ตัว *)
longtermValues[r_, count_, iterations_, x0_] :=
Map[{r, #} &, Take[NestList[f[r, #] &, x0, iterations], -count]]

(* เราเปลี่ยน r ตั้งแต่ 2.6 ไปจนถึง 4 โดยขยับทีละ 0.001 สำหรับแต่ละ r เรา iterate 500 ครั้งแล้วเอา 200 ตัวสุดท้่ายมาใช้ เราต้องใช้ Flatten[…,1] เพื่อให้คู่ลำดับทั้งหมดอยู่ในลิสท์ระดับเดียวกัน *)
allValues = Flatten[Table[longtermValues[r, 200, 500, 0.2], {r, 2.6, 4, 0.001}], 1];

(* วาดรูป *)
ListPlot[allValues, PlotStyle -> PointSize[0.001]]