как заставить модуль Delphi работать в Turbo Pascal 7.0 (помогите)

balera1111

субж

unit UMathServices;
{Автор Vit}
interface
Type TProgress = procedure(Done:real);
{Собственно экспортные функции}
Function ulFact(First:String):string;
Function ulSum(First, Second :string):string;
Function ulSub(First, Second :string):string;
Function ulMPL(First, Second :string):string;
Function ulPower(First, Second :string):string;
function UlDiv(First, Second:String; Precision:integer):String; {Precision - не истинная точность а количество знаков учитываемых после запятой сверх тех которые значимы. Все знаки уже существующие в делимом и делителе в любом случае учитываются}
{Call back function for long operations}
var OnProgress: TProgress;
implementation
Uses SysUtils;
type TMathArray=array of integer;
Type TNumber=record
int, frac:TMathArray;
sign:boolean;
end;
var n1, n2:TNumber;
Procedure Str2Number(s:string; var n:TNumber);
var i, j, l:integer;
begin
if s='' then
begin
setlength(n.int , 0);
setlength(n.frac , 0);
exit;
end;
l:=length(s);
if s[1]='-' then
begin
s:=copy(s,2,l);
l:=l-1;
n.sign:=false;
end
else
n.sign:=true;
j:=pos('.', s);
if j>0 then
begin
setlength(n.int , j-1);
for i:=1 to j-1 do n.int[i-1]:=strtoint(s[j-i]);
setlength(n.frac , l-j);
for i:=1 to l-j do n.frac[i-1]:=strtoint(s[l-i+1]);
end
else
begin
setlength(n.int,l);
for i:=1 to l do n.int[i-1]:=strtoint(s[l-i+1]);
setlength(n.frac,0);
end;
end;
Function Num2Array(Var n:TNumber; var a:TMathArray):integer;
var i:integer;
begin
result:=length(n.frac);
setlength(a,length(n.int)+result);
for i:=0 to length(a)-1 do if i<result then a[i]:=n.frac[i] else a[i]:=n.int[i-result];
end;
Procedure MultiplyArray(var a1, a2, a:TMathArray);
var i, j:integer;
b:boolean;
begin
{checking for zero, 1}
for i:=length(a2)-1 downto 0 do
begin
for j:=length(a1)-1 downto 0 do
begin
a[j+i]:=a[j+i]+(a2[i]*a1[j]);
end;
end;
repeat
b:=true;
for i:=0 to length(a)-1 do
if a[i]>9 then
begin
b:=false;
try
a[i+1]:=a[i+1]+1;
except
setlength(a, length(a)+1);
a[i+1]:=a[i+1]+1;
end;
a[i]:=a[i]-10;
end;
until b;
end;
Procedure Array2Num(Var n:TNumber; var a:TMathArray; frac:integer; sign:boolean);
var i:integer;
begin
setlength(n.frac,frac);
setlength(n.int,length(a)-frac);
for i:=0 to length(a)-1 do
begin
if i<frac then n.frac[i]:=a[i] else n.int[i-frac]:=a[i];
end;
n.sign:=sign;
end;
Function Number2Str(var n:TNumber):string;
var i:integer;
s:string;
begin
result:='';
for i:=0 to high(n.int) do result:=inttostr(n.int[i])+result;
if length(n.frac)<>0 then
begin
for i:=0 to high(n.frac) do s:=inttostr(n.frac[i])+s;
result:=result+'.'+s;
end;
while (length(result)>1) and (result[1]='0') do delete(result,1,1);
if pos('.', result)>0 then while (length(result)>1) and (result[length(result)]='0') do delete(result,length(result1);
if not n.sign then result:='-'+result;
setlength(n.int,0);
setlength(n.frac,0);
end;
Procedure DisposeNumber(var n:TNumber);
begin
setlength(n.int,0);
setlength(n.frac,0);
end;
Function ulFact(First:String):string;
var n1, n2:TNumber;
i:integer;
a, a1, a2:TMathArray;
max:integer;
begin
Str2Number('1', n1);
Str2Number('1', n2);
Num2Array(n1, a1);
Num2Array(n2, a2);
max:=strtoint(First);
for i:=1 to strtoint(First) do
begin
if Assigned(OnProgress) then OnProgressi/max)*100);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a1,0);
setlength(a2,0);
a1:=a;
Str2Number(inttostr(i n2);
Num2Array(n2, a2);
end;
Array2Num(n1, a1, 0, true);
result:=Number2Str(n1);
DisposeNumber(n1);
end;
Function ulPower(First, Second :string):string;
var i, j, c:integer;
a, a1, a2:TMathArray;
var n1:TNumber;
max:integer;
begin
j:=strtoint(Second);
if j=0 then
begin
result:='1';
exit;
end
else
if j=1 then
begin
result:=First;
exit;
end;
max:=j-1;
Str2Number(First, n1);
c:=Num2Array(n1, a1);
setlength(a,0);
setlength(a2,0);
a2:=a1;
for i:=1 to j-1 do
begin
if Assigned(OnProgress) then OnProgressi/max)*100);
setlength(a,0);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a2,0);
a2:=a;
end;
setlength(a1,0);
setlength(a2,0);
c:=c*j;
if n1.sign then
Array2Num(n1, a, c, true)
else
if odd(j) then Array2Num(n1, a, c, false) else Array2Num(n1, a, c, true);
setlength(a,0);
result:=Number2Str(n1);
DisposeNumber(n1);
end;

