unit Unit_TKmeans;
interface
uses types, classes, Generics.Collections,
vcl.Graphics;
const
Infinity = 10000000;
type
/// <summary>
/// here it is just a simple pixel but can be more in future
/// </summary>
TClusterData =
record
DrawingColor: TColor;
x, y: Integer;
// tbd.
// ...
// ..
// .
end;
/// <summary>
/// here it can be just a simple pixel, in general we store the complete morginal data inside this list
/// </summary>
TRawData<T> =
class(TList<T>)
end;
/// <summary>
/// store the data now inside a cluster with a Centroid
/// </summary>
TCluster<T> =
record
/// <summary>
/// <para>
/// as of today T, but in future some other data type , depending
/// </para>
/// <para>
/// on future research :-)
/// </para>
/// </summary>
Center: T;
/// <summary>
/// the selected elements from out complete raw data
/// </summary>
ClusterElements: TArray<T>;
end;
/// <summary>
/// the cluster list
/// </summary>
TClusterList<T> =
class(TList < TCluster < T >> )
private
function GetItem(Aindex: Integer): TCluster<T>;
procedure SetItem(Aindex: Integer;
const Value: TCluster<T>);
public
property Items[Aindex: Integer]: TCluster<T>
Read GetItem
Write SetItem;
end;
/// <summary>
/// measure the distance according to this function
/// </summary
TDistanceMetricfunction < T >= reference
to
function(
const A, B: T): Double;
/// <summary>
/// result of this function could be the TColor value , but also
/// coordinates my have some impact in future ....
/// </summary
TCentroidfunction < T >= reference
to
function(
const A: T): Cardinal;
TKMeans<T> =
class
private
FClusteredData: TClusterList<T>;
FRawData: TRawData<T>;
FNumClusters: Integer;
FDistanceMetric:TDistanceMetricfunction<T>;
FCentroidfct: TCentroidfunction<T>;
FMaxIterations: Integer;
procedure SaveData(OutBitMap: TBitmap);
public
constructor Create(NumClusters: Integer;
DistanceMetric: TDistanceMetricfunction<T>;
Centroidfct: TCentroidfunction<T>; MaxIterations: Integer = 10);
procedure LoadData(SoureBitMap: TBitmap);
overload;
function FindNewClusterCentroids: Boolean;
procedure GroupData2NearestCluster;
end;
implementation
constructor TKMeans<T>.Create(NumClusters: Integer;
DistanceMetric: TDistanceMetricfunction<T>; Centroidfct: TCentroidfunction<T>;
MaxIterations: Integer = 10);
begin
FNumClusters := NumClusters;
FDistanceMetric := DistanceMetric;
FMaxIterations := MaxIterations;
FClusteredData := TClusterList<T>.Create;
FRawData := TRawData<T>.Create;
FDistanceMetric := DistanceMetric;
FCentroidfct := Centroidfct;
end;
function TKMeans<T>.FindNewClusterCentroids: Boolean;
var
i, j: Integer;
SelectedCluster: TCluster<T>;
OldCentroid: Cardinal;
ElementCount: Cardinal;
Centroid: Cardinal;
begin
for i := 0
to FClusteredData.Count - 1
do
begin
SelectedCluster := FClusteredData.Items[i];
ElementCount := length(SelectedCluster.ClusterElements);
OldCentroid := FCentroidfct(SelectedCluster.Center);
for j := low(SelectedCluster.ClusterElements)
to High(SelectedCluster.ClusterElements)
do
begin
Centroid := Centroid + FCentroidfct(SelectedCluster.ClusterElements[j]);
end;
Centroid := Round(Centroid / ElementCount);
end;
end;
procedure TKMeans<T>.GroupData2NearestCluster;
var
i, j: Integer;
closestCluster: Integer;
minDist: Double;
Dist: Double;
ReferenceClusterCenter: T;
RawDataItem: T;
UpdateCluster: TCluster<T>;
begin
/// loop all raw data elements
for j := 0
to FRawData.Count - 1
do
begin
RawDataItem := FRawData.Items[j];
closestCluster := -1;
minDist := Infinity;
// Find the nearest cluster
for i := 0
to FClusteredData.Count - 1
do
begin
Dist := FDistanceMetric(RawDataItem, FClusteredData[i].Center);
if Dist < minDist
then
begin
closestCluster := i;
minDist := Dist;
end;
end;
// these lines are wrong and do not compile, fix the code here !!!!
UpdateCluster := FClusteredData[closestCluster];
SetLength(UpdateCluster.ClusterElements,
length(UpdateCluster.ClusterElements) + 1);
UpdateCluster.ClusterElements[High(UpdateCluster.ClusterElements)] :=
FRawData[j];
FClusteredData[closestCluster] := UpdateCluster;
end;
end;
procedure TKMeans<T>.SaveData(OutBitMap: TBitmap);
var
x, y: Integer;
ClusterIndex: Integer;
closestCluster: Integer;
minDist: Double;
Dist: Double;
Cluster: TCluster<T>;
begin
// Loop through all the pixels in the output bitmap
for y := 0
to OutBitMap.Height - 1
do
begin
for x := 0
to OutBitMap.Width - 1
do
begin
closestCluster := -1;
minDist := Infinity;
// Find the index of the closest cluster to the current pixel
for ClusterIndex := 0
to FClusteredData.Count - 1
do
begin
Dist := FDistanceMetric(FRawData[x + y * OutBitMap.Width],
FClusteredData[ClusterIndex].Center);
if Dist < minDist
then
begin
closestCluster := ClusterIndex;
minDist := Dist;
end;
end;
// Assign the color of the closest cluster center to the current pixel
Cluster := FClusteredData[closestCluster];
// OutBitMap.Canvas.Pixels[x, y] := Cluster.Center.DrawingColor;
end;
end;
// Save the output bitmap to a file or show it in a GUI component
// For example, to save the bitmap to a file:
OutBitMap.SaveToFile('
output.bmp');
// Or, to show the bitmap in a TImage control:
// Image1.Picture.Assign(OutBitMap);
end;
procedure TKMeans<T>.LoadData(SoureBitMap: TBitmap);
var
x, y: Integer;
ClusterData: TClusterData;
begin
// Clear the old data
FRawData.Clear;
// Loop through all the pixels in the bitmap
for y := 0
to SoureBitMap.Height - 1
do
begin
for x := 0
to SoureBitMap.Width - 1
do
begin
// Create a TClusterData object for each pixel
ClusterData.DrawingColor := SoureBitMap.Canvas.Pixels[x, y];
ClusterData.x := x;
ClusterData.y := y;
// Add the TClusterData object to the FRawData list
FRawData.Add(ClusterData);
end;
end;
end;
{ TClusterList<T> }
function TClusterList<T>.GetItem(Aindex: Integer): TCluster<T>;
begin
Result :=
inherited Items[Aindex];
end;
procedure TClusterList<T>.SetItem(Aindex: Integer;
const Value: TCluster<T>);
begin
inherited Items[Aindex] := Value;
end;
end.