administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Добавлены примеры ML

Browse source 
Улучшены параметры синтетических датасетов

Метрики разнесены по трем классам

PlotML - сделан Surface и улучшены палитры
This commit is contained in:
Mikhalkovich Stanislav 2026-03-24 14:26:08 +03:00
parent 750902d09f
commit 7b1f89fb4c
21 changed files with 2018 additions and 199 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
InstallerSamples/MachineLearning/04_Models/01_RegressionBasic.pas Normal file
View file

@ -0,0 +1,40 @@
// Простейший пример линейной регрессии на синтетических данных.
//
// Датасет сгенерирован функцией MakeRegression:
// • признаки — случайные вещественные значения
// • зависимость — линейная комбинация признаков
// • добавлен небольшой гауссов шум
// • нелинейность отключена (nonlinearStrength = 0)
//
// Таким образом, модель полностью соответствует предположениям LinearRegression.
//
// Ожидаемый результат:
// • модель восстанавливает зависимость почти идеально
// • ошибка (MSE) близка к нулю
//
// Этот пример демонстрирует:
// • базовый pipeline регрессии (Fit → Predict → Metrics)
// • ситуацию "идеальной модели", когда данные линейны
// • нижнюю границу ошибки для линейных методов
uses MLABC;
begin
var (X, y) := Datasets.MakeRegression(
n := 300,
nFeatures := 10,
nInformative := 8,
noise := 0.1,
coefScale := 1.0,
bias := 0.0,
nonlinearStrength := 0.0,
shuffle := True,
seed := 42
);
var model := new LinearRegression;
model.Fit(X, y);
var yPred := model.Predict(X);
Println('LinearRegression MSE:', Metrics.MSE(y, yPred):0:4);
end.

91
InstallerSamples/MachineLearning/04_Models/02_RegressionRegularization.pas Normal file
View file

@ -0,0 +1,91 @@
// Пример влияния регуляризации (RidgeRegression) на линейную модель
// в задаче с большим числом признаков и относительно малым числом объектов.
//
// Датасет:
// • 20 признаков, из которых информативны только 3, остальные — шум
// • добавлен существенный гауссов шум (noise = 2.0)
// • зависимость остаётся линейной, но сигнал частично скрыт шумом
//
// Такая постановка приводит к переобучению:
// модель может подстраиваться под шум и случайные колебания признаков.
//
// Наблюдения:
//
// • LinearRegression:
// – достигает меньшей ошибки на обучающей выборке (лучше подгонка)
// – но заметно хуже работает на тесте (переобучение)
//
// • RidgeRegression:
// – даёт большую ошибку на обучении (штраф за коэффициенты)
// – но существенно лучше обобщает и снижает ошибку на тесте
//
// Интерпретация:
//
// • обычная линейная регрессия переобучается на шуме и лишних признаках
// • Ridge вводит L2-регуляризацию и "сжимает" коэффициенты модели
// • регуляризация подавляет влияние неинформативных признаков
// • в результате модель становится более устойчивой к новым данным
//
// Этот пример демонстрирует:
// • разницу между train и test ошибками как признак переобучения
// • влияние лишних признаков на качество модели
// • практическую пользу регуляризации в задачах с шумом и мультиколлинеарностью
uses MLABC;
function Normal(rnd: System.Random): real;
begin
var u1 := rnd.NextDouble;
var u2 := rnd.NextDouble;
if u1 < 1e-12 then
u1 := 1e-12;
Result := Sqrt(-2 * Ln(u1)) * Cos(2 * Pi * u2);
end;
begin
var (X, y) := Datasets.MakeRegression(
n := 100,
nFeatures := 20,
nInformative := 3,
noise := 2.0,
coefScale := 1.0,
bias := 0.0,
nonlinearStrength := 0.0,
shuffle := True,
seed := 42
);
// --- добавляем корреляцию
var rnd := new System.Random(1);
for var i := 0 to X.RowCount - 1 do
begin
X[i, 1] := X[i, 0] + 0.01 * Normal(rnd);
X[i, 2] := X[i, 0] - 0.01 * Normal(rnd);
end;
var (XTrain, XTest, yTrain, yTest) := Validation.TrainTestSplit(
X, y,
testRatio := 0.3,
seed := 42
);
var lr := new LinearRegression;
lr.Fit(XTrain, yTrain);
var ridge := new RidgeRegression(50.0);
ridge.Fit(XTrain, yTrain);
var yTrainLR := lr.Predict(XTrain);
var yTestLR := lr.Predict(XTest);
var yTrainRidge := ridge.Predict(XTrain);
var yTestRidge := ridge.Predict(XTest);
Println('--- Train ---');
Println($'Linear MSE: {Metrics.MSE(yTrain, yTrainLR),0:F4}');
Println($'Ridge MSE: {Metrics.MSE(yTrain, yTrainRidge),0:F4}');
Println;
Println('--- Test ---');
Println($'Linear MSE: {Metrics.MSE(yTest, yTestLR),0:F4}');
Println($'Ridge MSE: {Metrics.MSE(yTest, yTestRidge),0:F4}');
end.

90
InstallerSamples/MachineLearning/04_Models/03_RegressionCorrelated.pas Normal file
View file

@ -0,0 +1,90 @@
// В этом примере сравниваются три модели: LinearRegression, Ridge и ElasticNet.
// На обучении Linear даёт наименьшую ошибку, так как максимально подгоняет данные,
// но на тесте его ошибка резко растёт — это признак переобучения. Ridge слегка
// ухудшает качество на train, зато заметно снижает ошибку на test за счёт
// регуляризации (штрафа на величину коэффициентов). ElasticNet ведёт себя как
// компромисс: он тоже борется с переобучением и дополнительно может занулять
// часть коэффициентов, выполняя отбор признаков.
// По коэффициентам это видно особенно хорошо: у Linear они большие и нестабильные
// (из-за коррелированных признаков модель «раздувает» веса и компенсирует одни
// признаки другими). Ridge сглаживает веса — они становятся меньше и ближе друг
// к другу, что делает решение устойчивым. ElasticNet помимо сглаживания ещё и
// зануляет часть коэффициентов, оставляя только наиболее значимые признаки.
// Итог: Linear лучше подгоняет обучение, но переобучается; Ridge даёт лучший
// баланс и результат на тесте; ElasticNet — промежуточный вариант с эффектом
// отбора признаков.
uses MLABC;
uses System;
function Normal(rnd: Random): real;
begin
var u1 := rnd.NextDouble;
var u2 := rnd.NextDouble;
if u1 < 1e-12 then u1 := 1e-12;
Result := Sqrt(-2 * Ln(u1)) * Cos(2 * Pi * u2);
end;
begin
var (X, y) := Datasets.MakeRegression(
n := 100,
nFeatures := 20,
nInformative := 3,
noise := 2.0,
coefScale := 1.0,
bias := 0.0,
nonlinearStrength := 0.0,
shuffle := True,
seed := 42
);
// --- корреляция
var rnd := new Random(1);
for var i := 0 to X.RowCount - 1 do
begin
X[i, 1] := X[i, 0] + 0.01 * Normal(rnd);
X[i, 2] := X[i, 0] - 0.01 * Normal(rnd);
end;
var (XTrain, XTest, yTrain, yTest) := Validation.TrainTestSplit(
X, y, testRatio := 0.3, seed := 42
);
var lr := new LinearRegression;
lr.Fit(XTrain, yTrain);
var ridge := new RidgeRegression(50.0);
ridge.Fit(XTrain, yTrain);
var en := new ElasticNet(5.0, 0.2); // alpha, l1_ratio
en.Fit(XTrain, yTrain);
// --- предсказания
var yTrainLR := lr.Predict(XTrain);
var yTestLR := lr.Predict(XTest);
var yTrainRidge := ridge.Predict(XTrain);
var yTestRidge := ridge.Predict(XTest);
var yTrainEN := en.Predict(XTrain);
var yTestEN := en.Predict(XTest);
// --- вывод
Println('--- Train ---');
Println($'Linear MSE: {Metrics.MSE(yTrain, yTrainLR),0:F4}');
Println($'Ridge MSE: {Metrics.MSE(yTrain, yTrainRidge),0:F4}');
Println($'ElasticNet MSE: {Metrics.MSE(yTrain, yTrainEN),0:F4}');
Println;
Println('--- Test ---');
Println($'Linear MSE: {Metrics.MSE(yTest, yTestLR),0:F4}');
Println($'Ridge MSE: {Metrics.MSE(yTest, yTestRidge),0:F4}');
Println($'ElasticNet MSE: {Metrics.MSE(yTest, yTestEN),0:F4}');
{Println;
Println('Коэффициенты (первые 10):');
lr.Coefficients.ToArray.Take(10).Println;
ridge.Coefficients.ToArray.Take(10).Println;
en.Coefficients.ToArray.Take(10).Println;}
end.

60
InstallerSamples/MachineLearning/04_Models/04_RegressionNonlinear.pas Normal file
View file

@ -0,0 +1,60 @@
// В этом примере зависимость между признаками и целевой переменной
// специально сделана нелинейной. Линейная регрессия не умеет
// аппроксимировать такую зависимость, поэтому даёт большую ошибку
// и на обучении, и на тесте. Это не переобучение, а недообучение:
// модель слишком простая для задачи.
// RandomForest и GradientBoosting работают намного лучше,
// потому что деревья решений умеют моделировать сложные нелинейные связи.
// GradientBoosting показывает лучший результат,
// так как особенно хорошо приближает сложные зависимости.
uses MLABC;
begin
var (X, y) := Datasets.MakeRegression(
n := 300,
nFeatures := 2,
nInformative := 2,
noise := 0.1,
coefScale := 1.0,
bias := 0.0,
nonlinearStrength := 5.0, // КЛЮЧЕВОЕ !!!
shuffle := True,
seed := 42
);
var (XTrain, XTest, yTrain, yTest) := Validation.TrainTestSplit(
X, y, testRatio := 0.3, seed := 42
);
var lr := new LinearRegression;
lr.Fit(XTrain, yTrain);
var rf := new RandomForestRegressor(100);
rf.Fit(XTrain, yTrain);
var gb := new GradientBoostingRegressor(100);
gb.Fit(XTrain, yTrain);
var yTrainLR := lr.Predict(XTrain);
var yTestLR := lr.Predict(XTest);
var yTrainRF := rf.Predict(XTrain);
var yTestRF := rf.Predict(XTest);
var yTrainGB := gb.Predict(XTrain);
var yTestGB := gb.Predict(XTest);
Println('nonlinearStrength = 5.0');
Println;
Println('--- Train ---');
Println($'Linear MSE: {RegressionMetrics.MSE(yTrain, yTrainLR),0:F4}');
Println($'Forest MSE: {RegressionMetrics.MSE(yTrain, yTrainRF),0:F4}');
Println($'Boost MSE: {RegressionMetrics.MSE(yTrain, yTrainGB),0:F4}');
Println;
Println('--- Test ---');
Println($'Linear MSE: {RegressionMetrics.MSE(yTest, yTestLR),0:F4}');
Println($'Forest MSE: {RegressionMetrics.MSE(yTest, yTestRF),0:F4}');
Println($'Boost MSE: {RegressionMetrics.MSE(yTest, yTestGB),0:F4}');
end.

