Скачиваний:
4
Добавлен:
02.05.2014
Размер:
2.64 Кб
Скачать
Uses Crt, Graph, Sprites, Keyboard, Math, Strings, Shifrs; //BmpRW,
label 1;
const Point_Count=640;
Sigma=0.6;
Count_Dis=10;
var
j, t, Gd, Gm: integer;
Fj:array[0..Point_Count] of real;
Dlina_Dis, xx:real;
n:array[0..Point_Count] of longint;
Sum_Teor, Sum_Prac:real;
// Bmp:BmpFile;

function RealToStr(A:real):string;
var S:string;
begin
S:='';
Str(A:9:9,S);
RealToStr:=S;
end;

function Teor(A,B:longint):Extended;
var Result,P: Extended;
ErrCode: Longint;
begin
P:=0;
for t:=A to B do
begin
Evaluate('('+IntToStr(t)+')^0.8', Result, ErrCode);
if ErrCode <> 0 then begin writeln('Invalid expression');bip;wait;end;
P:=P+1+2*Result*Exp(-2*Result-1);
end;
Teor:=P;
end;

function Time(j:longint):real;
var
Result: Extended;
ErrCode, Cod: Longint;
Value:Extended;
r_str:string;
begin
Value:=0;
Str(Ln(Fj[j]):9:9,r_str);
Evaluate(' (-'+r_str+'/2)^1.25 ', Result, ErrCode);
if ErrCode = 0 then
begin r_str:=Fls(Result); Val(r_str,Value,Cod); Time:=Value; end else
Writeln('Invalid expression');
end;

function x(j:longint):real;
begin
if (1-Fj[j]<>0) then x:=Sigma*SQRT(Ln(1/SQR(1-Fj[j])));
end;

function y(j:longint):real;
begin
y:=(x(j)/SQR(Sigma))*EXP(-SQR(x(j))/(2*SQR(Sigma)));
end;

function ProcPogr:real;
begin
Sum_Teor:=Teor(0,640);
Sum_Prac:=0;
for j:=0 to Count_Dis do
Sum_Prac:=Sum_Prac+Dlina_dis*n[j];
ProcPogr:=(Sum_Teor*100)/Sum_Prac;
end;

begin
SetSVGAMode(640,480,16,0);
MultiKeysInit;
// OBmp('bmp.bmp',Bmp);
// PutBmp(0,0,Bmp);
1:
ChangePage;
randomize;
FillChar(n, SizeOf(n), 0);

for j:=0 to Point_Count do
Fj[j]:=random;
Dlina_Dis:=Point_Count div Count_Dis;

for j:=0 to Point_Count do
begin
xx:=Time(j);
PutPixel(round(Fj[j]*600),round(GetMaxY-Time(j)*100),RGBColor(255,0,255));
for t:=0 to Count_Dis-1 do
if ((t*Dlina_Dis <= xx*300) and (xx*300 < (t*Dlina_Dis+Dlina_Dis) ))
then inc(n[t]);
end;

SetColor(RGBColor(0,255,0));
for t:=0 to Count_Dis do
Rectangle(round(t*Dlina_Dis),round(479-n[t]*3), round(t*Dlina_Dis+Dlina_Dis)-1,479);
Line(0,479,640,479,$FFF);
Line(0,479,0,0,$FFF);
SetBkColor($FFFF);
SetColor(0);
OutTextXY(10,10,'Teor='+RealToStr(Sum_Teor)+' Pract='+ RealToStr(Sum_Prac)+' Pogr='+ RealToStr(ProcPogr)+'%');
if TestKey(Esc_Scan) then halt;
if page then
begin
if page then if TestKey(Space_Scan) then wait;
//if TestKey(F1_Scan) then SaveFromScr('bmp5.bmp',Bmp,0,0,GetMaxX,GetMaxY);
end;
goto 1;
end.
Соседние файлы в папке Вейбуло-Гнеденко