PABCSystem - изменение реализациии Milliseconds на StopWatch

InstallerSamples/WhatsNew/3_12/MillisecondsDelta_test.pas

@@ -0,0 +1,14 @@
+// Реализация Milliseconds и MillisecondsDelta через StopWatch - более стабильная
+// Ожидается вывод без скачков значений
+begin
+  Println('MillisecondsDelta test:');
+  MillisecondsDelta;
+  for var i := 1 to 200 do
+  begin
+    var sum := 0;
+    for var k := 1 to 3000000 do 
+      sum += k;
+    
+    Print(MillisecondsDelta);
+  end;
+end.

bin/Lib/Graph3D.pas

@@ -3218,7 +3218,7 @@ type
 /// Диаметр трубы тора
     property TubeDiameter: real read GetTD write SetTD;
 /// Возвращает клон тора
-    function Clone := (inherited Clone) as PrismT;
+    function Clone := (inherited Clone) as TorusT;
     
     function CreateModel: Visual3D; override := new TorusVisual3D;
 ///--

bin/Lib/LinearAlgebraML.pas

@@ -303,6 +303,8 @@ const
     'Вектор пуст!!Vector is empty';
   ER_VECTOR_DIVIDE_BY_ZERO =
     'Деление на ноль при делении вектора на скаляр!!Division by zero in Vector / scalar';
+  ER_VECTOR_TO_INT_NON_INTEGER =
+    'Вектор содержит нецелое значение на позиции {0}: {1}!!Vector contains non-integer value at index {0}: {1}';
   ER_MATRIX_SIZE_NEGATIVE =
     'Размеры матрицы должны быть неотрицательными!!Matrix size must be non-negative';
   ER_MATRIX_SIZE_MISMATCH =
@@ -383,7 +385,15 @@ begin
   Result := new integer[Length];
   
   for var i := 0 to Length - 1 do
-    Result[i] := integer(Data[i]);
+  begin
+    var x := Data[i];
+    var ix := Round(x);
+    
+    if PABCSystem.Abs(x - ix) > 1e-12 then
+      ArgumentError(ER_VECTOR_TO_INT_NON_INTEGER, i, x);
+    
+    Result[i] := ix;
+  end;
 end;
 
 function Vector.Clone: Vector;
@@ -1803,4 +1813,4 @@ begin
 end;
 
 
-end.
+end.

bin/Lib/MLABC.pas

@@ -89,7 +89,7 @@ type
   NormType = MLModelsABC.NormType;
   
   Activations = MLModelsABC.Activations;
-  Pipeline = MLModelsABC.MatrixPipeline;
+  MatrixPipeline = MLModelsABC.MatrixPipeline;
   
   LinearRegression = MLModelsABC.LinearRegression;
   LogisticRegression = MLModelsABC.LogisticRegression;

bin/Lib/MLExceptions.pas

@@ -6,10 +6,12 @@ const
   ER_DIM_MISMATCH =
     'Размерности не совпадают: {0} и {1}!!Dimension mismatch: {0} and {1}';  
   ER_TO_VECTOR_NON_NUMERIC =
-    'ToVector: столбец "{0}" содержит нечисловые или NA значения!!' +
+      'ToVector: столбец "{0}" содержит нечисловые или NA значения!!' +
-    'ToVector: column "{0}" contains non-numeric or NA values';
+      'ToVector: column "{0}" contains non-numeric or NA values';
+  ER_LABELS_NOT_INTEGER =
+      'Метки классов должны быть целыми числами!!Class labels must be integers';
   ER_PARAM_VALUES_EMPTY =
-    'Список paramValues пуст!!paramValues is empty';
+      'Список paramValues пуст!!paramValues is empty';
   ER_EMPTY_DATASET =
     'Набор данных пуст!!Dataset is empty';
   ER_LAMBDA_NEGATIVE =

bin/Lib/MLModelsABC.pas

@@ -248,6 +248,8 @@ type
       fMaxIter: integer;
       fTol: real;
       
+      function GetCoefficients: Vector;
+      function GetIntercept: real;
       function GetIsFitted: boolean;
     public
       /// Создаёт модель Lasso-регрессии.
@@ -278,6 +280,17 @@ type
 /// Используется для создания независимых экземпляров модели.
       function Clone: IModel;
       
+      /// Вектор коэффициентов модели.
+      /// Длина равна числу признаков.
+      /// Доступен после обучения (Fit).
+      property Coefficients: Vector read GetCoefficients;
+    
+      /// Свободный член модели (смещение, bias).
+      property Intercept: real read GetIntercept;
+    
+      /// Коэффициент L1-регуляризации.
+      property Alpha: real read fAlpha;
+      
       /// Показывает, была ли модель обучена.
       /// После вызова Fit значение становится True.
       property IsFitted: boolean read GetIsFitted;
@@ -2176,6 +2189,7 @@ type
   MLConfig = static class
   public
     /// Проверять ли входные данные моделей на NaN, Inf
+    /// Изменение этого флага влияет на все модели и все параллельные вычисления.
     static ValidateFiniteInputs: boolean := True;
   end;
 
@@ -2216,8 +2230,6 @@ const
     'Параметр learningRate должен быть > 0!!learningRate must be > 0';
   ER_SUBSAMPLE_OUT_OF_RANGE =
     'Параметр subsample должен быть в диапазоне (0, 1]!!subsample must be in (0, 1]'; 
-  ER_LABELS_NOT_INTEGER =
-    'Метки классов должны быть целыми!!Class labels must be integers'; 
   ER_N_ESTIMATORS_INVALID =
     'nEstimators должен быть > 0!!nEstimators must be > 0';
   ER_LEARNING_RATE_INVALID =
@@ -2479,6 +2491,9 @@ begin
   if not ffitted then
     NotFittedError(ER_FIT_NOT_CALLED);
   
+  if X = nil then
+    ArgumentNullError(ER_X_NULL);
+  
   if MLConfig.ValidateFiniteInputs then
     CheckXForPredict(X);
 
@@ -2848,6 +2863,16 @@ begin
   Result := new LassoRegression(fAlpha, fMaxIter, fTol);
 end;
 
+function LassoRegression.GetCoefficients: Vector;
+begin
+  Result := fModel.Coefficients;
+end;
+
+function LassoRegression.GetIntercept: real;
+begin
+  Result := fModel.Intercept;
+end;
+
 function LassoRegression.GetIsFitted: boolean;
 begin
   Result := (fModel <> nil) and fModel.IsFitted;
@@ -8592,14 +8617,16 @@ begin
   var p := X.ColCount;
 
   Result := new Matrix(n, p);
+  
+  var scale := fRangeMax - fRangeMin;
 
   for var i := 0 to n - 1 do
     for var j := 0 to p - 1 do
     begin
       var range := fMax[j] - fMin[j];
 
-      if range <> 0 then
+      if (scale > 1e-12) and (range > 1e-12) then
-        Result[i,j] := X[i,j] * range + fMin[j]
+        Result[i,j] := (X[i,j] - fRangeMin) / scale * range + fMin[j]
       else
         Result[i,j] := fMin[j];
     end;
@@ -8643,19 +8670,11 @@ begin
     ArgumentOutOfRangeError(ER_K_EXCEEDS_FEATURES, fK);
 
   fFeatureCount := X.ColCount;
-
+  
-  // --- центрирование
   fMean := X.ColumnMeans;
 
-  var Xc := X.Clone;
+  var (W, variances) := X.PCA(fK);
-
+  
-  for var j := 0 to X.ColCount - 1 do
-    for var i := 0 to X.RowCount - 1 do
-      Xc[i,j] -= fMean[j];
-
-  // --- PCA
-  var (W, variances) := Xc.PCA(fK);
-
   fComponents := W;
 
   fFitted := true;

bin/Lib/MLUtilsABC.pas

@@ -100,8 +100,6 @@ const
     '{0} не может быть nil!!{0} cannot be nil';
   ER_LABELS_ARRAY_NULL =
     'labels не может быть nil!!labels cannot be nil';
