Перенести программу, использующую модуль Graph, с Турбо Паскаля на PascalABC

@Dewasta · Регистрация: 07.12.2014

Студворк — интернет-сервис помощи студентам

Всем доброго времени суток. Перейду сразу к делу. У меня есть программа, которая хорошо работает в TP, но при переносе в ABC, программа пишет множество ошибок. Да, я знаю, что в ABC не нужна инициализация графика, но при корректировке ошибок(убрать, что не нужно и тому подобное), график не показывается. Кому не трудно, измените мой алгоритм под ABC, заранее большое спасибо этому человеку.

Pascal
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
Program possible;
uses crt, GraphABC;
const h=0.1;
e=0.001;
a=-1;
b=4;
var gd, dm, xi, yi: integer; sx, sy:string[30];
x,y,x1,x2,y1,y2,n,m:real;
x0,y0:integer;
function F(X:real):real;
begin
F:=1*Power((-x/2-1),4)+4*Power((x/2-1),2)-1; {выражение, которое нужно считать}
end;
 
begin
clrscr;
gd:=detect;
initGraph(gd,gm, '');
x0:=320;
y0:=240;
line(x0,0,x0,480);
line(0,y0,640,y0);
x:=a;
while x<=b do
begin
line(x0-2, y0-round(x*60), x0+2, y0-round(x*60));
line(x0+round(x*60), y0-2, x0+round(x*60), y0+2);
x:=x+0.5;
end;
OutTextXY(x0+5, 10, 'y');
OutTextXY(y0-5, 620, 'x');
x:=a;
while x<=b+h do
begin
moveto(x0+round(x*60), y0-round(F(x)*60));
x:=x+h;
setcolor(7);
lineto(x0+round(x*60), y0-round(F(x)*60));
end;
n:=a;
m:=b;
repeat
x1:=(n+m-e)/2;
x:=x1;
y1:=F(x);
x2:=(n+m-e)/2;
x:=x2;
y2:=F(x);
if y1<y2 then m:=x2 else n:=x1;
until abs(m-n)<2*e;
x:=(n+m)/2;
OutTextXY(350, 25, 'min');
str(x:8:3,sx);
str(F(x):8:3,sy);
sx:='xmin='+sx;
sy:='ymin='+sy;
OutTextXY(350,50,sx);
OutTextXY(350,60,sy);
OutTextXY(343,250,'0,5');
 
OutTextXY(377,250,'1');
OutTextXY(400,250,'1,5');
OutTextXY(440,250,'2');
OutTextXY(290,210,'0,5');
OutTextXY(305,180,'1');
readkey;
closeGraph;
end.

@Puporev · 16.12.2014, 11:21

И Вам такой график нужен?

@Puporev · 16.12.2014, 11:22

Это из того кода что Вы привели. Напишите лучше полное и точное условие задачи.

@Puporev · 16.12.2014, 13:49

Может такой график лучше?

@Puporev · 16.12.2014, 13:59

Вот код в АВС

Pascal
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
Program possible;
uses graphABC;
const h=0.1;
      e=0.001;
      a=-1;
      b=4;
var x0,y0,xi, yi: integer;
    sx, sy:string;
    x,y,x1,x2,y1,y2,n,m,mx,my:real;
function f(x:real):real;
begin
f:=power(-x/2-1,4)+4*power(x/2-1,2)-1;
end;
 
begin
x0:=windowwidth div 5;
y0:=windowheight-50;
mx:=(4*x0-60)/b;
my:=(y0-60)/f(b);
line(x0,0,x0,2*y0);
line(0,y0,5*x0,y0);
x:=a;
while x<b+h/2 do
 begin
  line(x0+round(x*mx), y0+3, x0+round(x*mx),y0-3);
  str(x:0:1,sx);
  textout(x0+round(x*mx), y0+10,sx);
  x:=x+0.5;
 end;
x:=0;
while x<=f(b)+10 do
 begin
  line(x0+3,y0-round(x*my), x0-3, y0-round(x*my));
  str(x:0:0,sy);
  if x>0 then textout(x0-25,y0-round(x*my),sy);
  x:=x+10;
 end;
textout(x0+10, 10, 'Y');
textout(5*x0-20,y0-20, 'X');
x:=a;
moveto(x0+round(x*mx), y0-round(f(x)*my));
setpencolor(clRed);
while x<b+h/2 do
 begin
  lineto(x0+round(x*mx), y0-round(f(x)*my));
  x:=x+h;
 end;
n:=a;
m:=b;
repeat
x1:=(n+m-e)/2;
x:=x1;
y1:=F(x);
x2:=(n+m-e)/2;
x:=x2;
y2:=F(x);
if y1<y2 then m:=x2 else n:=x1;
until abs(m-n)<2*e;
x:=(n+m)/2;
str(x:0:3,sx);
str(f(x):0:3,sy);
sx:='ymin= '+sx;
sy:='ymax='+sy;
setfontsize(12);
textout(350,50,sx);
textout(350,70,sy);
end.

@Dewasta · 16.12.2014, 18:37 **[ТС]**

Большое вам спасибо, на всякий случай скину сюда свою задачу

Y=-(X/2-1)^4+4*(X/2-1)^2-1

-1..4

золотого сечения

Вроде всё верно.. Как мне кажется.

@Puporev · 16.12.2014, 19:50

И график не такой и значения неверные.
У меня была функция

Pascal
1
f:=power(-x/2-1,4)+4*power(x/2-1,2)-1;

а на картинке вроде(нихрена толком не видно) такая

Pascal
1
f:=-power(x/2-1,4)+4*power(x/2-1,2)-1;

Добавлено через 1 минуту
А задание свое Вы так и не написали.

Добавлено через 52 минуты
Если нужно найти минимум функции методом золотого сечения то можно так.

Pascal
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
Program possible;
uses graphABC;
const h=0.1;
      e=0.001;
 
var x0,y0: integer;
    sx, sy:string;
    a,b,x,y,mx,my,min,max,r,d,r0,l0,z:real;
 
function f(x:real):real;
begin
f:=-power(x/2-1,4)+4*power(x/2-1,2)-1;
end;
 
begin
a:=-1;
b:=4;
x0:=windowwidth div 5;
mx:=(4*x0-60)/b;
min:=f(a);//мин и макс для масштаба по y и положения горизонтальной оси
max:=min;
x:=a;
while x<=b do
 begin
  if f(x)<min then min:=f(x);
  if f(x)>max then max:=f(x);
  x:=x+0.1;
 end;
y0:=round(windowheight*max/(max-min));
my:=(y0-40)/max;
line(x0,0,x0,2*y0);
line(0,y0,5*x0,y0);
x:=a;
while x<=b do
 begin
  line(x0+round(x*mx), y0+3, x0+round(x*mx),y0-3);
  str(x:0:1,sx);
  textout(x0+round(x*mx)+5, y0+10,sx);
  x:=x+0.5;
 end;
x:=-1.5;
while x<=max+0.5 do
 begin
  line(x0+3,y0-round(x*my), x0-3, y0-round(x*my));
  str(x:0:1,sy);
  if abs(x)>0.1 then textout(x0-25,y0-round(x*my),sy);
  x:=x+0.5;
 end;
textout(x0+10, 10, 'Y');
textout(5*x0-20,y0-20, 'X');
x:=a;
moveto(x0+round(x*mx), y0-round(f(x)*my));
setpencolor(clRed);
while x<b+h/2 do
 begin
  lineto(x0+round(x*mx), y0-round(f(x)*my));
  x:=x+h;
 end;
r:=(sqrt(5)-1)/2; //коэффициент золотого сеения
d:=e/2;//половина точности
r0:=a+(b-a)*r;//правый край
l0:=b-(b-a)*r;//левый край
z:=1;//ищем минимум
while abs(b-a)>e do
 begin
  r0:=a+(b-a)*r;
  l0:=b-(b-a)*r;
  if (z*f(l0))<(z*f(r0)) then b:=r0 else a:=l0;
 end;
str(l0:0:3,sx);
str(f(l0):0:3,sy);
sx:='xmin= '+sx;
sy:='ymin='+sy;
setfontsize(12);
textout(300,70,sx);
textout(300,50,sy);
end.

@Dewasta · 16.12.2014, 21:28 **[ТС]**

Простите, забыл. Мне нужно указать минимум и максимум функции, методом золотого сечения.А так же, отобразить это на графике.

Странно, что картинка плохо отображается, когда я открываю её у себя, все впорядке. Если дословно, то мой пример следующего вида: Y=-(x/2-1)^4+4*(x/2-1)^2-1.

Снова спасибо за помощь, без вас бы вряд ли додумался.

Новые блоги и статьи Все статьи Все блоги /
Жизнь в неопределённости kumehtar 23.03.2026 Жизнь — это постоянное существование в неопределённости. Например, даже если у тебя есть список дел, невозможно дойти до точки, где всё окончательно завершено и больше ничего не осталось. В принципе,. . .	Модель здравоСохранения: работники работают быстрее после её введения. anaschu 23.03.2026 geJalZw1fLo Корпорация до введения программа здравоохранения имела много невыполненных работниками заданий, после введения программы количество заданий выросло. Но на выплатах по больничным это. . .	1С: Контроль уникальности заводского номера Maks 23.03.2026 Алгоритм контроля уникальности заводского (или серийного) номера на примере документа выдачи шин для спецтехники с табличной частью. Данные берутся из регистра сведений, по которому настроено. . .	Хочу заставить корпорации вкладываться в здоровье сотрудников: делаю мат модель здравосохранения anaschu 22.03.2026 e7EYtONaj8Y Z4Tv2zpXVVo https:/ / github. com/ shumilovas/ med2. git
1С: Программный отбор элементов справочника по группе Maks 22.03.2026 Установка программного отбора элементов справочника "Номенклатура" из модуля формы документа. В качестве фильтра для отбора справочника служит группа номенклатуры. Отбор по наименованию группы. . .	Как я обхитрил таблицу Word Alexander-7 21.03.2026 Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .	Krabik - рыболовный бот для WoW 3.3.5a AmbA 21.03.2026 без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .	1С: Программный отбор элементов справочника по значению перечисления Maks 21.03.2026 Установка программного отбора элементов справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит значение перечислений. / / Событие "НачалоВыбора" реквизита на форме. . .

Перенести программу, использующую модуль Graph, с Турбо Паскаля на PascalABC

Решение

Решение

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	16.12.2014, 11:21
	И Вам такой график нужен? Миниатюры 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	16.12.2014, 11:22
	Это из того кода что Вы привели. Напишите лучше полное и точное условие задачи. 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	16.12.2014, 13:49
	Может такой график лучше? Миниатюры 0

@Dewasta 0 / 0 / 0 Регистрация: 07.12.2014 Сообщений: 19
	16.12.2014, 21:28 [ТС]
	Простите, забыл. Мне нужно указать минимум и максимум функции, методом золотого сечения.А так же, отобразить это на графике. Странно, что картинка плохо отображается, когда я открываю её у себя, все впорядке. Если дословно, то мой пример следующего вида: Y=-(x/2-1)^4+4*(x/2-1)^2-1. Снова спасибо за помощь, без вас бы вряд ли додумался. 0