Sordie.co.uk

libsassy/libSassy.Integers.pas

Raw

{(
 )) libSassy.Integers
((    Misc integer helper/functions
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2017
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Integers;

interface

uses
  libSassy.Maths,
  libSassy.Arrays,
  libSassy.Strings;

type
  TByteSet = set of Byte;

{$REGION 'TIntegers'}
  TIntegers = class(TArray<Integer>)
  private
    function  GetTop: Integer;
    procedure SetTop(Value: Integer);
  public
    function InternalCompareProc(const A, B): Integer; override;

    function AddIntegers(Numbers: String; const ToStart: Integer = 0): Integer;
    function AddByteSet (Numbers: TByteSet): Integer;

    function Total: Integer;

    function Min: Integer;
    function Max: Integer;

    function Average:  Integer; inline;
    function AverageF: Extended;

    function HarmonicMean:  Extended;
    function GeometricMean: Extended;

    function  AllocUID(const Base: Integer = 1; const Step: Integer = 1): Integer;
    procedure FreeUID(UID: Integer); inline;

    property Top: Integer read GetTop write SetTop;
  end;
{$ENDREGION}

{$REGION 'Clamping functions'}
function  Clamp(const Value: Integer; const Min: Integer = 0; const Max: Integer = 255): Integer;
procedure AdjustClamp(var Value, Width: Integer; const Min, Max: Integer);
procedure AdjustClampDelta(var Value, Width: Integer; const Min, Max: Integer; var Delta: Integer);
procedure ClampAdd(var Value: Integer; const Cap: Integer = 255; const Step: Integer = 1);
{$ENDREGION}

implementation

{$REGION 'Clamping functions'}
function Clamp;
begin
       if Value < Min then Result := Min
  else if Value > Max then Result := Max
  else Result := Value;
end;

procedure AdjustClamp;
begin
  if Value < Min then
  begin
    Width := Width - (Min - Value);
    Value := Min;
  end;

  if (Value + Width) > Max then
    Width := Max - Value;

  if Width < 0 then Width := 0;
end;

procedure AdjustClampDelta;
begin
  Delta := 0;

  if Value < Min then
  begin
    Delta := Min - Value;
    Width := Width - Delta;
    Value := Min;
  end;

  if (Value + Width) > Max then
    Width := Max - Value;

  if Width < 0 then Width := 0;
end;

procedure ClampAdd;
begin
  Value := Value + Step;
  if Value > Cap then Value := Cap;
end;
{$ENDREGION}

{$REGION 'TIntegers'}
function TIntegers.GetTop;
begin
  Result := Last;
end;

procedure TIntegers.SetTop;
begin
  Items[Count - 1] := Value;
end;

function TIntegers.InternalCompareProc;
begin
  Result := Integer(A) - Integer(B);
end;

function TIntegers.AddIntegers;
var
  i, j, k, l: Integer;
  s, n:       String;

  procedure ToNext;
  begin
    while pos(n[i], ' ,.') > 0 do
    begin
      inc(i);
      if i > n.Length then break;
    end;
  end;

  procedure ReadNumber;
  begin
    s := '';

    ToNext;

    while pos(n[i], ' ,.') = 0 do
    begin
      s := s + n[i];
      inc(i);
      if i > n.Length then break;
    end;
  end;

  procedure AddNumber;
  begin
    inc(Result);
    Add(s.AsInteger);
  end;
begin
  Result := 0;

  Numbers := Numbers.Replace(' ', '');
  Numbers := Numbers.Tidy;
  if Numbers.Empty then exit;

  i := 1;
  if Numbers[i] = '.' then n := String.Int(ToStart) + Numbers else n := Numbers;

  repeat
    ReadNumber;

    if i > Numbers.Length then
    begin
      if not s.Empty then AddNumber;
      exit;
    end;

    if n[i] = '.' then
    begin
      j := s.AsInteger;

      ReadNumber; k := s.AsInteger;

      if j < k then
        for l := j to k do begin inc(Result); Add(l); end
      else
        for l := j downto k do begin inc(Result); Add(l); end;
    end
    else if n[i] = ',' then
    begin
      if not s.Empty then AddNumber;
    end
    else
      exit;
  until i > n.Length;
end;

function TIntegers.AddByteSet;
var
  i: Byte;
begin
  Result := 0;

  for i in Numbers do
  begin
    Add(i);
    inc(Result);
  end;
end;

function TIntegers.Total;
var
  i: Integer;
begin
  Result := 0;

  for i in Self do
    inc(Result, i);
end;

function TIntegers.Min;
var
  i: Integer;
begin
  if Count = 0 then Exit(0);

  Result := Items[0];

  for i in Self do
    if i < Result then Result := i;
end;

function TIntegers.Max;
var
  i: Integer;
begin
  if Count = 0 then Exit(0);

  Result := Items[0];

  for i in Self do
    if i > Result then Result := i;
end;

function TIntegers.Average;
begin
  Result := round(AverageF);
end;

function TIntegers.AverageF;
begin
  if Count = 0 then exit(0);
  Result := Total / Count;
end;

function TIntegers.HarmonicMean;
var
  i: Integer;
begin
  Result := 1;

  if Count = 0 then exit;

  for i in Self do
    if i <> 0 then
      Result := Result + 1 / i;

  if Result = 0 then exit;
  Result := Count / Result;
end;

function TIntegers.GeometricMean;
var
  i: Integer;
begin
  Result := 1;

  if Count = 0 then exit;

  for i in Self do
    Result := Result * i;

  Result := Power(Result, 1 / Count);
end;

function TIntegers.AllocUID;
begin
  Result := Base;

  while Exists(Result) do
    inc(Result, Step);

  Add(Result);
end;

procedure TIntegers.FreeUID;
begin
  RemoveAll(UID);
end;
{$ENDREGION}

end.