:: MVP ::
|
|
:: RSS ::
|
|
|
Как вычислить объем икосаэдра по известной длине ребра?
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;
|
Как инвертировать число (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;
|
|