Хід роботи
Завантажити середовище Турбо Паскаль.
Набрати текст програми по побудові ізоліній
program Izolines;
uses crt,graph,serv;
const Hiz: real=0.2;
Mi: integer=30000;
Nvr: integer=1;
var a: coef;
procedure HorComp(a: Coef; R,I: real; var Re,Im: real);
var R1: real;
n,s: integer;
begin
n:=round(a[-1]); Re:=a[n]; Im:=0;
For s:=n-1 downto 0 do
begin
R1:=Re*R-Im*I+a[s];
Im:=Re*I+Im*R;
Re:=R1;
end;
end;
Function Fxy(x,y: real):real;
var Re,Im: real;
begin
case Nvr of
1: Begin
HorComp(a,x,y,Re,Im);
Fxy:=sqrt(sqr(Re)+sqr(Im));
end;
2: Fxy:=sqr(sin(x))+sqr(cos(y));
3: Fxy:=1-cos(Pi*x)/2+sqr(y);
end;
end;
procedure Izo;
var Nr,s,z: integer;
Nrr: real;
Mnr: array[-1..800]of integer;
begin
for z:=-1 to H0 do
begin
Nrr:=Fxy(Xmin-Dx,Ymin+Z*Dy)/Hiz;
if abs(Nrr)>Mi then mNr[z]:=Mi
else mnr[z]:=trunc(Nrr);
end;
for s :=0 to L0 do
begin
x:=xmin+s*dx;
for z:=-1 to H0 do
begin
nrr:=fxy(x,ymin + z *dy)/hiz;
If abs(nrr)>Mi then Nr:=Mi
else Nr:=trunc(Nrr);
If z>-1 then
begin
if (Nr<>Mnr[z-1])or(Nr<>Mnr[z]) then
if abs(Nrr)<Mi then
PutPixel(Xu+s,Yu+H0-z,{round(abs(nrr))mod 16} 15);
if abs(Nrr)<1 then
if (Nrr*Mnr[z-1]<0)or(Nrr*Mnr[z]<0) then
PutPixel(xu+s,yu+h0-z,round(abs(Nrr)mod 16);
end;
Mnr[z]:=Nr;
end;
end;
end;
Function Radius(A: coef): real;
var s,n: integer;
b: real;
begin
n:=round(A[-1]);
b:=abs(a[0]);
for s:=1 to n-1 do
if abs(a[s])>b then b:=abs(a[s]);
radius:=1+b/(abs(a[n]));
end;
procedure Diap;
begin
repeat
PutA; Ou('0-exit,1-Xmin,2-xmax,3-Ymin,4-Ymax');
if Nvr=1 then
begin
x:=Radius(a);
str(x:1:3,t10);
Ts:='Radius='+t10+' ';
end
else Ts:=' ';
str(Xmin:1:3,T10); Ts:=Ts+',Xmin='+T10;
str(Xmax:1:3,T10); Ts:=Ts+', Xmax='+T10;
str(Ymin:1:3,T10); Ts:=Ts+', Ymin='+T10;
str(Ymax:1:3,T10); Ts:=Ts+', Ymax='+T10;
info; j:=readkey;
case j of
'1': Our('Xmin',Xmin);
'2': Our('Xmax',Xmax);
'3': Our('Ymin',Ymin);
'4': Our('Ymax',Ymax);
end;
until j='0';
end;
Procedure InpPol(Id: string; var A: Coef);
Var s, n: Integer;
Begin
Oui('n-step pol',n);
A[-1] := n;
For s := 0 to n do
Begin
Str(s, T10);
Our(Id+'['+T10+']',A[s])
end
End;
begin
Xmin:=-2; Xmax:=2; Ymin:=-2; Ymax:=2; c:=15;
A[-1]:=5; A[0]:=1; a[5]:=1;
for s:=1 to 4 do A[s]:=0;
repeat
PutA; Ou('Esc-exit,1-Nvr,2-InpPol,3-L,4-H,5-Diap,6-Hiz,7-Clear,8-SC,9-Izo');
Str(Nvr,t10); Ts:='Nvr='+t10;
Str(L,t10); Ts:=Ts+', L='+t10;
Str(H,t10); Ts:=Ts+', H='+t10;
Str(Hiz:1:2,t10); Ts:=Ts+', Hiz='+t10;
Info; J:=readkey;
case J of
'1': oui('Nvr',nvr);
'2': InpPol('A',A);
'3': oui('L', L);
'4': oui('H',h);
'5': Diap;
'6': Our('Hiz',Hiz);
'7': Cleardevice;
'8': begin
X0Y0(true);
systcoor;
end;
'9': Izo;
end;
until J=#27;
end.
Перенести в протокол результати побудови 3-х варіантів (Nvr)
Звіт повинен містити назву роботи, мету, короткі теоретичні відомості, тексти виконуваної програми п.2, результати побудови ізоліній в залежності від значення параметра Nvr.
Контрольні запитання
1. Пояснити механізм роботи процедури HorComp.
2. Пояснити механізм роботи процедури InpPol.
3. Пояснити механізм роботи функції Radius.
4. Пояснити механізм роботи процедури Izo.
Лабораторна робота №6
Побудова рельєфа.
Мета роботи : Дослідити побудову зображення рельєфа функції, використовуючи графічний режим в Турбо Паскалі.
Теоретичні відомості
Уявлення про особливості рельєфу поверхні функції двох змінних Z=f(X,Y) можна одержати, сформувавши на екрані комп‘ютера зображення системи перетинів цієї поверхні площинами, перпендикулярними осям x та (чи) y. Для більшої зручності будемо розглядати варіант, коли користувачеві програми, що формує подібне зображення, надається можливість за своїм бажанням змінювати орієнтацію досліджуваної поверхні відносно спостерігача.
Розрахункова схема поворотів зображення об’єкта. U, v, w – кути повороту.
Cистема співвідношень
Екранні
координати
Хід роботи
Завантажити середовище Турбо Паскаль.
Набрати текст програми по побудові рельєфа
Program Relief;
uses Crt,Graph,Serv;
const
Nvr:integer=1;
Nx:integer=20;
Ny:integer=20;
U:integer=20;
V:integer=30;
W:integer=0;
Rx:integer=100;
Ry:integer=120;
Rz:integer=100;
D:integer=500;
Nmax=40;
var Xs,Ys,Zs,Kx,Ky,Kz,Zmin,Zmax:real;
Mo:array[0..Nmax,0..Nmax] of real;
Mxe,Mye:array[0..Nmax,0..Nmax] of integer;
E:Coef;
function Fxy (x,y:real):real;
begin
case Nvr of
1:Fxy:=0.5*(1-cos(Pi*x)+2*sqr(y));
2:Fxy:=sin(x)*sqr(cos(y));
3:Fxy:=exp(y*ln(abs(x)+0.2));
end
end;
procedure FormMo;
var f,x,y,Dx,Dy:real;
z,s:integer;
begin
Dx:=(Xmax-Xmin)/Nx; Dy:=(Ymax-Ymin)/Ny;
Zmin:=Fxy(Xmin,Ymax); Zmax:=Zmin;
for z:=0 to Ny do
begin
y:=Ymin+z*Dy;
for s:=0 to Nx do
begin
x:=Xmin+s*Dx;
f:=Fxy(x,y); Mo[s,z]:=f;
if f<Zmin then Zmin:=f;
if f>Zmax then Zmax:=f;
end;
end;
Xs:=(Xmin+Xmax)/2; Kx:=(Xmax-Xmin)/Rx;
Ys:=(Ymin+Ymax)/2; Ky:=(Ymax-Ymin)/Ry;
Zs:=(Zmin+Zmax)/2; Kz:=(Zmax-Zmin)/Rz;
end;
procedure Coefs;
var x,sinu,cosu,sinv,cosv,sinw,cosw:real;
begin
x:=U*Pi/180; sinu:=sin(x); cosu:=cos(x);
x:=V*Pi/180; sinv:=sin(x); cosv:=cos(x);
x:=W*Pi/180; sinw:=sin(x); cosw:=cos(x);
E[1]:=cosu*cosv;
E[2]:=-sinu*cosv;
E[3]:=sinv;
E[4]:=sinu*cosw+cosu*sinv*sinw;
E[5]:=cosu*cosw-sinu*sinv*sinw;
E[6]:=-cosv*sinw;
E[7]:=sinu*sinw-cosu*sinv*cosw;
E[8]:=cosu*sinw+sinu*sinv*cosw;
E[9]:=cosv*cosw;
end;
procedure FormMe;
var Kp,f,x,y,x3,y3,z3,Dx,Dy:real;
s,z:integer;
begin
Dx:=(Xmax-Xmin)/Nx; Dy:=(Ymax-Ymin)/Ny;
for s:=0 to Nx do
begin
x:=(Xmin+s*Dx-Xs)/Kx;
for z:=0 to Ny do
begin
y:=(Ymin+z*Dy-Ys)/Ky;
f:=(Mo[s,z]-Zs)/Kz;
x3:=E[1]*x+E[2]*y+E[3]*f;
y3:=E[4]*x+E[5]*y+E[6]*f;
z3:=E[7]*x+E[8]*y+E[9]*f;
Kp:=D/(D-x3);
Mxe[s,z]:=x0+round(y3*Kp);
Mye[s,z]:=y0-round(z3*Kp);
end;
end;
end;
procedure FormRel;
var s,z:integer;
begin
SetColor(c);
for s:=0 to Nx do
begin
MoveTo(Mxe[s,0],Mye[s,0]);
for z:=1 to Ny do
LineTo(Mxe[s,z],Mye[s,z]);
end;
for z:=0 to Ny do
begin
MoveTo(Mxe[0,z],Mye[0,z]);
for s:=1 to Nx do
LineTo(Mxe[s,z],Mye[s,z])
end;
SetColor(15)
end;
procedure Geom;
var J1:char;
begin
repeat
PutA;Ou('0-exit, 1-Rx, 2-Ry, 3-Rz, 4-D, 5-X0, 6-Y0');
Str(Rx,T10); Ts:='Rx='+T10;
Str(Ry,T10); Ts:=Ts+', Ry='+T10;
Str(Rz,T10); Ts:=Ts+', Rz='+T10;
Str(D,T10); Ts:=Ts+', D='+T10;
Str(X0,T10); Ts:=Ts+', X0='+T10;
Str(Y0,T10); Ts:=Ts+', Y0='+T10;
Str(GetMaxX,T10); Ts:=Ts+'(X0='+T10+')';
Str(GetMaxY,T10); Ts:=Ts+'(Y0='+T10+')';
Info; J1:=ReadKey;
case J1 of
'1':Oui('Rx',Rx);
'2':Oui('Ry',Ry);
'3':Oui('Rz',Rz);
'4':Oui('D',D);
'5':Oui('X0',X0);
'6':Oui('Y0',Y0);
end
until J1='0'
end;
procedure Diap;
var J1:char;
begin
repeat
PutA;Ou('0-exit, 1-Xmin, 2-Xmax, 3-Ymin, 4-Ymax, 5-Nx, 6-Ny');
Str(Xmin:1:2,T10); Ts:='Xmin='+T10;
Str(Xmax:1:2,T10); Ts:=Ts+', Xmax='+T10;
Str(Ymin:1:2,T10); Ts:=Ts+', Ymin='+T10;
Str(Ymax:1:2,T10); Ts:=Ts+', Ymax='+T10;
Str(Nx,T10); Ts:=Ts+', Nx='+T10;
Str(Ny,T10); Ts:=Ts+', Ny='+T10;
Info; J1:=ReadKey;
case J1 of
'1':Our('Xmin',Xmin);
'2':Our('Xmax',Xmax);
'3':Our('Ymin',Ymin);
'4':Our('Ymax',Ymax);
'3':Oui('Nx',Nx);
'4':Oui('Ny',Ny);
end
until J1='0';
FormMo
end;
begin
Xmin:=-2; Xmax:=2; Ymin:=-1.5; Ymax:=1.5; X0:=320; Y0:=200;
repeat
PutA;
Ou('Esc-exit,1-Nvr,2-Geom,3-Diap,4-U,5-V,6-W,7-C,8-Rel,9-Clear');
Str(Nvr,T10); Ts:='Nvr='+T10;
Str(U,T10); Ts:=Ts+', U='+T10;
Str(V,T10); Ts:=Ts+', V='+T10;
Str(W,T10); Ts:=Ts+', W='+T10;
Str(C,T10); Ts:=Ts+', C='+T10;
Info; J:=ReadKey;
case J of
'1':Oui('Nvr',Nvr);
'2':Geom;
'3':Diap;
'4':Oui('U',U);
'5':Oui('V',V);
'6':Oui('W',W);
'7':Oui('C',C);
'8':begin
FormMo; Coefs; FormMe; FormRel
end;
'9': ClearDevice
end
until J=#27;
CloseGraph
end.
Перенести в протокол зображення рельєфа.
Звіт повинен містити назву роботи, мету, короткі теоретичні відомості, тексти виконуваної програми п.2, результати побудови рельєфу.