Нахождение суммы

[Ania Lunee]

разбираться пришлось самой))
слава богу добрые люди помогли вот задача выполняется

uses crt;
var xn,xk,h,x,t,e,s:real;
    i:integer;
begin
clrscr;
repeat
write('Введите начало интервала |xn|>1 xn=');
readln(xn);
until abs(xn)>1;
if xn<-1 then
 begin
  repeat
   write('Введите конец интервала xk>',xn:0:1,' xk<-1 xk=');
   readln(xk);
  until (xk>xn)and(xk<-1);
 end
else if xn>1 then
 begin
  repeat
   write('Введите конец интервала xk>',xn:0:1,' xk=');
   readln(xk);
  until xk>xn;
 end;
repeat
write('Введите шаг табуляции h > 0 и <',xk-xn:0:1,' h=');
readln(h);
until (h>0)and(h<xk-xn);
repeat
write('Введите точность (0;1) e=');readln(e);{точность типа 0,0001}
until (e>0)and(e<1);
writeln('Табулирование функции y=Arth(x) для |x|>1');
writeln('на интервале [',xn:0:1,';',xk:0:1,'] с шагом ',h:0:1);
writeln('-------------------------------');
writeln('|  x  |    S    |   Arth  | N |');
writeln('-------------------------------');
x:=xn;
while x<=xk+h/2 do
 begin
  s:=1/x;
  t:=1/x;
  i:=0;{нулевое значение}
  while abs(t)>e do
   begin
    i:=i+1;
    t:=t/(x*x);
    s:=s+t/(2*i+1);
   end;
  writeln('|',x:4:1,' |',s:8:4,' |',0.5*ln((x+1)/(x-1)):8:4,' |',i+1:3,'|');
  x:=x+h;
 end;
writeln('-------------------------------');
readln
end.

но при табуляции в последнем столбце, шаг идет не в праильном порядке(снизу вверх) а нужно наоборот как исправить????

[Mad_Cat]

все верно ! чем больше X тем быстрее достигается точность!
вот мой вариант

Function f(x:real):real;
begin
f:=0.5*ln((x+1)/(x-1));
end;
procedure Arth(var x,eps,sum,count:real);
var st,zn:real;
i:integer;
begin
count:=0;
sum:=0;
i:=1;
st:=x;
zn:=i*st;
repeat
sum:=sum+1/zn;
st:=st*x*x;
inc(i,2);
count:=count+1;
zn:=i*st;
until abs(1/zn)<eps;
end;
var xn,xk,dx,e,n,s:real;
begin
write('xn=');readln(xn);
write('xk=');readln(xk);
write('dx=');readln(dx);
write('e=');readln(e);
writeln('---------------------------------------------');
writeln('| x     |       S    |    arth   |        N |');
writeln('---------------------------------------------');
while xn<=xk+dx/2 do
begin
Arth(xn,e,s,n);
Writeln(xn:6:3,'      '  ,s:6:3,'      ', f(xn):6:3,'   ',n:6:0);
xn:=xn+dx;
end;
readln;
end.

[Ania Lunee]

Сообщение от Mad_Cat

все верно ! чем больше X тем быстрее достигается точность!
вот мой вариант

Function f(x:real):real;
begin
f:=0.5*ln((x+1)/(x-1));
end;
procedure Arth(var x,eps,sum,count:real);
var st,zn:real;
i:integer;
begin
count:=0;
sum:=0;
i:=1;
st:=x;
zn:=i*st;
repeat
sum:=sum+1/zn;
st:=st*x*x;
inc(i,2);
count:=count+1;
zn:=i*st;
until abs(1/zn)<eps;
end;
var xn,xk,dx,e,n,s:real;
begin
write('xn=');readln(xn);
write('xk=');readln(xk);
write('dx=');readln(dx);
write('e=');readln(e);
writeln('---------------------------------------------');
writeln('| x     |       S    |    arth   |        N |');
writeln('---------------------------------------------');
while xn<=xk do
begin
Arth(xn,e,s,n);
Writeln(xn:6:3,'      '  ,s:6:3,'      ', f(xn):6:3,'   ',n:6:0);
xn:=xn+dx;
end;
readln;
end.

спасибо
большое