Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Pseudozufallszahlengenerator

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 20.03.2021, 13:29    Titel: Pseudozufallszahlengenerator Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:14, insgesamt 2-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 29.03.2021, 20:11    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:13, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 21.04.2021, 21:20    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:13, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 19.05.2021, 18:41    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:12, insgesamt 3-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 19.05.2021, 18:45    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:12, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 28.08.2021, 13:21    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:11, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 17.11.2021, 21:07    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:11, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 30.11.2021, 12:10    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:10, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 18.12.2021, 15:48    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:09, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 25.12.2021, 11:45    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:09, insgesamt 4-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 25.12.2021, 22:51    Titel: Antworten mit Zitat

gelöscht

Zuletzt bearbeitet von hhr am 11.02.2022, 10:08, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 01.02.2022, 22:53    Titel: Antworten mit Zitat

gelöscht
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 11.03.2022, 22:04    Titel: Antworten mit Zitat

Code:
Dim Shared As Ulong x32 = 314159265 ' Starting value, must be greater than zero

Function xorshift32 As Ulong ' https://en.wikipedia.org/wiki/Xorshift
   x32 Xor= (x32 Shl 13)
   x32 Xor= (x32 Shr 17)
   x32 Xor= (x32 Shl 5)
   Return x32
End Function

Dim Shared As Ulong x_lcg = 123456789 ' Starting value

Function lcg32_bad As Ulong ' https://en.wikipedia.org/wiki/Linear_congruential_generator
   x_lcg = x_lcg + 3567564561
   Return x_lcg
End Function

Function parity32(Byval n As Ulong) As Ulong ' https://en.wikipedia.org/wiki/Parity_bit
   n = n Xor (n Shr 16)
   n = n Xor (n Shr 8)
   n = n Xor (n Shr 4)
   n = n Xor (n Shr 2)
   n = n Xor (n Shr 1)
   Return n And 1
End Function

Function parity_extractor32 As Ulong ' https://en.wikipedia.org/wiki/Randomness_extractor
   Dim As Ulong i,k,result
'   lcg32_bad ' Reject one or more numbers to increase period length
   For i = 0 To 31
      k = lcg32_bad
      result = result Or (parity32(k) Shl i) ' If parity32(k) = 1 Then result = Bitset(result,i)
   Next i
   Return result
End Function

Function nextnumber32 As Ulong
   Return xorshift32 Xor parity_extractor32
End Function

'=================================================

Do
   Print Bin(nextnumber32,32)
Loop Until Getkey = 27 ' Esc

'-------------------------------------------------

'Chdir "Path to PractRand's RNG_test.exe" ' PractRand Version 0.94
Dim As String s = "RNG_test stdin32"
s &= " -tlmin 1KB"
's &= " -tlmaxonly"
Open Pipe s For Binary Access Write As #1
Do
   Put #1,,nextnumber32
Loop
'

Die Ausgabefolge von parity_extractor32 hat die Periodenlänge 134217728.
Um die Periodenlänge zu vergrößern, kann man Zahlen verwerfen, indem man Zeilen einfügt, die nur lcg32_bad enthalten:

0 x lcg32_bad: 134217728 = (2^32)/(2^5) = 2^27
1 x lcg32_bad: 4294967296 = 2^32
2 x lcg32_bad: 2147483648 = (2^32)/(2^1) = 2^31
3 x lcg32_bad: 4294967296 = 2^32
4 X lcg32_bad: 1073741824 = (2^32)/(2^2) = 2^30
5 X lcg32_bad: 4294967296 = 2^32
6 X lcg32_bad: 2147483648 = (2^32)/(2^1) = 2^31
7 X lcg32_bad: 4294967296 = 2^32
8 X lcg32_bad: 536870912 = (2^32)/(2^3) = 2^29

Allgemein läßt sich die Periodenlänge folgendermaßen berechnen:

a = Periodenlänge von lcg32_bad, hier 2^32
b = Stichprobenlänge in parity_extractor32, hier 32 = 2^5
c = Anzahl der verworfenen Zahlen
d = Periodenlänge am Ausgang von parity_extractor32

d = lcm(a,b+c)/(b+c)

lcm: Kleinstes gemeinsames Vielfaches

Um die größtmögliche Periodenlänge am Ausgang von parity_extractor32 zu erhalten,
muss die Anzahl der verworfenen Zahlen in diesem Beispiel lediglich ungerade sein.

--------------------------------------------------------------------------------

