Фундаментальные алгоритмы и структуры данных в Delphi
Шрифт:
Листинг 6.2. Базовый класс генератора случайных чисел
type
TtdBasePRNG = class private
FName : TtdNameString;
protected procedure bError(aErrorCode : integer;
const aMethodName : TtdNameString);
public
function AsDouble : double; virtual;
abstract;
{вернуть случайное число из диапазона от 0 включительно до 1 исключительно}
function AsLimitedDouble(aLower, aUpper : double): double;
{-вернуть
function AsInteger(aUpper : integer): integer;
{-вернуть случайное число из диапазона от 0 включительно до aUpper исключительно}
property Name : TtdNameString read FName write FName;
end;
function TtdBasePRNG.AsLimitedDouble(aLower, aUpper : double): double;
begin
if (aLower < 0.0) or (aUpper < 0.0) or (aLower >= aUpper) then
bError(tdeRandRangeError, 'AsLimitedDouble');
Result := (AsDouble * (aUpper - aLower)) + aLower;
end;
function TtdBasePRNG.AsInteger(aUpper : integer): integer;
begin
if (aUpper <= 0) then
bError(tdeRandRangeError, 'AsInteger');
Result := Trunc(AsDouble * aUpper);
end;
procedure TtdBasePRNG.bError(aErrorCode : integer;
const aMethodName : TtdNameString);
begin
raise EtdRandGenException.Create(
FmtLoadStr(aErrorCode,
[UnitName, ClassName, aMethodName, Name]));
end;
В листинге 6.2 приведен код базового класса генератора случайных чисел. В нем определен виртуальный метод AsDouble, который возвращает случайное число X в диапазоне 0< х< 1. Кроме того, в классе объявлены два простых метода, один из которых возвращает случайное число с плавающей запятой из заданного диапазона значений, а второй - из диапазона значений от 0 до некоторой заданной верхней границы (аналогично тому, как функция Random (Limit) использует целое значение Limit). Теперь, когда базовый класс определен, для реализации алгоритма Парка и Миллера можно объявить дочерний класс.
Листинг 6.3. Минимальный стандартный генератор псевдослучайных чисел
type
TtdMinStandardPRNG = class(TtdBasePRNG) private
FSeed : longint;
protected
procedure msSetSeed(aValue : longint);
public
constructor Create(aSeed : longint);
function AsDouble : double; override;
property Seed : longint read FSeed write msSetSeed;
end;
constructor TtdMinStandardPRNG.Create(aSeed : longint);
begin
inherited Create;
Seed := aSeed;
end;
function TtdMinStandardPRNG.AsDouble : double;
const
a = 16807;
m = 2147483647;
q = 127773; {равно m diva}
r = 2836; {равно m mod a}
OneOverM : double = 1.0 / 2147483647.0;
var
k : longint;
begin
k := FSeed div q;
FSeed := (a * (FSeed - (k * q))) - (k * r);
if (FSeed <= 0) then
inc( FSeed, m);
Result := FSeed * OneOverM;
end;
function GetTimeAsLong : longint;
{$IFDEF Delphi1}
assembler;
asm
mov ah, $2С
call DOS3Call
mov ax, cx end;
{$ENDIF}
{$IFDEF Delph2Plus}
begin
Result := longint(GetTickCount);
end;
{$ENDIF}
{$IFDEF KylixlPlus}
var
T : TTime_t;
begin
_time(@T);
Result := longint(T);
end;
{$ENDIF}
procedure TtdMinStandardPRNG.msSetSeed(aValue : longint);
const
m = 2147483647;
begin
if (aValue > 0) then
FSeed := aValue
else
FSeed := GetTimeAsLong;
{убедиться, что значение начального числа находится в переделах от 0 до m-1 включительно}
if (FSeed >=m-1) then
FSeed := FSeed - (m - 1) + 1;
end;
Как несложно заметить в коде метода AsDouble, метод Шрейга выглядит гораздо сложнее, нежели простая формула X(_n+1_) = aX(_n_) mod m со значениями а = 16807 и m = 2(^31^) - 1. Тем не менее, используя достаточно сложные математические выкладки, можно доказать его равенство приведенной формуле.
Кроме того, как уже упоминалось, в генераторе случайных чисел подобного типа использование нуля в качестве начального числа нежелательно, поскольку тогда бы все генерируемые значения были бы нулевыми. Поэтому метод msSetSeed использует значение 0 в качестве флага при необходимости установки начального числа по значению системных часов. К сожалению, для выполнения этой операции в 16- и 32-разрядных системах Windows используется разный код.
Создадим класс случайных чисел, который будет использовать системный генератор случайных чисел - функцию Random. В листинге 6.4 показан код метода AsDouble для такого класса.
Листинг 6.4. Использование в классе системной функции Random
function TtdSystemPRNG.AsDouble : double;
var
OldSeed : longint;
begin
OldSeed := System.RandSeed;
System.RandSeed := Seed;
Result := System.Random;
Seed := System.RandSeed;
System.RandSeed := OldSeed;
end;
Теперь, когда в нашем арсенале имеется два генератора случайных чисел, можно перейти к обсуждению методов тестирования их результатов.