diff --git a/Compiler/PCU/PCUReader.cs b/Compiler/PCU/PCUReader.cs index ca1bd8b2f..f0135cf37 100644 --- a/Compiler/PCU/PCUReader.cs +++ b/Compiler/PCU/PCUReader.cs @@ -3016,6 +3016,15 @@ namespace PascalABCCompiler.PCU br.ReadInt32();//namespace type_node cnst_type = GetTypeReference(); constant_node en = (constant_node)CreateExpressionWithOffset(); + + // SSM 10.03.26 Вклиниваемся сюда и подменяем значение константы __PascalABCDir. + // Для стандартных модулей, откомпилированных в pcu, это всё равно работать не будет + /*if (name == "__PascalABCDir") + { + var value = System.AppDomain.CurrentDomain.BaseDirectory; + en = new string_const_node(value, en.location); + }*/ + en.type = cnst_type; location loc = ReadDebugInfo(); ncd = new namespace_constant_definition(name, en, loc, cun.namespaces[(is_interface)?0:1]); diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 210ad5f14..e7a245651 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -15,7 +15,7 @@ internal static class RevisionClass public const string Major = "3"; public const string Minor = "11"; public const string Build = "1"; - public const string Revision = "3768"; + public const string Revision = "3773"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 9b8265266..b217f7047 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=1 -%REVISION%=3768 %MINOR%=11 +%REVISION%=3773 +%COREVERSION%=1 %MAJOR%=3 diff --git a/InstallerSamples/MachineLearning/08_Datasets/01_MakeBlobs.pas b/InstallerSamples/MachineLearning/08_Datasets/01_MakeBlobs.pas index c8fa2c046..e62b15fae 100644 --- a/InstallerSamples/MachineLearning/08_Datasets/01_MakeBlobs.pas +++ b/InstallerSamples/MachineLearning/08_Datasets/01_MakeBlobs.pas @@ -3,7 +3,6 @@ uses MLABC, PlotML; begin - // --- генерируем синтетические данные var centers := 3; var (X,y) := Datasets.MakeBlobs( n := 600, @@ -12,20 +11,10 @@ begin seed := 1 ); - var n := X.RowCount; - - // --- визуализация Plot.Title('MakeBlobs синтетический датасет'); - Plot.XLabel('признак 1'); - Plot.YLabel('признак 2'); - - for var c := 0 to centers-1 do - begin - var ind := y.ToArray.Indices(v -> Round(v) = c).ToArray; - - var xs := ind.ConvertAll(i -> X[i,0]); - var ys := ind.ConvertAll(i -> X[i,1]); - - Plot.Points(xs, ys, size := 3, legend := 'кластер ' + c); - end; + + var xs := X.Col(0); + var ys := X.Col(1); + + Plot.Points(xs, ys, LabelsToInts(y), size := 4); end. \ No newline at end of file diff --git a/InstallerSamples/MachineLearning/08_Datasets/02_MakeMoons.pas b/InstallerSamples/MachineLearning/08_Datasets/02_MakeMoons.pas new file mode 100644 index 000000000..339dc13ac --- /dev/null +++ b/InstallerSamples/MachineLearning/08_Datasets/02_MakeMoons.pas @@ -0,0 +1,15 @@ +// MakeMoons синтетический датасет. +// Демонстрирует генерацию данных в форме двух «лун». +uses MLABC, PlotML; + +begin + var (X,y) := Datasets.MakeMoons( + n := 600, + noise := 0.1, + seed := 1 + ); + + Plot.Title('MakeMoons синтетический датасет'); + + Plot.Points(X.Col(0), X.Col(1), LabelsToInts(y), size := 4); +end. \ No newline at end of file diff --git a/InstallerSamples/MachineLearning/08_Datasets/03_MakeRegression.pas b/InstallerSamples/MachineLearning/08_Datasets/03_MakeRegression.pas new file mode 100644 index 000000000..86ecce750 --- /dev/null +++ b/InstallerSamples/MachineLearning/08_Datasets/03_MakeRegression.pas @@ -0,0 +1,20 @@ +// MakeRegression синтетический датасет. +// Демонстрирует генерацию данных для задачи линейной регрессии. +uses MLABC, PlotML; + +begin + // --- генерируем синтетические данные + var (X,y) := Datasets.MakeRegression( + n := 500, + nFeatures := 1, + noise := 0.2, + seed := 1 + ); + + // --- визуализация + Plot.Title('MakeRegression синтетический датасет'); + Plot.XLabel('признак'); + Plot.YLabel('целевая переменная'); + + Plot.Points(X.Col(0), y.ToArray, size := 3); +end. \ No newline at end of file diff --git a/InstallerSamples/MachineLearning/08_Datasets/04_MakeCircles.pas b/InstallerSamples/MachineLearning/08_Datasets/04_MakeCircles.pas new file mode 100644 index 000000000..5f91fcb0c --- /dev/null +++ b/InstallerSamples/MachineLearning/08_Datasets/04_MakeCircles.pas @@ -0,0 +1,16 @@ +// MakeCircles синтетический датасет. +// Демонстрирует генерацию данных в виде двух концентрических окружностей. +uses MLABC, PlotML; + +begin + var (X,y) := Datasets.MakeCircles( + n := 600, + noise := 0.05, + factor := 0.5, + seed := 1 + ); + + Plot.Title('MakeCircles синтетический датасет'); + + Plot.Points(X.Col(0), X.Col(1), LabelsToInts(y), size := 3); +end. \ No newline at end of file diff --git a/InstallerSamples/MachineLearning/08_Datasets/05_MakeSpiral.pas b/InstallerSamples/MachineLearning/08_Datasets/05_MakeSpiral.pas new file mode 100644 index 000000000..142487b9d --- /dev/null +++ b/InstallerSamples/MachineLearning/08_Datasets/05_MakeSpiral.pas @@ -0,0 +1,16 @@ +// MakeSpiral синтетический датасет. +// Демонстрирует генерацию данных в виде спиралей. +uses MLABC, PlotML; + +begin + var (X, y) := Datasets.MakeSpiral( + n := 600, + classes := 3, + turns := 2.5, + noise := 0.015, + seed := 1 + ); + + Plot.Title('MakeSpiral синтетический датасет'); + Plot.Points(X.Col(0), X.Col(1), LabelsToInts(y), size := 3); +end. \ No newline at end of file diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 292fe7b7f..5f7509154 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.11.1.3768 +3.11.1.3773 diff --git a/ReleaseGenerators/PascalABCNET_end.nsh b/ReleaseGenerators/PascalABCNET_end.nsh index 12a1430fe..f726d763c 100644 --- a/ReleaseGenerators/PascalABCNET_end.nsh +++ b/ReleaseGenerators/PascalABCNET_end.nsh @@ -24,7 +24,17 @@ Delete "$INSTDIR\gacutil.exe.config" Delete "$INSTDIR\gacutlrc.dll" Delete "$INSTDIR\ExecHide.exe" + WriteRegStr HKCU "${REGDIR}" "${INSTALLDIRREGKEY}" "$INSTDIR" + SetRegView 64 + WriteRegStr HKLM "${REGDIR}" "${INSTALLDIRREGKEY}" "$INSTDIR" + + ; переменная окружения + WriteRegExpandStr HKCU "Environment" "PASCALABCNET_DIR" "$INSTDIR\" + + ; уведомить систему, чтобы новые процессы увидели переменную + System::Call 'user32::SendMessageTimeoutA(i 0xffff,i ${WM_SETTINGCHANGE},i 0,t "Environment",i 0,i 1000,*i .r0)' + WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\PascalABCNET" \ "DisplayName" "PascalABC.NET" WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\PascalABCNET" \ diff --git a/ReleaseGenerators/PascalABCNET_head.nsh b/ReleaseGenerators/PascalABCNET_head.nsh index e2bcafd35..25dffb54f 100644 --- a/ReleaseGenerators/PascalABCNET_head.nsh +++ b/ReleaseGenerators/PascalABCNET_head.nsh @@ -3,7 +3,7 @@ !include PascalABCNET_version.nsh !define REGDIR "Software\PascalABC.NET" -!define INSTALLDIRREGKEY "Install Directory" +!define INSTALLDIRREGKEY "InstallDir" !define UninstLog "uninstall.log" InstType $(DESC_Common) diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 101295dfa..29d030df0 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.11.1.3768' +!define VERSION '3.11.1.3773' diff --git a/bin/Lib/LinearAlgebraML.pas b/bin/Lib/LinearAlgebraML.pas index c78885b56..678bed2cd 100644 --- a/bin/Lib/LinearAlgebraML.pas +++ b/bin/Lib/LinearAlgebraML.pas @@ -99,6 +99,9 @@ type function Clone: Matrix; + function Row(i: integer) := data.Row(i); + function Col(j: integer) := data.Col(j); + function ColumnSums: Vector; function RowSums: Vector; function ColumnMeans: Vector; diff --git a/bin/Lib/MLABC.pas b/bin/Lib/MLABC.pas index 2867c90c8..f8fddbf6f 100644 --- a/bin/Lib/MLABC.pas +++ b/bin/Lib/MLABC.pas @@ -79,7 +79,21 @@ type Datasets = MLDatasets.Datasets; +/// Преобразует вектор меток классов в массив целых чисел. +/// Используется при визуализации и других задачах, +/// где метки должны быть представлены как 0,1,2,... +/// Значения округляются функцией Round, чтобы устранить +/// возможные небольшие численные ошибки +function LabelsToInts(y: Vector): array of integer; + implementation + +function LabelsToInts(y: Vector): array of integer; +begin + if y = nil then + ArgumentNullError(ER_ARG_NULL, 'y'); + Result := ArrGen(y.Length, i -> Round(y[i])); +end; end. \ No newline at end of file diff --git a/bin/Lib/MLDatasets.pas b/bin/Lib/MLDatasets.pas index 8c2523157..301f5546f 100644 --- a/bin/Lib/MLDatasets.pas +++ b/bin/Lib/MLDatasets.pas @@ -5,6 +5,10 @@ interface uses DataFrameABC, LinearAlgebraML; type + /// Набор генераторов и загрузчиков датасетов для задач машинного обучения. + /// Содержит синтетические генераторы (MakeBlobs, MakeMoons, MakeRegression) + /// и реальные учебные датасеты (например, RussianHousing, StudentExam). + /// Используется в примерах, экспериментах и демонстрациях алгоритмов ML Datasets = static class public // --- Синтетические датасеты (Matrix + Vector) @@ -23,33 +27,84 @@ type centers: integer := 3; clusterStd: real := 1.0; nFeatures: integer := 2; - seed: integer := -1 - ): (Matrix, Vector); + shuffle: boolean := true; + seed: integer := -1): (Matrix, Vector); - /// Генерирует датасет "две луны" для демонстрации нелинейной классификации и кластеризации + /// Генерирует синтетический датасет «две луны» (two interleaving moons), + /// часто используемый для демонстрации алгоритмов классификации и кластеризации. + /// Возвращает матрицу признаков X (n × 2) и вектор меток классов y (0 или 1). + /// + /// • n — число генерируемых точек. + /// • noise — стандартное отклонение гауссовского шума, добавляемого к координатам. + /// • shuffle — перемешивать ли порядок объектов. + /// • seed — значение генератора случайных чисел (-1 означает использовать текущее время). static function MakeMoons( n: integer := 300; noise: real := 0.05; - seed: integer := 1): (Matrix, Vector); + shuffle: boolean := true; + seed: integer := -1): (Matrix, Vector); - /// Генерирует синтетический датасет для задач регрессии + /// Генерирует синтетический датасет для задачи линейной регрессии. + /// Данные создаются по модели y = Xβ + ε, где X — матрица признаков, + /// β — случайный вектор коэффициентов, ε — гауссовский шум. + /// Возвращает матрицу признаков X (n × nFeatures) и вектор целевой переменной y. + /// + /// • n — число объектов. + /// • nFeatures — число признаков. + /// • noise — стандартное отклонение гауссовского шума, добавляемого к y. + /// • shuffle — перемешивать ли порядок объектов. + /// • seed — значение генератора случайных чисел (-1 означает использовать текущее время). static function MakeRegression( n: integer := 300; + nFeatures: integer := 10; noise: real := 0.1; - seed: integer := 1): (Matrix, Vector); + shuffle: boolean := true; + seed: integer := -1): (Matrix, Vector); - /// Генерирует концентрические круги (сложная нелинейная классификация) + /// Генерирует синтетический датасет из двух концентрических окружностей. + /// Используется для демонстрации задач классификации и кластеризации, + /// где граница разделения является нелинейной. + /// + /// Датасет состоит из двух классов: + /// внешний круг (класс 0) и внутренний круг (класс 1). + /// При добавлении шума точки отклоняются от идеальной окружности. + /// + /// Полезен для демонстрации: + /// • преимуществ нелинейных моделей (RandomForest, GradientBoosting, kNN) + /// • работы DBSCAN и спектральной кластеризации + /// • ограничений линейных моделей (LogisticRegression, LinearSVM). + /// + /// • n — число объектов. + /// • noise — стандартное отклонение гауссовского шума, добавляемого к координатам. + /// • factor — отношение радиуса внутреннего круга к внешнему (0 < factor < 1). + /// • shuffle — перемешивать ли порядок объектов. + /// • seed — значение генератора случайных чисел (-1 означает использовать текущее время). static function MakeCircles( n: integer := 300; noise: real := 0.05; - seed: integer := 1): (Matrix, Vector); + factor: real := 0.5; + shuffle: boolean := true; + seed: integer := -1): (Matrix, Vector); - /// Генерирует спиральный датасет (очень сложная нелинейная классификация) + /// Генерирует синтетический датасет в виде спиралей. + /// Используется для демонстрации сложных нелинейных границ + /// классификации и возможностей нейросетей и деревьев решений. + /// + /// • n — число объектов. + /// • classes — число спиральных ветвей (классов). + /// • noise — стандартное отклонение гауссовского шума. + /// • turns — число оборотов спирали. + /// • radius — максимальный радиус спирали. + /// • shuffle — перемешивать ли порядок объектов. + /// • seed — значение генератора случайных чисел (-1 означает использовать текущее время). static function MakeSpiral( n: integer := 300; classes: integer := 2; - seed: integer := 1): (Matrix, Vector); - + noise: real := 0.1; + turns: real := 3.0; + radius: real := 1.0; + shuffle: boolean := true; + seed: integer := -1): (Matrix, Vector); // --- DataFrame датасеты (реалистичные таблицы, считываемые из csv) @@ -80,7 +135,13 @@ uses MLExceptions; const ER_PARAM_GT_ZERO = 'Параметр {0} должен быть > 0!!Parameter {0} must be > 0'; - + ER_PARAM_GT_ONE = + 'Параметр {0} должен быть > 1!!Parameter {0} must be > 1'; + ER_PARAM_GE_ZERO = + 'Параметр {0} должен быть >= 0!!Parameter {0} must be >= 0'; + ER_PARAM_BETWEEN_01 = + 'Параметр {0} должен быть в диапазоне (0,1)!!Parameter {0} must be in range (0,1)'; + function Normal(rnd: System.Random): real; begin var u1 := rnd.NextDouble; @@ -99,7 +160,8 @@ end; /// • seed — значение генератора случайных чисел (seed < 0 → случайный) static function Datasets.MakeBlobs( n: integer; centers: integer; - clusterStd: real; nFeatures: integer; seed: integer): (Matrix, Vector); + clusterStd: real; nFeatures: integer; + shuffle: boolean; seed: integer): (Matrix, Vector); begin if n <= 0 then ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); @@ -112,6 +174,248 @@ begin if nFeatures <= 0 then ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nFeatures'); + + var actualSeed := + if seed >= 0 then seed + else System.Environment.TickCount and integer.MaxValue; + + var rnd := new System.Random(actualSeed); + + var X := new Matrix(n, nFeatures); + var y := new Vector(n); + + // --- генерируем центры кластеров + var centersM := new Matrix(centers, nFeatures); + + for var c := 0 to centers - 1 do + for var j := 0 to nFeatures - 1 do + centersM[c, j] := rnd.NextDouble * 20 - 10; + + // --- индексы строк + var idx := Arr(0..n - 1); + if shuffle then + PABCSystem.Shuffle(idx, rnd); + + // --- генерация точек + for var i := 0 to n - 1 do + begin + var row := idx[i]; + + var c := rnd.Next(centers); + y[row] := c; + + for var j := 0 to nFeatures - 1 do + X[row, j] := centersM[c, j] + clusterStd * Normal(rnd); + end; + + Result := (X, y); +end; + +static function Datasets.MakeMoons( + n: integer; + noise: real; + shuffle: boolean; + seed: integer): (Matrix, Vector); +begin + if n <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); + + if noise < 0 then + ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise'); + + var actualSeed := + if seed >= 0 then seed + else System.Environment.TickCount and integer.MaxValue; + + var rnd := new System.Random(actualSeed); + + var X := new Matrix(n, 2); + var y := new Vector(n); + + var idx := Arr(0..n - 1); + if shuffle then + PABCSystem.Shuffle(idx, rnd); + + var half := n div 2; + + // --- первая луна + for var i := 0 to half - 1 do + begin + var row := idx[i]; + var t := rnd.NextDouble * Pi; + + y[row] := 0; + + X[row, 0] := Cos(t); + X[row, 1] := Sin(t); + + if noise > 0 then + begin + X[row, 0] += noise * Normal(rnd); + X[row, 1] += noise * Normal(rnd); + end; + end; + + // --- вторая луна + for var i := half to n - 1 do + begin + var row := idx[i]; + var t := rnd.NextDouble * Pi; + + y[row] := 1; + + X[row, 0] := 1 - Cos(t); + X[row, 1] := 0.5 - Sin(t); + + if noise > 0 then + begin + X[row, 0] += noise * Normal(rnd); + X[row, 1] += noise * Normal(rnd); + end; + end; + + Result := (X, y); +end; + +static function Datasets.MakeRegression( + n: integer; + nFeatures: integer; + noise: real; + shuffle: boolean; + seed: integer): (Matrix, Vector); +begin + if n <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); + + if nFeatures <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nFeatures'); + + if noise < 0 then + ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise'); + + var actualSeed := + if seed >= 0 then seed + else System.Environment.TickCount and integer.MaxValue; + + var rnd := new System.Random(actualSeed); + + var X := new Matrix(n, nFeatures); + var y := new Vector(n); + + // --- истинные коэффициенты β + var beta := new Vector(nFeatures); + for var j := 0 to nFeatures - 1 do + beta[j] := Normal(rnd); + + var idx := Arr(0..n - 1); + if shuffle then + PABCSystem.Shuffle(idx, rnd); + + // --- генерация данных + for var i := 0 to n - 1 do + begin + var row := idx[i]; + + var s := 0.0; + + for var j := 0 to nFeatures - 1 do + begin + var xx := Normal(rnd); + X[row, j] := xx; + s += xx * beta[j]; + end; + + y[row] := s + noise * Normal(rnd); + end; + + Result := (X, y); +end; + +static function Datasets.MakeCircles(n: integer; noise: real; + factor: real; shuffle: boolean; seed: integer): (Matrix, Vector); +begin + if n <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); + + if noise < 0 then + ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise'); + + if (factor <= 0) or (factor >= 1) then + ArgumentOutOfRangeError(ER_PARAM_BETWEEN_01, 'factor'); + + var actualSeed := + if seed >= 0 then seed + else System.Environment.TickCount and integer.MaxValue; + + var rnd := new System.Random(actualSeed); + + var X := new Matrix(n, 2); + var y := new Vector(n); + + var idx := Arr(0..n - 1); + if shuffle then + PABCSystem.Shuffle(idx, rnd); + + var half := n div 2; + + // --- внешний круг + for var i := 0 to half - 1 do + begin + var row := idx[i]; + var t := 2*Pi*i/half + 0.1*Normal(rnd); + + y[row] := 0; + + X[row, 0] := Cos(t); + X[row, 1] := Sin(t); + + if noise > 0 then + begin + X[row, 0] += noise * Normal(rnd); + X[row, 1] += noise * Normal(rnd); + end; + end; + + // --- внутренний круг + for var i := half to n - 1 do + begin + var row := idx[i]; + var t := 2*Pi*(i-half)/half + 0.1*Normal(rnd); + + y[row] := 1; + + X[row, 0] := factor * Cos(t); + X[row, 1] := factor * Sin(t); + + if noise > 0 then + begin + X[row, 0] += noise * Normal(rnd); + X[row, 1] += noise * Normal(rnd); + end; + end; + + Result := (X, y); +end; + +static function Datasets.MakeSpiral( + n: integer; classes: integer; + noise: real; turns: real; radius: real; + shuffle: boolean; seed: integer): (Matrix, Vector); +begin + if n <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); + + if classes <= 1 then + ArgumentOutOfRangeError(ER_PARAM_GT_ONE, 'classes'); + + if noise < 0 then + ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise'); + + if turns <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'turns'); + + if radius <= 0 then + ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'radius'); var actualSeed := if seed >= 0 then seed @@ -119,61 +423,37 @@ begin var rnd := new System.Random(actualSeed); - var X := new Matrix(n, nFeatures); + var X := new Matrix(n,2); var y := new Vector(n); - // --- генерируем центры кластеров - var centersM := new Matrix(centers, nFeatures); + var idx := Arr(0..n-1); + if shuffle then + PABCSystem.Shuffle(idx, rnd); - for var c := 0 to centers - 1 do - for var j := 0 to nFeatures - 1 do - centersM[c,j] := rnd.NextDouble * 20 - 10; + var perClass := n div classes; - // --- генерация точек - for var i := 0 to n - 1 do + for var c := 0 to classes-1 do begin - var c := rnd.Next(centers); - y[i] := c; + for var i := 0 to perClass-1 do + begin + var row := idx[c*perClass + i]; + + var u := i / perClass; - for var j := 0 to nFeatures - 1 do - X[i,j] := centersM[c,j] + clusterStd * Normal(rnd); + var r := radius * u; + + var t := turns * 2 * Pi * u + c * 2 * Pi / classes + noise * 0.5 * Normal(rnd); + + y[row] := c; + + X[row,0] := r * Cos(t) + noise * Normal(rnd); + X[row,1] := r * Sin(t) + noise * Normal(rnd); + end; end; Result := (X, y); end; -static function Datasets.MakeMoons( - n: integer ; - noise: real ; - seed: integer): (Matrix, Vector); -begin - Result := nil; -end; - -static function Datasets.MakeRegression( - n: integer ; - noise: real ; - seed: integer): (Matrix, Vector); -begin - Result := nil; -end; - -static function Datasets.MakeCircles( - n: integer ; - noise: real ; - seed: integer): (Matrix, Vector); -begin - Result := nil; -end; - -static function Datasets.MakeSpiral( - n: integer ; - classes: integer ; - seed: integer): (Matrix, Vector); -begin - Result := nil; -end; - static function Datasets.RussianHousing: DataFrame; begin Result := nil; diff --git a/bin/Lib/MLModelsABC.pas b/bin/Lib/MLModelsABC.pas index b156ab440..2325eeea2 100644 --- a/bin/Lib/MLModelsABC.pas +++ b/bin/Lib/MLModelsABC.pas @@ -1653,13 +1653,22 @@ type function Clone: ITransformer; end; - {$endregion Transformers} + +{$region Utility functions} +/// Преобразует вектор меток классов в массив целых. +/// Предполагается, что значения y являются целыми +/// (0,1,2,...) и могут содержать небольшие +/// численные ошибки, поэтому используется Round. +function LabelsToInts(y: Vector): array of integer; + +{$endregion Utility functions} + var /// Проверять ли входные данные моделей на NaN, Inf - ValidateFiniteInputs := true; + ValidateFiniteInputs := True; implementation @@ -8085,5 +8094,10 @@ begin Result := t; end; +function LabelsToInts(y: Vector): array of integer; +begin + Result := ArrGen(y.Length, i -> Round(y[i])); +end; + end. \ No newline at end of file diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index 3d749bc8d..4bd874cbf 100644 --- a/bin/Lib/PABCSystem.pas +++ b/bin/Lib/PABCSystem.pas @@ -3208,6 +3208,12 @@ type /// Функция для перевода сообщений об ошибках function GetTranslation(message: string): string; + +const __PascalABCDir = 'меняется на этапе компиляции'; + +/// Возвращает каталог запуска PascalABC.NET +/// (каталог, содержащий PascalABCNET.exe или консольный компилятор) +function PascalABCDirectory: string; // ----------------------------------------------------- // Internal procedures for PABCRTL.dll @@ -3312,6 +3318,58 @@ begin Result := arr[0] end; +function ReadPascalABCRegistry(rootName: string): string; +begin + Result := nil; + + try + var t := System.Type.GetType('Microsoft.Win32.Registry, mscorlib'); + if t = nil then exit; + + var root := t.GetProperty(rootName).GetValue(nil,nil); + if root = nil then exit; + + var openSubKey := root.GetType.GetMethod('OpenSubKey'); + var key := openSubKey.Invoke(root, new object[]('Software\PascalABC.NET')); + if key = nil then exit; + + var getValue := key.GetType.GetMethod('GetValue'); + var v := getValue.Invoke(key, new object[]('InstallDir')); + + if v <> nil then + Result := v.ToString; + except + end; +end; + +function PascalABCDirectory: string; +begin + // --- переменная окружения пользователя + Result := System.Environment.GetEnvironmentVariable( + 'PASCALABCNET_DIR', + System.EnvironmentVariableTarget.User + ); + + // --- переменная окружения системы + if Result = nil then + Result := System.Environment.GetEnvironmentVariable( + 'PASCALABCNET_DIR', + System.EnvironmentVariableTarget.Machine + ); + + // --- реестр HKLM + if Result = nil then + Result := ReadPascalABCRegistry('LocalMachine'); + + // --- реестр HKCU + if Result = nil then + Result := ReadPascalABCRegistry('CurrentUser'); + + // --- нормализация пути + if (Result <> nil) and not Result.EndsWith('\') then + Result := Result + '\'; +end; + constructor ZeroStepException.Create; begin inherited Create(GetTranslation(FOR_STEP_CANNOT_BE_EQUAL0)) diff --git a/bin/Lib/PlotML.pas b/bin/Lib/PlotML.pas index c8c6e9d87..333498680 100644 --- a/bin/Lib/PlotML.pas +++ b/bin/Lib/PlotML.pas @@ -112,6 +112,9 @@ type color: ColorWPF? := nil; thickness: real := 2; legend: string := nil); static procedure Points(x, y: array of real; color: ColorWPF? := nil; size: real := 6; marker: MarkerType := MarkerType.Circle; legend: string := nil); + static procedure Points(x, y: array of real; + labels: array of integer; color: ColorWPF? := nil; size: real := 6; marker: MarkerType := MarkerType.Circle); + static procedure Heatmap(m: array[,] of real); static function Grid(rows,cols: integer): Figure; @@ -124,6 +127,7 @@ type static procedure Title(s: string); static procedure XLabel(s: string); static procedure YLabel(s: string); + static procedure SetLabels(title: string := ''; xlabel: string := ''; ylabel: string := ''); static procedure Clear; @@ -528,6 +532,21 @@ begin end); end; +static procedure Plot.SetLabels(title: string; xlabel: string; ylabel: string); +begin + RunUI(() -> + begin + if title <> '' then + rootChart.Title := title; + + if xlabel <> '' then + rootChart.BottomTitle := xlabel; + + if ylabel <> '' then + rootChart.LeftTitle := ylabel; + end); +end; + static procedure Plot.Clear; begin RunUI(() -> @@ -673,6 +692,28 @@ begin end); end; +static procedure Plot.Points(x, y: array of real; labels: array of integer; + color: ColorWPF?; size: real; marker: MarkerType); +begin + if (x = nil) or (y = nil) or (labels = nil) then + raise new System.ArgumentNullException; + + if (x.Length <> y.Length) or (x.Length <> labels.Length) then + raise new System.ArgumentException('Points: array sizes mismatch'); + + var k := labels.Max + 1; + + for var c := 0 to k-1 do + begin + var ind := labels.Indices(v -> v = c).ToArray; + + var xs := ind.ConvertAll(i -> x[i]); + var ys := ind.ConvertAll(i -> y[i]); + + Points(xs, ys, color, size, marker, 'cluster ' + c); + end; +end; + static procedure Plot.Heatmap(m: array[,] of real); begin RunUI(() ->