Die Periodenlänge von nextnumber32 ist das kleinste gemeinsame Vielfache der Periodenlängen von
xorshift32 und parity_extractor32. Die von xorshift32 erzeugte Folge hat die Periodenlänge (2^32)-1.
Wenn parity_extractor32 die Periodenlänge 2^32 hat, ist die Periodenlänge der von nextnumber32
ausgegebenen Folge ((2^32)-1) * (2^32) = (2^64) - (2^32).


Zuletzt bearbeitet von hhr am 28.04.2022, 07:40, insgesamt 2-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
hhr



Anmeldungsdatum: 15.07.2020
Beiträge: 72

BeitragVerfasst am: 11.04.2022, 20:58    Titel: Antworten mit Zitat

Code:
Function parity32(Byval n As Ulong) As Ulong
   n = n Xor (n Shr 16)
   n = n Xor (n Shr 8)
   n = n Xor (n Shr 4)
   n = n Xor (n Shr 2)
   n = n Xor (n Shr 1)
   Return n And 1
End Function

Function tsc32 As Ulong ' https://en.wikipedia.org/wiki/Time_Stamp_Counter
   Dim As Ulong ts
   Asm
'      cpuid ' Complete all preceding instructions (CPU IDentification)
      rdtsc ' Read time-stamp counter into EDX:EAX
      mov [ts],eax
   End Asm
   Return ts
End Function

Function vne32 As Ulong ' Von-Neumann extractor(tsc)
   Dim As Ulong i,k,rc,result
   Do
      i = tsc32
      For k = 0 To 30 Step 2
         If Bit(i,k) = Bit(i,k+1) Then
            Continue For
         Else
            If Bit(i,k) Then result = Bitset(result,rc)
            rc += 1
            If rc = 32 Then Return result
         End If
      Next k
   Loop
End Function

Function pe32 As Ulong ' Parity extractor(Von-Neumann extractor(tsc))
   Dim As Ulong k,result
   For k = 0 To 31
      result = result Or (parity32(vne32) Shl k)
   Next k
   Return result
End Function

Function nextnumber32 As Ulong
   Return pe32
End Function

'=================================================

Do
   Print Bin(nextnumber32,32)
Loop Until Getkey = 27 ' Esc

'-------------------------------------------------

'Chdir "Path to PractRand's RNG_test.exe" ' PractRand Version 0.94
Dim As String s = "RNG_test stdin32"
s &= " -tlmin 1KB"
's &= " -tlmaxonly"
Open Pipe s For Binary Access Write As #1
Do
   Put #1,,nextnumber32
Loop
'

Wenn rdtsc in kurzen Zeitabständen aufgerufen wird, unterscheiden sich die ausgegebenen Zahlen nur wenig.
Deshalb ist zum Testen anstelle der Funktion nextnumber32 folgendes verwendet worden:
Eine Anzahl von Zahlen wird in ein Array geschrieben. Die im Array gespeicherten Zahlen werden dann zyklisch ausgegeben.
Code:
Dim Shared As Ulongint i = 100000
Dim Shared As Ulong a(i)

For i = Lbound(a) To Ubound(a)
   a(i) = pe32
Next

Function nextnumber32 As Ulong
   If i > Ubound(a) Then i = Lbound(a)
   Function = a(i)
   i += 1
End Function

Wenn man die Zahlen von rdtsc aufsummiert, ist es schneller und sogar etwas besser:
Code:
Function parity32(Byval n As Ulong) As Ulong
   n = n Xor (n Shr 16)
   n = n Xor (n Shr 8)
   n = n Xor (n Shr 4)
   n = n Xor (n Shr 2)
   n = n Xor (n Shr 1)
   Return n And 1
End Function

Function tsc32 As Ulong
   Dim As Ulong ts
   Asm
      rdtsc
      mov [ts],eax
   End Asm
   Return ts
End Function

Function add32 As Ulong Static
   Dim As Ulong sum
   sum += tsc32
   Return sum
End Function

Function pe32 As Ulong
   Dim As Ulong k,result
   For k = 0 To 31
      result = result Or (parity32(add32) Shl k)
   Next k
   Return result
End Function

Function nextnumber32 As Ulong
   Return pe32
End Function

'=================================================

Do
   Print Bin(nextnumber32,32)
Loop Until Getkey = 27 ' Esc

'-------------------------------------------------

'Chdir "Path to PractRand's RNG_test.exe" ' PractRand Version 0.94
Dim As String s = "RNG_test stdin32"
s &= " -tlmin 1KB"
's &= " -tlmaxonly"
Open Pipe s For Binary Access Write As #1
Do
   Put #1,,nextnumber32
Loop
'
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz