function PascalABCDirectory: string;

ML - Datasets, мелкие правки, примеры
This commit is contained in:
Mikhalkovich Stanislav 2026-03-10 13:32:40 +03:00
parent 779dc358b6
commit a40a45d47a
18 changed files with 566 additions and 81 deletions

View file

@ -3016,6 +3016,15 @@ namespace PascalABCCompiler.PCU
br.ReadInt32();//namespace br.ReadInt32();//namespace
type_node cnst_type = GetTypeReference(); type_node cnst_type = GetTypeReference();
constant_node en = (constant_node)CreateExpressionWithOffset(); 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; en.type = cnst_type;
location loc = ReadDebugInfo(); location loc = ReadDebugInfo();
ncd = new namespace_constant_definition(name, en, loc, cun.namespaces[(is_interface)?0:1]); ncd = new namespace_constant_definition(name, en, loc, cun.namespaces[(is_interface)?0:1]);

View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3"; public const string Major = "3";
public const string Minor = "11"; public const string Minor = "11";
public const string Build = "1"; public const string Build = "1";
public const string Revision = "3768"; public const string Revision = "3773";
public const string MainVersion = Major + "." + Minor; public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

View file

@ -1,4 +1,4 @@
%COREVERSION%=1
%REVISION%=3768
%MINOR%=11 %MINOR%=11
%REVISION%=3773
%COREVERSION%=1
%MAJOR%=3 %MAJOR%=3

View file

@ -3,7 +3,6 @@
uses MLABC, PlotML; uses MLABC, PlotML;
begin begin
// --- генерируем синтетические данные
var centers := 3; var centers := 3;
var (X,y) := Datasets.MakeBlobs( var (X,y) := Datasets.MakeBlobs(
n := 600, n := 600,
@ -12,20 +11,10 @@ begin
seed := 1 seed := 1
); );
var n := X.RowCount;
// --- визуализация
Plot.Title('MakeBlobs синтетический датасет'); Plot.Title('MakeBlobs синтетический датасет');
Plot.XLabel('признак 1');
Plot.YLabel('признак 2'); var xs := X.Col(0);
var ys := X.Col(1);
for var c := 0 to centers-1 do
begin Plot.Points(xs, ys, LabelsToInts(y), size := 4);
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;
end. end.

View file

@ -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.

View file

@ -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.

View file

@ -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.

View file

@ -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.

View file

@ -1 +1 @@
3.11.1.3768 3.11.1.3773

View file

@ -24,7 +24,17 @@
Delete "$INSTDIR\gacutil.exe.config" Delete "$INSTDIR\gacutil.exe.config"
Delete "$INSTDIR\gacutlrc.dll" Delete "$INSTDIR\gacutlrc.dll"
Delete "$INSTDIR\ExecHide.exe" Delete "$INSTDIR\ExecHide.exe"
WriteRegStr HKCU "${REGDIR}" "${INSTALLDIRREGKEY}" "$INSTDIR" 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" \ WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\PascalABCNET" \
"DisplayName" "PascalABC.NET" "DisplayName" "PascalABC.NET"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\PascalABCNET" \ WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\PascalABCNET" \

View file

@ -3,7 +3,7 @@
!include PascalABCNET_version.nsh !include PascalABCNET_version.nsh
!define REGDIR "Software\PascalABC.NET" !define REGDIR "Software\PascalABC.NET"
!define INSTALLDIRREGKEY "Install Directory" !define INSTALLDIRREGKEY "InstallDir"
!define UninstLog "uninstall.log" !define UninstLog "uninstall.log"
InstType $(DESC_Common) InstType $(DESC_Common)

View file

@ -1 +1 @@
!define VERSION '3.11.1.3768' !define VERSION '3.11.1.3773'

View file

@ -99,6 +99,9 @@ type
function Clone: Matrix; function Clone: Matrix;
function Row(i: integer) := data.Row(i);
function Col(j: integer) := data.Col(j);
function ColumnSums: Vector; function ColumnSums: Vector;
function RowSums: Vector; function RowSums: Vector;
function ColumnMeans: Vector; function ColumnMeans: Vector;

