FAQ VCL
Математика

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как вычислить площадь поверхности икосаэдра по известной длине ребра?

uses
  {...,} Math;

// S = 5 * Sqrt(3) * a^2
function GetSurfaceAreaOfIcosahedron(Edge: Extended): Extended;
begin
  Result := 5 * Sqrt(3) * Power(Edge, 2);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FloatToStr(GetSurfaceAreaOfIcosahedron(1)));
end;


Как вычислить объем икосаэдра по известной длине ребра?

uses
  {...,} Math;

// V = 5 * (3 * Sqrt(5)) / 12 * a^3
function GetVolumeOfIcosahedron(Edge: Extended): Extended;
begin
  Result := (5 * (3 + Sqrt(5))) / 12 * Power(Edge, 3);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FloatToStr(GetVolumeOfIcosahedron(1)));
end;


Как найти ближайшее из ряда значений (1,2,4,8,16,32,64,128) число, большее либо равное N?

uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);
const
  n: Integer = 33;
var
  i: Integer;
begin
  i := 1 shl Trunc(Log2(n));
  if i < n then
    i := i shl 1;
  ShowMessage(IntToStr(i));
end;


Как найти ближайшее из ряда значений (1,2,4,8,16,32,64,128) число, меньшее либо равное N?

uses
  {...,} Math;

procedure TForm1.Button2Click(Sender: TObject);
const
  n: Integer = 31;
var
  i: Integer;
begin
  i := 1 shl Trunc(Log2(n));
  ShowMessage(IntToStr(i));
end;


Как инвертировать число (123 <=> 321)?

// Способ первый
uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);

  function ReverseInt(Num: Integer): Integer;
  var
    NumIn, NumOut: Double;
    TmpNumIn, CalcNum: Double;
    Degree: Integer;
  begin
    NumIn := Num;
    NumOut := 0;

    while abs(NumIn) >= 1 do
    begin
      Degree := 0;
      TmpNumIn := NumIn;
      while Abs(TmpNumIn) >= 1 do
      begin
        Inc(Degree);
        TmpNumIn := TmpNumIn / 10;
      end;
      CalcNum := Power(10, Degree-1);
      NumOut := Trunc(NumIn) mod 10 * CalcNum + NumOut;
      NumIn := NumIn / 10;
    end;

    Result := Trunc(NumOut);
  end;

begin
   ShowMessage(IntToStr(ReverseInt(-123456789)));
end;

// Способ второй
uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);

  function ReverseInt(a: Integer): Integer;
  var
    i, k, Znak: Integer;
  begin
    k := a;
    i := 0;
    Znak := Sign(a);

    while Abs(k) > 0 do
    begin
      i := i + (Abs(k) mod 10);
      k := Abs(k) div 10;
      if k > 0 then
        i := i * 10;
    end;
    Result := i * Znak;
  end;

begin
  ShowMessage(IntToStr(ReverseInt(-1592)));
end;

// Способ третий
uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);

  function ReverseInt(N: LongInt): LongInt;
  var
    Buf, Znak: LongInt;
  begin
    Buf := 0;
    Znak := Sign(N);

    while Abs(N) > 0 do
    begin
      Buf := Buf * 10 + Abs(N) mod 10;
      N := N div 10;
    end;
    Result := Buf * Znak;
  end;

begin
   ShowMessage(IntToStr(ReverseInt(-1592)));
end;


Как выбрать случайное значение из нескольких диапазонов ('0'..'9', 'a'..'z', 'A'..'Z')?

uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);

  function RandomMultiRange(Values: array of Integer): Integer;
  begin
    Randomize;
    Result := Values[Random(Length(Values))];
  end;

begin
  Randomize;
  ShowMessage(Chr(
    RandomMultiRange([
      RandomRange(Ord('0'), Ord('9')+1), // 48..57
      RandomRange(Ord('A'), Ord('Z')+1), // 65..90
      RandomRange(Ord('a'), Ord('z')+1)  // 97..122
    ])
  ));
end;


Как определить знак числа?

// Можно воспользоваться функцией Sign из модуля System.Math, но если у
// вас есть необходимость в том, чтобы 0 воспринимался как положительное
// число (со знаком "+"), можно применить следующее решение:

/// <param name="NotZero">
///   True - если нужно воспринимать 0 как число со знаком "+"
/// </param>
function SignEx(x: Int64; const NotZero: Boolean = False): ShortInt;
begin
  Result := Ord(x > 0) - Ord(x < 0);
  if NotZero then
    Result := Result or 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(
    Format('(x < 0) = %d'#13'(x = 0) = %d'#13'(x > 0) = %d'#13#13 +
           '(x < 0) = %d'#13'(x = 0) = %d'#13'(x > 0) = %d',
           [SignEx(-1234), SignEx(0), SignEx(1234),
            SignEx(-1234, True), SignEx(0, True), SignEx(1234, True)]
    )
  );
end;


