Category Archives: Mathematica

หวยล็อก รถนายก ความน่าจะเป็น และ Bayesian Inference

 

มีเพื่อนใน Facebook แชร์ลิงค์จาก ThaiPublica ว่าเลขทะเบียนรถนายกตรงกับหวย 8 งวดจาก 63 งวด  (ทั้งหมดเป็นเลขท้ายสองและสามตัว หรือเลขท้ายรางวัลที่ 1) แปลว่าน่าจะมีการล็อคหรือไม่

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

รายละเอียดการคำนวณอยู่ที่ http://www.atriumtech.com/ko/mathematica/PooLottery/ ครับ

ตัวอย่างการใช้ 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

วัดความถี่เสียงด้วยไมโครโฟน คอมพิวเตอร์ และโปรแกรม Spectrum Analyzer และเล่นแก้วน้ำร้องเพลงกับเด็กอนุบาล

 

อัลบั้มภาพการเรียนการสอนอยู่ที่นี่ครับ

ถ้าสงสัยว่าไม่เห็นรูปหรือวิดีโอ เข้าไปดูที่เว็บ http://witpoko.com/ นะครับ ส่วนใหญ่ถ้าอ่านในเมล์จะไม่เห็นวิดีโอครับ

(คราวที่แล้วเรื่อง “ดูการ์ตูนการแกว่งลูกตุ้ม ดูสะพานแขวนพัง และเล่นแก้วน้ำร้องเพลง” ครับ)

วันอังคารที่ผ่านมานี้ผมไปสอนเด็กๆกลุ่มบ้านเรียนปฐมธรรม กลุ่มบ้านเรียนเฟิร์น และอนุบาลบ้านพลอยภูมิครับ สำหรับเด็กประถมวันนี้เราวัดความถี่เสียงด้วยไมโครโฟน แล้วเอาคลื่นเสียงที่บันทึกไปให้คอมพิวเตอร์วัดความถี่กันครับ สำหรับเด็กอนุบาลเราเล่นแก้วน้ำร้องเพลงที่เด็กประถมได้เล่นกันไปในครั้งที่แล้วครับ

ผมเอาแก้วร้องเพลงที่เราเล่นกันครั้งที่แล้วมาเล่นกันอีกครั้ง ผมให้เด็กๆดูแก้วที่ใส่น้ำไว้เกือบเต็มที่ผมใช้นิ้วเปียกๆถูปากแก้วจนเกิดการกำทอนมีเสียงดัง (เสียงดังเพราะนิ้วเราลากไปบนปากแก้วเหมือนคันซอสีสายซอครับ ทำให้ปากแก้วสั่นเป็นความถี่ธรรมชาติของมัน ถ้าเราใส่น้ำไว้ด้วยน้ำก็จะสั่นตามแก้วที่สั่นครับ) ให้เด็กๆสังเกตคลื่นในน้ำดังในคลิปเหล่านี้ครับ:

ต่อจากนั้นผมก็ถามเด็กๆว่ามีใครรู้ไหมว่าแก้วสั่นกี่ครั้งต่อวินาที เราไม่สามารถนับการสั่นได้เหมือนตอนเราทำการทดลองเกี่ยวกับการแกว่งของลูกตุ้มได้เพราะแก้วสั่นเร็วกว่าที่เราจะนับทันได้ ผมจึงบอกเด็กๆว่าเรามีวิธีอื่นๆมาช่วยเรานับการสั่นได้ Continue reading วัดความถี่เสียงด้วยไมโครโฟน คอมพิวเตอร์ และโปรแกรม Spectrum Analyzer และเล่นแก้วน้ำร้องเพลงกับเด็กอนุบาล

ดูการ์ตูนการแกว่งลูกตุ้ม ดูสะพานแขวนพัง และเล่นแก้วน้ำร้องเพลง

 

อัลบั้มภาพการเรียนการสอนอยู่ที่นี่ครับ

ถ้าสงสัยว่าไม่เห็นรูปหรือวิดีโอ เข้าไปดูที่เว็บ http://witpoko.com/ นะครับ ส่วนใหญ่ถ้าอ่านในเมล์จะไม่เห็นวิดีโอครับ

(คราวที่แล้วเรื่อง “(พยายาม)ติดตั้งลูกตุ้มความยาวต่างๆให้มันแกว่งสวยๆ” ครับ)

วันอังคารที่ผ่านมานี้ผมไปสอนเด็กๆกลุ่มบ้านเรียนปฐมธรรมและกลุ่มบ้านเรียนเฟิร์นมาครับ วันนี้เราดูวิดีโออนิเมชั่นของการแกว่งลูกตุ้มที่เราพยายามติดตั้งเมื่อครั้งที่แล้ว ดูการสั่นและพังของสะพาน และเอานิ้วถูปากแก้วให้เกิดการกำทอนมีเสียงดังครับ

