Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Бельчонок
0 / 0 / 0
Регистрация: 24.02.2016
Сообщений: 9
1

исправите ошибку, пожалуйста до четверга надо сдать

27.05.2009, 07:42. Просмотров 429. Ответов 1
Метки нет (Все метки)

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
{$A+,N+,B+,D+,E+,F+,G+,I+,L+,O+,P+,Q+,R+,S+,T+,V+,X+,Y+}
{$M 16384,0,655360}
program kur;
uses graph, crt;
const e=0.4;step=0.01;pause=15000;
var xn,xk,dx,b:real;
    grDriver,grMode,ErrCode:integer;
 
function f1(x:real):real;
begin
  f1:=ln(1+x)+b;
end;
 
function df1dx(x:real):real;
begin
  df1dx:=1/(1+x*x);
end;
 
function Newton(x1 : real):extended;
var
    x : real;
    a : real;
begin
    x := x1;
    a := F1(x)/dF1dX(x);
    while Abs(-a)>=e do
    begin
        x := x-a;
        a := F1(x)/dF1dX(x);
    end;
    Newton := x;
end;
 
 
function power(a:integer;b:integer):integer;
         begin
              if b=0 then power:=1 else  power:=a*power(a,b-1);
         end;
 
function factorial(a:integer):longint;
         begin
              if a=0 then factorial:=1 else  factorial:=a*factorial(a-1);
         end;
 
function teyn(x:integer;n:integer):extended;
         begin
         if x=0 then teyn:=0 else teyn:=power(-1,n)*power(x, 2*n)/factorial(2*n);
         end;
 
function teylor(x:integer):integer;
var n:integer;temp:integer;
         begin
              n:=0;
              repeat
              temp:=temp+trunc(teyn(x,n));
              n:=n+1;
              until abs(teyn(x,n)-teyn(x,n+1))<e;
              teylor:=temp;
         end;
 
function getymin:real;
         begin
         if b>0 then getymin:=arctan(xn) else getymin:=arctan(xn)+b;
         end;
 
function getymax:real;
         begin
         if b>0 then getymax:=arctan(xk)+b else getymax:=arctan(xk);
         end;
 
function newx(x:real):integer;
         begin
         newx:=trunc((x-xn)/((xk-xn)/640))-1;
         end;
 
function newy(y:real):integer;
         begin;
         newy:=480-trunc((y-getymin)/((xk-xn)/640));
         end;
 
function floattostr(a:real):string;
var temp:string;
         begin
         str(a:0:2,temp);
         floattostr:=temp;
         end;
 
procedure ongraph;
          var xt:real;
          begin
          grDriver:=Detect;
          InitGraph(grDriver, grMode, 'c:\infprog\bp70');
          ErrCode:=GraphResult;
          if ErrCode = grOk then
          begin
          outtextxy(120,80,'Grafiki fynksi');
          outtextxy(30,10,'y');
          outtextxy(630,475,'x');
          setcolor(green);
          line(newx(0),0,newx(0),480);
          line(newx(0),0,newx(0)-2,10);
          line(newx(0),0,newx(0)+2,10);
          line(0,newy(0),640,newy(0));
          line(630,newy(0)+2,640,newy(0));
          line(630,newy(0)-2,640,newy(0));
          moveto(newx(0)+5,newy(0)+5);
          outtext('0');
          moveto(newx(0)-15,5);
          outtext('y');
          moveto(625,newy(0)+10);
          outtext('x');
          setcolor(red);
          moveto(0,0);
          outtext('y(x)');
          moveto(0,10);
          setcolor(blue);
          outtext('z(x)');
          xt:=xn;
            while xt<xk do
                  begin
                  setcolor(red);
                  line(newx(xt),newy(arctan(xt)),newx(xt+step),newy(arctan(xt+step)));
                  setcolor(blue);
                  line(newx(xt),newy(f1(xt)),newx(xt+step),newy(f1(xt+step)));
                  xt:=xt+step;
                  end;
            xt:=xn;
            setcolor(red);
            while xt<xk do
                  begin
                  delay(pause);
                  delay(pause);
                  SetFillStyle(XHatchFill, cyan);
                  setcolor(red);
                  pieslice(newx(xt),newy(teylor(trunc(xt))) , 0, 360, 10);
                  circle(newx(xt),newy(teylor(trunc(xt))),10);
                  setlinestyle(DashedLn, 0, NormWidth);
                  line(newx(xt),newy(teylor(trunc(xt))),newx(0),newy(teylor(trunc(xt))));
                  line(newx(xt),newy(teylor(trunc(xt))),newx(xt),newy(0));
                  SetTextStyle(DefaultFont, HorizDir, 1);
                  moveto(newx(0)-35,newy(teylor(trunc(xt)))+5);
                  outtext(floattostr(exp(xt)));
                  SetTextStyle(DefaultFont, VertDir, 1);
                  moveto(newx(xt)+5,newy(0)+5);
                  outtext(floattostr(xt));
                  xt:=xt+dx;
                  end;
            ReadLn;
            CloseGraph;
          end
          Else WriteLn('Graphic error:', GraphErrorMsg(ErrCode));
          end;
 
procedure getsource;
          begin
          write('Vvedite Xna4alnoe ');
          readln(xn);
          write('Vvedite Xkone4noe ');
          readln(xk);
          write('Vvedite shag ');
          readln(dx);
          write('Vvedite koefficient b ');
          readln(b);
          end;
 
begin
{getsource;}
xn:=-1.5 ;
xk:=0.5;
dx:=0.08;
b:=-0.4;
ongraph;
writeln('z(x)=',newton(xn):0:3);
readln;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.05.2009, 07:42
Ответы с готовыми решениями:

Найдите пожалуйста ошибку в программе и напишите как надо!
Program wtf; uses crt; var a:array of integer; i,j,s,p,m,n:integer; Begin clrscr;...

срочно надо сдать контрольную Pascal !!
Помогите пожалуйста осталась неделя до сдачи контрольной ! 2е задачи сам смог решить ) 2...

Программа на сортировку. Кто-нибудь сделайте в ближайшее время, надо сдать
Написать программу сортировки линейного массива целых чисел методом обмена. Элементы отсортировать...

Исправить ошибку надо
Помогите исправить ошибку,ПЛЗ, при выполнении процедуры nechet вылетает ошибка: выход за границы...

помогите, пожалуйста, решить задачу( оч.надо!)
Уважаемые программисты, помогите, пожалуйста, решить задачу решить задачу, связанную с оценкой...

1
mamedovvms
2918 / 839 / 324
Регистрация: 30.04.2009
Сообщений: 2,633
27.05.2009, 08:10 2
а что должно получаться
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.05.2009, 08:10

Надо найти ошибку.Файлы.
Собственно задание такое:В файл f записать элементы,потом из файла f в файл g.сначала записать...

откомментируйте пожалуйста код программы очень надо
сделайте хотя бы основные коментарии.. буду очень благодарен. заранее спасибо uses crt; var...

пожалуйста кто разбирается с массивами мне по курсовой надо
дан массив целых чисел, состоящих из 20 элементов. Заполнить его с клавиатуры! Найти: 1)сумму...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru