หากมีคำถาม ขอให้ไปโพสต์ลง เว็บบอร์ดจีทูจีเน็ตดอตคอม ตัวใหม่แทนน่ะครับ

หรือติดต่อเข้ามาทาง Inbox ที่ เฟซบุ๊ค ผมครับ

หน้าหลัก
ข่าวสาร - บทความ ทั้งหมด
VB 6/VB.Net
ASP/ASP.Net
จับฉ่ายคอมพิวเตอร์
เรียนรู้ผ่าน Flash Movie
บทความที่มีผู้ตอบล่าสุด  
 RSS Feeds
 ดาวน์โหลดโปรแกรม RSS Reader ได้ที่นี่ ...   Download โปรแกรม RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 4 5 6 5 5 5 6

7 ธันวาคม พ.ศ.2549
591 Users On-Line.
Visitors - Page views
 7 7 1 6 4 8 3
1 กุมภาพันธ์ พ.ศ.2551

Google   
เว็บ g2gnet.com
ขนาดตัวอักษร:  

โปรแกรมสุ่มตัวเลขจำนวนเต็มแบบไม่ให้ซ้ำกันเลย - Random Number

Category »  VB 6/VB.Net
โดย : Webmaster เมื่อ 6/8/2550 23:59:00
(อ่าน : 87436) 

อันที่จริงอัลกอริทึมตัวนี้ เดิมผมกะจะมานำเสนอในการทำ CAI (Computer Assisted Instruction) ด้วยโปรแกรม MS Visual Basic 6.0 โดยทำ ...

  1. แบบฝึกหัดการสุ่มตัวเลขออกมา เพื่อให้เด็กๆได้ทำการ + - * / (อันนี้รอบหน้าครับ เตรียมไว้แล้ว แต่ยังขาดคำอธิบายไป)
  2. โปรแกรมทำการสุ่มข้อสอบ (ของเดิมที่ทำไว้สมบูรณ์แบบมันเป็น DAO)
ซึ่งเรื่องนี้มีน้องๆที่กำลังทำโปรเจคการทำข้อสอบแบบสุ่ม (สงสัยเป็นโปรเจค 1000 ปีมั้ง) ได้ขอกันเข้ามาพอดี้พอดี และพอดี (อีกนั่นแหละ) ที่น้องๆเขาก็เป็นผู้หญิงทั้งนั้นด้วย เอ้า ประเดี๋ยวจะหาว่าผมเนี่ยใจจืด ใจดำ ไม่สงสารเด็กๆน้องๆ ตาดำๆเขา มันจะบาปกรรมซ่ะเปล่าน่ะ ... อิอิอิ ... อัลกอริทึมตัวนี้น่ะครับต้นฉบับเป็นของ Professor ชาวต่างชาติท่านนึง (น่าจะเป็น UK น่ะหากผมจำไม่ผิด) ซึ่งผมได้มาจากหนังสือ Visual Basic 3.0 ก็คิดดูแล้วกันว่ามันกี่ปีมาแล้วครับ ... พี่น้อง ... หนังสือเล่มไหนของผมที่ว่าดีๆมักจะถูก "ขอลืม" ไปเสมอแหละครับ รวมถึงเล่มนี้ด้วย ซึ่งในเวลานั้นผมก็พอที่จะไล่อัลกอริทึมตัวนี้ได้พอสมควร เพราะมีข้อมูลที่เป็นเอกสารประกอบด้วย แต่ตอนนี้บอกกันตรงๆ ... ไม่รู้เรื่องครับ อธิบายไม่ได้ แต่รู้วิธีการนำมาใช้งาน ...
เอาสำหรับเท่าที่จำได้ว่า หลักการของมันก็คือกำหนดค่าเริ่มต้น (Initialize) ของวันที่ กับ เวลาของ Timer หรือ นาฬิการะบบ ในแต่ละวันมาทำการสุ่ม (Random) เนี่ย ทำยังไงๆก็ไม่มีทางซ้ำกันได้เลย โดยใช้ฟังค์ชั่น RandShuffle(key$) ตัวนี้แหละครับนำร่องมาก่อน จำได้แค่นี้จริงๆครับ ... เหอๆๆๆๆ

 

   ดาวน์โหลด Source Code สำหรับ MS Visual Basic 6.0 - Service Pack 6

ผลลัพธ์จากการรันโปรแกรม รับรองครับไม่มีพลาด
ลองคิดดูเอาแล้วกันว่าหากสลับตัวเลข 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

จี ทู จี เน็ต ดอต คอม - g2gNet Dot Com
เลขทะเบียนพาณิชย์อิเล็กทรอนิกส์ 0407314800231
CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
Email: thongkorn@hotmail.com หรือ โทร. 08-6862-6560