74
InstallerSamples/MachineLearning/04_Models/05_ClassificationNonlinear.pas Normal file
View file

@ -0,0 +1,74 @@
// В датасете MakeMoons классы разделяются нелинейной границей.
// Поэтому LogisticRegression, строящая линейную разделяющую поверхность,
// показывает худший результат.
// DecisionTreeClassifier идеально подгоняет обучающую выборку,
// но на тесте заметно уступает, что указывает на переобучение.
// RandomForest и GradientBoosting значительно лучше работают
// с нелинейной структурой данных за счёт ансамблей деревьев.
// KNNClassifier показывает лучший результат на тесте,
// потому что это локальная модель, хорошо улавливающая
// сложную геометрию классов.
uses MLABC;
begin
var (X, y) := Datasets.MakeMoons(
n := 300,
noise := 0.2,
shuffle := True,
seed := 42
);
var (XTrain, XTest, yTrain, yTest) := Validation.TrainTestSplit(
X, y, testRatio := 0.3, seed := 42
);
var logreg := new LogisticRegression;
logreg.Fit(XTrain, yTrain);
var tree := new DecisionTreeClassifier;
tree.Fit(XTrain, yTrain);
var rf := new RandomForestClassifier(100);
rf.Fit(XTrain, yTrain);
var gb := new GradientBoostingClassifier(100);
gb.Fit(XTrain, yTrain);
var knn := new KNNClassifier(5);
knn.Fit(XTrain, yTrain);
// --- предсказания
var yTrainLR := logreg.Predict(XTrain);
var yTestLR := logreg.Predict(XTest);
var yTrainTree := tree.Predict(XTrain);
var yTestTree := tree.Predict(XTest);
var yTrainRF := rf.Predict(XTrain);
var yTestRF := rf.Predict(XTest);
var yTrainGB := gb.Predict(XTrain);
var yTestGB := gb.Predict(XTest);
var yTrainKNN := knn.Predict(XTrain);
var yTestKNN := knn.Predict(XTest);
// --- вывод accuracy
Println('--- Train ---');
Println($'Logistic Acc: {Metrics.Accuracy(yTrain, yTrainLR),0:F4}');
Println($'Tree Acc: {Metrics.Accuracy(yTrain, yTrainTree),0:F4}');
Println($'Forest Acc: {Metrics.Accuracy(yTrain, yTrainRF),0:F4}');
Println($'Boost Acc: {Metrics.Accuracy(yTrain, yTrainGB),0:F4}');
Println($'KNN Acc: {Metrics.Accuracy(yTrain, yTrainKNN),0:F4}');
Println;
Println('--- Test ---');
Println($'Logistic Acc: {Metrics.Accuracy(yTest, yTestLR),0:F4}');
Println($'Tree Acc: {Metrics.Accuracy(yTest, yTestTree),0:F4}');
Println($'Forest Acc: {Metrics.Accuracy(yTest, yTestRF),0:F4}');
Println($'Boost Acc: {Metrics.Accuracy(yTest, yTestGB),0:F4}');
Println($'KNN Acc: {Metrics.Accuracy(yTest, yTestKNN),0:F4}');
end.

89
InstallerSamples/MachineLearning/04_Models/06_ClassificationLinear.pas.pas Normal file
View file

@ -0,0 +1,89 @@
// Линейно разделимая задача с шумом.
// LogisticRegression показывает наилучший результат,
// так как модель соответствует природе данных.
//
// DecisionTree переобучается (рваная граница) → хуже на тесте.
// RandomForest снижает переобучение и приближается к Logistic.
// KNN чувствителен к шуму и даёт промежуточный результат.
//
// Logistic Acc: 0.8733
// Tree Acc: 0.7800
// Forest Acc: 0.8467
// KNN Acc: 0.8533
uses MLABC, PlotML;
begin
// --- данные
var (X, y) := Datasets.MakeClassification(
n := 500,
nFeatures := 2,
nInformative := 2,
nRedundant := 0,
noise := 0.5,
classSep := 2.0,
flipProb := 0.1,
classBalance := 0.5,
shuffle := True,
seed := 1
);
var (XTrain, XTest, yTrain, yTest) :=
Validation.TrainTestSplit(X, y, testRatio := 0.3, seed := 1);
// --- модели
var logreg := new LogisticRegression;
logreg.Fit(XTrain, yTrain);
var tree := new DecisionTreeClassifier;
tree.Fit(XTrain, yTrain);
var rf := new RandomForestClassifier(100);
rf.Fit(XTrain, yTrain);
var knn := new KNNClassifier(5);
knn.Fit(XTrain, yTrain);
// --- предсказания (для визуализации)
var yLR := logreg.PredictLabels(X);
var yTree := tree.PredictLabels(X);
var yRF := rf.PredictLabels(X);
var yKNN := knn.PredictLabels(X);
// --- test предсказания
var yLR_test := logreg.PredictLabels(XTest);
var yTree_test := tree.PredictLabels(XTest);
var yRF_test := rf.PredictLabels(XTest);
var yKNN_test := knn.PredictLabels(XTest);
// --- метрики
var accLR := Metrics.Accuracy(yTest, yLR_test);
var accTree := Metrics.Accuracy(yTest, yTree_test);
var accRF := Metrics.Accuracy(yTest, yRF_test);
var accKNN := Metrics.Accuracy(yTest, yKNN_test);
Println($'Logistic Acc: {accLR,0:F4}');
Println($'Tree Acc: {accTree,0:F4}');
Println($'Forest Acc: {accRF,0:F4}');
Println($'KNN Acc: {accKNN,0:F4}');
Println;
// --- координаты
var x1 := X.Col(0);
var x2 := X.Col(1);
// --- визуализация
var fig := Plot.Grid(2, 2);
fig[0,0].Points(x1, x2, yLR, size := 5);
fig[0,0].Title := $'Logistic (acc={accLR,0:F3})';
fig[0,1].Points(x1, x2, yTree, size := 5);
fig[0,1].Title := $'Tree (acc={accTree,0:F3})';
fig[1,0].Points(x1, x2, yRF, size := 5);
fig[1,0].Title := $'Forest (acc={accRF,0:F3})';
fig[1,1].Points(x1, x2, yKNN, size := 5);
fig[1,1].Title := $'KNN (acc={accKNN,0:F3})';
end.

91
InstallerSamples/MachineLearning/04_Models/07_ClassificationLinearNoise.pas Normal file
View file

@ -0,0 +1,91 @@
// Линейно разделимая задача с шумом.
// Классы в целом разделяются почти прямой линией, но из-за шума
// и случайных выбросов граница получается неидеальной.
//
// LogisticRegression показывает наилучший результат,
// так как её линейная модель хорошо соответствует структуре данных.
//
// DecisionTree строит кусочно-постоянную (рваную) границу,
// переобучается на шуме и даёт худшее качество на тесте.
//
// RandomForest сглаживает переобучение дерева за счёт ансамбля,
// но всё равно уступает линейной модели на этой задаче.
//
// KNN хорошо улавливает локальную структуру,
// но чувствителен к шуму и поэтому даёт промежуточный результат.
//
// Визуализация показывает:
// • Logistic — почти прямая граница
// • Tree — рваная, переобученная
// • Forest — сглаженная версия дерева
// • KNN — локально адаптивная граница
uses MLABC, PlotML;
begin
// --- данные
var (X, y) := Datasets.MakeClassification(
n := 500,
nFeatures := 2,
nInformative := 2,
nRedundant := 0,
noise := 0.5,
classSep := 2.0,
flipProb := 0.1,
classBalance := 0.5,
shuffle := True,
seed := 1
);
var (XTrain, XTest, yTrain, yTest) :=
Validation.TrainTestSplit(X, y, testRatio := 0.3, seed := 1);
// --- модели
var logreg := new LogisticRegression;
logreg.Fit(XTrain, yTrain);
var tree := new DecisionTreeClassifier;
tree.Fit(XTrain, yTrain);
var rf := new RandomForestClassifier(100);
rf.Fit(XTrain, yTrain);
var knn := new KNNClassifier(5);
knn.Fit(XTrain, yTrain);
// --- accuracy на test
var accLR := Metrics.Accuracy(yTest, logreg.PredictLabels(XTest));
var accTree := Metrics.Accuracy(yTest, tree.PredictLabels(XTest));
var accRF := Metrics.Accuracy(yTest, rf.PredictLabels(XTest));
var accKNN := Metrics.Accuracy(yTest, knn.PredictLabels(XTest));
// --- область рисования
var x1 := X.Col(0);
var x2 := X.Col(1);
var yArr := y.ToIntArray;
var nx := 80;
var ny := 80;
// --- визуализация
var fig := Plot.Grid(2, 2);
// Logistic
fig[0,0].Surface(x1, x2, nx, ny, G -> logreg.PredictLabels(G),Palettes.Pastel);
fig[0,0].Points(x1, x2, yArr, size := 6);
fig[0,0].Title := $'Logistic (acc={accLR,0:F3})';
// Tree
fig[0,1].Surface(x1, x2, nx, ny, G -> tree.PredictLabels(G),Palettes.Pastel);
fig[0,1].Points(x1, x2, yArr, size := 6);
fig[0,1].Title := $'Tree (acc={accTree,0:F3})';
// Forest
fig[1,0].Surface(x1, x2, nx, ny, G -> rf.PredictLabels(G),Palettes.Pastel);
fig[1,0].Points(x1, x2, yArr, size := 6);
fig[1,0].Title := $'Forest (acc={accRF,0:F3})';
// KNN
fig[1,1].Surface(x1, x2, nx, ny, G -> knn.PredictLabels(G),Palettes.Pastel);
fig[1,1].Points(x1, x2, yArr, size := 6);
fig[1,1].Title := $'KNN (acc={accKNN,0:F3})';
end.

97
InstallerSamples/MachineLearning/04_Models/08_ClassificationCircles.pas Normal file
View file

@ -0,0 +1,97 @@
// Задача с концентрическими окружностями (MakeCircles).
// Классы вложены друг в друга, поэтому линейная разделяющая
// граница в принципе невозможна.
//
// LogisticRegression строит только линейную границу,
// поэтому полностью проваливается (сильное недообучение).
//
// DecisionTree способен моделировать нелинейную структуру,
// но делает это через разбиения по осям, из-за чего граница
// получается рваной и переобученной.
//
// RandomForest усредняет множество деревьев,
// сглаживает границу и даёт более устойчивый результат.
//
// KNNClassifier показывает лучший результат,
// так как является локальной моделью и хорошо восстанавливает
// форму вложенных областей.
//
// Визуализация наглядно показывает различия:
// • Logistic — почти прямая граница (не подходит)
// • Tree — "ступенчатая" структура (переобучение)
// • Forest — сглаженная версия дерева
// • KNN — наиболее близкая к истинной геометрии граница
uses MLABC, PlotML;
begin
// --- данные
var (X, y) := Datasets.MakeCircles(
n := 400,
noise := 0.2,
factor := 0.5,
classBalance := 0.5,
flipProb := 0.05,
scale := 3.0,
shuffle := True,
seed := 1
);
var (XTrain, XTest, yTrain, yTest) :=
Validation.TrainTestSplit(X, y, testRatio := 0.3, seed := 1);
// --- модели
var logreg := new LogisticRegression;
logreg.Fit(XTrain, yTrain);
var tree := new DecisionTreeClassifier(seed := 1);
tree.Fit(XTrain, yTrain);
var rf := new RandomForestClassifier(100, seed := 1);
rf.Fit(XTrain, yTrain);
var knn := new KNNClassifier(5);
knn.Fit(XTrain, yTrain);
// --- метрики
var accLR := Metrics.Accuracy(yTest, logreg.PredictLabels(XTest));
var accTree := Metrics.Accuracy(yTest, tree.PredictLabels(XTest));
var accRF := Metrics.Accuracy(yTest, rf.PredictLabels(XTest));
var accKNN := Metrics.Accuracy(yTest, knn.PredictLabels(XTest));
Println('--- Circles ---');
Println($'Logistic Acc: {accLR,0:F4}');
Println($'Tree Acc: {accTree,0:F4}');
Println($'Forest Acc: {accRF,0:F4}');
Println($'KNN Acc: {accKNN,0:F4}');
// --- данные для визуализации
var x1 := X.Col(0);
var x2 := X.Col(1);
var yArr := y.ToIntArray;
var nx := 80;
var ny := 80;
// --- визуализация
var fig := Plot.Grid(2, 2);
// Logistic
fig[0,0].Surface(x1, x2, nx, ny, G -> logreg.PredictLabels(G),Palettes.Pastel);
fig[0,0].Points(x1, x2, yArr, size := 6);
fig[0,0].Title := $'Logistic (acc={accLR,0:F3})';
// Tree
fig[0,1].Surface(x1, x2, nx, ny, G -> tree.PredictLabels(G), Palettes.Pastel);
fig[0,1].Points(x1, x2, yArr, size := 6);
fig[0,1].Title := $'Tree (acc={accTree,0:F3})';
// Forest
fig[1,0].Surface(x1, x2, nx, ny, G -> rf.PredictLabels(G), Palettes.Pastel);
fig[1,0].Points(x1, x2, yArr, size := 6);
fig[1,0].Title := $'Forest (acc={accRF,0:F3})';
// KNN
fig[1,1].Surface(x1, x2, nx, ny, G -> knn.PredictLabels(G), Palettes.Pastel);
fig[1,1].Points(x1, x2, yArr, size := 6);
fig[1,1].Title := $'KNN (acc={accKNN,0:F3})';
end.

83
InstallerSamples/MachineLearning/04_Models/09_ClusteringDensityVsKMeans.pas Normal file
View file

@ -0,0 +1,83 @@
// Сравнение KMeans и DBSCAN на данных с шумом и разной плотностью кластеров.
//
// Датасет содержит:
// • несколько кластеров
// • различную плотность
// • дополнительные шумовые точки
//
// KMeans:
// • предполагает компактные и примерно одинаковые по размеру кластеры
// • плохо работает при наличии шума и различной плотности
// • стремится "размазать" шум по кластерам
//
// DBSCAN:
// • выделяет кластеры как области высокой плотности
// • естественно отделяет шум (метка -1)
// • лучше справляется с неоднородной структурой данных
//
// По метрике ARI DBSCAN показывает лучший результат,
// так как точнее восстанавливает истинную структуру кластеров.
//
// Этот пример демонстрирует различие двух подходов:
// • центроидный (KMeans)
// • плотностный (DBSCAN)
// KMeans ARI: 0.9073
// DBSCAN ARI: 0.9496
uses MLABC, PlotML;
begin
// --- данные (сложный случай: разная плотность + шум)
var (X, yTrue) := Datasets.MakeBlobs(
n := 400,
centers := 3,
nFeatures := 2,
clusterStd := 0.9,
clusterStdVar := 1.0,
centerBox := 6.0,
classBalance := 1.0,
noisePoints := 60,
shuffle := True,
seed := 1
);
// --- модели
var kmeans := new KMeans(3);
kmeans.Fit(X);
var yKM := kmeans.PredictLabels(X);
var db := new DBSCAN(0.7, 5);
db.Fit(X);
var yDB := db.PredictLabels(X);
// --- метрики
var ariKM := Metrics.AdjustedRandIndex(yTrue, yKM);
var ariDB := Metrics.AdjustedRandIndex(yTrue, yDB);
Println('--- Clustering ---');
Println($'KMeans ARI: {ariKM,0:F4}');
Println($'DBSCAN ARI: {ariDB,0:F4}');
Println;
// --- координаты
var x1 := X.Col(0);
var x2 := X.Col(1);
// --- визуализация
var fig := Plot.Grid(1, 2);
// KMeans
//fig[0,0].SetPalette(Palettes.Bright);
fig[0,0].Points(x1, x2, yKM, size := 6);
fig[0,0].Title := $'KMeans (ARI={ariKM,0:F3})';
var yDB_plot := new integer[yDB.Length];
for var i := 0 to yDB.Length - 1 do
yDB_plot[i] := if yDB[i] = -1 then 0 else yDB[i] + 1;
// DBSCAN
//fig[0,1].SetPalette(Palettes.Bright);
fig[0,1].Points(x1, x2, yDB_plot, size := 6);
fig[0,1].Title := $'DBSCAN (ARI={ariDB,0:F3})';
end.

2
InstallerSamples/MachineLearning/08_Datasets/RussianCities/01_Info.pas
View file

@ -7,4 +7,6 @@ begin
df.Schema.Println;
df.PrintlnInfo;
df.PrintlnPreview(20);
end.

38
InstallerSamples/MachineLearning/08_Datasets/RussianCities/02_PointsByClaster.pas Normal file
View file

@ -0,0 +1,38 @@
uses MLABC, PlotML;
begin
var ds := Datasets.RussianCities;
var df := ds.Data;
// --- признаки
df := df.WithColumnFloat('density', row -> row.Float('population') / row.Float('area'));
df := df.WithColumnInt('age', row -> 2026 - row.Int('foundation_year'));
df := df.WithColumnFloat('log_population', row -> Ln(row.Float('population')));
var features := ['log_population', 'density', 'lat', 'lon'{, 'age'}];
// --- кластеризация
var X := df.ToMatrix(features);
var km := new KMeans(5, seed := 42);
km.Fit(X);
var labels: array of integer := km.PredictLabels(X);
df.AddIntColumn('cluster', labels, nil);
// --- координаты
var lon := df.ToVector('lon').ToArray;
var lat := df.ToVector('lat').ToArray;
Plot.Points(
lon,
lat,
labels,
size := 5,
marker := MarkerType.Circle
);
Plot.XLabel('Долгота');
Plot.YLabel('Широта');
Plot.Title := 'Кластеры городов России';
end.

150
InstallerSamples/MachineLearning/08_Datasets/RussianCities/03_Clusters_KMeans.pas Normal file
View file

@ -0,0 +1,150 @@
// По log_population, density KMeans выделил три группы городов с разным масштабом и характером.
//
// Кластер 0 — крупнейшие и наиболее значимые города.
// Здесь сосредоточены мегаполисы и крупные региональные центры.
// Для них характерны большое население, сравнительно высокая плотность и в среднем более крупная площадь.
//
// Кластер 1 — компактные, но плотные города.
// Их немного, население у них умеренное, зато площадь очень мала, поэтому плотность населения максимальна.
// Это особая группа "сжатых" городов с городской концентрацией.
//
// Кластер 2 — малые и средние города.
// Это самый массовый кластер.
// Для него характерны небольшое население, низкая плотность и сравнительно умеренная площадь.
// Именно он отражает "обычный" фон большинства российских городов.
uses MLABC;
begin
var ds := Datasets.RussianCities;
var df := ds.Data;
// --- признаки
df := df.WithColumnFloat('density', row -> row.Float('population') / row.Float('area'));
df := df.WithColumnInt('age', row -> 2025 - row.Int('foundation_year'));
df := df.WithColumnFloat('log_population', row -> Ln(row.Float('population')));
var features := ['log_population', 'density'{, 'lat', 'lon', 'age'}];
Println('Подбор числа кластеров для KMeans');
Println;
Println('k inertia silhouette calinski_harabasz davies_bouldin');
Println('-' * 78);
var sils := new List<real>;
var chs := new List<real>;
var dbis := new List<real>;
foreach var k in 2..8 do
begin
var model := new KMeans(k, seed := 42);
var pipe :=
UDataPipeline.Build(
features,
new StandardScaler,
model
);
pipe.Fit(df);
var labels := pipe.PredictLabels(df);
var dfT := pipe.Transform(df);
var X := dfT.ToMatrix(features);
var inertia := model.Inertia;
var sil := Metrics.SilhouetteScore(X, labels);
var ch := Metrics.CalinskiHarabaszScore(X, labels);
var dbi := Metrics.DaviesBouldinScore(X, labels);
sils.Add(sil);
chs.Add(ch);
dbis.Add(dbi);
Println($'{k,-4} {inertia,12:F3} {sil,14:F4} {ch,20:F3} {dbi,18:F4}');
end;
// границы
var sil_min := sils.Min; var sil_max := sils.Max;
var ch_min := chs.Min; var ch_max := chs.Max;
var dbi_min := dbis.Min; var dbi_max := dbis.Max;
// второй проход
var bestScore := -1e9;
var bestK := -1;
for var i := 0 to sils.Count - 1 do
begin
var sil_norm := (sils[i] - sil_min) / (sil_max - sil_min);
var ch_norm := (chs[i] - ch_min) / (ch_max - ch_min);
var dbi_norm := (dbi_max - dbis[i]) / (dbi_max - dbi_min);
var score := 0.5 * sil_norm + 0.3 * ch_norm + 0.2 * dbi_norm;
var k := i + 2;
if score > bestScore then
begin
bestScore := score;
bestK := k;
end;
end;
Println;
Println($'Лучший k: {bestK}');
Println;
var model := new KMeans(bestK, seed := 42);
// --- финальная модель
var pipe :=
UDataPipeline.Build(
features,
new StandardScaler,
model
);
pipe.Fit(df);
var labels := pipe.PredictLabels(df);
var X := df.ToMatrix(features);
df.AddIntColumn('cluster', labels, nil);
Println('Финальные метрики для выбранного k:');
Println($'Inertia: {model.Inertia:F3}');
Println($'SilhouetteScore: {Metrics.SilhouetteScore(X, labels):F4}');
Println($'CalinskiHarabasz: {Metrics.CalinskiHarabaszScore(X, labels):F3}');
Println($'DaviesBouldin: {Metrics.DaviesBouldinScore(X, labels):F4}');
Println;
Println('Центры кластеров (в стандартизованном пространстве признаков):');
model.ClusterCenters.Print;
Println;
// --- анализ кластеров
for var c := 0 to bestK - 1 do
begin
var sub := df.Filter(r -> r.Int('cluster') = c);
Println;
Println('=' * 70);
Println($'Кластер {c}');
Println('=' * 70);
Println($'Число городов: {sub.RowCount}');
Println($'Среднее население: {sub.Mean(''population''),0:F3}');
Println($'Средняя площадь: {sub.Mean(''area''),0:F3}');
Println($'Средняя плотность: {sub.Mean(''density''),0:F3}');
Println($'Средний возраст: {sub.Mean(''age''),0:F3}');
Println;
Println('Топ-10 по населению:');
sub.SortBy('population', descending := True)
.Select(['city', 'population', 'area', 'density', 'age'])
.Head(10)
.Print;
end;
end.