เมื่อสัปดาห์ที่แล้วเด็กๆได้วัดความยาวลูกตุ้มให้มีความยาวต่างๆกันแล้วเอามาแขวนเรียงกันให้แกว่งเป็นรูปสวยงาม เนื่องจากความละเอียดในการวัดและการแขวนของเรามีไม่มากนัก รูปแบบการแกว่งของเราจึงสวยงามในระยะแรกๆแต่จะไม่สวยเมื่อเวลาผ่านไปสักพักครับ ผมจึงเอาภาพจำลองการแกว่งที่วาดด้วยคอมพิวเตอร์มาให้เด็กๆดูว่าถ้าเราทำการทดลองได้ละเอียดมากขึ้น การแกว่งจะสวยขึ้นอย่างไร:

วิดีโอข้างบนคือภาพลูกตุ้มความยาวขนาดต่างๆกันที่แกว่ง 51, 52, 53, … , 65 คร้้งต่อหน่วยเวลาใช้คำสั่ง Mathematica วาดดังนี้ครับ:

Animate[
 Show[
  Graphics[Line[{{-Pi/10, 0}, {Pi/10,0}, {Pi/10, -0.4}, {-Pi/10, -0.4}, {-Pi/10,0}}]],
  Graphics[Flatten[
    Table[{Disk[9.8/(2 Pi k/60)^2 {Sin[Pi/10 Cos[2 Pi k/60 t]], -Cos[Pi/10 Cos[2 Pi k/60 t]]},0.01],
      Line[{{0, 0},9.8/(2 Pi k/60)^2 {Sin[Pi/10 Cos[2 Pi k/60 t]], -Cos[Pi/10 Cos[2 Pi k/60 t]]}}]}, {k, 51, 65}]]
   ]
  ]
 , {t, 0, 60}]

เนื่องจากเราสามารถสั่งให้คอมพิวเตอร์วาดให้ดูได้ง่ายๆ เราก็เลยเพิ่มจำนวนลูกตุ้มเป็น 70 ลูกเสียเลย: Continue reading ดูการ์ตูนการแกว่งลูกตุ้ม ดูสะพานแขวนพัง และเล่นแก้วน้ำร้องเพลง

สร้าง 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]]

A Barnsley’s Fern In 7 Lines of Mathematica

I used to draw a Barnsley’s fern with a program written in Pascal when I was 19 years old. Yesterday someone asked about it in a forum I visited, so I drew another one using Mathematica. The code is much shorter this time. (I’m sure that many people can shorten it even more.)
Here’s the code to draw the fern with 10,000 points. You can copy and paste and run it in Mathematica:

          

ifsFern[p_] := Module[{i},
i = Random[Integer, 99];
If[i < 1, Return[{{0., 0.}, {0., .16}}.p ]];
If[i >= 1 && i < 86, Return[{{0.85, 0.04}, {-0.04, 0.85}}.p + {0., 1.6}]];
If[i >= 86 && i < 93, Return[{{0.20, -0.26}, {0.23, 0.22}}.p + {0., 1.6}]];
If[i >= 93, Return[{{-0.15, 0.28}, {0.26, 0.24}}.p + {0., 0.44}]]]


Graphics[{RGBColor[0, 0.5, 0], Point[NestList[ifsFern, {0, 0}, 10000]]}]


The result looks like this:

แก้สมการด้วยวิธีของนิวตัน

 
มีเด็กๆที่สนใจคณิตศาสตร์มาถามผมว่าสมการทั่วๆไปแก้ออกมาเป๊ะๆไม่ได้แล้วเราทำอย่างไร ผมก็บอกว่าสมการส่วนใหญ่เราต้องหาคำตอบด้วยการประมาณเอาครับ ซึ่งวิธีอันหนึ่งที่เราสามารถใช้ได้ง่ายๆก็คือวิธีของนิวตัน ข้างล่างนี้เป็นกระทู้ที่ผมเขียนไว้ที่ Mahidol Physics Educational Center ครับ:

******