View file

@ -79,7 +79,21 @@ type
Datasets = MLDatasets.Datasets; Datasets = MLDatasets.Datasets;
/// Преобразует вектор меток классов в массив целых чисел.
/// Используется при визуализации и других задачах,
/// где метки должны быть представлены как 0,1,2,...
/// Значения округляются функцией Round, чтобы устранить
/// возможные небольшие численные ошибки
function LabelsToInts(y: Vector): array of integer;
implementation 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. end.

View file

@ -5,6 +5,10 @@ interface
uses DataFrameABC, LinearAlgebraML; uses DataFrameABC, LinearAlgebraML;
type type
/// Набор генераторов и загрузчиков датасетов для задач машинного обучения.
/// Содержит синтетические генераторы (MakeBlobs, MakeMoons, MakeRegression)
/// и реальные учебные датасеты (например, RussianHousing, StudentExam).
/// Используется в примерах, экспериментах и демонстрациях алгоритмов ML
Datasets = static class Datasets = static class
public public
// --- Синтетические датасеты (Matrix + Vector) // --- Синтетические датасеты (Matrix + Vector)
@ -23,33 +27,84 @@ type
centers: integer := 3; centers: integer := 3;
clusterStd: real := 1.0; clusterStd: real := 1.0;
nFeatures: integer := 2; nFeatures: integer := 2;
seed: integer := -1 shuffle: boolean := true;
): (Matrix, Vector); seed: integer := -1): (Matrix, Vector);
/// Генерирует датасет "две луны" для демонстрации нелинейной классификации и кластеризации /// Генерирует синтетический датасет «две луны» (two interleaving moons),
/// часто используемый для демонстрации алгоритмов классификации и кластеризации.
/// Возвращает матрицу признаков X (n × 2) и вектор меток классов y (0 или 1).
///
/// • n — число генерируемых точек.
/// • noise — стандартное отклонение гауссовского шума, добавляемого к координатам.
/// • shuffle — перемешивать ли порядок объектов.
/// • seed — значение генератора случайных чисел (-1 означает использовать текущее время).
static function MakeMoons( static function MakeMoons(
n: integer := 300; n: integer := 300;
noise: real := 0.05; 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( static function MakeRegression(
n: integer := 300; n: integer := 300;
nFeatures: integer := 10;
noise: real := 0.1; 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( static function MakeCircles(
n: integer := 300; n: integer := 300;
noise: real := 0.05; 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( static function MakeSpiral(
n: integer := 300; n: integer := 300;
classes: integer := 2; 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) // --- DataFrame датасеты (реалистичные таблицы, считываемые из csv)
@ -80,7 +135,13 @@ uses MLExceptions;
const const
ER_PARAM_GT_ZERO = ER_PARAM_GT_ZERO =
'Параметр {0} должен быть > 0!!Parameter {0} must be > 0'; 'Параметр {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; function Normal(rnd: System.Random): real;
begin begin
var u1 := rnd.NextDouble; var u1 := rnd.NextDouble;
@ -99,7 +160,8 @@ end;
/// • seed — значение генератора случайных чисел (seed < 0 → случайный) /// • seed — значение генератора случайных чисел (seed < 0 → случайный)
static function Datasets.MakeBlobs( static function Datasets.MakeBlobs(
n: integer; centers: integer; n: integer; centers: integer;
clusterStd: real; nFeatures: integer; seed: integer): (Matrix, Vector); clusterStd: real; nFeatures: integer;
shuffle: boolean; seed: integer): (Matrix, Vector);
begin begin
if n <= 0 then if n <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n'); ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n');
@ -112,6 +174,248 @@ begin
if nFeatures <= 0 then if nFeatures <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nFeatures'); 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 := var actualSeed :=
if seed >= 0 then seed if seed >= 0 then seed
@ -119,61 +423,37 @@ begin
var rnd := new System.Random(actualSeed); var rnd := new System.Random(actualSeed);
var X := new Matrix(n, nFeatures); var X := new Matrix(n,2);
var y := new Vector(n); var y := new Vector(n);
// --- генерируем центры кластеров var idx := Arr(0..n-1);
var centersM := new Matrix(centers, nFeatures); if shuffle then
PABCSystem.Shuffle(idx, rnd);
for var c := 0 to centers - 1 do var perClass := n div classes;
for var j := 0 to nFeatures - 1 do
centersM[c,j] := rnd.NextDouble * 20 - 10;
// --- генерация точек for var c := 0 to classes-1 do
for var i := 0 to n - 1 do
begin begin
var c := rnd.Next(centers); for var i := 0 to perClass-1 do
y[i] := c; begin
var row := idx[c*perClass + i];
var u := i / perClass;
for var j := 0 to nFeatures - 1 do var r := radius * u;
X[i,j] := centersM[c,j] + clusterStd * Normal(rnd);
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; end;
Result := (X, y); Result := (X, y);
end; 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; static function Datasets.RussianHousing: DataFrame;
begin begin
Result := nil; Result := nil;

View file

@ -1653,13 +1653,22 @@ type
function Clone: ITransformer; function Clone: ITransformer;
end; end;
{$endregion Transformers} {$endregion Transformers}
{$region Utility functions}
/// Преобразует вектор меток классов в массив целых.
/// Предполагается, что значения y являются целыми
/// (0,1,2,...) и могут содержать небольшие
/// численные ошибки, поэтому используется Round.
function LabelsToInts(y: Vector): array of integer;
{$endregion Utility functions}
var var
/// Проверять ли входные данные моделей на NaN, Inf /// Проверять ли входные данные моделей на NaN, Inf
ValidateFiniteInputs := true; ValidateFiniteInputs := True;
implementation implementation
@ -8085,5 +8094,10 @@ begin
Result := t; Result := t;
end; end;
function LabelsToInts(y: Vector): array of integer;
begin
Result := ArrGen(y.Length, i -> Round(y[i]));
end;
end. end.

View file

@ -3208,6 +3208,12 @@ type
/// Функция для перевода сообщений об ошибках /// Функция для перевода сообщений об ошибках
function GetTranslation(message: string): string; function GetTranslation(message: string): string;
const __PascalABCDir = 'меняется на этапе компиляции';
/// Возвращает каталог запуска PascalABC.NET
/// (каталог, содержащий PascalABCNET.exe или консольный компилятор)
function PascalABCDirectory: string;
// ----------------------------------------------------- // -----------------------------------------------------
// Internal procedures for PABCRTL.dll // Internal procedures for PABCRTL.dll
@ -3312,6 +3318,58 @@ begin
Result := arr[0] Result := arr[0]
end; 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; constructor ZeroStepException.Create;
begin begin
inherited Create(GetTranslation(FOR_STEP_CANNOT_BE_EQUAL0)) inherited Create(GetTranslation(FOR_STEP_CANNOT_BE_EQUAL0))

View file

@ -112,6 +112,9 @@ type
color: ColorWPF? := nil; thickness: real := 2; legend: string := nil); color: ColorWPF? := nil; thickness: real := 2; legend: string := nil);
static procedure Points(x, y: array of real; static procedure Points(x, y: array of real;
color: ColorWPF? := nil; size: real := 6; marker: MarkerType := MarkerType.Circle; legend: string := nil); 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 procedure Heatmap(m: array[,] of real);
static function Grid(rows,cols: integer): Figure; static function Grid(rows,cols: integer): Figure;
@ -124,6 +127,7 @@ type
static procedure Title(s: string); static procedure Title(s: string);
static procedure XLabel(s: string); static procedure XLabel(s: string);
static procedure YLabel(s: string); static procedure YLabel(s: string);
static procedure SetLabels(title: string := ''; xlabel: string := ''; ylabel: string := '');
static procedure Clear; static procedure Clear;
@ -528,6 +532,21 @@ begin
end); end);
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; static procedure Plot.Clear;
begin begin
RunUI(() -> RunUI(() ->
@ -673,6 +692,28 @@ begin
end); end);
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); static procedure Plot.Heatmap(m: array[,] of real);
begin begin
RunUI(() -> RunUI(() ->