150
InstallerSamples/MachineLearning/08_Datasets/RussianCities/04_Clusters_DBScan.pas Normal file
View file

@ -0,0 +1,150 @@
// Подбор параметра eps для DBSCAN с использованием фильтрации и составного скоринга.
//
// Рассматривались различные значения eps и для каждого вычислялись:
// • число кластеров (k)
// • доля крупнейшего кластера (max%)
// • доля шума (noise%)
// • silhouette
//
// Наблюдения:
//
// • При увеличении eps происходит слияние кластеров.
// Уже при eps ≥ 0.6 практически все объекты попадают в один доминирующий кластер
// (max% ≈ 0.97–0.99), что делает разбиение вырожденным.
//
// • Несмотря на высокий silhouette (например, при eps = 0.8),
// такие решения не являются содержательно корректными,
// так как фактически отражают почти однородную структуру данных.
//
// • Фильтрация отбрасывает варианты с:
// – одним кластером,
// – слишком большим доминирующим кластером,
// – некорректным уровнем шума.
//
// • В результате единственным допустимым вариантом оказался eps = 0.2.
//
// Интерпретация результата:
//
// • При eps = 0.2 алгоритм выделяет несколько кластеров (k = 5),
// однако структура получается фрагментированной:
// присутствует один крупный кластер и несколько очень малых,
// а также заметная доля шума.
//
// • Это говорит о том, что:
// – DBSCAN плохо согласуется с геометрией данного датасета,
// – либо признаки недостаточно разделимы по плотности,
// – либо требуется более аккуратный подбор параметров (eps, minPts),
// или использование другой модели кластеризации.
//
// Вывод:
//
// • DBSCAN в данном виде не даёт устойчивого и интерпретируемого разбиения.
// • Жёсткая фильтрация позволяет избежать вырожденных решений,
// но может приводить к выбору некачественного eps.
// • Для данного датасета более предпочтительны методы типа KMeans,
// либо требуется дополнительная предобработка признаков.
uses MLABC;
begin
var ds := Datasets.RussianCities;
var df := ds.Data;
df := df.WithColumnFloat('density', r -> r.Float('population') / r.Float('area'));
df := df.WithColumnFloat('log_population', r -> Ln(r.Float('population')));
df := df.WithColumnInt('age', row -> 2025 - row.Int('foundation_year'));
var features := ['log_population', 'density'];
Println('Подбор eps для DBSCAN (с фильтрацией)');
Println;
Println('eps k max% noise% silhouette score');
Println('-' * 70);
var X := df.ToMatrix(features);
var scaler := new StandardScaler;
scaler.Fit(X);
X := scaler.Transform(X);
var bestEps := -1.0;
var bestScore := -1.0;
foreach var eps in [0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0] do
begin
var model := new DBSCAN(eps, 5);
model.Fit(X);
var labels := model.PredictLabels(X);
var counts := new Dictionary<integer, integer>();
foreach var l in labels do
counts[l] := counts.Get(l, 0) + 1;
var n := df.RowCount;
// --- считаем кластеры (без шума)
var k := 0;
var maxCluster := 0;
var noise := counts.Get(-1, 0);
foreach var kv in counts do
if kv.Key <> -1 then
begin
k += 1;
if kv.Value > maxCluster then
maxCluster := kv.Value;
end;
var maxFrac := maxCluster / n;
var noiseFrac := noise / n;
var sil := -1.0;
if k >= 2 then
sil := Metrics.SilhouetteScore(X, labels);
// --- фильтрация плохих случаев
var valid :=
(k >= 2) and (k <= 5) and
(maxFrac < 0.85) and
(noiseFrac > 0.01) and (noiseFrac < 0.4);
var score := -1.0;
if valid then
begin
// составной скоринг
score :=
sil
- 0.5 * maxFrac // штраф за доминирующий кластер
- 0.3 * noiseFrac; // штраф за шум
if score > bestScore then
begin
bestScore := score;
bestEps := eps;
end;
end;
Println($'{eps,4:F1} {k,4} {maxFrac,7:F2} {noiseFrac,8:F2} {sil,12:F4} {score,10:F4}');
end;
Println;
Println($'Выбран eps: {bestEps,0:F2}');
Println;
// --- финальная модель
var model := new DBSCAN(bestEps, 5);
model.Fit(X);
var labels := model.PredictLabels(X);
df.AddIntColumn('cluster_db', labels, nil);
// --- итог
var counts := new Dictionary<integer, integer>();
foreach var l in labels do
counts[l] := counts.Get(l, 0) + 1;
Println('Финальные кластеры:');
foreach var kv in counts do
Println($'Cluster {kv.Key}: {kv.Value}');
end.

2
InstallerSamples/MachineLearning/08_Datasets/_Synthetic/05_MakeSpiral.pas
View file

@ -12,5 +12,5 @@ begin
);
Plot.Title('MakeSpiral синтетический датасет');
Plot.Points(X.Col(0), X.Col(1), LabelsToInts(y), size := 3);
Plot.Points(X.Col(0), X.Col(1), LabelsToInts(y), size := 5);
end.

9
bin/Lib/LinearAlgebraML.pas
View file

@ -31,6 +31,7 @@ type
function Clone: Vector;
function ToArray: array of real;
function ToIntArray: array of integer;
static function operator +(a, b: Vector): Vector;
static function operator -(a, b: Vector): Vector;
@ -356,6 +357,14 @@ begin
Result := Copy(fdata);
end;
function Vector.ToIntArray: array of integer;
begin
Result := new integer[Length];
for var i := 0 to Length - 1 do
Result[i] := integer(Data[i]);
end;
function Vector.Clone: Vector;
begin
Result := new Vector(fdata);

5
bin/Lib/MLABC.pas
View file

@ -24,8 +24,11 @@ type
Validation = ValidationML.Validation;
ConfusionMatrix = MetricsABC.ConfusionMatrix;
Metrics = MetricsABC.Metrics;
ClassificationMetrics = MetricsABC.ClassificationMetrics;
RegressionMetrics = MetricsABC.RegressionMetrics;
ClusteringMetrics = MetricsABC.ClusteringMetrics;
ConfusionMatrix = MetricsABC.ConfusionMatrix;
DataPipeline = MLPipelineABC.DataPipeline;

2
bin/Lib/MLCoreABC.pas
View file

@ -64,6 +64,8 @@ type
/// Наследуется от IModel.
/// Предназначен для моделей, выполняющих классификацию (предсказание меток классов).
IClassifier = interface(ISupervisedModel)
/// Возвращает метки классов
function PredictLabels(X: Matrix): array of integer;
end;
/// Интерфейс классификатора, возвращающего вероятности.

418
bin/Lib/MLDatasets.pas
View file