สำหรับปัญหาที่เราแก้สมการโดยตรงไม่ได้ เราต้องแก้ด้วยวิธีประมาณด้วยตัวเลขครับ วิธีที่ใช้กันบ่อยๆวิธีหนึ่งก็คือวิธีการของนิวตัน (Newton’s method: http://en.wikipedia.org/wiki/Newton’s_method) ครับ

วิธีการของนิวตันบอกว่า ถ้าจะแก้สมการ f(x) = 0 ให้เราเดาค่า x มาสักค่า (เรียกมันว่า x0) ก็แล้วกัน แล้วค่า x อันต่อไป (เรียกมันว่า x1) ที่น่าจะทำให้ f(x) ใกล้ศูนย์มากขึ้น ควรจะคำนวณอย่างนี้ครับ:

x1 = x0 – f(x0)/f'(x0) โดยที่ f'(x) คือ derivative ของ f(x) ครับ

ถ้าค่า x1 ทำให้ f(x) ไม่ใกล้ 0 พอ เราก็หา x2, x3, x4, … ไปเรื่อยๆจนเราพอใจว่าค่า f(xn) ใกล้ 0 พอแล้ว โดยที่ xn หาได้จาก xn-1 ดังนี้ครับ:

xn = xn-1 – f(xn-1)/f'(xn-1)

ถ้าจะทำการคำนวณด้วยวิธีของนิวตันใน Mathematica สามารถทำอย่างนี้ครับ:

newtonSolve[f_, guess_, steps_] := NestList[ #1 – f[#1]/f'[#1] &, guess, steps]

f คือฟังค์ชั่นที่เราจะหา f(x) = 0
guess คือค่าที่เราเดาตอนแรกว่า f(guess) น่าจะไม่ห่างจาก 0 นัก
steps คือจำนวนครั้งที่เราจะทำการทำวิธีของนิวตันซำ้ๆกัน

ยกตัวอย่างเช่น เราจะหาค่ารูทที่สองของสอง เราก็เขียนสมการ f(x) = x^2 -2 = 0 ก่อน เพราะค่า x เท่ากับรูทที่สองของสองจะแก้สมการนั้นพอดี:

f[x_] := x^2 – 2

แล้วเราก็เรียก newtonSolve ด้วยฟังค์ชั่น f โดยเดาค่า guess = 1 และให้ทำซ้ำสักห้าครั้ง:

newtonSolve[f, 1, 5]

แล้วเราก็ได้ผลดังนี้: {1, 3/2, 17/12, 577/408, 665857/470832, 886731088897/627013566048}

Mathematica ทำการคำนวณให้เป็นค่าเศษส่วนไม่มีทศนิยม เพราะเราเดาด้วยค่า 1 ซึ่งเป็นจำนวนที่ไม่มีการประมาณเข้ามาเกี่ยวข้อง ถ้าเราต้องการคำตอบเป็นเลขทศนิยม เราก็ควรเดาด้วยค่า 1.0 ดังนี้:

newtonSolve[f, 1.0, 5]

แล้วเราก็จะได้ผลดังนี้: {1., 1.5, 1.41667, 1.41422, 1.41421, 1.41421} ซึ่งเราจะเห็นว่า 1.41421 นั้นเป็นค่าประมาณของรูทที่สองของสองได้ดีทีเดียว

นักศึกษาลองไปทดลองดูครับ

มีใครอยากลองอธิบายว่า newtonSolve[f_, guess_, steps_] := NestList[ #1 – f[#1]/f'[#1] &, guess, steps] ทำงานอย่างไรใน Mathematica ไหมครับ เป็นการฝึกความเข้าใจเรื่อง Pure function และ Functional programming ครับ

******

1, 11, 21, 1211, 111221 แล้วอะไรต่อไปเอ่ย

เฉลยที่นี่

ผมสงสัยว่าจำนวนหลัก (หน่วย สิบ ร้อย พัน …) ในพจน์ที่ N จะใหญ่ประมาณ 1.324N นั่นก็คือพจน์ที่ N จะยาวขึ้นเร็วมากๆๆๆ

เว็บตารางธาตุดีที่สุดในโลก (หรือน่าจะดีที่สุดในระบบสุริยะด้วย)

ถ้าคุณอยากรู้เรื่องเกี่ยวกับธาตุต่างๆ คุณต้องไปดูที่ The Elements คุณจะเห็นรูป ประวัติ วิธีผลิต ตัวอย่างการใช้งาน ข้อมูลเกี่ยวข้อง การแปรธาตุ และอื่นๆ

ผู้สร้างคือ Theodore Gray ซี่งเป็นผู้ร่วมก่อตั้งบริษัทที่สร้าง Mathematica เขาบอกคร่าวๆว่าเขาใช้ Mathematica อย่างไรในการผลิตเว็บอันนี้ที่นี่

ยกตัวอย่างเช่นถ้าคุณจะผลิตไฮโดรเจนคุณก็สามารถดูวิธีทำได้ที่นี่ หรือที่หน้านี้คุณจะได้รู้ว่าคุณไม่สามารถถ่ายรูปไอของไอโอดีนบนพื้นหลังสีดำได้เนื่องจากไอจะไม่สะท้อนแสง

This is another resource for my homeschooling project.