algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Generator AWCG (Generator Dodawanie Z Przeniesieniem) - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 28 września 2008 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

AWCG - Delphi/AWCG.dpr:
//generowanie liczb pseudolosowych
//generator AWCG - Add With Carry Generator
//Generator Dodawanie Z Przeniesieniem
//www.algorytm.org (c) 2008 Tomasz Lubinski

program AWCG;
{$APPTYPE CONSOLE}
uses
  SysUtils;

const

// Definicje wspolczynnikow j, k oraz m
J = 24;
K = 55;
M = $FFFFFFFB; // 2^32-5

// Definicja wspolczynnika a dla generatora LCG dla zainicjowania tablicy
A = 69069;

var

// Tablica x - rejestr cykliczny oraz jej aktualny wskaznik
x: Array [0 .. K-1] of Int64;
i: Integer;

//Wartosc przeniesienia c
c: Integer;

ii, n : Integer;
seed: Int64;

// Zainicjuj tablice X - uzyj gneratora LCG o wspolczynnikach:
//m = 2^32-5, a = 69069, c = 0.
//dla takiego generatora wszystkie posrednie wyniki mieszcza sie w 49 bitach
procedure initX(seed: Int64);
var
   j: Integer;
begin

   x[0] := seed;
   for j:=1 to K-1 do
      x[j] := (A*x[j-1]) mod M;

   i := 0;
end;

// Generator AWCG
function genRand(): Int64;
begin

   result := (x[(K + i - J) mod K] + x[i] + c);
   if (result < M) then
      c := 0
   else
   begin
      result := result - M;
      c := 1;
   end;

   x[i] := result;
   i := (i + 1) mod K;

end;


begin

   writeln('Podaj wartosc poczatkowa ziarna (seed)');
   readln(seed);

   writeln('Podaj ile liczb pseudolosowych wylosowac');
   readln(n);

   initX(seed);

   for ii:=1 to n do
      writeln(genRand());

end.
Dodaj komentarz