Версия для печати темы

Автор: So Slow 23.01.2008 21:51

Программа моделирует нормальное распределение и строит график, но как сделать, чтобы график автоматом маштабировался?

program Norm;
uses crt,graph;
type zap=record
         x,y:real
         end;
     masZ=array [1..1000] of zap;
var   rez,a,m,x:real;
            FrSV:masZ;
           GenSV:masZ;
          F1,F2:text;
        st1,st2:string;
      j,w,t,i,n:integer;
        h1,h2,h:real;
          con,d:real;
              u:integer;
       dt,dl,ch:array [1..5] of integer;
            ch1:array [1..5] of real;

procedure sort(var M:masZ);
var v:zap;
    k,i,j:integer;
begin
for i:=1 to (n-1) do
    begin
    k:=i;
    for j:=(i+1) to n do
    if M[j].x<M[k].x then k:=j;
    v:=M[i];
    M[i]:=M[k];
    M[k]:=v
    end
end;

procedure Grafiki;
var      k,e:integer;
     xk1,yk1:integer;
     xk2,yk2:integer;
           r:real;
begin
clrscr;
k:=Detect;
InitGraph(k,e,'C:\BP\BGI');

SetColor(1);
Line(29,0,29,450);
Line(29,450,639,450);

PutPixel(29,50,4);
PutPixel(29,450,4);
PutPixel(429,450,4);
PutPixel(229,450,4);
PutPixel(629,450,4);
setcolor(1);
setlinestyle(2,0,1);
line(29,50,639,50);
line(229,450,229,0);
line(429,450,429,0);
outtextxy(20,5,'Y');
outtextxy(630,455,'X');
outtextxy(25,455,'O');
outtextxy(20,45,'l');
outtextxy(433,440,'l');
setcolor(6);
outtextxy(29+round(400*m),455,'mat-ojid');
line(29+round(400*m),450,29+round(400*m),0);

SetBkColor(15);
r:=400;
SetLineStyle(0,0,2);
SetColor(3);
line(29,450,29+round(r*FrSV[1].x),450-round(r*FrSV[1].y));
for i:=2 to n do      {Teor.Sl.Vel}
begin
xk1:=29+round(r*FrSV[i-1].x);
yk1:=450-round(r*FrSV[i-1].y);
xk2:=29+round(r*FrSV[i].x);
yk2:=450-round(r*FrSV[i].y);
line(xk1,yk1,xk2,yk2);
end;

SetLineStyle(0,0,2);
SetColor(4);
line(29,450,29+round(r*GenSV[1].x),450-round(r*GenSV[1].y));
for i:=2 to n do      {Generir. Sl.Vel}
begin
xk1:=29+round(r*GenSV[i-1].x);
yk1:=450-round(r*GenSV[i-1].y);
xk2:=29+round(r*GenSV[i].x);
yk2:=450-round(r*GenSV[i].y);
line(xk1,yk1,xk2,yk2);
end;

readkey;
CloseGraph
end;


begin
clrscr;
randomize;
write('vvedite N => ');
readln(n);
write('vvedite mat.ojidanie m => ');
readln(m);
h:=1/n;
GenSV[1].y:=0;
for i:=1 to n do
begin
a:=-6;
for j:=1 to 12 do a:=a+random;
GenSV[i].x:=m+a*m/5;
end;
Sort(GenSV);
for i:=2 to n do
GenSV[i].y:=GenSV[i-1].y+h;

if GenSV[n].x>1 then h:=1.5/n
                else h:=1/n;
FrSV[1].x:=0;
FrSV[1].y:=0;
con:=5/(m*sqrt(2*pi));
for i:=2 to n do
begin
FrSV[i].x:=FrSV[i-1].x+h;
h1:=exp(-sqr(FrSV[i-1].x-m)/(2*sqr(m/5)));
h2:=exp(-sqr(FrSV[i].x-m)/(2*sqr(m/5)));
d:=(h1+h2)/2;
FrSV[i].y:=(h*d*con)+FrSV[i-1].y;
end;

writeln;
write('vvedite imja faila s sgenerir.sl.vel. => ');
readln(st1);
write('vvedite imja faila s teoret.znach. => ');
readln(st2);

assign(f1,st1);
rewrite(f1);
assign(f2,st2);
rewrite(f2);

for i:=1 to n do
begin
writeln(f1,GenSV[i].x:8:5,' ' ,GenSV[i].y:8:5);
writeln(f2,FrSv[i].x:8:5,' ',frSV[i].y:8:5)
end;

Grafiki;
close(F1);
close(F2);
end.

Автор: So Slow 24.01.2008 1:28

так...уже не надо, лучше скажите как принтскрин графика сделать?

Автор: volvo 24.01.2008 2:04

Автор: So Slow 24.01.2008 5:35

Цитата(volvo @ 23.01.2008 22:04)

uses graph, crt,bmp_plus;

const
  n1 = 2000;
  n = 20;
  h = 400;
  w = 500;
  dx = 0.0001;
  y0 = 450;

var
  m, sigma, mu : real;
  r, x : real;
  max, min : real;
  massX : array [1..n+1] of real;
  massY : array [1..n] of integer;

Function g(x : real) : real;
begin
  if(x >= 0) then
    g := mu*exp(-mu*x);
end;

Function f(x: real): real;
begin
  f := 1/(sigma*sqrt(2*pi))*exp(-sqr(x-m)/(2*sqr(sigma)));
end;

Procedure printF;
var
  y1, y2, x, temp, mx, my : real;
begin
  y1 := f(min);
  y2 := f(min);
  x := min;
  repeat
    temp := f(x);
    if temp < y1 then y1 := temp;
    if temp > y2 then y2 := temp;
    x := x + dx;
  until (x >= max);

  my := h / abs(y2) ;
  mx := w / abs(max - min);

  x := min;
  repeat
    temp := f(x);
    putpixel(40 + Round((x-min) * mx), y0 - Round(temp * my), green);
    x := x + dx;
  until (x >= (max));
  save_bmp(0,0,getmaxx,getmaxy,'1.bmp',0);
  readkey;
  closegraph;
end;

Procedure printG;
var
  y1, y2, x, temp, mx, my : real;
begin
  y1 := g(min);
  y2 := g(min);
  x := min;
  repeat
    temp := g(x);
    if temp < y1 then y1 := temp;
    if temp > y2 then y2 := temp;
    x := x + dx;
  until (x >= max);

  my := h / abs(y2) ;
  mx := w / abs(max - min);

  x := min;
  repeat
    temp := g(x);
    putpixel(40 + Round((x-min) * mx), y0 - Round(temp * my), green);
    x := x + dx;
  until (x >= (max));
   save_bmp(0,0,getmaxx,getmaxy,'2.bmp',0);
  readkey;

  closegraph;
end;

Procedure gistogram;
var
  maxY : real;
  x1: integer;
  x : real;
  y: integer;
  e, d : integer;
  i : integer;
  mx, my: real;
  x0: integer;
  s : string;

begin
  d := Detect;
  initgraph(d, e, '');

  maxY := massY[1];
  for i := 2 to n do
    if maxY < massY[i] then
      maxY := massY[i];

  my := h / maxY;
  mx := w / abs(max - min);

  setFillStyle(11, blue);
  setColor(blue);

  for i := 1 to n do
    begin
      if i = 1 then
        x1 := 40
      else
        x1 := x1+Round(r*mx);
      setColor(blue);
      bar(x1, y0 - Round(massY[i]*my), x1+Round(r*mx), y0);
      rectangle(x1, y0 - Round(massY[i]*my), x1+Round(r*mx), y0);
      setColor(white);
      Line(x1, y0-3, x1, y0+3);
    end;

  setColor(white);

  str(min:2:2, s);
  y := 40;
  Line(y, y0-3, y, y0+3);
  outTextXY(y, y0+5, s);

  str(max:2:2, s);
  y := 40 + n*Round(r * mx);
  Line(y, y0-3, y, y0+3);
  outTextXY(y, y0+5, s);

  if (min <= 0) AND (max >= 0) then
    begin
      x0 := 40 + Round(mx*abs(min));
      outTextXY(x0-10, y0+5, '0')
    end
  else
    if min > 0 then
      begin
        x0 := 30;
        outTextXY(x0-10, y0+5, '0');
      end
    else
      begin
        x0 := 40+w+50;
        outTextXY(x0+10, y0+5, '0');
      end;

  MoveTo(x0, y0+20);      {os Y}
  LineTo(x0, y0-h-20);
  MoveTo(20, y0);     {os X}
  LineTo(40+w+60, y0);
 save_bmp(0,0,getmaxx,getmaxy,'3.bmp',0);
  readkey;
