อันที่จริงอัลกอริทึมตัวนี้ เดิมผมกะจะมานำเสนอในการทำ CAI (Computer Assisted Instruction) ด้วยโปรแกรม MS Visual Basic 6.0 โดยทำ ...
- แบบฝึกหัดการสุ่มตัวเลขออกมา เพื่อให้เด็กๆได้ทำการ + - * / (อันนี้รอบหน้าครับ เตรียมไว้แล้ว แต่ยังขาดคำอธิบายไป)
- โปรแกรมทำการสุ่มข้อสอบ (ของเดิมที่ทำไว้สมบูรณ์แบบมันเป็น DAO)
ซึ่งเรื่องนี้มีน้องๆที่กำลังทำโปรเจคการทำข้อสอบแบบสุ่ม (สงสัยเป็นโปรเจค 1000 ปีมั้ง) ได้ขอกันเข้ามาพอดี้พอดี และพอดี (อีกนั่นแหละ) ที่น้องๆเขาก็เป็นผู้หญิงทั้งนั้นด้วย เอ้า ประเดี๋ยวจะหาว่าผมเนี่ยใจจืด ใจดำ ไม่สงสารเด็กๆน้องๆ ตาดำๆเขา มันจะบาปกรรมซ่ะเปล่าน่ะ ... อิอิอิ ... อัลกอริทึมตัวนี้น่ะครับต้นฉบับเป็นของ Professor ชาวต่างชาติท่านนึง (น่าจะเป็น UK น่ะหากผมจำไม่ผิด) ซึ่งผมได้มาจากหนังสือ Visual Basic 3.0 ก็คิดดูแล้วกันว่ามันกี่ปีมาแล้วครับ ... พี่น้อง ... หนังสือเล่มไหนของผมที่ว่าดีๆมักจะถูก "ขอลืม" ไปเสมอแหละครับ รวมถึงเล่มนี้ด้วย ซึ่งในเวลานั้นผมก็พอที่จะไล่อัลกอริทึมตัวนี้ได้พอสมควร เพราะมีข้อมูลที่เป็นเอกสารประกอบด้วย แต่ตอนนี้บอกกันตรงๆ ... ไม่รู้เรื่องครับ อธิบายไม่ได้ แต่รู้วิธีการนำมาใช้งาน ... เอาสำหรับเท่าที่จำได้ว่า หลักการของมันก็คือกำหนดค่าเริ่มต้น (Initialize) ของวันที่ กับ เวลาของ Timer หรือ นาฬิการะบบ ในแต่ละวันมาทำการสุ่ม (Random) เนี่ย ทำยังไงๆก็ไม่มีทางซ้ำกันได้เลย โดยใช้ฟังค์ชั่น RandShuffle(key$) ตัวนี้แหละครับนำร่องมาก่อน จำได้แค่นี้จริงๆครับ ... เหอๆๆๆๆ
ผลลัพธ์จากการรันโปรแกรม รับรองครับไม่มีพลาดลองคิดดูเอาแล้วกันว่าหากสลับตัวเลข 1-100 จะมีความเป็นไปได้ในการจัดเรียงมากน้อยแค่ไหนตัวเลขที่สุ่ม = Int((ค่าสูงสุด - ค่าต่ำสุด + 1) * Rnd + ค่าต่ำสุด) แบบนี้ใช้ไม่ได้เลยครับในครั้งกระโน้นผมลองทำมาหลายวิธี แต่ทุกครั้งจะพบกับการ LOOP แบบ Dead Lock เสมอ
สำหรับน้องๆครับ การทำโปรแกรมสุ่มข้อสอบนั้นหัวใจสำคัญที่สุดมันก็คือเรื่องนี้แหละครับ ส่วนเรื่องของฐานข้อมูลนั้นมันกลายเป็นเรื่องเด็กๆไปเลย
ส่วนประกาศไว้ใน Module
'Array of long integers for generating all random numbers
Dim r&(1 To 100)
Function Rand&()
'Get pointers into table
i% = r&(98)
j% = r&(99)
'Subtract the two table values
t& = r&(i%) - r&(j%)
'Adjust result if less than zero
If t& < 0 Then
t& = t& + 1000000000
End If
'Replace table entry with new random number
r&(i%) = t&
'Decrement first index, keeping in range 1 through 55
If i% > 1 Then
r&(98) = i% - 1
Else
r&(98) = 55
End If
'Decrement second index, keeping in range 1 through 55
If j% > 1 Then
r&(99) = j% - 1
Else
r&(99) = 55
End If
'Use last random number to index into shuffle table
i% = r&(100) Mod 42 + 56
'Grab random number from table as current random number
r&(100) = r&(i%)
'Put new calculated random number into table
r&(i%) = t&
'Return random number grabbed from table
Rand& = r&(100)
End Function
Function RandInteger%(a%, b%)
RandInteger% = a% + (Rand&() Mod (b% - a% + 1))
End Function
Sub RandShuffle(key$)
'Form 97-character string, with key$ as part of it
tmp$ = Left$("Abracadabra" + key$ + Space$(86), 97)
'Use each character to seed table
For i% = 1 To 97
r&(i%) = Asc(Mid$(tmp$, i%, 1)) * 8171717 + i% * 997&
Next i%
'Preserve string space
tmp$ = ""
'Initialize pointers into table
i% = 97
j% = 12
'Randomize table to get it warmed up
For k% = 1 To 997
'Subtract entries pointed to by i% and j%
r&(i%) = r&(i%) - r&(j%)
'Adjust result if less than zero
If r&(i%) < 0 Then
r&(i%) = r&(i%) + 1000000000
End If
'Decrement first index, keeping in range 1 through 97
If i% > 1 Then
i% = i% - 1
Else
i% = 97
End If
'Decrement second index, keeping in range 1 through 97
If j% > 1 Then
j% = j% - 1
Else
j% = 97
End If
Next k%
'Initialize pointers for use by Rand& function
r&(98) = 55
r&(99) = 24
'Initialize pointer for shuffle table lookup by Rand& function
r&(100) = 77
End Sub
|
โค้ดตัวอย่าง (จริงๆ) ในการเรียกใช้งาน
Option Explicit
Dim MAXNUM As Integer ' จำนวนตัวเลขสูงสุด
Dim Flag()
Dim TempRandom() ' เก็บไว้ทดสอบไม่ให้มีค่าซ้ำ
Dim TempRandomAll() ' สุ่มตัวเลขออกมาทั้งหมด
Dim blnFlag As Boolean
Private Sub Form_Load()
txtRandom.Text = ""
txtMax = ""
End Sub
Private Sub cmdRandom_Click()
If Trim(txtMax.Text) = "" Or Len(Trim(txtMax.Text)) = 0 Then Exit Sub
MAXNUM = txtMax.Text
' สุ่มค่าเริ่มต้นก่อน
RandShuffle Date$ + Time$ + Str$(Timer)
'
Call RandomNew
' อันนี้ไม่มีอะไรครับ เลื่อนตำแหน่งตามการแสดงผลของ TextBox เท่านั้นเอง
txtRandom.SetFocus
SendKeys "^{End}"
End Sub
Private Sub Timer1_Timer()
Dim k As Variant
Dim n As Integer
Dim i As Integer, j As Integer
ReDim Flag(MAXNUM)
ReDim TempRandom(MAXNUM)
ReDim TempRandomAll(MAXNUM)
' ตรวจสอบทุกครั้งที่มีการสุ่ม
For i = 1 To MAXNUM
' Flag is True if already random and fix Vaule
If Flag(i) = False Then
'Generate unique number
Do
'Generate any number in range
n = RandInteger(1, MAXNUM)
'Previously grabbed?
blnFlag = True
For j = 1 To i
k = TempRandomAll(j)
If j < i And n = k Then
blnFlag = False
Exit For
End If
Next
'Grab only if number is unique
If blnFlag = True Then
TempRandom(i) = n
TempRandomAll(i) = n
End If
Loop Until blnFlag = True
End If
Next
End Sub
Sub RandomNew()
Dim i As Integer
ReDim TempRandom(MAXNUM)
' Trig Timer
Timer1_Timer
' ส่วนนี้แหละครับที่นำไปใช้งานได้เลย
For i = 1 To MAXNUM
txtRandom.Text = txtRandom.Text & " " & TempRandomAll(i)
Next i
' นำไปแสดงผลใน TextBox
txtRandom.Text = txtRandom.Text & vbCrLf
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub txtRandom_KeyPress(KeyAscii As Integer)
' ไม่รับการกดคีย์ใดๆ
KeyAscii = 0
End Sub
Private Sub txtMax_KeyPress(KeyAscii As Integer)
KeyAscii = CheckDigitOnly(KeyAscii)
End Sub
' ฟังค์ชั่นตรวจการกดคีย์ให้รับค่าเฉพาะตัวเลขเท่านั้น
Function CheckDigitOnly(Index As Integer) As Integer
Select Case Index
Case 48 To 57 ' 0 - 9
Case 8 ' Back Space
Case 13 ' Enter
Case Else
Index = 0
End Select
CheckDigitOnly = Index
End Function
|
|