Как в массиве натуральных чисел найти число без пары?

procedure TForm1.Button1Click(Sender: TObject);
var
  arr: TBytes;
  i: Integer;
  b: Byte;
begin
  // Имеется массив натуральных чисел. Каждое из чисел присутствует в
  // массиве ровно два раза, и только одно из чисел не имеет пары.
  // Уникальный элемент будет совпадать с xor-суммой всех элементов массива.
  arr := [2, 1, 2, 3, 9, 7, 5, 4, 9, 7, 5, 1, 4];
  b := arr[0];
  for i := Low(arr)+1 to High(arr) do
    b := b xor arr[i];
  ShowMessage(IntToStr(b));
end;

// Для общего случая, когда все элементы, кроме искомого, будут присутствовать
// в массиве не парами, а по 3, 4 и т.д., нужно применить функцию xor с
// соответствующим модулем.

type
  TXorModule = class
  private class var
    Module: UInt64;
  public
    class procedure InitModule(Module: UInt64);
    class function XorModule(a, b: UInt64): UInt64;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  arr: TBytes;
  i: Integer;
  b: Byte;
begin
  // считаем по модулю 3
  TXorModule.InitModule(3); // Инициализация модуля
  arr := [1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 9];
  b := arr[0];
  for i := Low(arr)+1 to High(arr) do
    b := TXorModule.XorModule(b, arr[i]);
  ShowMessage(IntToStr(b));

  // считаем по модулю 5
  TXorModule.InitModule(5); // Инициализация модуля
  arr := [1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 7];
  b := arr[0];
  for i := Low(arr)+1 to High(arr) do
    b := TXorModule.XorModule(b, arr[i]);
  ShowMessage(IntToStr(b));
end;

{ TXorModule }

class procedure TXorModule.InitModule(Module: UInt64);
begin
  Self.Module := Module;
end;

class function TXorModule.XorModule(a, b: UInt64): UInt64;
var
  c, m: UInt64;
begin
  c := 0;
  m := 1;
  while (a > 0) and (b > 0) do
  begin
    c  := c + m * ((a mod Self.Module + b mod Self.Module) mod Self.Module);
    a := a div Self.Module;
    b := b div Self.Module;
    m := m * Self.Module;
  end;
  c := c + m * (a + b);
  Result := c;
end;


Как вычислить факториал?

// Способ первый
function FactFor(x: Int64): Extended;
var
  i: Integer;
begin
  if x < 1 then
    Result := 0
  else
  begin
    Result := 1;
    for i := 2 to x do
      Result := Result * i;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FactFor(6).ToString);
end;

// Способ второй
function FactRec(x: Word): Extended;
begin
  if x < 1 then
    Result := 0
  else
    if x = 1 then
      Result := 1
    else
      Result := X * FactRec(x-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(FactRec(6).ToString);
end;

// Способ третий
uses
  {...,} Math;

function FactNaiveTuned(n: Integer): Cardinal;
var
  i, Mult: Integer;
  r1, r2, r3, r4: Cardinal;
begin
  if n <= 1 then
    Exit(1);

  r1 := 1;
  r2 := 1;
  r3 := 1;
  r4 := 1;

  i := n;
  while i > 4 do
  begin
    r1 := r1 * i;
    r2 := r2 * i-1;
    r3 := r3 * i-2;
    r4 := r4 * i-3;
    Dec(i, 4);
  end;

  Mult := IfThen(i = 4, 24, IfThen(i = 3, 6, IfThen(i = 2, 2, 1)));
  Result := (r1*r2) * (r3*r4) * Mult;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(IntToStr(FactNaiveTuned(5)));
end;

// Способ четвертый
//
// Алгоритм вычисления деревом - основан на том соображении, что
// длинные числа примерно одинаковой длины умножать эффективнее,
// чем длинное число умножать на короткое (как в рекурсивной реализации).
// То есть нужно добиться, чтобы при вычислении факториала множители
// постоянно были примерно одинаковой длины.
//
// Пусть нужно найти произведение последовательных чисел от L до R,
// обозначим его как P(L, R). Разделим интервал от L до R пополам и
// посчитаем P(L, R) как P(L, M) * P(M + 1, R), где M находится
// посередине между L и R, M = (L + R) / 2. Заметим, что множители
// будут примерно одинаковой длины. Аналогично разобьем P(L, M) и
// P(M + 1, R). Будем производить эту операцию, пока в каждом интервале
// останется не более двух множителей. Очевидно, что P(L, R) = L, если
// L и R равны, и P(L, R) = L * R, если L и R отличаются на единицу.
// Чтобы найти N! нужно посчитать P(2, N).

function ProdTree(l, r: Integer): Cardinal;
var
  m: Integer;
begin
  if l > r then
    Exit(1);
  if l = r then
    Exit(l);
  if r - l = 1 then
    Exit(Cardinal(l) * r);
  m := (l + r) div 2;
  Result := ProdTree(l, m) * ProdTree(m + 1, r);
end;

function FactTree(n: Integer): Cardinal;
begin
  if n < 0 then
    Exit(0);
  if n = 0 then
    Exit(1);
  if (n = 1) or (n = 2) then
    Exit(n);
  Result := ProdTree(2, n);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(FactTree(6)));