@ -68,20 +68,29 @@ type
static Language: string := 'ru';
// --- Синтетические датасеты (Matrix + Vector)
/// Генерирует синтетический датасет из нескольких гауссовых кластеров.
/// Возвращает матрицу признаков X и вектор меток кластеров y.
/// Генерирует синтетический датасет из гауссовых кластеров.
/// Каждый кластер задаётся центром и разбросом. Используется для задач кластеризации и классификации.
///
/// Параметры:
/// • n — количество объектов (точек)
/// • n — число объектов
/// • centers — число кластеров
/// • clusterStd — стандартное отклонение точек внутри кластера
/// • nFeatures — число признаков (размерность пространства)
/// • seed — значение генератора случайных чисел (seed < 0 → случайный)
/// • nFeatures — размерность пространства
/// • clusterStd — базовое стандартное отклонение
/// • clusterStdVar — разброс std между кластерами (0 → одинаковые)
/// • centerBox — диапазон генерации центров [-centerBox, centerBox]
/// • classBalance — равномерность кластеров (0..1, 1 = равномерно)
/// • noisePoints — число шумовых точек (outliers)
/// • shuffle — перемешивание
/// • seed — генератор (seed < 0 → случайный)
static function MakeBlobs(
n: integer := 300;
centers: integer := 3;
clusterStd: real := 1.0;
nFeatures: integer := 2;
clusterStd: real := 1.0;
clusterStdVar: real := 0.0;
centerBox: real := 5.0;
classBalance: real := 1.0;
noisePoints: integer := 0;
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
@ -99,45 +108,57 @@ type
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
/// Генерирует синтетический датасет для задачи линейной регрессии.
/// Данные создаются по модели y = Xβ + ε, где X — матрица признаков,
/// β — случайный вектор коэффициентов, ε — гауссовский шум.
/// Генерирует синтетический датасет для задачи регрессии.
/// Данные создаются по модели y = Xβ + f(X) + ε, где:
/// X — матрица признаков,
/// β — вектор коэффициентов (часть признаков может быть неинформативной),
/// f(X) — добавочная нелинейная компонента,
/// ε — гауссовский шум.
/// Возвращает матрицу признаков X (n × nFeatures) и вектор целевой переменной y.
///
/// • n — число объектов.
/// • nFeatures — число признаков.
/// • noise — стандартное отклонение гауссовского шума, добавляемого к y.
/// • nFeatures — общее число признаков.
/// • nInformative — число информативных признаков (остальные имеют нулевые коэффициенты).
/// • noise — стандартное отклонение гауссовского шума.
/// • coefScale — масштаб коэффициентов β.
/// • bias — свободный член (смещение).
/// • nonlinearStrength — коэффициент нелинейной компоненты (например, квадрат первого признака).
/// • shuffle — перемешивать ли порядок объектов.
/// • seed — значение генератора случайных чисел (-1 означает использовать текущее время).
static function MakeRegression(
n: integer := 300;
nFeatures: integer := 10;
nInformative: integer := 5;
noise: real := 0.1;
coefScale: real := 1.0;
bias: real := 0.0;
nonlinearStrength: real := 0.0;
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
/// Генерирует синтетический датасет из двух концентрических окружностей.
/// Используется для демонстрации задач классификации и кластеризации,
/// где граница разделения является нелинейной.
/// Используется для демонстрации задач классификации и кластеризации, в которых граница разделения является нелинейной.
///
/// Датасет состоит из двух классов:
/// внешний круг (класс 0) и внутренний круг (класс 1).
/// При добавлении шума точки отклоняются от идеальной окружности.
/// Датасет состоит из двух классов: внешний круг (класс 0) и внутренний круг (класс 1)
///
/// Параметры позволяют управлять сложностью задачи:
/// • noise — отклонение точек от идеальной окружности
/// • factor — отношение радиусов внутреннего и внешнего круга
/// • classBalance — доля объектов внутреннего круга
/// • flipProb — вероятность случайной инверсии метки
/// • scale — общий масштаб (радиус внешнего круга)
///
/// Полезен для демонстрации:
/// • преимуществ нелинейных моделей (RandomForest, GradientBoosting, kNN)
/// • работы DBSCAN и спектральной кластеризации
/// • ограничений линейных моделей (LogisticRegression, LinearSVM).
///
/// • n — число объектов.
/// • noise — стандартное отклонение гауссовского шума, добавляемого к координатам.
/// • factor — отношение радиуса внутреннего круга к внешнему (0 < factor < 1).
/// • shuffle — перемешивать ли порядок объектов.
/// • seed — значение генератора случайных чисел (-1 означает использовать текущее время)
/// • ограничений линейных моделей (LogisticRegression, LinearSVM)
/// • преимуществ нелинейных моделей (DecisionTree, RandomForest, kNN)
/// • методов кластеризации (DBSCAN, Spectral Clustering)
static function MakeCircles(
n: integer := 300;
noise: real := 0.05;
factor: real := 0.5;
classBalance: real := 0.5;
flipProb: real := 0.0;
scale: real := 1.0;
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
@ -161,6 +182,31 @@ type
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
/// Генерирует синтетический датасет для задачи классификации.
/// Формирует линейно (или почти линейно) разделимые классы с контролируемым шумом.
///
/// • n — число объектов.
/// • nFeatures — общее число признаков.
/// • nInformative — число информативных признаков.
/// • nRedundant — число линейно зависимых признаков.
/// • noise — уровень шума в модели.
/// • classSep — расстояние между классами.
/// • flipProb — вероятность случайной смены метки (label noise).
/// • classBalance — доля класса 1 (0..1).
/// • shuffle — перемешивание объектов.
/// • seed — генератор случайных чисел (-1 → авто)
static function MakeClassification(
n: integer := 300;
nFeatures: integer := 10;
nInformative: integer := 5;
nRedundant: integer := 2;
noise: real := 0.1;
classSep: real := 1.0;
flipProb: real := 0.0;
classBalance: real := 0.5;
shuffle: boolean := true;
seed: integer := -1): (Matrix, Vector);
/// Загружает датасет по имени.
///
/// Датасет ищется в каталоге:
@ -260,6 +306,12 @@ const
'ValueCounts доступны только для задач классификации!!ValueCounts are only available for classification datasets';
ER_DATASET_TARGET_MISSING =
'Target обязателен для задач обучения с учителем!!Target is required for supervised learning datasets';
ER_PARAM_LE =
'Параметр {0} должен быть <= допустимого максимума!!Parameter {0} must be <= the allowed maximum value';
ER_PARAM_RANGE_01 =
'Параметр {0} должен быть в диапазоне (0, 1)!!Parameter {0} must be in range (0, 1)';
ER_PARAM_LT =
'Параметр {0} должен быть меньше допустимого значения!!Parameter {0} must be less than allowed value';
C_DATASET = 'Датасет: {0}!!Dataset: {0}';
C_DESCRIPTION = 'Описание:!!Description:';
@ -480,9 +532,10 @@ end;
//-----------------------------
static function Datasets.MakeBlobs(
n: integer; centers: integer;
clusterStd: real; nFeatures: integer;
shuffle: boolean; seed: integer): (Matrix, Vector);
n, centers, nFeatures: integer;
clusterStd, clusterStdVar, centerBox, classBalance: real;
noisePoints: integer; shuffle: boolean;
seed: integer): (Matrix, Vector);
begin
if n <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n');
@ -490,43 +543,115 @@ begin
if centers <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'centers');
if clusterStd <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'clusterStd');
if nFeatures <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nFeatures');
if clusterStd <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'clusterStd');
if clusterStdVar < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'clusterStdVar');
if centerBox <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'centerBox');
if (classBalance <= 0) or (classBalance > 1) then
ArgumentOutOfRangeError(ER_PARAM_RANGE_01, 'classBalance');
if noisePoints < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noisePoints');
if noisePoints >= n then
ArgumentOutOfRangeError(ER_PARAM_LT, 'noisePoints');
var actualSeed :=
if seed >= 0 then seed
else System.Environment.TickCount and integer.MaxValue;
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;
centersM[c, j] := (rnd.NextDouble * 2 - 1) * centerBox;
// --- индексы строк
// --- std по кластерам
var stds := new real[centers];
for var c := 0 to centers - 1 do
stds[c] := clusterStd * (1 + clusterStdVar * (2 * rnd.NextDouble - 1));
// --- вероятности кластеров
var probs := new real[centers];
if classBalance = 1 then
begin
for var c := 0 to centers - 1 do
probs[c] := 1.0 / centers;
end
else
begin
var sum := 0.0;
for var c := 0 to centers - 1 do
begin
var p := Power(rnd.NextDouble, 1 / classBalance);
probs[c] := p;
sum += p;
end;
for var c := 0 to centers - 1 do
probs[c] /= sum;
end;
// --- CDF
var cdf := new real[centers];
cdf[0] := probs[0];
for var c := 1 to centers - 1 do
cdf[c] := cdf[c-1] + probs[c];
// --- индексы
var idx := Arr(0..n - 1);
if shuffle then
PABCSystem.Shuffle(idx, rnd);
// --- генерация точек
for var i := 0 to n - 1 do
var mainCount := n - noisePoints;
// --- генерация
for var i := 0 to mainCount - 1 do
begin
var row := idx[i];
var c := rnd.Next(centers);
// --- выбор кластера (inline вместо функции)
var r := rnd.NextDouble;
var c := 0;
while (c < centers - 1) and (r > cdf[c]) do
c += 1;
y[row] := c;
var std := stds[c];
for var j := 0 to nFeatures - 1 do
X[row, j] := centersM[c, j] + clusterStd * Normal(rnd);
X[row, j] := centersM[c, j] + std * Normal(rnd);
end;
// --- шум
for var i := mainCount to n - 1 do
begin
var row := idx[i];
y[row] := -1;
for var j := 0 to nFeatures - 1 do
X[row, j] := (rnd.NextDouble * 2 - 1) * centerBox;
end;
Result := (X, y);
@ -601,7 +726,11 @@ end;
static function Datasets.MakeRegression(
n: integer;
nFeatures: integer;
nInformative: integer;
noise: real;
coefScale: real;
bias: real;
nonlinearStrength: real;
shuffle: boolean;
seed: integer): (Matrix, Vector);
begin
@ -611,22 +740,36 @@ begin
if nFeatures <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nFeatures');
if nInformative < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'nInformative');
if nInformative > nFeatures then
nInformative := nFeatures;
if noise < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise');
if coefScale <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'coefScale');
var actualSeed :=
if seed >= 0 then seed
else System.Environment.TickCount and integer.MaxValue;
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);
if j < nInformative then
beta[j] := coefScale * Normal(rnd)
else
beta[j] := 0.0;
var idx := Arr(0..n - 1);
if shuffle then
@ -637,7 +780,7 @@ begin
begin
var row := idx[i];
var s := 0.0;
var s := bias;
for var j := 0 to nFeatures - 1 do
begin
@ -646,14 +789,25 @@ begin
s += xx * beta[j];
end;
// --- добавляем нелинейность (по первому признаку)
if nonlinearStrength <> 0 then
begin
var x0 := X[row, 0];
s += nonlinearStrength * x0 * x0;
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);
static function Datasets.MakeCircles(
n: integer;
noise, factor, classBalance, flipProb, scale: real;
shuffle: boolean;
seed: integer): (Matrix, Vector);
begin
if n <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'n');
@ -662,57 +816,62 @@ begin
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise');
if (factor <= 0) or (factor >= 1) then
ArgumentOutOfRangeError(ER_PARAM_BETWEEN_01, 'factor');
ArgumentOutOfRangeError(ER_PARAM_RANGE_01, 'factor');
if (classBalance <= 0) or (classBalance >= 1) then
ArgumentOutOfRangeError(ER_PARAM_RANGE_01, 'classBalance');
if flipProb < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'flipProb');
if scale <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'scale');
var actualSeed :=
if seed >= 0 then seed
else System.Environment.TickCount and integer.MaxValue;
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);
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
for var i := 0 to n - 1 do
begin
var row := idx[i];
var t := 2*Pi*i/half + 0.1*Normal(rnd);
y[row] := 0;
// --- класс
var label1 := Ord(rnd.NextDouble < classBalance);
X[row, 0] := Cos(t);
X[row, 1] := Sin(t);
// --- радиус
var r :=
if label1 = 1 then
scale * factor
else
scale;
if noise > 0 then
begin
X[row, 0] += noise * Normal(rnd);
X[row, 1] += noise * Normal(rnd);
end;
end;
// --- угол
var angle := 2 * Pi * rnd.NextDouble;
// --- внутренний круг
for var i := half to n - 1 do
begin
var row := idx[i];
var t := 2*Pi*(i-half)/half + 0.1*Normal(rnd);
var xx := r * Cos(angle);
var yv := r * Sin(angle);
y[row] := 1;
// --- шум
xx += noise * Normal(rnd);
yv += noise * Normal(rnd);
X[row, 0] := factor * Cos(t);
X[row, 1] := factor * Sin(t);
X[row, 0] := xx;
X[row, 1] := yv;
if noise > 0 then
begin
X[row, 0] += noise * Normal(rnd);
X[row, 1] += noise * Normal(rnd);
end;
// --- flip labels
if rnd.NextDouble < flipProb then
label1 := 1 - label1;
y[row] := label1;
end;
Result := (X, y);
@ -775,6 +934,107 @@ begin
Result := (X, y);
end;
static function Datasets.MakeClassification(
n, nFeatures, nInformative, nRedundant: integer;
noise, classSep, flipProb, classBalance: 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 nInformative <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'nInformative');
if nInformative > nFeatures then
ArgumentOutOfRangeError(ER_PARAM_LE, 'nInformative');
if nRedundant < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'nRedundant');
if nInformative + nRedundant > nFeatures then
ArgumentOutOfRangeError(ER_PARAM_LE, 'nRedundant');
if noise < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'noise');
if classSep <= 0 then
ArgumentOutOfRangeError(ER_PARAM_GT_ZERO, 'classSep');
if (classBalance <= 0) or (classBalance >= 1) then
ArgumentOutOfRangeError(ER_PARAM_RANGE_01, 'classBalance');
if flipProb < 0 then
ArgumentOutOfRangeError(ER_PARAM_GE_ZERO, 'flipProb');
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 center := new Vector(nInformative);
for var j := 0 to nInformative - 1 do
center[j] := Normal(rnd);
// --- нормализуем направление, чтобы classSep имел предсказуемый смысл
var norm := 0.0;
for var j := 0 to nInformative - 1 do
norm += center[j] * center[j];
norm := Sqrt(norm);
if norm > 0 then
for var j := 0 to nInformative - 1 do
center[j] := center[j] / norm;
// --- индексы
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 label1 := Ord(rnd.NextDouble < classBalance);
var sign := if label1 = 1 then 1.0 else -1.0;
// --- информативные признаки:
// два класса имеют разные центры вдоль направления center
for var j := 0 to nInformative - 1 do
X[row, j] := Normal(rnd) + sign * classSep * center[j] + noise * Normal(rnd);
// --- редундантные признаки: линейные комбинации информативных
for var j := 0 to nRedundant - 1 do
begin
var s := 0.0;
for var k := 0 to nInformative - 1 do
s += Normal(rnd) * X[row, k];
X[row, nInformative + j] := s / nInformative;
end;
// --- шумовые признаки
for var j := nInformative + nRedundant to nFeatures - 1 do
X[row, j] := Normal(rnd);
// --- шум в метках
if rnd.NextDouble < flipProb then
label1 := 1 - label1;
y[row] := label1;
end;
Result := (X, y);
end;
function ParseTask(s: string): TaskType;
begin
case s.ToLower of

