, , . , , , , . , , , . . , . . . .
{ Consts }
uses
Crt,
Graph, { }
Consts, { }
Types, { }
Mathem1, { }
Draw1, { }
{ }
Mathem2, { }
Draw2; { }
{ }
function F1(x:real):real; far; { }
begin
F1:=9*x*x-11;
end;
{ }
function F2(x:real):real; far; { }
begin
F2:=x*x*x+5;
end;
{ **************** **************** }
var
M1,M2:TMatMas; { }
Y1min,Y2min, { ... }
Y1max,Y2max, {... }
Ymin,Ymax:real; { }
Kx,Ky:real; { }
Ms1,Ms2:TScrMas; { "" }
Xo,Yo:word; { "" }
RootMas:TRoot; { }
K:word; { }
Rect:TRect; { }
begin
{ ********* *********** }
with Rect do
begin
Origin.X:=OriginX;
Origin.Y:=OriginY;
Size.X:=Nx;
Size.Y:=Ny;
end;
{ }
EnterMatMas (M1,Nx,@F1,Xmin,Xmax);
EnterMatMas (M2,Nx,@F2,Xmin,Xmax);
{ }
Y1min:=Min(M1,Nx); Y1max:=Max(M1,Nx);
Y2min:=Min(M2,Nx); Y2max:=Max(M2,Nx);
Ymin:=Minimum(Y1min,Y2min);
Ymax:=Maximum(Y1max,Y2max);
{ }
Kx:=Nx/(Xmax-Xmin);
Ky:=Ny/(Ymax-Ymin);
{ "" }
EnterScrMas(Ms1,M1,Ymin,Ky,Rect);
EnterScrMas(Ms2,M2,Ymin,Ky,Rect);
{ "" }
|
|
|
Zero(Xmin,Xmax,Ymin,Ymax,Rect,Kx,Ky,Xo,Yo);
{ }
K:=Solution(Xmin,Xmax,@F1,@F2,RootMas);
{ ********************** ********************* }
GraphInit;
{ }
Ramka(Rect,Width,Cyan);
{ }
DrawBounds(Xmin,Xmax,Ymin,Ymax,Rect,Red);
{ }
DrawGridLines(NgrX,NgrY,Rect,DarkGray);
{ }
DrawAxis(Rect,Xo,Yo,Red);
{ }
DrawFunction(Ms1,Nx,LightGreen);
DrawFunction(Ms2,Nx,Yellow);
{ }
WriteCoord(RootMas,K,Rect,LightGreen);
ReadKey;
CloseGraph;
end.
. .
unit Consts;
interface
const
Nx=440; { X }
Ny=480; { Y }
OriginX=180; OriginY=40; { }
Xmin=-2; Xmax=2; { }
NgrX=6; NgrY=23; { }
Epsilon=0.001; { }
R=10; { }
const
Width=3; { }
implementation
end.
.
unit Types;
interface
uses Consts;
type
TMatMas=array[1..Nx] of real; { }
TScrMas=array[1..Nx] of word; { "" }
TRealCoord=record x,y:real; end; { . }
TRoot=array[1..Nx div 10] of TRealCoord; { }
TIntCoord=record x,y:word; end; { }
TRect=record { }
Origin:TIntCoord; { }
Size:TIntCoord; { }
end;
implementation
end.
, .
Mathem1 , . . , .
unit Mathem1;
interface
uses Types, Consts;
procedure EnterMatMas (
var M: array of real; { }
Nx: word; { }
Func: Pointer; { }
Xmin,Xmax: real { }
);
{ }
function Solution(
Xmin,Xmax:real; { }
F1,F2:pointer; { }
var RootMas:TRoot): { }
byte; { }
implementation
procedure EnterMatMas(
var M: array of real; { }
Nx: word; { }
Func: Pointer; { }
Xmin,Xmax: real { }
);
type
TFunc = function (x:real):real; { }
var
F: TFunc; { }
x: real; { }
dx: real; { }
i: word; { }
begin
F:=TFunc(Func); { }
dx:=(Xmax-Xmin)/(Nx-1); { }
|
|
|
x:=Xmin; { }
for i:=0 to Nx-1 do { }
begin
M[i]:=F(x); { }
x:=x+dx; { }
end;
end;
{ }
function Solution(
Xmin,Xmax:real; { }
F1,F2:pointer; { }
var RootMas:TRoot): { }
byte; { }
type
TFunc = function (x:real):real; { }
var
Fu1,Fu2: TFunc; { }
{ ,
}
function Fu(x:real):real;
begin
Fu:=Fu1(x)-Fu2(x);
end;
{ , }
function SubRange (var FirstX, LastX, Step: real): boolean;
begin
{ , .
, X }
while (Fu(FirstX)*Fu(FirstX+Step)>0)and((FirstX+Step)<=Xmax) do
FirstX:= FirstX+Step;
if ((FirstX+Step)<=Xmax)
then
begin
LastX:= FirstX+Step;
SubRange:= True;
end
else SubRange:= False;
end;
{ }
function Root (FirstX, LastX, NewStep: real): real;
begin
repeat
{ }
NewStep:= NewStep/R;
{ () }
SubRange (FirstX,LastX,NewStep);
{ }
LastX:= FirstX + NewStep;
until abs(NewStep)<=Epsilon/R; { }
Root:= FirstX; { }
end;
var
Step: real; { }
CurLeft,CurRight:real; { , }
k:word; { }
begin
k:=0;
{ }
Fu1:=TFunc(F1); Fu2:=TFunc(F2);
{ }
Step:=(Xmax-Xmin)/R;
{ }
CurLeft:= Xmin;
{ }
while SubRange(CurLeft,CurRight,Step) do
begin
inc(k);
RootMas[k].X:=Root(CurLeft,CurRight,Step);
RootMas[k].Y:=Fu1(RootMas[k].X);
CurLeft:= CurRight;
end;
Solution:=K;
end;
end.
: (implementation) Mathem2. :
unit Mathem2;
interface
{ () }
function Min(
M: array of real; { }
N: word { }
):real;
{ () }
function Max(
M: array of real; { }
N: word { }
):real;
{ }
function Minimum(x,y:real):real;
{ }
function Maximum(x,y:real):real;
{ "" }
procedure EnterScrMas(
var Ms: array of word; { "" }
Mm: array of real; { }
Ymin: real; { }
K: real; { }
var Rect { }
);
{ "" }
procedure Zero (
Xmin,Xmax,Ymin,Ymax:real; { }
var Rect; { "" }
Kx,Ky:real; { }
var Xo,Yo:word); { "" }
implementation
end.
. - . , . .
{*********** *************}
|
|
|
unit Draw1;
interface
uses Types;
{ }
procedure GraphInit;
{ }
procedure DrawFunction(M:array of word;N:word;Color:byte);
{ }
procedure Ramka(Rect:TRect;Width,Color:word);
implementation
uses Graph,Consts;
{ }
procedure GraphInit;
var
Driver,Mode:integer;
Res:integer;
begin
Driver:=Detect;
InitGraph(Driver,Mode,'');
Res:=GraphResult;
if Res<>0 then
begin
WriteLn(GraphErrorMsg(Res));
WriteLn('Press <Enter> for exit');
ReadLn;
Halt(1);
end;
end;
{ }
procedure DrawFunction(M:array of word;N:word;Color:byte);
var
i:word;
begin
SetColor(Color);
MoveTo(OriginX,M[0]);
for i:=1 to N-1 do
begin
LineTo(OriginX+i,M[i]);
{ PutPixel(OriginX+i,M[i],Color);}
end;
end;
{ }
procedure Ramka(Rect:TRect;Width,Color:word);
var
i,OldColor:byte;
begin
OldColor:=GetColor;
SetColor(Color);
with Rect do
for i:=1 to Width do
Rectangle(Origin.X-i, Origin.Y-i,
Origin.X+Size.X+i, Origin.Y+Size.Y+i);
SetColor(OldColor);
end;
end.
: (implementation) Draw2. :
{*********** *************}
unit Draw2;
interface
{ }
procedure DrawAxis(var Rect;Xo,Yo,Color:word);
{ }
procedure DrawBounds(Xmin,Xmax,Ymin,Ymax:real;var Rect;Color:word);
{ }
procedure DrawGridLines(NgrX,NgrY:word;var Rect;Color:word);
{ }
procedure WriteCoord(var RootMas;K:word;var Rect;Color:word);
implementation
end.
8
1. Turbo Pascal.
2. .
3. . .
4. ( , , ).
