ตัวอย่างการใช้ Mathematica แก้ปัญหาแบบง่ายๆ

พอดีมีคนถามว่า
จะหาจำนวนนับที่เล็กที่สุด ที่มีคุณสมบัติครบทั้ง 2 ข้อต่อไปนี้ได้ยังไงครับ???
I
(1) ขึ้นต้นด้วยเลข 1
(2) เมื่อสลับตัวเลขหลักแรก (ซึ่งก็คือ 1) กับตัวเลขหลักสุดท้าย แล้วจำนวนใหม่มีค่าเป็น 3 เท่าของจำนวนเดิม
II
(1) ขึ้นต้นด้วยเลข 1
(2) เมื่อย้ายตัวเลขหลักแรก (ซึ่งก็คือ 1) ไปต่อหลังตัวเลขหลักสุดท้าย แล้วจำนวนใหม่มีค่าเป็น 3 เท่าของจำนวนเดิม

(http://www.pantip.com/cafe/wahkor/topic/X11362457/X11362457.html)

อันนี้เป็นคำสั่ง Mathematica แบบง่ายๆ ที่ลองเขียนเพื่อแก้ปัญหานี้
I
swapInt1[tmp_Integer] := FromDigits@ ReplacePart[IntegerDigits[tmp], {1 -> Last@IntegerDigits[tmp], Length@IntegerDigits[tmp] -> First@IntegerDigits[tmp]}]
Catch[If[swapInt1@# == 3*#, Throw[#]] & /@ Range[1, 1000000, 1]]
คำตอบที่ได้จะเป็น Null ทั้งหมด นั่นหมายความว่ามันไม่มีคำตอบ
II
swapInt2[tmp__Integer] := FromDigits@RotateLeft@IntegerDigits@tmp

Catch[If[swapInt2@# == 3*#, Throw[#]] & /@ Range[1, 1000000, 1]]

คำตอบที่ได้คือ 142857
————————————————

จาก http://www.pantip.com/cafe/wahkor/topic/X11435196/X11435196.html

เราเรียก 6 28 496 8128….
ว่าเป็นจำนวนสมบูรณ์
เพราะมันมีคุณสมบัติที่น่าสนใจคือ
6     มีตัวประกอบแท้คือ 1,2,3
6  = 1+2+3
28   มีตัวประกอบแท้คือ 1,2,4,7,14
28  = 1+2+4+7+14 28 = 1+2+3+4+5+6+7
496 มีตัวประกอบแท้คือ 1,2,4,8,16,31,62,124,248
496 = 1+2+4+8+16+31+62+124+248
496 = 1+2+3+…+31

โดยตัวเลขพวกนี้ มันมีนิยามว่า มันอยู่ในรูป 2^n-1(2ⁿ-1) เมื่อ n เป็นจำนวนนับที่ทำให้  2ⁿ-1 เป็นจำนวนเฉพาะ ซึ่งจากนิยามนี้เองเราสามารถเขียนคำสั่ง Mathematica ง่ายๆเพื่อหาตัวเลขพวกนี้ได้ว่า

(# (# + 1))/2 & /@ Select[2^Range[100] – 1, PrimeQ]

(#(#+1))/2 นี้ได้มาจากการให้ (2ⁿ-1) = x –> 2ⁿ =x+1  ดังนั้น  2^n-1= (x+1)/2

——————————————
จาก
http://www.pantip.com/cafe/wahkor/topic/X11494743/X11494743.html
http://www.pantip.com/cafe/wahkor/topic/X11495190/X11495190.html

มีเลขอยู่หกหลักที่ไม่เหมือนกันซักตัว
เลขชุดนี้สามารถถอดรากที่สองได้เป็นจำนวนเต็ม
เมื่อกลับเลขชุดนี้ ก็จะยังถอดรากที่สองได้เป็นจำนวนเต็มเหมือนเดิม
เช่น MINTLA —> ถอดรากได้เป็นจำนวนเต็ม       ALTNIM —> ถอดรากได้เป็นจำนวนเต็ม
ถามว่า มีจำนวนใดบ้างที่เข้ากฏนี้และมีกี่จำนวน
ตัวอย่าง Mathematica code สำหรับปัญหานี้
(* ตั้งแต่ 3 – 10 หลัก แบบไม่ซ้ำ *)
For[i = 3, i <= 10, i++,
Print[“==”, i “==”];
num = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9};
test = Select[Permutations[num, {i}], #[[1]] != 0 &];
For[j = 1, j <= Length@test, j++,
If[FractionalPart@N@Sqrt@FromDigits@test[[j]] == 0 &&
FractionalPart@N@Sqrt@FromDigits@Reverse@test[[j]] == 0,
Print[FromDigits@test[[j]]]]
] ]

==3 ==
169
961
==4 ==
1089
9801
==5 ==
12769
96721
==6 ==
==7 ==
1238769
9678321
==8 ==
==9 ==
==10==

—————————–
http://www.pantip.com/cafe/wahkor/topic/X11514071/X11514071.html

ABCDEF แทนจำนวนใดได้บ้าง?
กำหนดให้
(1) ABCDEF แทนจำนวนซึ่งมี 6 หลัก
(2) ตัวอักษรแต่ละตัว แทนเลขโดด 1 – 9 ซึ่งอาจซ้ำกันได้
(3) AB ถอดรากที่สองแล้วได้จำนวนเต็ม
(4) CD ถอดรากที่สองแล้วได้จำนวนเต็ม
(5) EF ถอดรากที่สองแล้วได้จำนวนเต็ม
(6) ABCDEF ถอดรากที่สองแล้วได้จำนวนเต็ม

ตัวอย่างคำสั่ง Mathematica สำหรับปัญหานี้ครับ
num = {1, 2, 3, 4, 5, 6, 7, 8, 9};
test = Tuples[num, 6];

For[j = 1, j <= Length@test, j++,
If[FractionalPart@N@Sqrt@FromDigits@test[[j, # ;; # + 1]] & /@ {1, 3, 5} == {0, 0, 0} &&
FractionalPart@N@Sqrt@FromDigits@test[[j]] == 0,
Print[FromDigits@test[[j]]]]
]

166464
646416

——–

จาก http://www.pantip.com/cafe/wahkor/topic/X12638167/X12638167.html

 

ทำด้วย Mathematica

NestList[Total[IntegerDigits[#]^3] &, ตัวเลขที่หารด้วย 3 ลงตัว, จำนวนรอบจากข้อ (2-4) ]

เช่น เริ่มที่เลข 3 จำนวน 10 รอบ NestList[Total[IntegerDigits[#]^3]&, 3, 10]

{3, 27, 351, 153, 153, 153, 153, 153, 153, 153, 153}

หรือ เริ่มที่เลข 123345 (ตามตัวอย่าง) 10 รอบ NestList[Total[IntegerDigits[#]^3]&, 123345, 10]

{123345, 252, 141, 66, 432, 99, 1458, 702, 351, 153, 153}

มันมาหยุดอยู่ที่ 153