77
bin/Lib/MLModelsABC.pas
View file

@ -253,9 +253,18 @@ type
/// Возвращает массив меток классов в порядке столбцов PredictProba.
function GetClasses: array of real;
/// Возвращает вектор предсказанных классов.
/// Возвращает предсказанные классы для объектов из X.
/// Результат — вектор значений, где каждый элемент соответствует классу объекта.
/// Порядок элементов соответствует строкам матрицы X.
/// Требует предварительного вызова Fit.
function Predict(X: Matrix): Vector;
/// Возвращает предсказанные метки классов для объектов из X.
/// Каждый элемент результата — индекс класса (целое число).
/// Порядок элементов соответствует строкам матрицы X.
/// Требует предварительного вызова Fit.
function PredictLabels(X: Matrix): array of integer;
/// Показывает, была ли модель обучена.
/// Если false — вызов Predict или PredictProba приведет к ошибке.
property IsFitted: boolean read fFitted;
@ -469,6 +478,12 @@ type
/// Для каждого объекта возвращается класс, соответствующий листу дерева.
function Predict(X: Matrix): Vector; override;
/// Возвращает предсказанные метки классов для объектов из X.
/// Каждый элемент результата — индекс класса (целое число).
/// Порядок элементов соответствует строкам матрицы X.
/// Требует предварительного вызова Fit.
function PredictLabels(X: Matrix): array of integer;
/// Создает глубокую копию дерева классификации.
/// Копируется структура узлов, параметры и обученное состояние.
function Clone: IModel; override;
@ -725,6 +740,12 @@ type
/// Итоговый класс определяется большинством голосов или максимальной суммарной вероятностью.
function Predict(X: Matrix): Vector; override;
/// Возвращает предсказанные метки классов для объектов из X.
/// Каждый элемент результата — индекс класса (целое число).
/// Порядок элементов соответствует строкам матрицы X.
/// Требует предварительного вызова Fit.
function PredictLabels(X: Matrix): array of integer;
function PredictProba(X: Matrix): Matrix;
/// Создает глубокую копию случайного леса классификации.
@ -1016,6 +1037,8 @@ type
/// Возвращает исходные значения классов, а не внутренние индексы.
function Predict(X: Matrix): Vector;
function PredictLabels(X: Matrix): array of integer;
/// Возвращает вероятности принадлежности к каждому классу.
/// Размер результата: [nSamples x nClasses].
/// Вероятности получаются через softmax.
@ -1156,6 +1179,8 @@ type
/// Возвращает вектор предсказанных меток
function Predict(X: Matrix): Vector; override;
function PredictLabels(X: Matrix): array of integer;
/// Возвращает матрицу вероятностей размера (nSamples × nClasses).
/// Столбцы соответствуют классам в порядке, возвращаемом GetClasses()
function PredictProba(X: Matrix): Matrix;
@ -2699,6 +2724,16 @@ begin
end;
end;
function LogisticRegression.PredictLabels(X: Matrix): array of integer;
begin
var v := Predict(X);
Result := new integer[v.Length];
for var i := 0 to v.Length - 1 do
Result[i] := integer(v[i]);
end;
function LogisticRegression.ToString: string;
begin
Result :=
@ -3513,6 +3548,16 @@ begin
end;
end;
function DecisionTreeClassifier.PredictLabels(X: Matrix): array of integer;
begin
var v := Predict(X);
Result := new integer[v.Length];
for var i := 0 to v.Length - 1 do
Result[i] := integer(v[i]);
end;
function DecisionTreeClassifier.Clone: IModel;
begin
var m := new DecisionTreeClassifier(
@ -4311,6 +4356,16 @@ begin
Result := resultVec;
end;
function RandomForestClassifier.PredictLabels(X: Matrix): array of integer;
begin
var v := Predict(X);
Result := new integer[v.Length];
for var i := 0 to v.Length - 1 do
Result[i] := integer(v[i]);
end;
function RandomForestClassifier.PredictProba(X: Matrix): Matrix;
begin
if not fFitted then
@ -6194,6 +6249,16 @@ begin
end;
end;
function GradientBoostingClassifier.PredictLabels(X: Matrix): array of integer;
begin
var v := Predict(X);
Result := new integer[v.Length];
for var i := 0 to v.Length - 1 do
Result[i] := integer(v[i]);
end;
//-----------------------------
// KNNBase
//-----------------------------
@ -6512,6 +6577,16 @@ begin
end;
end;
function KNNClassifier.PredictLabels(X: Matrix): array of integer;
begin
var v := Predict(X);
Result := new integer[v.Length];
for var i := 0 to v.Length - 1 do
Result[i] := integer(v[i]);
end;
function KNNClassifier.PredictProba(X: Matrix): Matrix;
begin
if not fFitted then

269
bin/Lib/MetricsABC.pas
View file

@ -15,7 +15,7 @@ uses LinearAlgebraML;
type
/// Метрики оценки качества моделей машинного обучения
/// для задач регрессии и классификации.
/// для задач регрессии, классификации и кластеризации
Metrics = static class
public
/// Среднеквадратичная ошибка (MSE).
@ -49,7 +49,7 @@ type
/// Сильно штрафует уверенные, но ошибочные прогнозы.
/// Используется для моделей, возвращающих вероятности
/// (например, LogisticRegression).
static function LogLoss(yTrue, yProb: Vector): real;
static function LogLoss(yTrue, yPred: Vector): real;
// ---- ROC / AUC ----
@ -57,13 +57,13 @@ type
/// Возвращает кортеж из двух векторов:
/// FPR (доля ложных положительных)
/// и TPR (доля истинно положительных).
static function ROC(yTrue, yProb: Vector): (Vector, Vector);
static function ROC(yTrue, yPred: Vector): (Vector, Vector);
/// Площадь под ROC-кривой (AUC).
/// Значение от 0 до 1.
/// 0.5 — случайная модель,
/// 1 — идеальная модель.
static function AUC(yTrue, yProb: Vector): real;
static function AUC(yTrue, yPred: Vector): real;
/// Доля правильных предсказаний.
/// Показывает, какая часть объектов классифицирована верно.
@ -71,6 +71,18 @@ type
/// Пример: Accuracy = 0.9 означает 90% правильных ответов.
static function Accuracy(yTrue, yPred: Vector): real;
/// Доля правильных предсказаний.
/// Показывает, какая часть объектов классифицирована верно.
/// Удобна, когда классы примерно сбалансированы.
/// Пример: Accuracy = 0.9 означает 90% правильных ответов.
static function Accuracy(yTrue, yPred: array of integer): real;
/// Доля правильных предсказаний.
/// Показывает, какая часть объектов классифицирована верно.
/// Удобна, когда классы примерно сбалансированы.
/// Пример: Accuracy = 0.9 означает 90% правильных ответов.
static function Accuracy(yTrue: Vector; yPred: array of integer): real;
/// Точность (Precision) для положительного класса (1).
/// Среди всех объектов, которые модель предсказала как 1,
/// показывает долю действительно принадлежащих этому классу.
@ -203,6 +215,166 @@ type
function BalancedAccuracy: real;
end;
/// Метрики для оценки качества классификационных моделей
/// Используются когда целевая переменная является категорией (классом)
/// (например, определение вида цветка, спам/не спам, диагноз пациента)
ClassificationMetrics = static class
public
/// Доля правильных предсказаний (Accuracy)
/// Accuracy = (TP + TN) / (TP + TN + FP + FN)
/// Показывает долю верно классифицированных объектов
/// Удобна когда классы примерно сбалансированы
static function Accuracy(yTrue, yPred: Vector): real := Metrics.Accuracy(yTrue, yPred);
/// Доля правильных предсказаний (Accuracy)
/// Accuracy = (TP + TN) / (TP + TN + FP + FN)
/// Показывает долю верно классифицированных объектов
/// Удобна когда классы примерно сбалансированы
static function Accuracy(yTrue, yPred: array of integer): real := Metrics.Accuracy(yTrue, yPred);
/// Доля правильных предсказаний (Accuracy)
/// Accuracy = (TP + TN) / (TP + TN + FP + FN)
/// Показывает долю верно классифицированных объектов
/// Удобна когда классы примерно сбалансированы
static function Accuracy(yTrue: Vector; yPred: array of integer): real := Metrics.Accuracy(yTrue, yPred);
/// Точность (Precision) для положительного класса (1)
/// Precision = TP / (TP + FP)
/// Среди всех предсказанных положительных объектов показывает долю истинно положительных
/// Важна когда критичны ложные положительные результаты ("ложные тревоги")
static function Precision(yTrue, yPred: Vector): real := Metrics.Precision(yTrue, yPred);
/// Полнота (Recall) для положительного класса (1)
/// Recall = TP / (TP + FN)
/// Среди всех истинно положительных объектов показывает долю правильно найденных
/// Важна когда нежелательны пропуски положительных случаев (например, заболеваний)
static function Recall(yTrue, yPred: Vector): real := Metrics.Recall(yTrue, yPred);
/// F1-мера
/// F1 = 2 * (Precision * Recall) / (Precision + Recall)
/// Гармоническое среднее точности и полноты
/// Высока только когда оба показателя высоки
/// Особенно полезна при несбалансированных классах
static function F1(yTrue, yPred: Vector): real := Metrics.F1(yTrue, yPred);
/// Специфичность (Specificity / True Negative Rate)
/// Specificity = TN / (TN + FP)
/// Доля правильно предсказанных отрицательных объектов
/// Показывает способность модели корректно распознавать отрицательный класс
static function Specificity(yTrue, yPred: Vector): real := Metrics.Specificity(yTrue, yPred);
/// Сбалансированная точность (Balanced Accuracy)
/// Balanced Accuracy = (Recall + Specificity) / 2
/// Среднее арифметическое полноты и специфичности
/// Устойчива к дисбалансу классов
static function BalancedAccuracy(yTrue, yPred: Vector): real := Metrics.BalancedAccuracy(yTrue, yPred);
/// Логарифмическая функция потерь (LogLoss)
/// LogLoss = - (1/n) * Σ [yTrue * log(yProb) + (1 - yTrue) * log(1 - yProb)]
/// Оценивает качество вероятностных предсказаний
/// Сильно штрафует уверенные, но ошибочные прогнозы
/// Чем меньше значение, тем лучше модель
static function LogLoss(yTrue, yPred: Vector): real := Metrics.LogLoss(yTrue, yPred);
/// Построение ROC-кривой
/// Возвращает кортеж из двух векторов: FPR (ложноположительные) и TPR (истинноположительные)
/// Используется для визуализации качества бинарной классификации
static function ROC(yTrue, yPred: Vector): (Vector, Vector) := Metrics.ROC(yTrue, yPred);
/// Площадь под ROC-кривой (AUC)
/// Значение от 0 до 1:
/// 1.0 — идеальная модель
/// 0.5 — случайная модель
/// <0.5 — модель хуже случайной
static function AUC(yTrue, yPred: Vector): real := Metrics.AUC(yTrue, yPred);
end;
/// Метрики для оценки качества регрессионных моделей
/// Используются когда целевая переменная является непрерывным числом
/// (например, предсказание цены дома, температуры, возраста)
RegressionMetrics = static class
public
/// Среднеквадратичная ошибка (MSE)
/// MSE = (1/n) * Σ (yTrue - yPred)^2
/// Чувствительна к большим отклонениям и выбросам
/// Чем меньше значение, тем лучше модель
static function MSE(yTrue, yPred: Vector): real := Metrics.MSE(yTrue, yPred);
/// Корень из среднеквадратичной ошибки (RMSE)
/// RMSE = √MSE
/// Измеряется в тех же единицах, что и целевая переменная
/// Чем меньше значение, тем лучше модель
static function RMSE(yTrue, yPred: Vector): real := Metrics.RMSE(yTrue, yPred);
/// Средняя абсолютная ошибка (MAE)
/// MAE = (1/n) * Σ |yTrue - yPred|
/// Менее чувствительна к выбросам, чем MSE
/// Чем меньше значение, тем лучше модель
static function MAE(yTrue, yPred: Vector): real := Metrics.MAE(yTrue, yPred);
/// Коэффициент детерминации (R²)
/// R² = 1 - SS_res / SS_tot
/// Показывает долю дисперсии, объяснённую моделью
/// Значения:
/// 1.0 — идеальная модель
/// 0.0 — модель не лучше среднего
/// <0 — модель хуже простого среднего
static function R2(yTrue, yPred: Vector): real := Metrics.R2(yTrue, yPred);
end;
/// Метрики для оценки качества кластеризации
/// Используются когда нужно оценить, насколько хорошо объекты сгруппированы в кластеры
/// Делятся на:
/// - внутренние (без эталонных меток) — оценивают компактность и разделимость
/// - внешние (с эталонными метками) — сравнивают с правильным разбиением
ClusteringMetrics = static class
public
// ========== ВНУТРЕННИЕ МЕТРИКИ (без эталонных меток) ==========
/// Вычисляет силуэт (Silhouette) для каждой точки
/// Для каждой строки матрицы X возвращает значение s(i) в диапазоне [-1, 1]
/// s(i) ≈ 1 — точка хорошо сгруппирована в своём кластере
/// s(i) ≈ 0 — точка находится на границе между кластерами
/// s(i) < 0 — точка, вероятно, попала не в свой кластер
/// Требует как минимум 2 различных кластера
/// Сложность O(n²) — для умеренных размеров данных
static function SilhouetteSamples(X: Matrix; labels: Vector): Vector := Metrics.SilhouetteSamples(x, labels);
/// Вычисляет средний силуэт (Silhouette Score)
/// Возвращает среднее значение Silhouette по всем точкам
/// Чем ближе к 1 — тем лучше разделены кластеры
/// Значение около 0 означает пересечение кластеров
/// Отрицательное значение указывает на возможную ошибку кластеризации
static function SilhouetteScore(X: Matrix; labels: Vector): real := Metrics.SilhouetteScore(x, labels);
/// Индекс Калински–Харабаса (Calinski–Harabasz Index)
/// Возвращает отношение межкластерной дисперсии к внутрикластерной дисперсии
/// Чем больше значение — тем лучше разделены кластеры
/// Требует как минимум 2 кластера и n > k
/// Сложность O(n·p)
static function CalinskiHarabaszScore(X: Matrix; labels: Vector): real := Metrics.CalinskiHarabaszScore(x, labels);
/// Индекс Дэвиса–Булдина (Davies–Bouldin Index)
/// Чем меньше значение — тем лучше разделены кластеры
/// Минимальное значение 0 (идеальное разделение)
/// Требует минимум 2 кластера
/// Сложность O(n·p + k²·p)
static function DaviesBouldinScore(X: Matrix; labels: Vector): real := Metrics.DaviesBouldinScore(x, labels);
// ========== ВНЕШНИЕ МЕТРИКИ (с эталонными метками) ==========
/// Скорректированный индекс Рэнда (Adjusted Rand Index, ARI)
/// Сравнивает предсказанные кластеры с истинными метками
/// Основан на анализе всех пар объектов:
/// проверяет, совпадает ли решение алгоритма и истинная разметка
/// в вопросе "находятся ли две точки в одном кластере"
/// Значения:
/// 1.0 — идеальное совпадение кластеризации и истинных меток
/// 0.0 — случайное разбиение
/// <0 — хуже случайного
static function AdjustedRandIndex(yTrue, yPred: Vector): real := Metrics.AdjustedRandIndex(yTrue, yPred);
end;
implementation
uses MLExceptions;
@ -362,18 +534,18 @@ begin
Result := 1 - ssRes / ssTot;
end;
static function Metrics.LogLoss(yTrue, yProb: Vector): real;
static function Metrics.LogLoss(yTrue, yPred: Vector): real;
begin
if yTrue = nil then
ArgumentNullError(ER_ARG_NULL, 'yTrue');
if yProb = nil then
if yPred = nil then
ArgumentNullError(ER_ARG_NULL, 'yProb');
var n := yTrue.Length;
if n <> yProb.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yProb.Length);
if n <> yPred.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yPred.Length);
if n = 0 then
ArgumentError(ER_EMPTY_DATA, 'LogLoss');
@ -384,13 +556,13 @@ begin
for var i := 0 to n - 1 do
begin
var yt := yTrue[i];
var p := yProb[i];
var p := yPred[i];
if double.IsNaN(yt) or double.IsInfinity(yt) then
ArgumentError(ER_INVALID_VALUE, 'yTrue', i);
if double.IsNaN(p) or double.IsInfinity(p) then
ArgumentError(ER_INVALID_VALUE, 'yProb', i);
ArgumentError(ER_INVALID_VALUE, 'yPred', i);
if (yt <> 0.0) and (yt <> 1.0) then
ArgumentError(ER_INVALID_CLASS_LABEL, yt);
@ -404,18 +576,18 @@ begin
Result := -s / n;
end;
static function Metrics.ROC(yTrue, yProb: Vector): (Vector, Vector);
static function Metrics.ROC(yTrue, yPred: Vector): (Vector, Vector);
begin
if yTrue = nil then
ArgumentNullError(ER_ARG_NULL, 'yTrue');
if yProb = nil then
ArgumentNullError(ER_ARG_NULL, 'yProb');
if yPred = nil then
ArgumentNullError(ER_ARG_NULL, 'yPred');
var n := yTrue.Length;
if n <> yProb.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yProb.Length);
if n <> yPred.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yPred.Length);
if n = 0 then
ArgumentError(ER_EMPTY_DATA, 'ROC');
@ -426,13 +598,13 @@ begin
for var i := 0 to n - 1 do
begin
var yt := yTrue[i];
var p := yProb[i];
var p := yPred[i];
if double.IsNaN(yt) or double.IsInfinity(yt) then
ArgumentError(ER_INVALID_VALUE, 'yTrue', i);
if double.IsNaN(p) or double.IsInfinity(p) then
ArgumentError(ER_INVALID_VALUE, 'yProb', i);
ArgumentError(ER_INVALID_VALUE, 'yPred', i);
if (yt <> 0.0) and (yt <> 1.0) then
ArgumentError(ER_INVALID_CLASS_LABEL, yt);
@ -448,7 +620,7 @@ begin
var idx :=
(0..n-1)
.OrderByDescending(i -> yProb[i])
.OrderByDescending(i -> yPred[i])
.ToArray;
var tp := 0;
@ -477,23 +649,23 @@ begin
new Vector(tprList.ToArray));
end;
static function Metrics.AUC(yTrue, yProb: Vector): real;
static function Metrics.AUC(yTrue, yPred: Vector): real;
begin
if yTrue = nil then
ArgumentNullError(ER_ARG_NULL, 'yTrue');
if yProb = nil then
ArgumentNullError(ER_ARG_NULL, 'yProb');
if yPred = nil then
ArgumentNullError(ER_ARG_NULL, 'yPred');
var n := yTrue.Length;
if n <> yProb.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yProb.Length);
if n <> yPred.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yPred.Length);
if n = 0 then
ArgumentError(ER_EMPTY_DATA, 'AUC');
var (fpr, tpr) := ROC(yTrue, yProb);
var (fpr, tpr) := ROC(yTrue, yPred);
if fpr.Length <> tpr.Length then
DimensionError(ER_DIM_MISMATCH, fpr.Length, tpr.Length);
@ -546,6 +718,55 @@ begin
Result := correct / n;
end;
static function Metrics.Accuracy(yTrue, yPred: array of integer): real;
begin
if yTrue = nil then
ArgumentNullError(ER_ARG_NULL, 'yTrue');
if yPred = nil then
ArgumentNullError(ER_ARG_NULL, 'yPred');
var n := yTrue.Length;
if n <> yPred.Length then
DimensionError(ER_DIM_MISMATCH, yTrue.Length, yPred.Length);
if n = 0 then
ArgumentError(ER_EMPTY_DATA, 'Accuracy');
var correct := 0;
for var i := 0 to n - 1 do
if yTrue[i] = yPred[i] then
correct += 1;
Result := correct / n;
end;
static function Metrics.Accuracy(yTrue: Vector; yPred: array of integer): real;
begin
if yTrue = nil then
ArgumentNullError(ER_ARG_NULL, 'yTrue');
var data := yTrue.Data;
var n := data.Length;
if n <> yPred.Length then
DimensionError(ER_DIM_MISMATCH, n, yPred.Length);
if n = 0 then
ArgumentError(ER_EMPTY_DATA, 'Accuracy');
var correct := 0;
for var i := 0 to n - 1 do
if integer(data[i]) = yPred[i] then
correct += 1;
Result := correct / n;
end;
static function Metrics.Precision(yTrue, yPred: Vector): real;
begin
Result := ConfusionMatrix.Create(yTrue, yPred).Precision;