-  ER_LABELS_NOT_INTEGER =
-    'Метки классов должны быть целыми числами!!Class labels must be integers';
   ER_UNKNOWN_CLASS_IN_TRANSFORM =
     'Неизвестное значение класса "{0}" при преобразовании меток!!Unknown class value "{0}" in TransformLabels';
   ER_LABEL_INDEX_OUT_OF_RANGE =

bin/Lib/PABCSystem.pas

@@ -3209,6 +3209,15 @@ type
 /// Функция для перевода сообщений об ошибках
 function GetTranslation(message: string): string;
 
+function FormatSafe(msg: string; args: array of object): string;
+
+/// Вызывает System.ArgumentException с локализованным форматированным сообщением msg
+procedure RaiseArgumentException(msg: string; params args: array of object);
+/// Вызывает System.ArgumentNullException с локализованным форматированным сообщением msg, используя paramName как аргумент шаблона
+procedure RaiseArgumentNullException(msg: string; paramName: string);
+/// Вызывает System.ArgumentOutOfRangeException с локализованным форматированным сообщением msg, используя paramName как аргумент шаблона
+procedure RaiseArgumentOutOfRangeException(msg: string; paramName: string);
+
 const __PascalABCDir = 'меняется на этапе компиляции';
 
 /// Возвращает каталог запуска PascalABC.NET
@@ -3281,7 +3290,8 @@ const
   SEQUENCE_CANNOT_BE_EMPTY = 'Последовательность не может быть пустой!!Sequence cannot be empty';
   ARRAY_CANNOT_BE_EMPTY = 'Массив не может быть пустым!!Array cannot be empty';
   MIN_CANNOT_BE_GREATER_THAN_MAX = 'Clamp: min не может быть больше чем max!!Clamp: min cannot be greater than max';
-  SUBSTRING_CANNOT_BE_EMPTY = 'Подстрока не может быть пустой!!Substring cannot be empty';
+  PARAMETER_MUST_BE_GREATER_THAN0_0 = 'Параметр {0} должен быть > 0!!Parameter {0} must be > 0';
+  SUBSTRING_CANNOT_BE_EMPTY_0 = 'Подстрока {0} не может быть пустой!!Substring {0} cannot be empty';
 // -----------------------------------------------------
 //                  WINAPI
 // -----------------------------------------------------
@@ -3318,6 +3328,31 @@ begin
     Result := arr[0]
 end;
 
+function FormatSafe(msg: string; args: array of object): string;
+begin
+  var text := GetTranslation(msg);
+  try
+    Result := Format(text, args);
+  except
+    Result := text;
+  end;
+end;
+
+procedure RaiseArgumentException(msg: string; params args: array of object);
+begin
+  raise new System.ArgumentException(FormatSafe(msg, args));
+end;
+
+procedure RaiseArgumentNullException(msg: string; paramName: string);
+begin
+  raise new System.ArgumentNullException(FormatSafe(msg, Arr&<object>(paramName)));
+end;
+
+procedure RaiseArgumentOutOfRangeException(msg: string; paramName: string);
+begin
+  raise new System.ArgumentOutOfRangeException(FormatSafe(msg, Arr&<object>(paramName)));
+end;
+
 function ReadPascalABCRegistry(rootName: string): string;
 begin
   Result := nil;