Procedure MultiplyNumbers(var n1, n2 :TNumber);
var i:integer;
a, a1, a2:TMathArray;
begin
i:=Num2Array(n1, a1)+Num2Array(n2, a2);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a1,0);
setlength(a2,0);
Array2Num(n1, a, i, n1.sign=n2.sign);
DisposeNumber(n2);
setlength(a,0);
end;
Function ulMPL(First, Second :string):string;
var n1, n2:TNumber;
begin
Str2Number(First, n1);
Str2Number(Second, n2);
MultiplyNumbers(n1, n2);
result:=Number2Str(n1);
DisposeNumber(n1);
end;
Procedure AlignNumbers(var n1, n2:TNumber);
var i1, i2, i:integer;
begin
i1:=length(n1.int);
i2:=length(n2.int);
if i1>i2 then setlength(n2.int, i1);
if i2>i1 then setlength(n1.int, i2);
i1:=length(n1.frac);
i2:=length(n2.frac);
if i1>i2 then
begin
setlength(n2.frac, i1);
for i:=i1-1 downto 0 do
begin
if i-(i1-i2)>0 then n2.frac[i]:=n2.frac[i-(i1-i2)] else n2.frac[i]:=0;
end;
end;
if i2>i1 then
begin
setlength(n1.frac, i2);
for i:=i2-1 downto 0 do
begin
if i-(i2-i1)>0 then n1.frac[i]:=n1.frac[i-(i2-i1)] else n1.frac[i]:=0;
end;
end;
end;
Function SubInteger(a1,a2:TMathArray):integer;
var i:integer;
b:boolean;
begin
result:=0;
if length(a1)=0 then exit;
for i:=0 to length(a1)-1 do a1[i]:=a1[i]-a2[i];
repeat
b:=true;
for i:=0 to length(a1)-1 do
if a1[i]<0 then
begin
b:=false;
if i=length(a1)-1 then
begin
result:=-1;
a1[i]:=a1[i]+10;
b:=true;
end
else
begin
a1[i+1]:=a1[i+1]-1;
a1[i]:=a1[i]+10;
end;
end;
until b;
end;
Procedure AssignNumber(out n1:TNumber; const n2:TNumber);
var i:integer;
begin
Setlength(n1.int, length(n2.int;
for i:=0 to length(n2.int)-1 do n1.int[i]:=n2.int[i];
Setlength(n1.frac, length(n2.frac;
for i:=0 to length(n2.frac)-1 do n1.frac[i]:=n2.frac[i];
n1.sign:=n2.sign;
end;
Procedure SubNumber(var n1, n

0000

Проще немного посидеть и написать самому. Для адаптации надо string видимо свой писать (в том числе и все функции, которые для него вызываются).
P.S. TP не знаю, помню что там string это Delphi string[255].

balera1111

string и string[255]
а самому чет не получается
тут просто функции и операторы из делфи
еслиб знать как они работают
и как их можно реализовать на паскале то дело в шляпе

0000

Если бы мне приспичило реализовать такой перевод, то я бы первым делом озаботился поиском ответов на эти вопросы
1. Если в TP string с длиной больше 255? Нет: надо написать свой (хоть что то типа char[512])
2. Если аналог AnsiString?
3. Есть ли аналог TNumber?
4. Что то еще.
Вообщем я бы забил на это, прочитал книгу и сделал сам!

balera1111

TNumber просто переменная сируктурниго типа
поддержка строки больше 255 просто через переадресацию
с использованием дерективы {$X+}

0000

А вот это не скомпиляецца? (с того же FAQ) На первый взгляд вообще ничего специфчного нет.

Огромные числа 



Данный модуль использует массив байт для предоставления БОЛЬШИХ чисел. Бинарно-хранимые числа заключены в массив, где первый элемент является Наименьшим Значимым Байтом (Least Significant Byte - LSB последний - Наибольшим Значимым Байтом (Most Significant Byte - MSB подобно всем Intel-целочисленным типам. 



Арифметика здесь использует не 10- или 2-тиричную, а 256-тиричную систему исчисления, чтобы каждый байт представлял одну (1) цифру. 



Числа HugeInttype - Подписанные Числа (Signed Numbers). 



При компиляции с директивой R+, ADD и MUL могут в определенных обстоятельствах генерировать "Arithmetic Overflow Error" (RunError(215 - ошибка арифметического переполнения. В таком случае пользуйтесь переменной "HugeIntCarry". 



Переменная "HugeIntDiv0" используется для проверки деления на ноль. 



Используйте {$DEFINE HugeInt_xx } или поле "Conditional defines" (символ условного компилирования) в "Compiler options" (опции компилятора) для задания размерности, где xx должно быть равно 64, 32 или 16, в противном случае HugeIntSize будет равен 8 байтам. 







unit HugeInts; 

interface 



const 

{$IFDEF HugeInt_64 } 



  HugeIntSize = 64; 



{$ELSE}{$IFDEF HugeInt_32 } 



  HugeIntSize = 32; 

{$ELSE}{$IFDEF HugeInt_16 } 



  HugeIntSize = 16; 

{$ELSE} 



  HugeIntSize = 8; 

{$ENDIF}{$ENDIF}{$ENDIF} 



  HugeIntMSB = HugeIntSize - 1; 



type 



  HugeInt = array[0..HugeIntMSB] of Byte; 



const 



  HugeIntCarry: Boolean = False; 

  HugeIntDiv0: Boolean = False; 



procedure HugeInt_Min(var a: HugeInt); { a := -a } 

procedure HugeInt_Inc(var a: HugeInt); { a := a + 1 } 

procedure HugeInt_Dec(var a: HugeInt); { a := a - 1 } 



procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt); { R := a + b } 

procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt); { R := a - b } 

procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt); { R := a * b } 

procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt); { R := a div b } 

procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt); { R := a mod b } 



function HugeInt_IsNeg(a: HugeInt): Boolean; 

function HugeInt_Zero(a: HugeInt): Boolean; 

function HugeInt_Odd(a: HugeInt): Boolean; 



function HugeInt_Comp(a, b: HugeInt): Integer; {-1:a< 0; 1:a>} 

procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt); { Dest := Src } 



procedure String2HugeInt(AString: string; var a: HugeInt); 

procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt); 

procedure HugeInt2String(a: HugeInt; var S: string); 



implementation 



procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt); 

{ Dest := Src } 

begin 



  Move(Src, Dest, SizeOf(HugeInt; 

end; { HugeInt_Copy } 



function HugeInt_IsNeg(a: HugeInt): Boolean; 

begin 



  HugeInt_IsNeg := a[HugeIntMSB] and $80 > 0; 

end; { HugeInt_IsNeg } 



function HugeInt_Zero(a: HugeInt): Boolean; 

var 

  i: Integer; 

begin 



  HugeInt_Zero := False; 

  for i := 0 to HugeIntMSB do 

    if a[i] <> 0 then 

      Exit; 

  HugeInt_Zero := True; 

end; { HugeInt_Zero } 



function HugeInt_Odd(a: HugeInt): Boolean; 

begin 



  HugeInt_Odd := a[0] and 1 > 0; 

end; { HugeInt_Odd } 



function HugeInt_HCD(a: HugeInt): Integer; 

var 

  i: Integer; 

begin 



  i := HugeIntMSB; 

  while (i > 0) and (a[i] = 0) do 

    Dec(i); 

  HugeInt_HCD := i; 

end; { HugeInt_HCD } 



procedure HugeInt_SHL(var a: HugeInt; Digits: Integer); 

{ Перемещение байтов переменной "Digits" в левую часть, 



байты "Digits" будут 'ослабевать' в MSB-части. 

LSB-часть заполняется нулями. } 

var 

  t: Integer; 

  b: HugeInt; 

begin 



  if Digits > HugeIntMSB then 

    FillChar(a, SizeOf(HugeInt 0) 

  else if Digits > 0 then 

  begin 

    Move(a[0], a[Digits], HugeIntSize - Digits); 

    FillChar(a[0], Digits, 0); 

  end; { else if } 

end; { HugeInt_SHL } 



procedure HugeInt_SHR(var a: HugeInt; Digits: Integer); 

var 

  t: Integer; 

begin 



  if Digits > HugeIntMSB then 

    FillChar(a, SizeOf(HugeInt 0) 

  else if Digits > 0 then 

  begin 

    Move(a[Digits], a[0], HugeIntSize - Digits); 

    FillChar(a[HugeIntSize - Digits], Digits, 0); 

  end; { else if } 

end; { HugeInt_SHR } 



procedure HugeInt_Inc(var a: HugeInt); 

{ a := a + 1 } 

var 



  i: Integer; 

  h: Word; 

begin 



  i := 0; 

  h := 1; 

  repeat 

    h := h + a[i]; 

    a[i] := Lo(h); 

    h := Hi(h); 

    Inc(i); 

  until (i > HugeIntMSB) or (h = 0); 

  HugeIntCarry := h > 0; 

{$IFOPT R+ } 

  if HugeIntCarry then 

    RunError(215); 

{$ENDIF} 

end; { HugeInt_Inc } 



procedure HugeInt_Dec(var a: HugeInt); 

{ a := a - 1 } 

var 

  Minus_1: HugeInt; 

begin 



  { самый простой способ } 

  FillChar(Minus_1, SizeOf(HugeInt $FF); { -1 } 

  HugeInt_Add(a, Minus_1, a); 

end; { HugeInt_Dec } 



procedure HugeInt_Min(var a: HugeInt); 

{ a := -a } 

var 

  i: Integer; 

begin 



  for i := 0 to HugeIntMSB do 

    a[i] := not a[i]; 

  HugeInt_Inc(a); 

end; { HugeInt_Min } 



function HugeInt_Comp(a, b: HugeInt): Integer; 

{ a = b: ==0; a > b: ==1; a < b: ==-1 } 

var 



  A_IsNeg, B_IsNeg: Boolean; 

  i: Integer; 

begin 



  A_IsNeg := HugeInt_IsNeg(a); 

  B_IsNeg := HugeInt_IsNeg(b); 

  if A_IsNeg xor B_IsNeg then 

    if A_IsNeg then 

      HugeInt_Comp := -1 

    else 

      HugeInt_Comp := 1 

  else 

  begin 

    if A_IsNeg then 

      HugeInt_Min(a); 

    if B_IsNeg then 

      HugeInt_Min(b); 

    i := HugeIntMSB; 

    while (i > 0) and (a[i] = b[i]) do 

      Dec(i); 

    if A_IsNeg then { оба отрицательные! } 

      if a[i] > b[i] then 

        HugeInt_Comp := -1 

      else if a[i] < b[i] then 

        HugeInt_Comp := 1 

      else 

        HugeInt_Comp := 0 

    else { оба положительные } if a[i] > b[i] then 

        HugeInt_Comp := 1 

      else if a[i] < b[i] then 

        HugeInt_Comp := -1 

      else 

        HugeInt_Comp := 0; 

  end; { else } 

end; { HugeInt_Comp } 



procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt); 

{ R := a + b } 

var 



  i: Integer; 

  h: Word; 

begin 



  h := 0; 

  for i := 0 to HugeIntMSB do 

  begin 

    h := h + a[i] + b[i]; 

    R[i] := Lo(h); 

    h := Hi(h); 

  end; { for } 

  HugeIntCarry := h > 0; 

{$IFOPT R+ } 

  if HugeIntCarry then 

    RunError(215); 

{$ENDIF} 

end; { HugeInt_Add } 



procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt); 

{ R := a - b } 

var 



  i: Integer; 

  h: Word; 

begin 



  HugeInt_Min(b); 

  HugeInt_Add(a, b, R); 

end; { HugeInt_Sub } 



procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt); 

{ R := a * b } 

var 



  i, j, k: Integer; 

  A_end, B_end: Integer; 

  A_IsNeg, B_IsNeg: Boolean; 

  h: Word; 

begin 



  A_IsNeg := HugeInt_IsNeg(a); 

  B_IsNeg := HugeInt_IsNeg(b); 

  if A_IsNeg then 

    HugeInt_Min(a); 

  if B_IsNeg then 

    HugeInt_Min(b); 

  A_End := HugeInt_HCD(a); 

  B_End := HugeInt_HCD(b); 

  FillChar(R, SizeOf(R 0); 

  HugeIntCarry := False; 

  for i := 0 to A_end do 

  begin 

    h := 0; 

    for j := 0 to B_end do 

      if (i + j) < HugeIntSize then 

      begin 

        h := h + R[i + j] + 

balera1111

етот модель для работы в большими числани в типе 2^100000000000000000000
мне ето не к чему
задача многократно повысить точность
в паскале максимум (если своего не писать) 20 знаков после запятой
ето очень мао мне надо как минимум 1000 как ето сделать может есть идеи поделитесь

0000

Обычная практика, если например double не поддерживается аппаратно, переводить дробные в целые, работать с уже целыми числами и потом переводить обратно в дробные.

sinet

А зачем тебе обязательно Turbo Pascal? Если нужно, чтобы под досом работало, то можно Free Pascal`ем скомпилить.

balera1111

Никакие целые числа не дадут точности до тысячного знака
(при больших значениях число преобрзуется к двадцатизначным числам (смещение разряда
Turbo Pascal нужет потому, что на нем написана программа,
необходимо только повысить ее точность

zorin29

Мне кажется, накладные расходы по переводу Delphi на TP будут слишком велики.
А обязательно, чтобы результирующая программа была под TP? Может, проще всю программу под Delphi переделать? Delphi почти полностью компилирует код под TP.

balera1111

вот блин
поставил delphi
перенес проги и скомпилил их
а можуль чето не работает нихера
т.е. работает но считает не правильно
может кто посмотрит в чем ошибка?

zorin29

пересматривать 500 строчек на предмект поиска ошибки из-за которой
"модуль не работает нифига"? Пардон, но не буду. Отладчик тебе в помощь.

balera1111

модуль работает но выдает неверные результаты
что касаеться математической модели
итерестное предложение но
при работе с многочленом 20 степени в окресности
7ми приходиться оперировать с числами
порядка 7^20=7'979'266'297'612'001.0000 вот что ето такое
так что при работе с такими числами точность выще 4 знака не получить
ны а если говорить про более высокие числа
то там вообце о точности до сотни или тысячи
что непеемлемо
вот так
как быть
P.S.Ча сплю с многочленими Чебышева может они меня удовлетворят