Uses crt Graph Const 1000 100 Var array of real xmin xmax ymin ymax re

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Uses crt, Graph;
Const n=1000; a=1; b=100;
Var x,y: array[1..n] of real;
xmin,xmax,ymin,ymax:real;
Procedure IsxmasXY;
var i,a:integer; hx:real;
begin
hx:=(b-a)/(n-1);
writeln('Enter a');
readln(a);
for i:=1 to n do
begin
x[i]:=a+hx*(i-1);
y[i]:=(a*x[i]*ln(a+x[i])/((a+x[i])*sqrt(x[i])));
end
end;
Procedure MinmaxY;
var i:integer;
begin
ymin:=y[1];
ymax:=y[1];
for i:=2 to n do
if y[i]<ymin then ymin:=y[i]
else
if y[i]>ymax then ymax:=y[i];
xmin:=a;
xmax:=b;
end;
Procedure Graf;
var gd,gm:integer;
x1,x2,y1,y2,s,k:integer;
xx,yy,i:integer;
Begin
gd:=detect;
InitGraph(gd,gm,'');
SetBKColor(8);
SetColor(15);
x1:=50;
x2:=GetmaxX-50;
y1:=getmaxY-50;
y2:=50;
moveto(20,20);
line(x1,y1,x2,y1);
line(50,y1,50,y2);
Line(x2,y1,x2-5,y1-10);
Line(x2,y1,x2-5,y1+10);
Line(x1,y2,x1+5,y2+10);
Line(x1,y2,x1-5,y2+10);
s:=x2-10;
while s>=x1 do
begin
Line(s,y1-3,s,y1+3);
s:=s-10;
end;
k:=y1-10;
while k>=y2 do
begin
Line(x1-3,k,x1+3,k);
k:=k-10;
end;
moveto(x1-15,y2);
outtext('Y');
moveto(x2,y1+5);
outtext('X');
xx:=x1;
yy:=y1;
Moveto(xx,yy);
for i:=2 to n do
begin
xx:=x1+round((x[i]-xmin)*(x2-x1)/(xmax-xmin));
yy:=y1-round((y[i]-ymin)/(ymax-ymin)*(y1-y2));
lineto(xx,yy);
end;
Repeat until keypressed;
CloseGraph;
end;
Begin
Clrscr;
IsxmasXY;
MinmaxY;
Graf;
readln;
end.