@@ -3441,7 +3476,7 @@ procedure AssignSetWithBounds(var left: TypedSet; right: TypedSet; low, high: ob
 begin
   left := right.CloneSet();
   left.low_bound := low;
-  right.upper_bound := high;
+  left.upper_bound := high;
 end;
 
 procedure TypedSetInit(var st: TypedSet);
@@ -5556,10 +5591,8 @@ end;
 
 function PartitionPoints(a, b: real; n: integer): sequence of real;
 begin
-  if n = 0 then
+  if n <= 0 then
-    raise new System.ArgumentException('Range: n = 0');
+    RaiseArgumentException(PARAMETER_MUST_BE_GREATER_THAN0_0, 'n');
-  if n < 0 then
-    raise new System.ArgumentException('Range: n < 0');
   var r := a;
   var h := (b - a) / n;
   for var i := 0 to n do
@@ -5585,53 +5618,37 @@ end;
 function Range(a, b, step: BigInteger): sequence of BigInteger;
 begin
   if step = 0 then
-    raise new System.ArgumentException('step = 0');
+    RaiseArgumentException(PARAMETER_STEP_MUST_BE_NOT_EQUAL_0);
-  if step > 0 then
+
-    while a<=b do
+  var x := a;
-    begin
+
-      yield a;
+  while (step > 0) and (x <= b) or (step < 0) and (x >= b) do
-      a += step;
+  begin
-    end
+    yield x;
-  else  
+    x += step;
-    while a>=b do
+  end;
-    begin
-      yield a;
-      a += step;
-    end
 end;
 
 function Range(a, b: BigInteger): sequence of BigInteger := Range(a,b,1);
 
-type
-  ArithmSeq = auto class
-    a, step: integer;
-    function f(x: integer): integer;
-    begin
-      Result := x * step + a;
-    end;
-  end;
-
 function Range(a, b, step: integer): sequence of integer;
 begin
   if step = 0 then
-    raise new System.ArgumentException('step = 0');
+    RaiseArgumentException(PARAMETER_STEP_MUST_BE_NOT_EQUAL_0);
-  if (step > 0) and (b < a) or (step < 0) and (b > a) then
+
+  var x := a;
+
+  while (step > 0) and (x <= b) or (step < 0) and (x >= b) do
   begin
-    Result := System.Linq.Enumerable.Empty&<integer>;
+    yield x;
-    exit;
+    x += step;
   end;
-  var n := abs((b - a) div step) + 1;
-  var ar: ArithmSeq;
-  {if step<0 then
-    ar := new ArithmSeq(b,step)
-  else} ar := new ArithmSeq(a, step);
-  Result := System.Linq.Enumerable.Range(0, n).Select(ar.f);
 end;
 
 function Range(a, b, step: real): sequence of real;
 begin
   if step = 0 then
-    raise new System.ArgumentException('step = 0');
+    RaiseArgumentException(PARAMETER_STEP_MUST_BE_NOT_EQUAL_0);
   if (step > 0) and (b < a) or (step < 0) and (b > a) then
     exit;
   if a = b then 
@@ -9064,11 +9081,9 @@ end;
 
 function DeleteFile(fileName: string): boolean;
 begin
-  if not &File.Exists(fileName) then
+  if not FileExists(fileName) then
-  begin
+    exit(False);
-    Result := False;
+  
-    exit
-  end;
   try
     Result := True;
     &File.Delete(fileName);
@@ -9137,18 +9152,12 @@ procedure Assert(cond: boolean; sourceFile: string; line: integer);
 begin
   if (Environment.OSVersion.Platform = PlatformID.Unix) or (Environment.OSVersion.Platform = PlatformID.MacOSX) or IsWDE then
   begin
-    //var stackTrace := new System.Diagnostics.StackTrace(true);
-    //var ind := 1;
-    //if stackTrace.GetFrame(0).GetMethod().Name <> 'Assert' then
-      //ind := 0;
-    //var currentLine := stackTrace.GetFrame(ind).GetFileLineNumber();
-    //var currentFile := stackTrace.GetFrame(ind).GetFileName();
     if not IsWDE then
       System.Diagnostics.Debug.Assert(cond, 'Файл ' + sourceFile + ', строка ' + line.ToString())
     else if not cond then
     begin
       var err := 'Сбой подтверждения: ' + Environment.NewLine + 'Файл ' + sourceFile + ', строка ' + line.ToString();
-      writeln(err);
+      Writeln(err);
       System.Threading.Thread.Sleep(500);
       raise new Exception();
     end;
@@ -9163,12 +9172,6 @@ procedure Assert(cond: boolean; message: string; sourceFile: string; line: integ
 begin
   if (Environment.OSVersion.Platform = PlatformID.Unix) or (Environment.OSVersion.Platform = PlatformID.MacOSX) or IsWDE then
   begin
-    //var stackTrace := new System.Diagnostics.StackTrace(true);
-    //var ind := 1;
-    //if stackTrace.GetFrame(0).GetMethod().Name <> 'Assert' then
-    //  ind := 0;
-    //var currentLine := stackTrace.GetFrame(ind).GetFileLineNumber();
-    //var currentFile := stackTrace.GetFrame(ind).GetFileName();
     if not IsWDE then
       System.Diagnostics.Debug.Assert(cond, 'Файл ' + sourceFile + ', строка ' + line.ToString() + ': ' + message)
     else if not cond then
@@ -9234,20 +9237,41 @@ begin
   Result := DiskSize(ConvertDiskToDiskName(disk));
 end;
 
-var
+{var
   curr_time := DateTime.Now;
 
 function Milliseconds: integer;
 begin
   curr_time := DateTime.Now;
-  Milliseconds := Convert.ToInt32((curr_time - StartTime).TotalMilliseconds);
+  Milliseconds := Round((curr_time - StartTime).TotalMilliseconds);
 end;
 
 function MillisecondsDelta: integer;
 begin
   var t := DateTime.Now;  
-  Result := Convert.ToInt32((t - curr_time).TotalMilliseconds);
+  Result := Round((t - curr_time).TotalMilliseconds);
-  curr_time := DateTime.Now;
+  curr_time := t;
+end;}
+
+var startTimestamp := Stopwatch.GetTimestamp;
+var lastTimestamp  := startTimestamp;
+var sync := new object;
+
+function Milliseconds: integer;
+begin
+  var now := Stopwatch.GetTimestamp;
+  Result := integer((now - startTimestamp) * 1000 div Stopwatch.Frequency);
+end;
+
+function MillisecondsDelta: integer;
+begin
+  lock sync do
+  begin
+    var now := Stopwatch.GetTimestamp;
+    var delta := (now - lastTimestamp) * 1000 div Stopwatch.Frequency;
+    lastTimestamp := now;
+    Result := integer(delta);
+  end;
 end;
 
 procedure Halt;
@@ -9666,23 +9690,22 @@ end;
 function RandomReal(a, b: real; digits: integer): real;
 begin
   if digits<0 then
-    Result := Random(a,b)
+    exit(Random(a,b));
-  else begin
+  
-    // Бывают некорректные данные. Например, найти точку с 2 знаками на [2.736, 2.737]. Тогда возвращать a скажем
+  // Бывают некорректные данные. Например, найти точку с 2 знаками на [2.736, 2.737]. Тогда возвращать a скажем
-    var step := 1/10**digits;
+  var step := 1/10**digits;
-    Result := Round(Random(a,b),digits);
+  Result := Round(Random(a,b),digits);
+  if Result < a then
+  begin  
+    Result += step;
+    if Result > b then
+      Result := b
+  end  
+  else if Result > b then 
+  begin  
+    Result -= step;
     if Result < a then
-    begin  
+      Result := a;
-      Result += step;
-      if Result > b then
-        Result := b
-    end  
-    else if Result > b then 
-    begin  
-      Result -= step;
-      if Result < a then
-        Result := a;
-    end;  
   end;  
 end;
 
@@ -10430,7 +10453,7 @@ end;
 
 function Trim(s: string): string;
 begin
-  Result := s.Trim(|' '|);
+  Result := s.Trim(' ');
 end;
 
 function TrimLeft(s: string): string;
@@ -15185,6 +15208,9 @@ end;
 function IndicesOf(Self, SubS: string; overlay: boolean := False): sequence of integer; extensionmethod;
 // Реализует КМП-алгоритм.
 begin
+  if string.IsNullOrEmpty(SubS) then
+    RaiseArgumentException(SUBSTRING_CANNOT_BE_EMPTY_0, 'SubS');
+  
   var L := new List<integer>;
   var (n, m) := (Self.Length, SubS.Length);
   var border := PrefixFunction(SubS);
@@ -15216,7 +15242,7 @@ end;
 function CountOf(Self: string; substring: string; allowOverlap: boolean := false): integer; extensionmethod;
 begin
   if string.IsNullOrEmpty(substring) then
-    raise new System.ArgumentException(GetTranslation(SUBSTRING_CANNOT_BE_EMPTY));
+    RaiseArgumentException(SUBSTRING_CANNOT_BE_EMPTY_0, 'substring');
   
   Result := 0;
   var i := 1;

bin/Lib/PreprocessorABC.pas

@@ -44,6 +44,8 @@ type
 /// Кодирует строковый категориальный столбец в целочисленные индексы (0,1,2,...).
 /// Соответствие значений и индексов фиксируется при вызове Fit
 /// в порядке первого появления категорий.
+/// Пропущенные значения (NA) игнорируются при обучении
+/// и сохраняются как пропуски при преобразовании.
 /// Работает только со строковыми столбцами и предназначен для признаков.
 /// Не должен применяться к целевому столбцу (target).
   LabelEncoder = class(IPreprocessor, IColumnBoundStep)
@@ -170,32 +172,11 @@ implementation
 uses MLExceptions;
 
 const
-  ER_SCALER_NO_COLUMNS =
-    'StandardScaler: столбцы не указаны!!StandardScaler: columns not specified';
-  ER_SCALER_COLUMN_NOT_NUMERIC =
-    'StandardScaler: столбец "{0}" не является числовым!!StandardScaler: column "{0}" is not numeric';  
-  ER_SCALER_NO_VALID_VALUES =
-    'StandardScaler: столбец "{0}" не содержит допустимых значений!!' +
-    'StandardScaler: column "{0}" has no valid values';
-  ER_SCALER_ZERO_VARIANCE =
-    'StandardScaler: нулевая дисперсия в столбце "{0}"!!' +
-    'StandardScaler: zero variance in column "{0}"';
-  ER_MINMAX_NO_COLUMNS =
-    'MinMaxScaler: столбцы не указаны!!MinMaxScaler: columns not specified';
-  ER_MINMAX_COLUMN_NOT_NUMERIC =
-    'MinMaxScaler: столбец "{0}" не является числовым!!MinMaxScaler: column "{0}" is not numeric';
-  ER_MINMAX_NO_VALID_VALUES =
-    'MinMaxScaler: столбец "{0}" не содержит допустимых значений!!' +
-    'MinMaxScaler: column "{0}" has no valid values';
-  ER_MINMAX_CONSTANT_COLUMN =
-    'MinMaxScaler: постоянный столбец "{0}"!!MinMaxScaler: constant column "{0}"';
   ER_LABELENCODER_NO_COLUMN =
     'LabelEncoder: столбец не указан!!LabelEncoder: column not specified';
   ER_LABELENCODER_NOT_STRING =
     'LabelEncoder: столбец "{0}" не является строковым!!' +
     'LabelEncoder: column "{0}" is not string';
-  ER_LABELENCODER_NA =
-    'LabelEncoder: NA значение не допускается!!LabelEncoder: NA value not allowed';
   ER_LABELENCODER_UNSEEN_CATEGORY =
     'LabelEncoder: неизвестная категория "{0}"!!' +
     'LabelEncoder: unseen category "{0}"';

bin/Lib/ValidationML.pas

@@ -135,7 +135,8 @@ const
     'Для {0} требуется как минимум 2 объекта!!' +
     'At least 2 samples are required for {0}';
   ER_STRATIFIED_CLASS_TOO_SMALL =
-    'Класс {0} содержит {1} объектов, что меньше числа фолдов ({2})!!Class {0} has {1} samples, which is less than the number of folds ({2})';    
+    'Класс {0} содержит {1} объектов, что меньше числа фолдов ({2}). Уменьшите k или объедините малочисленные классы.!!' +
+    'Class {0} has {1} samples, which is less than the number of folds ({2}). Reduce k or merge very small classes.';
   ER_STRATIFIED_K_TOO_LARGE =
     'Stratified CV: число фолдов ({0}) превышает минимальный размер класса ({1})!!Stratified CV: number of folds ({0}) exceeds smallest class size ({1})';