316
bin/Lib/PlotML.pas
View file

@ -36,21 +36,33 @@ const DefaultColor = default(ColorWPF);
type
MarkerType = (Circle, Box, Triangle, Diamond, Cross);
Palettes = static class
public
const &Default = 'default';
const Dark = 'dark';
const Pastel = 'pastel';
const Bright = 'bright';
const Muted = 'muted';
end;
Palette = class
public
Colors: array of Color;
constructor Create(params c: array of Color);
end;
PaletteWPF = Palette;
Palettes = static class
private
static paletteDict: Dictionary<string, Palette>;
static constructor;
static procedure InitPalettes;
public
static function &Default: Palette;
static function Pastel: Palette;
static function Dark: Palette;
static function Bright: Palette;
static function Muted: Palette;
static procedure Register(name: string; p: Palette);
static function Get(name: string): Palette;
end;
Figure = class;
Cell = class
@ -65,6 +77,7 @@ type
function NextColor: Color;
procedure EnsureChart;
procedure SetTitle(s: string);
public
constructor Create(g: GridWPF; r,c: integer);
@ -87,12 +100,16 @@ type
size: real := 6; marker: MarkerType := MarkerType.Circle);
procedure Hist(x: Vector; bins: integer := 0;
color: ColorWPF := DefaultColor; alpha: real := 0.7; legend: string := nil);
//procedure Surface(labels: array of integer; nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: PlotML.Palette := nil);
procedure Surface(x1, x2: array of real; nx, ny: integer; f: Matrix -> array of integer; pal: PlotML.Palette := nil);
procedure Heatmap(m: Matrix);
procedure Text(s: string; x: real := 0.5; y: real := 0.5);
procedure SetPalette(name: string);
procedure Title(s: string);
procedure SetPalette(p: PaletteWPF);
procedure XLabel(s: string);
procedure YLabel(s: string);
@ -101,6 +118,8 @@ type
procedure YLim(ymin,ymax: real);
procedure Clear;
property Title: string write SetTitle;
end;
Figure = class
@ -133,6 +152,12 @@ type
static procedure DrawHist(chart: ChartWPF; x: array of real;
bins: integer; color: ColorWPF; alpha: real; legend: string);
static procedure DrawSurface(chart: ChartWPF; labels: array of integer;
nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: Palette);
static function MakeGrid(xmin, xmax, ymin, ymax: real; nx, ny: integer): Matrix;
static procedure SetTitle(s: string);
public
static procedure AddSeries(chart: ChartWPF; series: UIElement);
@ -152,8 +177,11 @@ type
static procedure Heatmap(m: array[,] of real);
static procedure Surface(labels: array of integer; nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: PlotML.Palette := nil);
static procedure Surface(x1, x2: array of real; nx, ny: integer; f: Matrix -> array of integer; pal: PlotML.Palette := nil);
// с матрицами - векторами
// --- Vector overloads
static procedure LineGraph(x, y: Vector;
color: ColorWPF := DefaultColor; thickness: real := 2; legend: string := nil)
@ -180,14 +208,13 @@ type
static function Grid(rows,cols: integer): Figure;
static procedure SetPalette(name: string);
static procedure SetPalette(p: PaletteWPF);
static procedure EnsureAxes(chart: ChartWPF);
static procedure Limits(xmin,xmax,ymin,ymax: real);
static procedure XLim(xmin,xmax: real);
static procedure YLim(ymin,ymax: real);
static procedure Title(s: string);
static procedure XLabel(s: string);
static procedure YLabel(s: string);
static procedure SetLabels(title: string := ''; xlabel: string := ''; ylabel: string := '');
@ -195,6 +222,8 @@ type
static procedure Clear;
static procedure Save(filename: string);
static property Title: string write SetTitle;
end;
HistogramPlot = class(PlotWPF)
@ -218,6 +247,14 @@ type
property MaxCount: integer read fMaxCount;
end;
SurfacePlot = class(PlotWPF)
private
fRects: List<Polygon> := new List<Polygon>;
public
procedure SetData(labels: array of integer;
nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: Palette);
end;
implementation
var
@ -232,50 +269,31 @@ var
currentPalette: Palette;
rootPaletteIndex: integer := 0;
function CreateMarker(t: MarkerType): InteractiveDataDisplay.WPF.ColorSizeMarker;
static function Palettes.&Default: Palette := paletteDict['default'];
static function Palettes.Pastel: Palette := paletteDict['pastel'];
static function Palettes.Dark: Palette := paletteDict['dark'];
static function Palettes.Bright: Palette := paletteDict['bright'];
static function Palettes.Muted: Palette := paletteDict['muted'];
static constructor Palettes.Create;
begin
case t of
MarkerType.Circle: Result := new CircleMarker;
MarkerType.Box: Result := new BoxMarker;
MarkerType.Triangle: Result := new TriangleMarker;
MarkerType.Diamond: Result := new DiamondMarker;
MarkerType.Cross: Result := new CrossMarker;
end;
InitPalettes
end;
function NextRootColor: ColorWPF;
static procedure Palettes.Register(name: string; p: Palette);
begin
var c := currentPalette.Colors[
rootPaletteIndex mod currentPalette.Colors.Length
];
rootPaletteIndex += 1;
Result := c;
paletteDict[name] := p;
end;
function MakeHistogram(data: array of real; bins: integer): (array of real, array of real);
static function Palettes.Get(name: string): Palette;
begin
var xmin := data.Min;
var xmax := data.Max;
var h := (xmax-xmin)/bins;
var counts := new real[bins];
foreach var v in data do
begin
var k := integer((v-xmin)/h);
if k=bins then k := bins-1;
counts[k] += 1;
end;
var xs := ArrGen(bins, i -> xmin + (i+0.5)*h);
Result := (xs,counts);
Result := paletteDict[name];
end;
procedure InitPalettes;
static procedure Palettes.InitPalettes;
begin
if paletteDict <> nil then exit;
paletteDict := new Dictionary<string,Palette>;
paletteDict['default'] := new Palette(
@ -334,6 +352,50 @@ begin
currentPalette := paletteDict['default'];
end;
function CreateMarker(t: MarkerType): InteractiveDataDisplay.WPF.ColorSizeMarker;
begin
case t of
MarkerType.Circle: Result := new CircleMarker;
MarkerType.Box: Result := new BoxMarker;
MarkerType.Triangle: Result := new TriangleMarker;
MarkerType.Diamond: Result := new DiamondMarker;
MarkerType.Cross: Result := new CrossMarker;
end;
end;
function NextRootColor: ColorWPF;
begin
var c := currentPalette.Colors[
rootPaletteIndex mod currentPalette.Colors.Length
];
rootPaletteIndex += 1;
Result := c;
end;
function MakeHistogram(data: array of real; bins: integer): (array of real, array of real);
begin
var xmin := data.Min;
var xmax := data.Max;
var h := (xmax-xmin)/bins;
var counts := new real[bins];
foreach var v in data do
begin
var k := integer((v-xmin)/h);
if k=bins then k := bins-1;
counts[k] += 1;
end;
var xs := ArrGen(bins, i -> xmin + (i+0.5)*h);
Result := (xs,counts);
end;
procedure InitUI;
begin
uiThread := new Thread(() ->
@ -363,7 +425,7 @@ begin
uiDispatcher := Dispatcher.CurrentDispatcher;
InitPalettes;
Palettes.InitPalettes;
win.Show;
@ -401,16 +463,15 @@ begin
Result := c;
end;
procedure Cell.SetPalette(name: string);
procedure Cell.SetPalette(p: PaletteWPF);
begin
if paletteDict.ContainsKey(name) then
begin
palette := paletteDict[name];
paletteIndex := 0;
end;
if p = nil then exit;
palette := p;
paletteIndex := 0;
end;
procedure Cell.Title(s: string);
procedure Cell.SetTitle(s: string);
begin
Plot.RunUI(() ->
begin
@ -542,7 +603,7 @@ begin
var classes := labels.Distinct.ToArray;
&Array.Sort(classes);
var pal := CurrentPalette;
var pal := palette;
foreach var c in classes do
begin
@ -671,7 +732,7 @@ end;
var gridMode := false;
static procedure Plot.Title(s: string);
static procedure Plot.SetTitle(s: string);
begin
RunUI(() ->
begin
@ -970,12 +1031,13 @@ begin
Result := fig;
end;
static procedure Plot.SetPalette(name: string);
static procedure Plot.SetPalette(p: PaletteWPF);
begin
RunUI(() ->
begin
if name in paletteDict then
currentPalette := paletteDict[name];
if p = nil then exit;
currentPalette := p;
end);
end;
@ -1235,6 +1297,138 @@ begin
fMaxCount := counts.Max;
end;
procedure SurfacePlot.SetData(labels: array of integer;
nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: Palette);
begin
Children.Clear;
var dx := (xmax - xmin) / nx;
var dy := (ymax - ymin) / ny;
var k := 0;
for var iy := 0 to ny - 1 do
for var ix := 0 to nx - 1 do
begin
var lab := labels[k];
k += 1;
var clr := pal.Colors[Abs(lab) mod pal.Colors.Length];
var brush := new SolidColorBrush(clr);
var x0 := xmin + ix * dx;
var y0 := ymin + iy * dy;
var eps := dx * 0.01;
var x1 := x0 + dx + eps;
var y1 := y0 + dy + eps;
var poly := new Polygon;
var pts := new PointCollection;
pts.Add(new Point(x0, y0));
pts.Add(new Point(x0, y1));
pts.Add(new Point(x1, y1));
pts.Add(new Point(x1, y0));
PlotWPF.SetPoints(poly, pts);
poly.Fill := brush;
poly.StrokeThickness := 0;
Children.Add(poly);
end;
end;
static procedure Plot.DrawSurface(chart: ChartWPF;
labels: array of integer; nx, ny: integer;
xmin, xmax, ymin, ymax: real;
pal: Palette);
begin
EnsureAxes(chart);
var s := new SurfacePlot;
s.SetData(labels, nx, ny, xmin, xmax, ymin, ymax, pal);
AddSeries(chart, s);
end;
static function Plot.MakeGrid(xmin, xmax, ymin, ymax: real; nx, ny: integer): Matrix;
begin
Result := new Matrix(nx * ny, 2);
var k := 0;
for var iy := 0 to ny - 1 do
begin
var y := ymin + (ymax - ymin) * iy / (ny - 1);
for var ix := 0 to nx - 1 do
begin
var x := xmin + (xmax - xmin) * ix / (nx - 1);
Result[k, 0] := x;
Result[k, 1] := y;
k += 1;
end;
end;
end;
{procedure Cell.Surface(labels: array of integer; nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: PlotML.Palette);
begin
Plot.RunUI(() ->
begin
EnsureChart;
var usePal := if pal <> nil then pal else palette;
Plot.DrawSurface(chart, labels, nx, ny, xmin, xmax, ymin, ymax, usePal);
end);
end;}
procedure Cell.Surface(x1, x2: array of real; nx, ny: integer; f: Matrix -> array of integer; pal: PlotML.Palette);
begin
Plot.RunUI(() ->
begin
EnsureChart;
var xmin := x1.Min - 0.5;
var xmax := x1.Max + 0.5;
var ymin := x2.Min - 0.5;
var ymax := x2.Max + 0.5;
var G := Plot.MakeGrid(xmin, xmax, ymin, ymax, nx, ny);
var labels := f(G);
var usePal := if pal <> nil then pal else palette;
Plot.DrawSurface(chart, labels, nx, ny, xmin, xmax, ymin, ymax, usePal);
end);
end;
static procedure Plot.Surface(labels: array of integer; nx, ny: integer; xmin, xmax, ymin, ymax: real; pal: PlotML.Palette);
begin
RunUI(() ->
begin
var usePal := if pal <> nil then pal else CurrentPalette;
DrawSurface(rootChart, labels, nx, ny, xmin, xmax, ymin, ymax, usePal);
end);
end;
static procedure Plot.Surface(x1, x2: array of real; nx, ny: integer; f: Matrix -> array of integer; pal: PlotML.Palette);
begin
RunUI(() ->
begin
var xmin := x1.Min - 0.5;
var xmax := x1.Max + 0.5;
var ymin := x2.Min - 0.5;
var ymax := x2.Max + 0.5;
var G := MakeGrid(xmin, xmax, ymin, ymax, nx, ny);
var labels := f(G);
var usePal := if pal <> nil then pal else CurrentPalette;
DrawSurface(rootChart, labels, nx, ny, xmin, xmax, ymin, ymax, usePal);
end);
end;
initialization
InitUI;