end;

// Способ пятый
//
// Алгоритм вычисления факторизацией - использует разложение факториала на простые
// множители (факторизацию). Очевидно, что в разложении N! участвуют только простые
// множители от 2 до N. Попробуем посчитать, сколько раз простой множитель K
// содержится в N!, то есть узнаем степень множителя K в разложении. Каждый K-ый
// член произведения 1 * 2 * 3 * ... * N увеличивает показатель на единицу, то есть
// показатель степени будет равен N / K. Но каждый K^2-ый член увеличивает степень
// еще на единицу, то есть показатель становится N / K + N / K^2. Аналогично для
// K^3, K^4 и так далее. В итоге получим, что показатель степени при простом
// множителе K будет равен N / K + N / K^2 + N / K^3 + N / K^4 + ...
//
// Для наглядности посчитаем, сколько раз двойка содержится в 10! Двойку дает каждый
// второй множитель (2, 4, 6, 8 и 10), всего таких множителей 10 / 2 = 5. Каждый
// четвертый дает четверку (2^2), всего таких множителей 10 div 4 = 2 (4 и 8). Каждый
// восьмой дает восьмерку (2^3), такой множитель всего один 10 div 8 = 1 (8).
// Шестнадцать (2^4) и более уже не дает ни один множитель, значит, подсчет можно
// завершать. Суммируя, получим, что показатель степени при двойке в разложении 10!
// на простые множители будет равен 10 div 2 + 10 div 4 + 10 div 8 = 5 + 2 + 1 = 8.
//
// Если действовать таким же образом, можно найти показатели при 3, 5 и 7 в разложении
// 10!, после чего остается только вычислить значение произведения:
// 10! = 2^8 * 3^4 * 5^2 * 7^1 = 3 628 800
// Остается найти простые числа от 2 до N, для чего можно использовать решето Эратосфена

uses
  Generics.Collections, Math;

function FactFactor(n: Integer): Cardinal;
type
  TVal = record
    Item1, Item2: Integer;
  end;
var
  v: TVal;
  r: Cardinal;
  p: TList<TVal>;
  i, j, k, c: Integer;
  u: array of Boolean;
begin
  if n < 0 then
    Exit(0);
  if n = 0 then
    Exit(1);
  if (n = 1) or (n = 2) then
    Exit(n);

  SetLength(u, n+1); // Маркеры для решета Эратосфена
  // Множители и их показатели степеней
  p := TList<TVal>.Create();

  for i := 2 to n do
    if not u[i] then // Если i - очередное простое число
    begin
      // Считаем показатель степени в разложении
      k := n div i;
      c := 0;
      while k > 0 do
      begin
        c := c + k;
        k := k div i;
      end;
      // Запоминаем множитель и его показатель степени
      v.Item1 := i;
      v.Item2 := c;
      p.Add(v);
      // Просеиваем составные числа через решето
      j := 2;
      while i * j <= n do
      begin
        u[i * j] := True;
        Inc(j);
      end;
    end;

  // Вычисляем факториал
  r := 1;
  for i := p.Count-1 downto 0 do
    r := r * Trunc(Power(p[i].Item1, p[i].Item2));
  Result := r;

  p.Free;
  SetLength(u, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(IntToStr(FactFactor(6)));
end;

// Способ шестой
//
// Для каждого нечётного k считается наибольшее p, для которого k*2^p <= n,
// перемножаются все k, для которых p одинаковы, и произведение возводится в
// степень p+1. Потом всё это перемножается, и в конце умножается на нужную
// степень двойки (показатель равен n div 2 + n div 4 + n div 8 + ...)
uses
  Math;

function FactFast(n: Integer): Cardinal;
var
  p, c, k, n1, a: Integer;
  r, x: Cardinal;
begin
  p := 0;
  c := 0;

  while (n shr p) > 1 do
  begin
    Inc(p);
    c := c + (n shr p);
  end;

  r := 1;
  k := 1;

  while p >= 0 do
  begin
    n1 := n shr p;
    x := 1;
    a := 1;

    while k <= n1 do
    begin
      if(Cardinal(a)*k < Integer.MaxValue) then
        a := a * k
      else
      begin
        x := x * a;
        a := k;
      end;
      Inc(k, 2);
    end;
    r := r * Trunc(Power(x*a, p+1));
    Dec(p);
  end;
  Result := r shl c;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(IntToStr(FactFast(6)));
end;


Как проверить является ли число четным?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Odd(4) then
    ShowMessage('Число четное');
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
const
  N = 4;
begin
  if N and 1 = 0 then
    ShowMessage('Число четное');
end;