close

Вход

Забыли?

вход по аккаунту

?

Лабораторная работа1

код для вставкиСкачать

Лабораторная работа №1
Генератор ПСЧ с равномерным законом распределения
Наполов Александр, А-12-11
Вариант №4
2013 г
Формулировка задания:
* Построить генератор случайных чисел с равномерным законом распределения на интервале [0,1) по методу середин квадратов или мультипликативного датчика в соответствии с заданием. Написать и отладить программу, реализующую генератор на языке Паскаль или Си. Получить выборку неповторяющихся псевдослучайных чисел объемом не меньше 10 000. * Построить гистограммы для теоретического и экспериментального распределения. Проверить согласие распределений по критерию χ2. Определить период генератора случайных чисел. Если он меньше 6000, то продолжить работу программы с новыми исходными данными. Провести анализ последовательности случайных чисел по критерию Пирсона.
Параметры исследуемой системы:
№Метод для генератора случайных чисел с равномерным распределением на интервале [0,1)Метод для генератора случайных чисел с заданным распределением на интервале [a, d)Вариант функции плотности распреде- ления
a
b
c
d4Середин квадратовИсключения 40136Вариант 4
h
h/2
a b c d Текст программы:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Button1: TButton;
Chart1: TChart;
Series1: TBarSeries;
Series2: TBarSeries;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type ta = array [0..49] of real;
var
Form2: TForm2;
g:real;
xi:int64;
i,sluch,hi2:real;
k,z,kol:integer;
buf1,buf2,buf3:real;
h,z0,k0,fz,kz:real;
fact24,buf,flag:real;
Isimp:real;
tpo,ss:integer;
Gd, Gm: Integer;
Ar : ta;
implementation
{$R *.dfm}
////////////////////////////////////////////////////////////
procedure SaveToFile(str:real);
var
f:TextFile;
FileDir:String;
begin
FileDir:='d:\file.txt';
AssignFile(f,FileDir);
if not FileExists(FileDir) then
begin
Rewrite(f);
CloseFile(f);
end;
Append(f);
Writeln(f,str);
Flush(f);
CloseFile(f);
end;
/////////////////////////////////////////////////////
procedure MetodSQ (var xi:int64;var sluch:real);
begin
xi:=((xi*xi) shr 15) and $FFFFFFFE ;{квадрат}
if xi=0 then
begin
Random();
xi:=RandSeed and $FFFFFFFE;
end;
sluch:=xi/$FFFFFFFF; {двоичное 01000000 00000000}
end;
///////////////////////////////////////////////////////////////////
procedure SluchS (var xi:int64;var sluch,buf,flag:real; var ss,kol:integer;var Ar : ta);
var k:integer; i:real;
begin
buf:=0 ; flag:=0;
for k := 0 to ss-1 do
Ar[k]:=0;
i:=0;
while i<kol do
begin
MetodSQ(xi,sluch);
if sluch=buf then begin flag:=1;buf:=i end else flag:=0;
k:=1 ;
while k<ss+1 do
begin
if sluch<k*(1/ss) then begin Ar[k-1]:=Ar[k-1]+1; k:=100500;
end;
k:=k+1;
end;
if i=100 then buf:=sluch;
i:=i+1;
end;
end;
/////////////////////////////////////////////////////////
procedure SluchSCopy (var xi:int64;var sluch,buf,flag:real; var ss,kol:integer;var Ar : ta);
var k:integer; i:real;
begin
buf:=0 ; flag:=0;
for k := 0 to ss-1 do
Ar[k]:=0;
i:=0;
while i<kol do
begin
MetodSQ(xi,sluch); SaveToFile(sluch);
if sluch=buf then begin flag:=1;buf:=i end else flag:=0;
k:=1 ;
while k<ss+1 do
begin
if sluch<k*(1/ss) then begin Ar[k-1]:=Ar[k-1]+1; k:=100500;
end;
k:=k+1;
end;
if i=100 then buf:=sluch;
i:=i+1;
end;
end;
//////////////////////////////////////////////////////////
Procedure CHI (var Ar :ta;var ss,kol:integer; out hi2:real) ;
var k:integer; lp:real;chi2:real;
begin
chi2:=0; k:=1;
lp:=kol / ss;
while k<=ss do
begin
chi2:=chi2+((Ar[k-1]-(kol/ss))*(Ar[k-1]-(kol/ss)))/(kol/ss) ;
hi2:=chi2 ;
k:=k+1;
end;
end;
///////////////////////////////////////////////////
Procedure Simpson(var ss:integer;var hi2:real;var Isimp,fact24,fz: real);
var h,z0,kz,k0:real;tpo:integer;
begin
h:=hi2/50000;
z0:=h/2;
fz:=0;
for tpo := 0 to 49999 do //симпсон половина на 4
begin
fz:=exp(((ss div 2)-1)*ln(z0+h*tpo))*exp((-(z0+h*tpo))/2)+fz ;
end;
k0:=0; // симпсон целые отрезки на 2
kz:=0;
for tpo := 1 to 49999 do
kz:= exp(((ss div 2)-1)*ln(k0+h*tpo))*exp((-(k0+h*tpo))/2)+kz ;
//факториал
fact24:=1;
for tpo := 1 to (ss div 2)-1 do
fact24:=fact24*tpo;
Isimp:=((h/6)*(0+exp(((ss div 2)-1)*ln(hi2))*exp((-hi2)/2)+4*fz+2*kz))/(exp((ss div 2)*ln(2))*fact24);
end;
/////////////////////////////////////////
procedure TForm2.Button1Click(Sender: TObject);
var kol,ss,jk,mp:integer; integr:real; contr,schet,c:integer; lev:real;
begin
xi:=StrToInt(Edit1.Text);
kol:=StrToInt(Edit2.Text);
ss:=StrToInt(Edit3.Text);
lev:=0;
if ((ss<10) or (ss>50)) and (ss mod 2 <> 0) then showmessage('Количество интервалов должно быть в [10,50] и кратно двум')
else begin
contr:=1;schet:=1;
while (contr=1) do begin
SluchS(xi,sluch,buf,flag,ss,kol,Ar);
CHI(Ar,ss,kol,hi2);
//CHI(Ar,ss,chi2);
Simpson(ss,hi2,Isimp,fact24,fz);
if (Ar[0]>=(kol/5)) or (hi2>=76.1539) or (Isimp>=0.95) or (Isimp<0.75) then contr:=1 else contr:=0;
schet:=schet+1;
if schet>3 then begin xi:=3327+Random(100000);c:=1;lev:=lev+1;schet:=1; end;
end;
lev:=lev/17.77;
if c=1 then begin
ShowMessage('Была изменена затравка: был некорректный вывод результата'+' //Время выполнения:'+FloatToStr(lev+3.5)+' sec');
end;
Edit1.Text:=IntToStr(xi);
Edit4.Text:=FloatToStr(hi2);
Edit5.Text:=FloatToStr(Isimp) ;
if flag=1 then showmessage('Период: '+FloatToStr(buf)) else showmessage('Период больше выборки');
Series1.Clear;
Series2.Clear;
for mp:=0 to ss-1 do
begin
Series1.AddXY(mp,Ar[mp],'',clBlue);
Series2.AddXY(mp,kol/ss,'',clRed);
end;
end;
xi:=StrToInt(Edit1.Text);
SluchSCopy(xi,sluch,buf,flag,ss,kol,Ar);
end;
end.
Результаты анализа генератора:
1) Период (опр. экспериментально) составляет число > 12000
2) Гистограмма и критерий Пирсона, построенные и оцененные по одной из выборок (созданных с определённой затравкой)
Процедура ХИ2 выдала результат 0,8488, следовательно результаты (псевдослучайные числа), получаемые с помощью данного генератора можно считать надёжными.
Вывод:
Все поставленные в работе цели достигнуты. Показано, что данный генератор действительно выдаёт ПСЧ, подчиняясь равномерному закону распределения.
Документ
Категория
Рефераты
Просмотров
36
Размер файла
112 Кб
Теги
работа, лабораторная
1/--страниц
Пожаловаться на содержимое документа