Keskustelu: Koodit: VB6: Arpoo saman luvun vain kerran

Ohjelma arpoo taulukosta vuorotellen jokaisen luvun, muttei koskaan arvo samoja lukuja uudelleen. Keksin toimintaperiaatteen itse, mutta se on niin yksinkertainen, että joku on luultavasti keksinyt sen jo aikaisemmin.

Menetelmä on seuraava: Ensin arvotaan taulukkoon luvut. Sitten luodaan silmukka jota toistetaan niin monta kertaa kuin taulukossa on lukuja. Joka kierroksella arvotaan taulukosta yksi luku Rnd-funktiolla. Tämä luku voi olla väliltä 1-lukujen määrä. Joka kierroksella korkein mahdollinen luku pienenee yhdellä, joten jos lukuja olisi 200, ensimmäisellä kierroksella arvotaan luku väliltä 1-200, toisella väliltä 1-199, kolmannen väliltä 1-198 jne. Näin arvottavien lukujen ulkopuolelle kuitenkin jää aina taulukon viimeinen luku, mutta se ei haittaa sillä tuo luku kopioidaan juuri arvotun luvun paikalle, jolloin juuri arvottua lukua ei myöskään voi arpoa enää uudelleen.

Tässä esimerkissä visualisoidaan algoritmin toimintaa käyttämällä arvottavina lukuina ruudun koordinaatteja. Näin ohjelmaa piirtää ruudun täyteen satunnaisia pikseleitä, muttei koskaan arvo samaa pikseliä kahta kertaa.

Private Sub Form_Load()

Dim Pikseli(1 To 250000, 1 To 2) As Integer   'alustetaan

For y = 0 To 499
For x = 0 To 499
  i = i + 1
  Pikseli(i, 1) = x    'tallennetaan taulukkoon jokaisen pikselin koordinaatit
  Pikseli(i, 2) = y
Next x
Next y

Form1.Width = 8000
Form1.Height = 8000
Form1.Show            'näytetään formi
Form1.ScaleMode = 3     'pixelit käyttöön

For a = 250000 To 1 Step -1
  i = Int(Rnd * a) + 1         'arvotaan taulukosta pikseli
    PSet (Pikseli(i, 1), Pikseli(i, 2))    'piirretään pikseli

  Pikseli(i, 1) = Pikseli(a, 1)   'kopioidaan taulukon viimeinen pikseli
  Pikseli(i, 2) = Pikseli(a, 2)   'äsken piirretyn tilalle, jotta voidaan
                                  'huoletta poistaa viimeinen pikseli
Next a

End Sub

kävevä

Joo, juuri tällä tekniikalla kannattaa tehdä esim. lottonumeroiden arpominen.

Kätevä systeemi.

Keygenin alku. :p