end;

Procedure normalModeling;
var
  s : string;
  f : text;
  i, j : integer;
begin
  clrscr;
  assign(f, 'C:/1.txt');

  write('Input M(X) = ');
  readln(m);
  write('Input sigma = ');
  readln(sigma);

  rewrite(f);
  randomize;
  for i := 1 to n1 do
  begin
    x := 0;
    for j := 1 to 12 do
      begin
        r := random;
        x := x + r;
      end;
    x := x - 6;
    x := sigma*x + m;
    writeln(f, x:4:4);
  end;
  close(f);

  reset(f);
  readln(f, max);
  min := max;
  while(not EOLn(f)) do
    begin
      readln(f, x);
      if x > max then
        max := x;
      if x < min then
        min := x;
    end;
  close(f);
  writeln('max = ', max:4:4);
  writeln('min = ', min:4:4);

  readln;

  r := (max - min)/n;
  massX[1] := min;
  for i := 2 to n+1 do
    massX[i] := min + r*(i-1);

  for i := 1 to n do
    massY[i] := 0;

  for i := 2 to n+1 do
    begin
      reset(f);
      while not EOLn(f) do
        begin
          readln(f, x);
          if (massX[i-1] <= x) AND (x < massX[i]) then
            massY[i-1] := massY[i-1] + 1;
        end;
      close(f);
    end;

  reset(f);
  while not EOLn(f) do
    begin
      readln(f, x);
      if massX[n+1] = x then
        massY[n] := massY[n] + 1;
    end;
  close(f);

  rewrite(f);
  for i := 1 to n do
    begin
      str(massY[i], s);
      writeln(f, s);
    end;
  close(f);
end;

Procedure expModeling;
var
  s : string;
  f : text;
  i : integer;
begin
  clrscr;
  assign(f, 'C:/1.txt');

  write('Mu = ');
  readln(mu);

  rewrite(f);
  randomize;
  for i := 1 to n1 do
  begin
    r := random;
    x := (-1/mu)*ln(1-r);
    writeln(f, x:4:4);
  end;
  close(f);

  reset(f);
  readln(f, max);
  min := max;
  while(not EOLn(f)) do
    begin
      readln(f, x);
      if x > max then
        max := x;
      if x < min then
        min := x;
    end;
  close(f);
  writeln('max = ', max:4:4);
  writeln('min = ', min:4:4);

  readln;

  r := (max - min)/n;
  massX[1] := min;
  for i := 2 to n+1 do
    massX[i] := min + r*(i-1);

  for i := 1 to n do
    massY[i] := 0;

  for i := 2 to n+1 do
    begin
      reset(f);
      while not EOLn(f) do
        begin
          readln(f, x);
          if (massX[i-1] <= x) AND (x < massX[i]) then
            massY[i-1] := massY[i-1] + 1;
        end;
      close(f);
    end;

  reset(f);
  while not EOLn(f) do
    begin
      readln(f, x);
      if massX[n+1] = x then
        massY[n] := massY[n] + 1;
    end;
  close(f);

  rewrite(f);
  for i := 1 to n do
    begin
      str(massY[i], s);
      writeln(f, s);
    end;
  close(f);
end;

BEGIN
  normalModeling;
  gistogram;
  printF;
END.

Автор: volvo 24.01.2008 5:44

save_bmp(0,0,getmaxx,getmaxy,'2.bmp', 1); { <--- Ноль поменяй на 1 !!! }

Автор: So Slow 24.01.2008 5:55

сохраняются только 1.bmp и 3.bmp(черные), а 2.bmp не сохраняется вовсе что при 0, что при 1

Автор: volvo 24.01.2008 5:59

Не знаю, что ты там творишь, у меня только что сохранились нормально и 1 и 3 файлы (если надо - могу прикрепить), а второй не сохраняется по банальной причине - процедура PrintG (в которой и должно происходить сохранение) не вызывается в программе...

Автор: So Slow 24.01.2008 6:04

Цитата(volvo @ 24.01.2008 1:59)