LNS (логарифмический формат чисел)

Любые обсуждения, не нарушающие правил форума.

Модератор: Модераторы

LNS (логарифмический формат чисел)

Сообщение Alexander » 03.08.2025 20:30:10

Читая в Википедии статью про логарифм наткнулся на абзац рассказывающий о логарифмических представлениях чисел. Решил (используя ИИ) посмотреть как они эффективны на обычном ПК (там говорилось, что им нужно специальное "железо", для проявления их эффективности). Результат получился не очень (в 3 раза медленнее чем обычно вместо ускорения), но может быть всё равно какой-то интерес (скорее для расширения кругозора) это может представлять. Тем более в принципе такое "железо" выпускалось реально. Если интересно могу кроме этой начальной версии показать весь диалог с ИИ. А может и можно что-то в нём ускорить и он станет быстрее.

Код: Выделить всё
unit logoptunit;

{
    Logarithmic number system (LNS) unit.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

{$mode objfpc}{$H+}

interface

type
  TLogNumber = record
    LogAbs: Double;    // логарифм модуля
    Sign: ShortInt;    // -1, 0, 1
  end;

function MakeLogNumber(X: Double): TLogNumber;
function LogToFloat(L: TLogNumber): Double;

function LogMul(A, B: TLogNumber): TLogNumber;
function LogDiv(A, B: TLogNumber): TLogNumber;
function LogPow(A: TLogNumber; Exponent: Double): TLogNumber;
function LogSqrt(A: TLogNumber): TLogNumber;

implementation

uses Math, SysUtils;

procedure FatalError(const Msg: String);
begin
  Writeln(StdErr, 'LogOptUnit error: ', Msg);
  Halt(200);
end;

function MakeLogNumber(X: Double): TLogNumber;
begin
  if X = 0.0 then
  begin
    Result.LogAbs := 0.0;
    Result.Sign := 0;
  end
  else
  begin
    Result.LogAbs := Ln(Abs(X));
    Result.Sign := Sign(X);
  end;
end;

function LogToFloat(L: TLogNumber): Double;
begin
  if L.Sign = 0 then
    Result := 0.0
  else
    Result := L.Sign * Exp(L.LogAbs);
end;

function LogMul(A, B: TLogNumber): TLogNumber;
begin
  if (A.Sign = 0) or (B.Sign = 0) then
    Exit(MakeLogNumber(0.0));
  Result.LogAbs := A.LogAbs + B.LogAbs;
  Result.Sign := A.Sign * B.Sign;
end;

function LogDiv(A, B: TLogNumber): TLogNumber;
begin
  if B.Sign = 0 then
    FatalError('Division by zero in LogDiv');
  if A.Sign = 0 then
    Exit(MakeLogNumber(0.0));
  Result.LogAbs := A.LogAbs - B.LogAbs;
  Result.Sign := A.Sign * B.Sign;
end;

function LogPow(A: TLogNumber; Exponent: Double): TLogNumber;
begin
  if A.Sign = 0 then
    Exit(MakeLogNumber(0.0));
  Result.LogAbs := A.LogAbs * Exponent;

  if Frac(Exponent) = 0 then
  begin
    // целая степень
    if Odd(Trunc(Exponent)) then
      Result.Sign := A.Sign
    else
      Result.Sign := 1;
  end
  else
  begin
    if A.Sign < 0 then
      FatalError('Negative number to fractional power in LogPow');
    Result.Sign := 1;
  end;
end;

function LogSqrt(A: TLogNumber): TLogNumber;
begin
  Result := LogPow(A, 0.5);
end;

end.


Код: Выделить всё
program testlogopt;

{
    Logarithmic number system (LNS) unit test.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
  logoptunit;

var
  a, b, c: TLogNumber;

begin
  a := MakeLogNumber(2.0);
  b := MakeLogNumber(8.0);
  c := LogMul(a, b);
  Writeln('2 * 8 = ', LogToFloat(c):0:2);

  c := LogDiv(b, a);
  Writeln('8 / 2 = ', LogToFloat(c):0:2);

  c := LogPow(a, 3);
  Writeln('2 ^ 3 = ', LogToFloat(c):0:2);

  c := LogSqrt(b);
  Writeln('sqrt(8) = ', LogToFloat(c):0:4);
end.


Код: Выделить всё
program test_logopt_speed;
{$MODE OBJFPC}{$H+}

{
    Logarithmic number system (LNS) unit. Speed test.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
  logoptunit, sysutils, math, DateUtils;

const
  N = 1000000;

var
  i: Integer;
  normalA, normalB, normalResult: array of Double;
  logA, logB, logResult: array of TLogNumber;
  tStart, tEnd: TDateTime;
  totalNormal, totalLog: Double;

begin
  Randomize;
  SetLength(normalA, N);
  SetLength(normalB, N);
  SetLength(normalResult, N);
  SetLength(logA, N);
  SetLength(logB, N);
  SetLength(logResult, N);

  // Инициализация массивов
  for i := 0 to N - 1 do
  begin
    normalA[i] := Random * 1000 + 1e-3; // не ноль
    normalB[i] := Random * 1000 + 1e-3;
    logA[i] := MakeLogNumber(normalA[i]);
    logB[i] := MakeLogNumber(normalB[i]);
  end;

  // Обычное умножение
  tStart := Now;
  for i := 0 to N - 1 do
    normalResult[i] := normalA[i] * normalB[i];
  tEnd := Now;
  totalNormal := 0;
  for i := 0 to N - 1 do
    totalNormal += normalResult[i];
  Writeln('Обычное умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');

  // Логарифмическое умножение
  tStart := Now;
  for i := 0 to N - 1 do
    logResult[i] := LogMul(logA[i], logB[i]);
  tEnd := Now;
  totalLog := 0;
  for i := 0 to N - 1 do
    totalLog += LogToFloat(logResult[i]);
  Writeln('Логарифмическое умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');

  // Простая проверка (сумма результатов)
  Writeln('Сумма обычных результатов: ', totalNormal:0:4);
  Writeln('Сумма логарифмических результатов: ', totalLog:0:4);
end.


Код: Выделить всё
./test_logopt_speed
Обычное умножение: 10 мс
Логарифмическое умножение: 29 мс
Сумма обычных результатов: 250092748142.3317
Сумма логарифмических результатов: 250092748142.3317
Аватара пользователя
Alexander
энтузиаст
 
Сообщения: 845
Зарегистрирован: 18.12.2005 19:10:00
Откуда: оттуда

Re: LNS (логарифмический формат чисел)

Сообщение Дож » 08.08.2025 00:42:14

1. if в LogMul лишний, его можно просто выкинуть
2. Нужен inline, т.к. функция маленькая
3. Параметры передавать как const
4. Результат писать в out параметр, чтобы не было копирования

Код: Выделить всё
procedure LogMulOut(const A, B: TLogNumber; out Dst: TLogNumber); inline;
begin
  Dst.LogAbs := A.LogAbs + B.LogAbs;
  Dst.Sign := A.Sign * B.Sign;
end;


Основная деградация производительности скорее всего из-за памяти. Double занимает 8 байт, TLogNumber -- 16, из-за этого в два раза больше обращений к памяти требуется. Если поменять тип LogAbs на Single, либо в normal массивы докинуть 8 байт мусора, показатели должны приблизиться друг к другу.
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 900
Зарегистрирован: 12.10.2008 16:14:47

Re: LNS (логарифмический формат чисел)

Сообщение Alexander » 10.08.2025 08:20:14

Спасибо, стало в два раза быстрее.

Код: Выделить всё
unit logoptunit;

{
    Logarithmic number system (LNS) unit.
    Version: 2.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

{$mode objfpc}{$H+}
{$OPTIMIZATION LEVEL3}
{$OPTIMIZATION PEEPHOLE}
{$OPTIMIZATION REGVAR}
{$OPTIMIZATION LOOPUNROLL}
{$INLINE ON}

interface

type
  TLogNumber = record
    LogAbs: Double;    // логарифм модуля
    Sign: ShortInt;    // -1, 0, 1
  end;

function MakeLogNumber(X: Double): TLogNumber; inline;
function LogToFloat(L: TLogNumber): Double; inline;

function LogMul(A, B: TLogNumber): TLogNumber; inline;
function LogDiv(A, B: TLogNumber): TLogNumber; inline;
function LogPow(A: TLogNumber; Exponent: Double): TLogNumber; inline;
function LogSqrt(A: TLogNumber): TLogNumber; inline;
procedure LogMulOut(const A, B: TLogNumber; out Dst: TLogNumber); inline;
procedure LogDivOut(const A, B: TLogNumber; out Dst: TLogNumber); inline;

implementation

uses Math, SysUtils;

procedure FatalError(const Msg: String); inline;
begin
  Writeln(StdErr, 'LogOptUnit error: ', Msg);
  Halt(200);
end;

function MakeLogNumber(X: Double): TLogNumber; inline;
begin
  Result.Sign := Sign(X);
  if Result.Sign = 0 then
    Result.LogAbs := 0.0
  else
    Result.LogAbs := Ln(Abs(X));
end;

function LogToFloat(L: TLogNumber): Double; inline;
begin
  if L.Sign = 0 then
    Result := 0.0
  else
    Result := L.Sign * Exp(L.LogAbs);
end;

function LogMul(A, B: TLogNumber): TLogNumber; inline;
begin
  Result.LogAbs := A.LogAbs + B.LogAbs;
  Result.Sign := A.Sign * B.Sign;
end;

function LogDiv(A, B: TLogNumber): TLogNumber; inline;
begin
  if B.Sign = 0 then
    FatalError('Division by zero in LogDiv');
   
  Result.LogAbs := A.LogAbs - B.LogAbs;
  Result.Sign := A.Sign * B.Sign;
end;

procedure LogMulOut(const A, B: TLogNumber; out Dst: TLogNumber); inline;
begin
  Dst.LogAbs := A.LogAbs + B.LogAbs;
  Dst.Sign := A.Sign * B.Sign;
end;

procedure LogDivOut(const A, B: TLogNumber; out Dst: TLogNumber); inline;
begin
  if B.Sign = 0 then
    FatalError('Division by zero in LogDiv');
   
  Dst.LogAbs := A.LogAbs - B.LogAbs;
  Dst.Sign := A.Sign * B.Sign;
end;

function LogPow(A: TLogNumber; Exponent: Double): TLogNumber; inline;
var
  IntExponent: Integer;
begin
  if A.Sign = 0 then
    Exit(MakeLogNumber(0.0));
   
  Result.LogAbs := A.LogAbs * Exponent;

  if Frac(Exponent) = 0 then
  begin
    IntExponent := Trunc(Exponent);
    Result.Sign := IfThen(Odd(IntExponent), A.Sign, 1);
  end
  else
  begin
    if A.Sign < 0 then
      FatalError('Negative number to fractional power in LogPow');
    Result.Sign := 1;
  end;
end;

function LogSqrt(A: TLogNumber): TLogNumber; inline;
begin
  Result := LogPow(A, 0.5);
end;

end.


Код: Выделить всё
program testlogopt;

{
    Logarithmic number system (LNS) unit test.
    Version: 2.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
  logoptunit;

var
  a, b, c: TLogNumber;

begin
  a := MakeLogNumber(2.0);
  b := MakeLogNumber(8.0);
  LogMulOut(a, b, c);
  Writeln('2 * 8 = ', LogToFloat(c):0:2);

  LogDivOut(b, a, c);
  Writeln('8 / 2 = ', LogToFloat(c):0:2);

  c := LogPow(a, 3);
  Writeln('2 ^ 3 = ', LogToFloat(c):0:2);

  c := LogSqrt(b);
  Writeln('sqrt(8) = ', LogToFloat(c):0:4);
end.


Код: Выделить всё
program test_logopt_speed;
{$MODE OBJFPC}{$H+}

{
    Logarithmic number system (LNS) unit. Speed test.
    Version: 2.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
  logoptunit, sysutils, math, DateUtils;

const
  N = 1000000;

var
  i: Integer;
  normalA, normalB, normalResult: array of Double;
  logA, logB, logResult: array of TLogNumber;
  tStart, tEnd: TDateTime;
  totalNormal, totalLog: Double;

begin
  Randomize;
  SetLength(normalA, N);
  SetLength(normalB, N);
  SetLength(normalResult, N);
  SetLength(logA, N);
  SetLength(logB, N);
  SetLength(logResult, N);

  // Инициализация массивов
  for i := 0 to N - 1 do
  begin
    normalA[i] := Random * 1000 + 1e-3; // не ноль
    normalB[i] := Random * 1000 + 1e-3;
    logA[i] := MakeLogNumber(normalA[i]);
    logB[i] := MakeLogNumber(normalB[i]);
  end;

  // Обычное умножение
  tStart := Now;
  for i := 0 to N - 1 do
    normalResult[i] := normalA[i] * normalB[i];
  tEnd := Now;
  totalNormal := 0;
  for i := 0 to N - 1 do
    totalNormal += normalResult[i];
  Writeln('Обычное умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');

  // Логарифмическое умножение
  tStart := Now;
  for i := 0 to N - 1 do
    LogMulOut(logA[i], logB[i], logResult[i]);
  tEnd := Now;
  totalLog := 0;
  for i := 0 to N - 1 do
    totalLog += LogToFloat(logResult[i]);
  Writeln('Логарифмическое умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');

  // Простая проверка (сумма результатов)
  Writeln('Сумма обычных результатов: ', totalNormal:0:4);
  Writeln('Сумма логарифмических результатов: ', totalLog:0:4);

end.


Код: Выделить всё
./test_logopt_speed
Обычное умножение: 8 мс
Логарифмическое умножение: 15 мс
Сумма обычных результатов: 250160379925.2672
Сумма логарифмических результатов: 250160379925.2672
Аватара пользователя
Alexander
энтузиаст
 
Сообщения: 845
Зарегистрирован: 18.12.2005 19:10:00
Откуда: оттуда

Re: LNS (логарифмический формат чисел)

Сообщение Alexander » 29.09.2025 08:31:06

Тем не менее сделал полный тест, учитывающий все операции. Возведение в степень оказалось выигрышным.

Код: Выделить всё
program test_logopt_speed;
{$MODE OBJFPC}{$H+}

{
    Logarithmic number system (LNS) unit test.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
logoptunit, sysutils, math, DateUtils;

const
N = 1000000;

var
i: Integer;
normalA, normalB, normalResult: array of Double;
logA, logB, logResult: array of TLogNumber;
tStart, tEnd: TDateTime;
totalNormal, totalLog: Double;
exponent: Double;

begin
Randomize;
SetLength(normalA, N);
SetLength(normalB, N);
SetLength(normalResult, N);
SetLength(logA, N);
SetLength(logB, N);
SetLength(logResult, N);

// Инициализация массивов
for i := 0 to N - 1 do
begin
normalA[i] := Random * 1000 + 1e-3; // не ноль
normalB[i] := Random * 1000 + 1e-3;
logA[i] := MakeLogNumber(normalA[i]);
logB[i] := MakeLogNumber(normalB[i]);
end;

// ---------- Умножение ----------
tStart := Now;
for i := 0 to N - 1 do
normalResult[i] := normalA[i] * normalB[i];
tEnd := Now;
totalNormal := 0;
for i := 0 to N - 1 do
totalNormal += normalResult[i];
Writeln('Обычное умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');

tStart := Now;
for i := 0 to N - 1 do
LogMulOut(logA[i], logB[i], logResult[i]);
tEnd := Now;
totalLog := 0;
for i := 0 to N - 1 do
totalLog += LogToFloat(logResult[i]);
Writeln('Логарифмическое умножение: ', MilliSecondsBetween(tEnd, tStart), ' мс');
Writeln('Сумма обычных результатов: ', totalNormal:0:4);
Writeln('Сумма логарифмических результатов: ', totalLog:0:4);
Writeln;

// ---------- Деление ----------
tStart := Now;
for i := 0 to N - 1 do
normalResult[i] := normalA[i] / normalB[i];
tEnd := Now;
totalNormal := 0;
for i := 0 to N - 1 do
totalNormal += normalResult[i];
Writeln('Обычное деление: ', MilliSecondsBetween(tEnd, tStart), ' мс');

tStart := Now;
for i := 0 to N - 1 do
LogDivOut(logA[i], logB[i], logResult[i]);
tEnd := Now;
totalLog := 0;
for i := 0 to N - 1 do
totalLog += LogToFloat(logResult[i]);
Writeln('Логарифмическое деление: ', MilliSecondsBetween(tEnd, tStart), ' мс');
Writeln('Сумма обычных результатов: ', totalNormal:0:4);
Writeln('Сумма логарифмических результатов: ', totalLog:0:4);
Writeln;

// ---------- Возведение в степень ----------
exponent := 2.5; // можно поменять
tStart := Now;
for i := 0 to N - 1 do
normalResult[i] := Power(normalA[i], exponent);
tEnd := Now;
totalNormal := 0;
for i := 0 to N - 1 do
totalNormal += normalResult[i];
Writeln('Обычное возведение в степень: ', MilliSecondsBetween(tEnd, tStart), ' мс');

tStart := Now;
for i := 0 to N - 1 do
logResult[i] := LogPow(logA[i], exponent);
tEnd := Now;
totalLog := 0;
for i := 0 to N - 1 do
totalLog += LogToFloat(logResult[i]);
Writeln('Логарифмическое возведение в степень: ', MilliSecondsBetween(tEnd, tStart), ' мс');
Writeln('Сумма обычных результатов: ', totalNormal:0:4);
Writeln('Сумма логарифмических результатов: ', totalLog:0:4);
Writeln;

// ---------- Квадратный корень ----------
tStart := Now;
for i := 0 to N - 1 do
normalResult[i] := Sqrt(normalA[i]);
tEnd := Now;
totalNormal := 0;
for i := 0 to N - 1 do
totalNormal += normalResult[i];
Writeln('Обычный квадратный корень: ', MilliSecondsBetween(tEnd, tStart), ' мс');

tStart := Now;
for i := 0 to N - 1 do
logResult[i] := LogSqrt(logA[i]);
tEnd := Now;
totalLog := 0;
for i := 0 to N - 1 do
totalLog += LogToFloat(logResult[i]);
Writeln('Логарифмический квадратный корень: ', MilliSecondsBetween(tEnd, tStart), ' мс');
Writeln('Сумма обычных результатов: ', totalNormal:0:4);
Writeln('Сумма логарифмических результатов: ', totalLog:0:4);
end.


Код: Выделить всё
./test_logopt_speed
Обычное умножение: 8 мс
Логарифмическое умножение: 15 мс
Сумма обычных результатов: 249971287166.3401
Сумма логарифмических результатов: 249971287166.3402

Обычное деление: 8 мс
Логарифмическое деление: 18 мс
Сумма обычных результатов: 6895196.0800
Сумма логарифмических результатов: 6895196.0800

Обычное возведение в степень: 133 мс
Логарифмическое возведение в степень: 28 мс
Сумма обычных результатов: 9037311763559.8320
Сумма логарифмических результатов: 9037311763559.8320

Обычный квадратный корень: 8 мс
Логарифмический квадратный корень: 14 мс
Сумма обычных результатов: 21084078.8179
Сумма логарифмических результатов: 21084078.8179


Также запросил ИИ узнать, какие функции на основе этого можно ускорить. Из предложенных выигрышным оказался NthRoot.

Код: Выделить всё
unit NthRootLogUnit;

{$mode objfpc}{$H+}

{
    Logarithmic number system (LNS) NthRoot calculator.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

interface

// === Примеры применения ===

// 3. Численные методы: n-й корень из числа
function NthRoot(x: Double; n: Integer): Double; inline;
function NthRootLogSpecial(x: Double; n: Integer): Double; inline;
function NthRootLogShort(x: Double; n: Integer): Double; inline;
function NthRootLogFull(x: Double; n: Integer): Double; inline;

implementation

uses Math;

const
  EXP_LIMIT = Ln(MaxDouble); // 700.0 предел для Double

// === Применения ===

function NthRoot(x: Double; n: Integer): Double;
begin
  if (x < 0) or (n <= 0) then Exit(0.0);
  Exit(Power(x, 1.0 / n));
end;

function NthRootLogSpecial(x: Double; n: Integer): Double;
var y:Double;
begin
if (x <= 0) or (n <= 0) then Exit(0.0);

y:=Ln(x) * (1.0 / n);

    if y > EXP_LIMIT then
      Exit(Infinity)
    else if y < -EXP_LIMIT then
      Exit(0.0)
    else
      Exit(Exp(y));
end;

function NthRootLogShort(x: Double; n: Integer): Double;
var y:Double;
begin
if (x <= 0.0) or (n <= 0) then Exit(0.0);

y := Ln(x) / n;

  if y > EXP_LIMIT then
    Exit(Infinity)
  else if y < -EXP_LIMIT then
    Exit(0.0)
  else
    Exit(Exp(y));
end;

//Работает для положительных и отрицательных x (если корень нечётной степени).
//Защищена от переполнений через Ln(MaxDouble).

function NthRootLogFull(x: Double; n: Integer): Double;
var
  y: Double;
  oddRoot: Boolean;
begin
  // Недопустимые случаи
  if (n = 0) or IsNan(x) then
    Exit(NaN);
  if n < 0 then
    Exit(0.0); // отрицательная степень не поддерживается здесь

  // x = 0
  if x = 0.0 then
    Exit(0.0);

  // Проверка на нечётность корня
  oddRoot := Odd(n);

  // Отрицательное число и чётный корень → нет действительного результата
  if (x < 0.0) and (not oddRoot) then
    Exit(NaN);

  // Положительный случай
  if x > 0.0 then
  begin
    y := Ln(x) / n;

    if y > EXP_LIMIT then
      Exit(Infinity)
    else if y < -EXP_LIMIT then
      Exit(0.0)
    else
      Exit(Exp(y));
  end;

  // Отрицательный x и нечётный n
  y := Ln(-x) / n;

  if y > EXP_LIMIT then
    Exit(-Infinity)
  else if y < -EXP_LIMIT then
    Exit(0.0)
  else
    Exit(-Exp(y));
end;

end.


Код: Выделить всё
program test_NthRootLog;

{$mode objfpc}{$H+}
{RANGECHECKS ON}

{
    Logarithmic number system (LNS) NthRoot calculator test.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

uses
  SysUtils, Math, NthRootLogUnit;

var
  i: Integer;
  normal, logver, logverspec,logverfull,logvershort: Double;
  probs: array[0..9999] of Double;
  start, stop: QWord;

function GetTick: QWord;
begin
  Result := GetTickCount64;
end;

begin
  Writeln('=== Тест NthRootLogUnit ===');

  // --- Численные методы --- +
  start := GetTick;
  normal := 0;
  for i := 1 to 1000000 do
    normal := normal + NthRoot(i, 5);
  stop := GetTick;
  Writeln('NthRoot normal: ', stop - start, ' ms  sum=', normal:0:2);

  start := GetTick;
  logverspec := 0;
  for i := 1 to 1000000 do
    logverspec := logverspec + NthRootLogSpecial(i, 5);
  stop := GetTick;
  Writeln('NthRoot logverspec: ', stop - start, ' ms  sum=', logverspec:0:2);

  start := GetTick;
  logvershort := 0;
  for i := 1 to 1000000 do
    logvershort := logvershort + NthRootLogShort(i, 5);
  stop := GetTick;
  Writeln('NthRoot logvershort: ', stop - start, ' ms  sum=', logvershort:0:2);

  start := GetTick;
  logverfull := 0;
  for i := 1 to 1000000 do
    logverfull := logverfull + NthRootLogFull(i, 5);
  stop := GetTick;
  Writeln('NthRoot logverfull: ', stop - start, ' ms  sum=', logverfull:0:2);
end.


Код: Выделить всё
./test_NthRootLog
=== Тест NthRootLogUnit ===
NthRoot normal: 134 ms  sum=13207451.36
NthRoot logverspec: 93 ms  sum=13207451.36
NthRoot logvershort: 95 ms  sum=13207450.85
NthRoot logverfull: 116 ms  sum=13207450.85


За "точку отсчёта" здесь принимается NthRoot сделанный через Power (например https://forum.lazarus.freepascal.org/in ... ic=43741.0).
Аватара пользователя
Alexander
энтузиаст
 
Сообщения: 845
Зарегистрирован: 18.12.2005 19:10:00
Откуда: оттуда

Re: LNS (логарифмический формат чисел)

Сообщение Alex2013 » 29.09.2025 09:07:58

Как насчет еще более оригинального "метода подгонки" ?
https://ru.wikipedia.org/wiki/Метод_прогонки
Суть суть прикола адаптивном расчете с учетом особенностей конкретного набора данных.
Alex2013
долгожитель
 
Сообщения: 3169
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Потрепаться

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 7

Рейтинг@Mail.ru