' Visual Basic Mersenne-Twister ' Author: Carmine Arturo Sangiovanni ' carmine @ daygo.com.br ' daygo_gaming @ hotmail.com ' ' Aug 13,2004 ' ' based on C++ code ' ' ' Jan 4, 2010 ' rev1 ' bug fixes sent by Takano Akio (aljee @ hiper.cx) ' look for 'rev1:' to see changes Option Explicit Const N = 624 Const M = 397 Global mt(0 To N) As Currency Global mti As Currency Dim MATRIX_A As Currency Dim UPPER_MASK As Currency Dim LOWER_MASK As Currency Dim FULL_MASK As Currency Dim TEMPERING_MASK_B As Currency Dim TEMPERING_MASK_C As Currency Function tempering_shift_u(ty As Currency) tempering_shift_u = f_and(Int(ty / 2048@), FULL_MASK) End Function Function tempering_shift_s(ty As Currency) tempering_shift_s = and_ffffffff(ty * 128@) End Function Function tempering_shift_t(ty As Currency) tempering_shift_t = and_ffffffff(ty * 32768@) End Function Function tempering_shift_l(ty As Currency) tempering_shift_l = f_and(Int(ty / 262144@), FULL_MASK) End Function Function f_and(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_and = p1 And p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_and = p1 And (p2 - UPPER_MASK) End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_and = (p1 - UPPER_MASK) And p2 End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_and = (p1 - UPPER_MASK) And (p2 - UPPER_MASK) f_and = f_and + UPPER_MASK End If End Function Function f_or(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer Dim f As Boolean If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_or = p1 Or p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_or = p1 Or (p2 - UPPER_MASK) f_or = f_or + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_or = (p1 - UPPER_MASK) Or p2 'rev1: replaced 'And' with 'Or' f_or = f_or + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_or = (p1 - UPPER_MASK) Or (p2 - UPPER_MASK) 'rev1: replaced 'And' with 'Or' f_or = f_or + UPPER_MASK End If End Function Function f_xor(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer Dim f1 As Boolean, f2 As Boolean If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_xor = p1 Xor p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_xor = p1 Xor (p2 - UPPER_MASK) f_xor = f_xor + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_xor = (p1 - UPPER_MASK) Xor p2 f_xor = f_xor + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_xor = (p1 - UPPER_MASK) Xor (p2 - UPPER_MASK) End If End Function Function f_lower(ByVal p1 As Currency) 'rev1: added ByBal Do If p1 < UPPER_MASK Then f_lower = p1 Exit Do Else p1 = p1 - UPPER_MASK End If Loop End Function Function f_upper(ByVal p1 As Currency) 'rev1: added ByVal If p1 > LOWER_MASK Then f_upper = UPPER_MASK Else f_upper = 0 End If End Function Function f_xor3(p1 As Currency, p2 As Currency, p3 As Currency) Dim v As Currency Dim tmp As Currency Dim i As Integer Dim f As Integer If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then tmp = p1 Xor p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then tmp = p1 Xor (p2 - UPPER_MASK) tmp = tmp + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then tmp = (p1 - UPPER_MASK) Xor p2 tmp = tmp + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then tmp = (p1 - UPPER_MASK) Xor (p2 - UPPER_MASK) End If If (tmp < UPPER_MASK) And (p3 < UPPER_MASK) Then f_xor3 = tmp Xor p3 End If If (tmp < UPPER_MASK) And (p3 >= UPPER_MASK) Then f_xor3 = tmp Xor (p3 - UPPER_MASK) f_xor3 = f_xor3 + UPPER_MASK End If If (tmp >= UPPER_MASK) And (p3 < UPPER_MASK) Then f_xor3 = (tmp - UPPER_MASK) Xor p3 f_xor3 = f_xor3 + UPPER_MASK End If If (tmp >= UPPER_MASK) And (p3 >= UPPER_MASK) Then f_xor3 = (tmp - UPPER_MASK) Xor (p3 - UPPER_MASK) End If End Function Function and_ffffffff(ByVal c As Currency) 'rev1: added ByVal Dim e As Currency Dim i As Integer i = 32 Do e = 2 ^ (i + 16) Do While c >= e c = c - e Loop i = i - 1 Loop While i > 15 and_ffffffff = c End Function Sub random_init(seed As Currency) mt(0) = and_ffffffff(seed) For mti = 1 To N - 1 mt(mti) = and_ffffffff(69069 * mt(mti - 1)) Next mti End Sub Function Mersenne_twister_random(max As Integer) Dim kk As Integer Dim ty1 As Currency Dim ty2 As Currency Dim y As Currency Dim mag01(0 To 1) As Currency MATRIX_A = 2567483615@ '&H9908b0df UPPER_MASK = 2147483648@ '&H80000000 LOWER_MASK = 2147483647@ '&H7fffffff FULL_MASK = LOWER_MASK + UPPER_MASK '&Hffffffff TEMPERING_MASK_B = 2636928640@ '&H9d2c5680 TEMPERING_MASK_C = 4022730752@ '&Hefc60000 mag01(0) = 0@ mag01(1) = MATRIX_A If mti >= N Then If mti = N + 1 Then random_init 4537 End If For kk = 0 To (N - M) - 1 y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1))) mt(kk) = f_xor3(mt(kk + M), Int(y / 2@), mag01(f_and(y, 1))) Next kk For kk = kk To (N - 1) - 1 y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1))) mt(kk) = f_xor3(mt(kk + (M - N)), Int(y / 2@), mag01(f_and(y, 1))) Next kk y = f_or(f_upper(mt(N - 1)), f_lower(mt(0))) mt(N - 1) = f_xor3(mt(M - 1), Int(y / 2@), mag01(f_and(y, 1))) mti = 0 End If '--------------------------------------------------- y = mt(mti): mti = mti + 1 '--------------------------------------------------- y = f_xor(y, tempering_shift_u(y)) ty1 = f_and(tempering_shift_s(y), TEMPERING_MASK_B) y = f_xor(y, ty1) ty1 = f_and(tempering_shift_t(y), TEMPERING_MASK_C) y = f_xor(y, ty1) y = f_xor(y, tempering_shift_l(y)) '--------------------------------------------------- If max = 0 Then Mersenne_twister_random = 0 Else Mersenne_twister_random = Int(y / 32) Mod max End If End Function